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

1 files changed, 107 insertions, 6 deletions

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 ();
+	  }
 	}
     }