re PR fortran/40571 (F2008: ISO_FORTRAN_ENV: Missing constants)

2010-09-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40571
        * iso-fortran-env.def: Add NAMED_KINDARRAY with
        character_kinds, integer_kinds, logical_kinds and
        real_kinds.
        * gfortran.h: Add them to iso_fortran_env_symbol.
        * libgfortran.h: Rename GFC_INQUIRE_INTERNAL_UNIT to
        LIBERROR_INQUIRE_INTERNAL_UNIT and move it from
        libgfortran_stat_codes to libgfortran_error_codes.
        * module.c (create_int_parameter_array): New function.
        (use_iso_fortran_env_module): Use it for
        NAMED_KINDARRAY of iso-fortran-env.def.
        * trans-decl.c (gfc_get_symbol_decl): Parameter
        arrays of intrinsics modules become local static variables.
        * intrinsic.texi (ISO_FORTRAN_ENV): Add character_kinds,
        integer_kinds, logical_kinds and real_kinds.

2010-09-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40571
        * gfortran.dg/iso_fortran_env_7.f90: New.

From-SVN: r164581

9 files changed, 256 insertions, 13 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 02ab36d..18ce1ff 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2010-09-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40571
+	* iso-fortran-env.def: Add NAMED_KINDARRAY with
+	character_kinds, integer_kinds, logical_kinds and
+	real_kinds.
+	* gfortran.h: Add them to iso_fortran_env_symbol.
+	* libgfortran.h: Rename GFC_INQUIRE_INTERNAL_UNIT to
+	LIBERROR_INQUIRE_INTERNAL_UNIT and move it from
+	libgfortran_stat_codes to libgfortran_error_codes.
+	* module.c (create_int_parameter_array): New function.
+	(use_iso_fortran_env_module): Use it for
+	NAMED_KINDARRAY of iso-fortran-env.def.
+	* trans-decl.c (gfc_get_symbol_decl): Parameter
+	arrays of intrinsics modules become local static variables.
+	* intrinsic.texi (ISO_FORTRAN_ENV): Add character_kinds,
+	integer_kinds, logical_kinds and real_kinds.
+
 2010-09-23  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/45744
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 94b2b19..95886cd 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -613,6 +613,7 @@ gfc_reverse;
 #define BBT_HEADER(self) int priority; struct self *left, *right
 
 #define NAMED_INTCST(a,b,c,d) a,
+#define NAMED_KINDARRAY(a,b,c,d) a,
 typedef enum
 {
   ISOFORTRANENV_INVALID = -1,
@@ -620,7 +621,7 @@ typedef enum
   ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
 }
 iso_fortran_env_symbol;
-#undef NAMED_INTCST
+#undef NAMED_KINDARRAY
 
 #define NAMED_INTCST(a,b,c,d) a,
 #define NAMED_REALCST(a,b,c) a,
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index bb74a51..5c7d463 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -12606,6 +12606,10 @@ integer variables used in atomic operations. (Fortran 2008 or later.)
 Default-kind integer constant to be used as kind parameter when defining
 logical variables used in atomic operations. (Fortran 2008 or later.)
 
+@item @code{CHARACTER_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{CHARACTER} type. (Fortran 2008 or later.)
+
 @item @code{CHARACTER_STORAGE_SIZE}:
 Size in bits of the character storage unit.
 
@@ -12624,6 +12628,10 @@ Kind type parameters to specify an INTEGER type with a storage
 size of 16, 32, and 64 bits. It is negative if a target platform
 does not support the particular kind. (Fortran 2008 or later.)
 
+@item @code{INTEGER_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{INTEGER} type. (Fortran 2008 or later.)
+
 @item @code{IOSTAT_END}:
 The value assigned to the variable passed to the @code{IOSTAT=} specifier of
 an input/output statement if an end-of-file condition occurred.
@@ -12640,6 +12648,10 @@ internal unit. (Fortran 2008 or later.)
 @item @code{NUMERIC_STORAGE_SIZE}:
 The size in bits of the numeric storage unit.
 
+@item @code{LOGICAL_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{LOGICAL} type. (Fortran 2008 or later.)
+
 @item @code{OUTPUT_UNIT}:
 Identifies the preconnected unit identified by the asterisk
 (@code{*}) in @code{WRITE} statement.
@@ -12649,6 +12661,10 @@ Kind type parameters to specify a REAL type with a storage
 size of 32, 64, and 128 bits. It is negative if a target platform
 does not support the particular kind. (Fortran 2008 or later.)
 
+@item @code{REAL_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{REAL} type. (Fortran 2008 or later.)
+
 @item @code{STAT_LOCKED}:
 Scalar default-integer constant used as STAT= return value by @code{LOCK} to
 denote that the lock variable is locked by the executing image. (Fortran 2008
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
index 6c009f1..cd4f1d1 100644
--- a/gcc/fortran/iso-fortran-env.def
+++ b/gcc/fortran/iso-fortran-env.def
@@ -19,6 +19,15 @@ along with GCC; see the file COPYING3.  If not see
 /* This file contains the definition of the named integer constants provided
    by the Fortran 2003 ISO_FORTRAN_ENV intrinsic module.  */
 
+#ifndef NAMED_INTCST
+# define NAMED_INTCST(a,b,c,d)
+#endif
+
+#ifndef NAMED_KINDARRAY
+# define NAMED_KINDARRAY(a,b,c,d)
+#endif
+
+
 /* The arguments to NAMED_INTCST are:
      -- an internal name
      -- the symbol name in the module, as seen by Fortran code
@@ -50,7 +59,7 @@ NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END, \
 NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR, \
               GFC_STD_F2003)
 NAMED_INTCST (ISOFORTRANENV_IOSTAT_INQUIRE_INTERNAL_UNIT, \
-              "iostat_inquire_internal_unit", GFC_INQUIRE_INTERNAL_UNIT, \
+              "iostat_inquire_internal_unit", LIBERROR_INQUIRE_INTERNAL_UNIT, \
               GFC_STD_F2008)
 NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \
               gfc_numeric_storage_size, GFC_STD_F2003)
@@ -72,3 +81,21 @@ NAMED_INTCST (ISOFORTRANENV_FILE_STAT_STOPPED_IMAGE, "stat_stopped_image", \
 NAMED_INTCST (ISOFORTRANENV_FILE_STAT_UNLOCKED, "stat_unlocked", \
               GFC_STAT_UNLOCKED, GFC_STD_F2008)
 
+
+/* The arguments to NAMED_KINDARRAY are:
+     -- an internal name
+     -- the symbol name in the module, as seen by Fortran code
+     -- the gfortran variable containing the information
+     -- the Fortran standard  */
+
+NAMED_KINDARRAY (ISOFORTRAN_CHARACTER_KINDS, "character_kinds", \
+                 gfc_character_kinds, GFC_STD_F2008)
+NAMED_KINDARRAY (ISOFORTRAN_INTEGER_KINDS, "integer_kinds", \
+                 gfc_integer_kinds, GFC_STD_F2008)
+NAMED_KINDARRAY (ISOFORTRAN_LOGICAL_KINDS, "logical_kinds", \
+                 gfc_logical_kinds, GFC_STD_F2008)
+NAMED_KINDARRAY (ISOFORTRAN_REAL_KINDS, "real_kinds", \
+                 gfc_real_kinds, GFC_STD_F2008)
+
+#undef NAMED_INTCST
+#undef NAMED_KINDARRAY
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index d9216d3..e26cbf9 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -93,6 +93,7 @@ typedef enum
   LIBERROR_DIRECT_EOR,
   LIBERROR_SHORT_RECORD,
   LIBERROR_CORRUPT_FILE,
+  LIBERROR_INQUIRE_INTERNAL_UNIT, /* Must be different from STAT_STOPPED_IMAGE.  */
   LIBERROR_LAST			/* Not a real error, the last error # + 1.  */
 }
 libgfortran_error_codes;
@@ -102,8 +103,7 @@ typedef enum
   GFC_STAT_UNLOCKED = 0,
   GFC_STAT_LOCKED,
   GFC_STAT_LOCKED_OTHER_IMAGE,
-  GFC_STAT_STOPPED_IMAGE,
-  GFC_INQUIRE_INTERNAL_UNIT  /* Must be different from STAT_STOPPED_IMAGE.  */
+  GFC_STAT_STOPPED_IMAGE
 }
 libgfortran_stat_codes;
 
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index e9a8625..d4824a7 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5305,6 +5305,49 @@ create_int_parameter (const char *name, int value, const char *modname,
 }
 
 
+/* Value is already contained the array constructor, but not yet the shape.  */
+
+static void
+create_int_parameter_array (const char *name, int size, gfc_expr *value,
+			    const char *modname, intmod_id module, int id)
+{
+  gfc_symtree *tmp_symtree;
+  gfc_symbol *sym;
+  gfc_expr *e;
+
+  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, false);
+  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->attr.use_assoc = 1;
+  sym->from_intmod = module;
+  sym->intmod_sym_id = id;
+  sym->attr.dimension = 1;
+  sym->as = gfc_get_array_spec ();
+  sym->as->rank = 1;
+  sym->as->type = AS_EXPLICIT;
+  sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+  sym->as->upper[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, size); 
+
+  sym->value = value;
+  e->shape = gfc_get_shape (1);
+  mpz_init_set_ui (e->shape[0], size);
+}
+
+
+
 /* USE the ISO_FORTRAN_ENV intrinsic module.  */
 
 static void
@@ -5314,12 +5357,16 @@ use_iso_fortran_env_module (void)
   gfc_use_rename *u;
   gfc_symbol *mod_sym;
   gfc_symtree *mod_symtree;
-  int i;
+  gfc_expr *expr;
+  int i, j;
 
   intmod_sym symbol[] = {
 #define NAMED_INTCST(a,b,c,d) { a, b, 0, d },
 #include "iso-fortran-env.def"
 #undef NAMED_INTCST
+#define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d },
+#include "iso-fortran-env.def"
+#undef NAMED_KINDARRAY
     { ISOFORTRANENV_INVALID, NULL, -1234, 0 } };
 
   i = 0;
@@ -5371,10 +5418,39 @@ use_iso_fortran_env_module (void)
 				 gfc_option.flag_default_integer
 				   ? "-fdefault-integer-8"
 				   : "-fdefault-real-8");
+	      switch (symbol[i].id)
+		{
+#define NAMED_INTCST(a,b,c,d) \
+		case a:
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+		  create_int_parameter (u->local_name[0] ? u->local_name
+							 : u->use_name,
+					symbol[i].value, mod,
+					INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
+		  break;
+
+#define NAMED_KINDARRAY(a,b,KINDS,d) \
+		case a:\
+		  expr = gfc_get_array_expr (BT_INTEGER, \
+					     gfc_default_integer_kind,\
+					     NULL); \
+		  for (j = 0; KINDS[j].kind != 0; j++) \
+		    gfc_constructor_append_expr (&expr->value.constructor, \
+			gfc_get_int_expr (gfc_default_integer_kind, NULL, \
+					  KINDS[j].kind), NULL); \
+		  create_int_parameter_array (u->local_name[0] ? u->local_name \
+							 : u->use_name, \
+					      j, expr, mod, \
+					      INTMOD_ISO_FORTRAN_ENV, \
+					      symbol[i].id); \
+		  break;
+#include "iso-fortran-env.def"
+#undef NAMED_KINDARRAY
 
-	      create_int_parameter (u->local_name[0] ? u->local_name : u->use_name,
-				    symbol[i].value, mod,
-				    INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
+		default:
+		  gcc_unreachable ();
+		}
 	    }
 	}
 
@@ -5391,8 +5467,33 @@ use_iso_fortran_env_module (void)
 			     gfc_option.flag_default_integer
 				? "-fdefault-integer-8" : "-fdefault-real-8");
 
-	  create_int_parameter (symbol[i].name, symbol[i].value, mod,
-				INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
+	  switch (symbol[i].id)
+	    {
+#define NAMED_INTCST(a,b,c,d) \
+	    case a:
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+	      create_int_parameter (symbol[i].name, symbol[i].value, mod,
+				    INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
+	      break;
+
+#define NAMED_KINDARRAY(a,b,KINDS,d) \
+	    case a:\
+	      expr = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind, \
+					 NULL); \
+	      for (j = 0; KINDS[j].kind != 0; j++) \
+		gfc_constructor_append_expr (&expr->value.constructor, \
+                      gfc_get_int_expr (gfc_default_integer_kind, NULL, \
+                                        KINDS[j].kind), NULL); \
+            create_int_parameter_array (symbol[i].name, j, expr, mod, \
+                                        INTMOD_ISO_FORTRAN_ENV, symbol[i].id);\
+            break;
+#include "iso-fortran-env.def"
+#undef NAMED_KINDARRAY
+
+	  default:
+	    gcc_unreachable ();
+	  }
 	}
     }
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 0ff297f..d15d673 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1044,6 +1044,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   tree length = NULL_TREE;
   tree attributes;
   int byref;
+  bool intrinsic_array_parameter = false;
 
   gcc_assert (sym->attr.referenced
 		|| sym->attr.use_assoc
@@ -1181,6 +1182,12 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   if (sym->attr.intrinsic)
     internal_error ("intrinsic variable which isn't a procedure");
 
+  /* Special case for array-valued named constants from intrinsic
+     procedures; those are inlined.  */
+  if (sym->attr.use_assoc && sym->from_intmod && sym->attr.dimension
+      && sym->attr.flavor == FL_PARAMETER)
+    intrinsic_array_parameter = true;
+
   /* Create string length decl first so that they can be used in the
      type declaration.  */
   if (sym->ts.type == BT_CHARACTER)
@@ -1200,7 +1207,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   if (sym->module)
     {
       gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
-      if (sym->attr.use_assoc)
+      if (sym->attr.use_assoc && !intrinsic_array_parameter)
 	DECL_IGNORED_P (decl) = 1;
     }
 
@@ -1226,7 +1233,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  && !sym->attr.data
 	  && !sym->attr.allocatable
 	  && (sym->value && !sym->ns->proc_name->attr.is_main_program)
-	  && !sym->attr.use_assoc))
+	  && !(sym->attr.use_assoc && !intrinsic_array_parameter)))
     gfc_defer_symbol_init (sym);
 
   gfc_finish_var_decl (decl, sym);
@@ -1280,7 +1287,14 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   if (sym->attr.assign)
     gfc_add_assign_aux_vars (sym);
 
-  if (TREE_STATIC (decl) && !sym->attr.use_assoc
+  if (intrinsic_array_parameter)
+    {
+      TREE_STATIC (decl) = 1;
+      DECL_EXTERNAL (decl) = 0;
+    }
+
+  if (TREE_STATIC (decl)
+      && !(sym->attr.use_assoc && !intrinsic_array_parameter)
       && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
 	  || gfc_option.flag_max_stack_var_size == 0
 	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 649c269..932dfa1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40571
+	* gfortran.dg/iso_fortran_env_7.f90: New.
+
 2010-09-24  Nicola Pero  <nicola.pero@meta-innovation.com>
 
 	* obj-c++.dg/too-many-args.mm: New file.
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90
new file mode 100644
index 0000000..c8617ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90
@@ -0,0 +1,61 @@
+! { dg-do link }
+!
+! PR fortran/40571
+!
+! This test case adds check for the new Fortran 2008 array parameters
+! in ISO_FORTRAN_ENV: integer_kinds, logical_kinds, character_kinds,
+! and real_kinds.
+!
+! The test thus also checks that the values of the parameter are used
+! and no copy is made. (Cf. PR 44856.)
+
+program test
+  use iso_fortran_env, only: integer_kinds, character_kinds
+  implicit none
+  integer :: aaaa(2),i
+  i=1
+
+  print *, integer_kinds
+  print *, integer_kinds(1)
+  print *, (integer_kinds)
+  print *, (integer_kinds + 1)
+  print *, integer_kinds(1:2)
+  print *, integer_kinds(i)
+
+  aaaa = character_kinds
+  aaaa(1:2) = character_kinds(1:2)
+  aaaa(i) = character_kinds(i)
+  aaaa = character_kinds + 0
+  aaaa(1:2) = character_kinds(1:2) + 0
+  aaaa(i) = character_kinds(i) + 0
+end program test
+
+subroutine one()
+  use iso_fortran_env, only: ik => integer_kinds, ik2 => integer_kinds
+  implicit none
+
+  if (any (ik /= ik2)) call never_call_me()
+end subroutine one
+
+subroutine two()
+  use iso_fortran_env
+  implicit none
+
+  ! Should be 1, 2, 4, 8 and possibly 16
+  if (size (integer_kinds) < 4) call never_call_me()
+  if (any (integer_kinds(1:4) /= [1,2,4,8])) call never_call_me()
+  if (any (integer_kinds /= logical_kinds)) call never_call_me()
+
+  if (size (character_kinds) /= 2) call never_call_me()
+  if (any (character_kinds /= [1,4])) call never_call_me()
+
+  if (size (real_kinds) < 2) call never_call_me()
+  if (any (real_kinds(1:2) /= [4,8])) call never_call_me()
+end subroutine two
+
+subroutine three()
+  use iso_fortran_env
+  integer :: i, j(2)
+  i = real_kinds(1)
+  j = real_kinds(1:2)
+end subroutine three