This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch,Fortran] PR40571 - Add F2008's array valued PARAMETERs from ISO_FORTRAN_ENV
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Thu, 23 Sep 2010 13:52:14 +0200
- Subject: [Patch,Fortran] PR40571 - Add F2008's array valued PARAMETERs from ISO_FORTRAN_ENV
This patch added the array-valued named constants character_kinds,
integer_kinds, logical_kinds and real_kinds.
I also renamed GFC_INQUIRE_INTERNAL_UNIT to
LIBERROR_INQUIRE_INTERNAL_UNIT as I think it fits better - but until we
finally use it, we can keep changing it ;-)
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
PS (TODO): Missing F2008 module items are: Adding TYPE LOCK_TYPE, which
is needed for coarrays and the functions compiler_options() and
compiler_version() of ISO_FORTRAN_ENV (PR40569) and moving C_SIZEOF from
a general intrinsic function to a ISO_C_BINDING module function (PR40568).
2010-09-23 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 Tobias Burnus <burnus@net-b.de>
PR fortran/40571
* gfortran.dg/iso_fortran_env_7.f90: New.
Index: gcc/fortran/iso-fortran-env.def
===================================================================
--- gcc/fortran/iso-fortran-env.def (revision 164551)
+++ gcc/fortran/iso-fortran-env.def (working copy)
@@ -19,6 +19,15 @@ along with GCC; see the file COPYING3.
/* 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,
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_ST
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
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 164551)
+++ gcc/fortran/gfortran.h (working copy)
@@ -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,
Index: gcc/fortran/libgfortran.h
===================================================================
--- gcc/fortran/libgfortran.h (revision 164551)
+++ gcc/fortran/libgfortran.h (working copy)
@@ -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;
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (revision 164551)
+++ gcc/fortran/module.c (working copy)
@@ -5305,6 +5305,49 @@ create_int_parameter (const char *name,
}
+/* Value is contains already 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 ();
+ }
}
}
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 164551)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -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))
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi (revision 164551)
+++ gcc/fortran/intrinsic.texi (working copy)
@@ -12606,6 +12606,10 @@ integer variables used in atomic operati
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 INTEG
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 t
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
Index: gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90 (revision 0)
@@ -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