Commit be1f1ed9 by Tobias Burnus Committed by Tobias Burnus

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
parent 2b3a4837
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
......
......@@ -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,
......
......@@ -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
......
......@@ -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
......@@ -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;
......
......@@ -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 ();
}
}
}
......
......@@ -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))
......
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.
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment