OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

module.c (gfc_use_module): Uncomment the ISO_FORTRAN_ENV code. 

* module.c (gfc_use_module): Uncomment the ISO_FORTRAN_ENV code.
	Check that intrinsic and non-intrinsic modules don't conflict.
	(use_iso_fortran_env_module): New function.
	(create_int_parameter): New function.
	* trans-types.c (gfc_init_kinds): Choose values for
	gfc_numeric_storage_size and gfc_character_storage_size.
	(gfc_numeric_storage_size, gfc_character_storage_size): New variables.
	* resolve.c (resolve_symbol): Do no check intrinsic modules
	against the list of intrinsic symbols.
	* iso-fortran-env.def: New file.
	* gfortran.h (gfc_numeric_storage_size,
	gfc_character_storage_size): Add prototypes.

	* gfortran.dg/use_3.f90: Remove error message.
	* gfortran.dg/iso_fortran_env_1.f90: New test.
	* gfortran.dg/iso_fortran_env_2.f90: New test.
	* gfortran.dg/iso_fortran_env_3.f90: New test.
	* gfortran.dg/iso_fortran_env_4.f90: New test.

From-SVN: r118998
This commit is contained in:
Francois-Xavier Coudert 2006-11-19 22:18:26 +01:00 committed by François-Xavier Coudert
parent 0eab781508
commit 39f87c0333
12 changed files with 408 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/fortran/ChangeLog
View File

@ -1,3 +1,18 @@
2006-11-19 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* module.c (gfc_use_module): Uncomment the ISO_FORTRAN_ENV code.
Check that intrinsic and non-intrinsic modules don't conflict.
(use_iso_fortran_env_module): New function.
(create_int_parameter): New function.
* trans-types.c (gfc_init_kinds): Choose values for
gfc_numeric_storage_size and gfc_character_storage_size.
(gfc_numeric_storage_size, gfc_character_storage_size): New variables.
* resolve.c (resolve_symbol): Do no check intrinsic modules
against the list of intrinsic symbols.
* iso-fortran-env.def: New file.
* gfortran.h (gfc_numeric_storage_size,
gfc_character_storage_size): Add prototypes.
2006-11-18 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/24285

2
gcc/fortran/gfortran.h
View File

@ -1823,6 +1823,8 @@ extern int gfc_default_logical_kind;
extern int gfc_default_complex_kind;
extern int gfc_c_int_kind;
extern int gfc_intio_kind;
extern int gfc_numeric_storage_size;
extern int gfc_character_storage_size;
/* symbol.c */
void gfc_clear_new_implicit (void);

37
gcc/fortran/iso-fortran-env.def Normal file
View File

@ -0,0 +1,37 @@
/* Copyright (C) 2006 Free Software Foundation, Inc.
This file is part of GCC.
GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING. If not, write to the Free
Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA. */
/* This file contains the definition of the named integer constants provided
by the Fortran 2003 ISO_FORTRAN_ENV intrinsic module. */
/* The arguments to NAMED_INTCST are:
-- an internal name
-- the symbol name in the module, as seen by Fortran code
-- the value it has */
NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \
gfc_character_storage_size)
NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", 0)
NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8)
NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", 5)
NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", -1)
NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", -2)
NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \
gfc_numeric_storage_size)
NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", 6)

187
gcc/fortran/module.c
View File

@ -498,24 +498,24 @@ gfc_match_use (void)
if (gfc_match (" , ") == MATCH_YES)
{
if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module "
"nature in USE statement at %C") == FAILURE)
return MATCH_ERROR;
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module "
"nature in USE statement at %C") == FAILURE)
return MATCH_ERROR;
if (strcmp (module_nature, "intrinsic") == 0)
specified_int = true;
else
{
if (strcmp (module_nature, "non_intrinsic") == 0)
specified_nonint = true;
else
{
gfc_error ("Module nature in USE statement at %C shall "
"be either INTRINSIC or NON_INTRINSIC");
return MATCH_ERROR;
}
}
if (strcmp (module_nature, "intrinsic") == 0)
specified_int = true;
else
{
if (strcmp (module_nature, "non_intrinsic") == 0)
specified_nonint = true;
else
{
gfc_error ("Module nature in USE statement at %C shall "
"be either INTRINSIC or NON_INTRINSIC");
return MATCH_ERROR;
}
}
}
else
{
@ -538,11 +538,11 @@ gfc_match_use (void)
return MATCH_ERROR;
if (m != MATCH_YES)
{
m = gfc_match ("% ");
if (m != MATCH_YES)
return m;
}
{
m = gfc_match ("% ");
if (m != MATCH_YES)
return m;
}
}
m = gfc_match_name (module_name);
@ -3843,6 +3843,138 @@ gfc_dump_module (const char *name, int dump_flag)
}
/* Add an integer named constant from a given module. */
static void
create_int_parameter (const char *name, int value, const char *modname)
{
gfc_symtree * tmp_symtree;
gfc_symbol * sym;
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
if (tmp_symtree != NULL)
{
if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
return;
else
gfc_error ("Symbol '%s' already declared", name);
}
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree);
sym = tmp_symtree->n.sym;
sym->module = gfc_get_string (modname);
sym->attr.flavor = FL_PARAMETER;
sym->ts.type = BT_INTEGER;
sym->ts.kind = gfc_default_integer_kind;
sym->value = gfc_int_expr (value);
sym->attr.use_assoc = 1;
}
/* USE the ISO_FORTRAN_ENV intrinsic module. */
static void
use_iso_fortran_env_module (void)
{
static char mod[] = "iso_fortran_env";
const char *local_name;
gfc_use_rename *u;
gfc_symbol *mod_sym;
gfc_symtree *mod_symtree;
int i;
mstring symbol[] = {
#define NAMED_INTCST(a,b,c) minit(b,0),
#include "iso-fortran-env.def"
#undef NAMED_INTCST
minit (NULL, -1234) };
i = 0;
#define NAMED_INTCST(a,b,c) symbol[i++].tag = c;
#include "iso-fortran-env.def"
#undef NAMED_INTCST
/* Generate the symbol for the module itself. */
mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, mod);
if (mod_symtree == NULL)
{
gfc_get_sym_tree (mod, gfc_current_ns, &mod_symtree);
gcc_assert (mod_symtree);
mod_sym = mod_symtree->n.sym;
mod_sym->attr.flavor = FL_MODULE;
mod_sym->attr.intrinsic = 1;
mod_sym->module = gfc_get_string (mod);
}
else
if (!mod_symtree->n.sym->attr.intrinsic)
gfc_error ("Use of intrinsic module '%s' at %C conflicts with "
"non-intrinsic module name used previously", mod);
/* Generate the symbols for the module integer named constants. */
if (only_flag)
for (u = gfc_rename_list; u; u = u->next)
{
for (i = 0; symbol[i].string; i++)
if (strcmp (symbol[i].string, u->use_name) == 0)
break;
if (symbol[i].string == NULL)
{
gfc_error ("Symbol '%s' referenced at %L does not exist in "
"intrinsic module ISO_FORTRAN_ENV", u->use_name,
&u->where);
continue;
}
if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
&& strcmp (symbol[i].string, "numeric_storage_size") == 0)
gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
"from intrinsic module ISO_FORTRAN_ENV at %L is "
"incompatible with option %s", &u->where,
gfc_option.flag_default_integer
? "-fdefault-integer-8" : "-fdefault-real-8");
create_int_parameter (u->local_name[0] ? u->local_name
: symbol[i].string,
symbol[i].tag, mod);
}
else
{
for (i = 0; symbol[i].string; i++)
{
local_name = NULL;
for (u = gfc_rename_list; u; u = u->next)
{
if (strcmp (symbol[i].string, u->use_name) == 0)
{
local_name = u->local_name;
u->found = 1;
break;
}
}
if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
&& strcmp (symbol[i].string, "numeric_storage_size") == 0)
gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
"from intrinsic module ISO_FORTRAN_ENV at %C is "
"incompatible with option %s",
gfc_option.flag_default_integer
? "-fdefault-integer-8" : "-fdefault-real-8");
create_int_parameter (local_name ? local_name : symbol[i].string,
symbol[i].tag, mod);
}
for (u = gfc_rename_list; u; u = u->next)
{
if (u->found)
continue;
gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
"module ISO_FORTRAN_ENV", u->use_name, &u->where);
}
}
}
/* Process a USE directive. */
void
@ -3851,6 +3983,7 @@ gfc_use_module (void)
char *filename;
gfc_state_data *p;
int c, line, start;
gfc_symtree *mod_symtree;
filename = (char *) alloca(strlen(module_name) + strlen(MODULE_EXTENSION)
+ 1);
@ -3867,7 +4000,6 @@ gfc_use_module (void)
specified that the module is non-intrinsic. */
if (module_fp == NULL && !specified_nonint)
{
#if 0
if (strcmp (module_name, "iso_fortran_env") == 0
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
"ISO_FORTRAN_ENV intrinsic module at %C") != FAILURE)
@ -3875,7 +4007,6 @@ gfc_use_module (void)
use_iso_fortran_env_module ();
return;
}
#endif
module_fp = gfc_open_intrinsic_module (filename);
@ -3888,6 +4019,14 @@ gfc_use_module (void)
gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s",
filename, strerror (errno));
/* Check that we haven't already USEd an intrinsic module with the
same name. */
mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, module_name);
if (mod_symtree && mod_symtree->n.sym->attr.intrinsic)
gfc_error ("Use of non-intrinsic module '%s' at %C conflicts with "
"intrinsic module name used previously", module_name);
iomode = IO_INPUT;
module_line = 1;
module_column = 1;

2
gcc/fortran/resolve.c
View File

@ -6007,7 +6007,7 @@ resolve_symbol (gfc_symbol * sym)
}
/* Make sure that intrinsic exist */
if (sym->attr.intrinsic
if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic
&& ! gfc_intrinsic_name(sym->name, 0)
&& ! gfc_intrinsic_name(sym->name, 1))
gfc_error("Intrinsic at %L does not exist", &sym->declared_at);

20
gcc/fortran/trans-types.c
View File

@ -97,6 +97,10 @@ int gfc_c_int_kind;
kind=8, this will be set to 8, otherwise it is set to 4. */
int gfc_intio_kind;
/* The size of the numeric storage unit and character storage unit. */
int gfc_numeric_storage_size;
int gfc_character_storage_size;
/* Query the target to determine which machine modes are available for
computation. Choose KIND numbers for them. */
@ -228,11 +232,22 @@ gfc_init_kinds (void)
if (!saw_i8)
fatal_error ("integer kind=8 not available for -fdefault-integer-8 option");
gfc_default_integer_kind = 8;
/* Even if the user specified that the default integer kind be 8,
the numerica storage size isn't 64. In this case, a warning will
be issued when NUMERIC_STORAGE_SIZE is used. */
gfc_numeric_storage_size = 4 * 8;
}
else if (saw_i4)
gfc_default_integer_kind = 4;
{
gfc_default_integer_kind = 4;
gfc_numeric_storage_size = 4 * 8;
}
else
gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind;
{
gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind;
gfc_numeric_storage_size = gfc_integer_kinds[i_index - 1].bit_size;
}
/* Choose the default real kind. Again, we choose 4 when possible. */
if (gfc_option.flag_default_real)
@ -283,6 +298,7 @@ gfc_init_kinds (void)
/* Choose the smallest integer kind for our default character. */
gfc_default_character_kind = gfc_integer_kinds[0].kind;
gfc_character_storage_size = gfc_default_character_kind * 8;
/* Choose the integer kind the same size as "void*" for our index kind. */
gfc_index_integer_kind = POINTER_SIZE / 8;

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2006-11-19 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* gfortran.dg/use_3.f90: Remove error message.
* gfortran.dg/iso_fortran_env_1.f90: New test.
* gfortran.dg/iso_fortran_env_2.f90: New test.
* gfortran.dg/iso_fortran_env_3.f90: New test.
* gfortran.dg/iso_fortran_env_4.f90: New test.
2006-11-19 Dorit Nuzman <dorit@il.ibm.com>
* gcc.dg/vect/vect-27.c: Fix initialization.

44
gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90 Normal file
View File

@ -0,0 +1,44 @@
! { dg-do run }
module iso_fortran_env
real :: x
end module iso_fortran_env
subroutine bar
use , intrinsic :: iso_fortran_env
implicit none
if (file_storage_size /= 8) call abort
if (character_storage_size /= 8) call abort
if (all (numeric_storage_size /= [ 8, 16, 32, 64, 128])) call abort
if (input_unit /= 5) call abort
if (output_unit /= 6) call abort
if (error_unit /= 0) call abort
if (iostat_end /= -1) call abort
if (iostat_eor /= -2) call abort
end
subroutine bar2
use , intrinsic :: iso_fortran_env, only : file_storage_size, &
character_storage_size, numeric_storage_size, input_unit, output_unit, &
error_unit, iostat_end, iostat_eor
implicit none
if (file_storage_size /= 8) call abort
if (character_storage_size /= 8) call abort
if (all (numeric_storage_size /= [ 8, 16, 32, 64, 128])) call abort
if (input_unit /= 5) call abort
if (output_unit /= 6) call abort
if (error_unit /= 0) call abort
if (iostat_end /= -1) call abort
if (iostat_eor /= -2) call abort
end
program test
use , intrinsic :: iso_fortran_env, uu => output_unit
implicit none
if (input_unit /= 5 .or. uu /= 6) call abort
call bar
call bar2
end
! { dg-final { cleanup-modules "iso_fortran_env" } }

76
gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90 Normal file
View File

@ -0,0 +1,76 @@
! { dg-do compile }
module iso_fortran_env
logical :: x
end module iso_fortran_env
subroutine bar1
use , intrinsic :: iso_fortran_env
print *, character_storage_size
end
subroutine bar2
use, intrinsic :: iso_fortran_env
print *, character_storage_size
end
subroutine bar3
use,intrinsic :: iso_fortran_env
print *, character_storage_size
end
subroutine bar4
use,intrinsic::iso_fortran_env
print *, character_storage_size
end
subroutine bar5
use ,intrinsic :: iso_fortran_env
print *, character_storage_size
end
subroutine foo1
use :: iso_fortran_env
print *, x
end
subroutine foo2
use:: iso_fortran_env
print *, x
end
subroutine foo3
use::iso_fortran_env
print *, x
end
subroutine foo4
use ::iso_fortran_env
print *, x
end
subroutine gee1
use , non_intrinsic :: iso_fortran_env
print *, x
end
subroutine gee2
use, non_intrinsic :: iso_fortran_env
print *, x
end
subroutine gee3
use,non_intrinsic :: iso_fortran_env
print *, x
end
subroutine gee4
use,non_intrinsic::iso_fortran_env
print *, x
end
subroutine gee5
use ,non_intrinsic :: iso_fortran_env
print *, x
end
! { dg-final { cleanup-modules "iso_fortran_env" } }

29
gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90 Normal file
View File

@ -0,0 +1,29 @@
! { dg-do run }
subroutine foo1 (x,y)
use iso_fortran_env
integer, intent(out) :: x, y
x = numeric_storage_size
y = character_storage_size
end
subroutine foo2 (x,y)
use iso_fortran_env, foo => numeric_storage_size
integer, intent(in) :: x, y
if (foo /= x .or. character_storage_size /= y) call abort
end
subroutine foo3 (x,y)
use iso_fortran_env, only : numeric_storage_size, character_storage_size
integer, intent(in) :: x, y
if (numeric_storage_size /= x .or. character_storage_size /= y) call abort
end
program test
integer :: x, y
call foo1(x,y)
call foo2(x,y)
call foo3(x,y)
end

14
gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90 Normal file
View File

@ -0,0 +1,14 @@
! { dg-do compile }
module iso_fortran_env
end module iso_fortran_env
program foo
use, intrinsic :: iso_fortran_env
use, non_intrinsic :: iso_fortran_env ! { dg-error "conflicts with intrinsic module" }
end program foo
subroutine truc
use, non_intrinsic :: iso_fortran_env
use, intrinsic :: iso_fortran_env ! { dg-error "conflicts with non-intrinsic module" }
end subroutine truc
! { dg-final { cleanup-modules "iso_fortran_env" } }

2
gcc/testsuite/gfortran.dg/use_3.f90
View File

@ -7,6 +7,6 @@ end module foo
use, intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" }
use, non_intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" }
use, nonintrinsic :: iso_fortran_env ! { dg-error "shall be either INTRINSIC or NON_INTRINSIC" }
use, intrinsic :: iso_fortran_env ! { dg-error "Can't find an intrinsic module named" }
use, intrinsic :: iso_fortran_env
end
! { dg-final { cleanup-modules "foo" } }