diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dc4cab9aa5fccf56682f2221b20af27e3939fc54..70ca870af2c6d8ae92650722842b5f2c964116d7 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f33d2ee50b5ac09a8a78cf0e845c90fc6d3285fb..277cc7836a092c57e884d53c0838f09c73f03c29 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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);
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
new file mode 100644
index 0000000000000000000000000000000000000000..b9e753ad16bc0d3fd360996dc904483561c29c51
--- /dev/null
+++ b/gcc/fortran/iso-fortran-env.def
@@ -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)
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index dd103b896f419d0c0240650f00166f3f33daa77f..cd83ff9b270202dee4aca16d0d447ff9a0837d1f 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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 (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 (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;
+ }
+ }
}
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;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a0e8838eef6157d61d1a7d4874614fa30339fb06..31e1d7c2426d0b2a65250e0232d631829168e05b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 56575b009a3747887528580f805019fe57816377..f0c41bb79922464110f12015cfe5f103c6f1962e 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9d19a856e93a2d9f4979e650a93b28f15bdc63d3..61cf82cd076030ef960db5ae9e0e20eeb872e96c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dfcf49bf96097a409886986b061c006b99c72792
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90
@@ -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" } }
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6f8d228d924b5b4a7cf47fa64a0490ccc32cc98a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90
@@ -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" } }
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a90315958a90e96ec45236fcc18f1e5cd46577c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90
new file mode 100644
index 0000000000000000000000000000000000000000..515269bd7ec102bb941c52b5330b09e72cdbcfc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90
@@ -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" } }
diff --git a/gcc/testsuite/gfortran.dg/use_3.f90 b/gcc/testsuite/gfortran.dg/use_3.f90
index 504277f608490a19b9935fc9502f13539ba87c18..54100d191dda79b7888951c30d32b9c07df30e02 100644
--- a/gcc/testsuite/gfortran.dg/use_3.f90
+++ b/gcc/testsuite/gfortran.dg/use_3.f90
@@ -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" } }