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

gcc/fortran/ChangeLog

+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

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);

gcc/fortran/iso-fortran-env.def

+/* 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)

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;

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);

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;

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90

+! { 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

gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90

+! { 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" } }

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" } }