Commit d000aa67 by Tobias Burnus Committed by Tobias Burnus

re PR fortran/40569 (F2008: Support COMPILER_OPTIONS() / COMPILER_VERSION())

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

        PR fortran/40569
        PR fortran/40568
        * intrinsic.h (gfc_simplify_compiler_options,
        gfc_simplify_compiler_version): New prototypes.
        * intrinsic.c (gfc_intrinsic_function_by_id,
        make_from_module): New functions.
        (gfc_find_function, gfc_find_subroutine, gfc_generic_intrinsic,
        gfc_specific_intrinsic): Don't return module intrinsics.
        (add_functions): Add compiler_options, compiler_version.
        (gfc_intrinsic_func_interface): Also lookup symbol by ISYM ID.
        * symbol.c (std_for_isocbinding_symbol): Add version check for
        NAMED_FUNCTIONS.
        * iso-fortran-env.def: Add compiler_options, compiler_version.
        * iso-c-binding.def: Add c_sizeof.
        * gfortran.h (gfc_intrinsic_sym): Add from_module:1.
        (iso_c_binding_symbol, iso_fortran_env_symbol): Add NAMED_FUNCTIONS.
        (gfc_intrinsic_function_by_id): New prototype.
        * module.c (create_intrinsic_function): New function.
        (import_iso_c_binding_module, use_iso_fortran_env_module): Use it.
        * trans-types.c (init_c_interop_kinds): Add NAMED_FUNCTIONS.
        * resolve.c (resolve_intrinsic): Try also to resolve intrinsics
        by ISYM ID.
        * simplify.c (gfc_simplify_compiler_options,
        gfc_simplify_compiler_version): New functions.

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

        PR fortran/40569
        PR fortran/40568
        * gfortran.dg/storage_size_2.f08: Fix test.
        * gfortran.dg/c_sizeof_1.f90: Fix test.
        * gfortran.dg/c_sizeof_2.f90: Update dg-error.
        * gfortran.dg/c_sizeof_3.f90: New.
        * gfortran.dg/c_sizeof_4.f90: New.
        * gfortran.dg/iso_c_binding_compiler_1.f90: New.
        * gfortran.dg/iso_c_binding_compiler_2.f90: New.

From-SVN: r164639
parent 414e8be2
2010-09-27 Tobias Burnus <burnus@net-b.de>
PR fortran/40569
PR fortran/40568
* intrinsic.h (gfc_simplify_compiler_options,
gfc_simplify_compiler_version): New prototypes.
* intrinsic.c (gfc_intrinsic_function_by_id,
make_from_module): New functions.
(gfc_find_function, gfc_find_subroutine, gfc_generic_intrinsic,
gfc_specific_intrinsic): Don't return module intrinsics.
(add_functions): Add compiler_options, compiler_version.
(gfc_intrinsic_func_interface): Also lookup symbol by ISYM ID.
* symbol.c (std_for_isocbinding_symbol): Add version check for
NAMED_FUNCTIONS.
* iso-fortran-env.def: Add compiler_options, compiler_version.
* iso-c-binding.def: Add c_sizeof.
* gfortran.h (gfc_intrinsic_sym): Add from_module:1.
(iso_c_binding_symbol, iso_fortran_env_symbol): Add NAMED_FUNCTIONS.
(gfc_intrinsic_function_by_id): New prototype.
* module.c (create_intrinsic_function): New function.
(import_iso_c_binding_module, use_iso_fortran_env_module): Use it.
* trans-types.c (init_c_interop_kinds): Add NAMED_FUNCTIONS.
* resolve.c (resolve_intrinsic): Try also to resolve intrinsics
by ISYM ID.
* simplify.c (gfc_simplify_compiler_options,
gfc_simplify_compiler_version): New functions.
2010-09-26 Daniel Kraft <d@domob.eu> 2010-09-26 Daniel Kraft <d@domob.eu>
PR fortran/45783 PR fortran/45783
......
...@@ -343,6 +343,8 @@ enum gfc_isym_id ...@@ -343,6 +343,8 @@ enum gfc_isym_id
GFC_ISYM_CHMOD, GFC_ISYM_CHMOD,
GFC_ISYM_CMPLX, GFC_ISYM_CMPLX,
GFC_ISYM_COMMAND_ARGUMENT_COUNT, GFC_ISYM_COMMAND_ARGUMENT_COUNT,
GFC_ISYM_COMPILER_OPTIONS,
GFC_ISYM_COMPILER_VERSION,
GFC_ISYM_COMPLEX, GFC_ISYM_COMPLEX,
GFC_ISYM_CONJG, GFC_ISYM_CONJG,
GFC_ISYM_CONVERSION, GFC_ISYM_CONVERSION,
...@@ -614,6 +616,7 @@ gfc_reverse; ...@@ -614,6 +616,7 @@ gfc_reverse;
#define NAMED_INTCST(a,b,c,d) a, #define NAMED_INTCST(a,b,c,d) a,
#define NAMED_KINDARRAY(a,b,c,d) a, #define NAMED_KINDARRAY(a,b,c,d) a,
#define NAMED_FUNCTION(a,b,c,d) a,
typedef enum typedef enum
{ {
ISOFORTRANENV_INVALID = -1, ISOFORTRANENV_INVALID = -1,
...@@ -621,7 +624,9 @@ typedef enum ...@@ -621,7 +624,9 @@ typedef enum
ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
} }
iso_fortran_env_symbol; iso_fortran_env_symbol;
#undef NAMED_INTCST
#undef NAMED_KINDARRAY #undef NAMED_KINDARRAY
#undef NAMED_FUNCTION
#define NAMED_INTCST(a,b,c,d) a, #define NAMED_INTCST(a,b,c,d) a,
#define NAMED_REALCST(a,b,c) a, #define NAMED_REALCST(a,b,c) a,
...@@ -631,6 +636,7 @@ iso_fortran_env_symbol; ...@@ -631,6 +636,7 @@ iso_fortran_env_symbol;
#define NAMED_CHARCST(a,b,c) a, #define NAMED_CHARCST(a,b,c) a,
#define DERIVED_TYPE(a,b,c) a, #define DERIVED_TYPE(a,b,c) a,
#define PROCEDURE(a,b) a, #define PROCEDURE(a,b) a,
#define NAMED_FUNCTION(a,b,c,d) a,
typedef enum typedef enum
{ {
ISOCBINDING_INVALID = -1, ISOCBINDING_INVALID = -1,
...@@ -647,6 +653,7 @@ iso_c_binding_symbol; ...@@ -647,6 +653,7 @@ iso_c_binding_symbol;
#undef NAMED_CHARCST #undef NAMED_CHARCST
#undef DERIVED_TYPE #undef DERIVED_TYPE
#undef PROCEDURE #undef PROCEDURE
#undef NAMED_FUNCTION
typedef enum typedef enum
{ {
...@@ -1645,7 +1652,8 @@ typedef struct gfc_intrinsic_sym ...@@ -1645,7 +1652,8 @@ typedef struct gfc_intrinsic_sym
gfc_intrinsic_arg *formal; gfc_intrinsic_arg *formal;
gfc_typespec ts; gfc_typespec ts;
unsigned elemental:1, inquiry:1, transformational:1, pure:1, unsigned elemental:1, inquiry:1, transformational:1, pure:1,
generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1; generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1,
from_module:1;
int standard; int standard;
...@@ -2638,6 +2646,7 @@ bool gfc_is_intrinsic (gfc_symbol*, int, locus); ...@@ -2638,6 +2646,7 @@ bool gfc_is_intrinsic (gfc_symbol*, int, locus);
int gfc_intrinsic_actual_ok (const char *, const bool); int gfc_intrinsic_actual_ok (const char *, const bool);
gfc_intrinsic_sym *gfc_find_function (const char *); gfc_intrinsic_sym *gfc_find_function (const char *);
gfc_intrinsic_sym *gfc_find_subroutine (const char *); gfc_intrinsic_sym *gfc_find_subroutine (const char *);
gfc_intrinsic_sym *gfc_intrinsic_function_by_id (gfc_isym_id);
match gfc_intrinsic_func_interface (gfc_expr *, int); match gfc_intrinsic_func_interface (gfc_expr *, int);
match gfc_intrinsic_sub_interface (gfc_code *, int); match gfc_intrinsic_sub_interface (gfc_code *, int);
......
...@@ -814,6 +814,24 @@ find_sym (gfc_intrinsic_sym *start, int n, const char *name) ...@@ -814,6 +814,24 @@ find_sym (gfc_intrinsic_sym *start, int n, const char *name)
} }
gfc_intrinsic_sym *
gfc_intrinsic_function_by_id (gfc_isym_id id)
{
gfc_intrinsic_sym *start = functions;
int n = nfunc;
while (true)
{
gcc_assert (n > 0);
if (id == start->id)
return start;
start++;
n--;
}
}
/* Given a name, find a function in the intrinsic function table. /* Given a name, find a function in the intrinsic function table.
Returns NULL if not found. */ Returns NULL if not found. */
...@@ -823,10 +841,10 @@ gfc_find_function (const char *name) ...@@ -823,10 +841,10 @@ gfc_find_function (const char *name)
gfc_intrinsic_sym *sym; gfc_intrinsic_sym *sym;
sym = find_sym (functions, nfunc, name); sym = find_sym (functions, nfunc, name);
if (!sym) if (!sym || sym->from_module)
sym = find_sym (conversion, nconv, name); sym = find_sym (conversion, nconv, name);
return sym; return (!sym || sym->from_module) ? NULL : sym;
} }
...@@ -836,7 +854,9 @@ gfc_find_function (const char *name) ...@@ -836,7 +854,9 @@ gfc_find_function (const char *name)
gfc_intrinsic_sym * gfc_intrinsic_sym *
gfc_find_subroutine (const char *name) gfc_find_subroutine (const char *name)
{ {
return find_sym (subroutines, nsub, name); gfc_intrinsic_sym *sym;
sym = find_sym (subroutines, nsub, name);
return (!sym || sym->from_module) ? NULL : sym;
} }
...@@ -849,7 +869,7 @@ gfc_generic_intrinsic (const char *name) ...@@ -849,7 +869,7 @@ gfc_generic_intrinsic (const char *name)
gfc_intrinsic_sym *sym; gfc_intrinsic_sym *sym;
sym = gfc_find_function (name); sym = gfc_find_function (name);
return (sym == NULL) ? 0 : sym->generic; return (!sym || sym->from_module) ? 0 : sym->generic;
} }
...@@ -862,7 +882,7 @@ gfc_specific_intrinsic (const char *name) ...@@ -862,7 +882,7 @@ gfc_specific_intrinsic (const char *name)
gfc_intrinsic_sym *sym; gfc_intrinsic_sym *sym;
sym = gfc_find_function (name); sym = gfc_find_function (name);
return (sym == NULL) ? 0 : sym->specific; return (!sym || sym->from_module) ? 0 : sym->specific;
} }
...@@ -1014,6 +1034,15 @@ make_noreturn (void) ...@@ -1014,6 +1034,15 @@ make_noreturn (void)
next_sym[-1].noreturn = 1; next_sym[-1].noreturn = 1;
} }
/* Mark current intrinsic as module intrinsic. */
static void
make_from_module (void)
{
if (sizing == SZ_NOTHING)
next_sym[-1].from_module = 1;
}
/* Set the attr.value of the current procedure. */ /* Set the attr.value of the current procedure. */
static void static void
...@@ -2607,10 +2636,23 @@ add_functions (void) ...@@ -2607,10 +2636,23 @@ add_functions (void)
x, BT_UNKNOWN, 0, REQUIRED); x, BT_UNKNOWN, 0, REQUIRED);
make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU); make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
/* C_SIZEOF is part of ISO_C_BINDING. */
add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO, add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL, BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
x, BT_UNKNOWN, 0, REQUIRED); x, BT_UNKNOWN, 0, REQUIRED);
make_from_module();
/* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_IMPURE,
ACTUAL_NO, BT_CHARACTER, 1, GFC_STD_F2008,
NULL, gfc_simplify_compiler_options, NULL);
make_from_module();
add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_IMPURE,
ACTUAL_NO, BT_CHARACTER, 1, GFC_STD_F2008,
NULL, gfc_simplify_compiler_version, NULL);
make_from_module();
add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing, gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
...@@ -4012,7 +4054,14 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) ...@@ -4012,7 +4054,14 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
name = expr->symtree->n.sym->name; name = expr->symtree->n.sym->name;
isym = specific = gfc_find_function (name); if (expr->symtree->n.sym->intmod_sym_id)
{
int id = expr->symtree->n.sym->intmod_sym_id;
isym = specific = gfc_intrinsic_function_by_id ((gfc_isym_id) id);
}
else
isym = specific = gfc_find_function (name);
if (isym == NULL) if (isym == NULL)
{ {
if (!error_flag) if (!error_flag)
......
...@@ -246,6 +246,8 @@ gfc_expr *gfc_simplify_btest (gfc_expr *, gfc_expr *); ...@@ -246,6 +246,8 @@ gfc_expr *gfc_simplify_btest (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ceiling (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ceiling (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_char (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_char (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_compiler_options (void);
gfc_expr *gfc_simplify_compiler_version (void);
gfc_expr *gfc_simplify_complex (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_complex (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_conjg (gfc_expr *); gfc_expr *gfc_simplify_conjg (gfc_expr *);
gfc_expr *gfc_simplify_cos (gfc_expr *); gfc_expr *gfc_simplify_cos (gfc_expr *);
......
...@@ -39,6 +39,10 @@ along with GCC; see the file COPYING3. If not see ...@@ -39,6 +39,10 @@ along with GCC; see the file COPYING3. If not see
# define NAMED_CHARKNDCST(a,b,c) # define NAMED_CHARKNDCST(a,b,c)
#endif #endif
#ifndef NAMED_FUNCTION
# define NAMED_FUNCTION(a,b,c,d)
#endif
/* The arguments to NAMED_*CST are: /* The arguments to NAMED_*CST are:
-- an internal name -- an internal name
-- the symbol name in the module, as seen by Fortran code -- the symbol name in the module, as seen by Fortran code
...@@ -162,6 +166,15 @@ PROCEDURE (ISOCBINDING_LOC, "c_loc") ...@@ -162,6 +166,15 @@ PROCEDURE (ISOCBINDING_LOC, "c_loc")
PROCEDURE (ISOCBINDING_FUNLOC, "c_funloc") PROCEDURE (ISOCBINDING_FUNLOC, "c_funloc")
PROCEDURE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer") PROCEDURE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer")
/* The arguments to NAMED_FUNCTIONS are:
-- the ISYM
-- the symbol name in the module, as seen by Fortran code
-- the Fortran standard */
NAMED_FUNCTION (ISOCBINDING_C_SIZEOF, "c_sizeof", \
GFC_ISYM_C_SIZEOF, GFC_STD_F2008)
#undef NAMED_INTCST #undef NAMED_INTCST
#undef NAMED_REALCST #undef NAMED_REALCST
#undef NAMED_CMPXCST #undef NAMED_CMPXCST
...@@ -170,3 +183,4 @@ PROCEDURE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer") ...@@ -170,3 +183,4 @@ PROCEDURE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer")
#undef NAMED_CHARKNDCST #undef NAMED_CHARKNDCST
#undef DERIVED_TYPE #undef DERIVED_TYPE
#undef PROCEDURE #undef PROCEDURE
#undef NAMED_FUNCTION
...@@ -27,6 +27,9 @@ along with GCC; see the file COPYING3. If not see ...@@ -27,6 +27,9 @@ along with GCC; see the file COPYING3. If not see
# define NAMED_KINDARRAY(a,b,c,d) # define NAMED_KINDARRAY(a,b,c,d)
#endif #endif
#ifndef NAMED_FUNCTION
# define NAMED_FUNCTION(a,b,c,d)
#endif
/* The arguments to NAMED_INTCST are: /* The arguments to NAMED_INTCST are:
-- an internal name -- an internal name
...@@ -97,5 +100,17 @@ NAMED_KINDARRAY (ISOFORTRAN_LOGICAL_KINDS, "logical_kinds", \ ...@@ -97,5 +100,17 @@ NAMED_KINDARRAY (ISOFORTRAN_LOGICAL_KINDS, "logical_kinds", \
NAMED_KINDARRAY (ISOFORTRAN_REAL_KINDS, "real_kinds", \ NAMED_KINDARRAY (ISOFORTRAN_REAL_KINDS, "real_kinds", \
gfc_real_kinds, GFC_STD_F2008) gfc_real_kinds, GFC_STD_F2008)
/* The arguments to NAMED_FUNCTIONS are:
-- the ISYM
-- the symbol name in the module, as seen by Fortran code
-- the Fortran standard */
NAMED_FUNCTION (ISOFORTRAN_COMPILER_OPTIONS, "compiler_options", \
GFC_ISYM_COMPILER_OPTIONS, GFC_STD_F2008)
NAMED_FUNCTION (ISOFORTRAN_COMPILER_VERSION, "compiler_version", \
GFC_ISYM_COMPILER_VERSION, GFC_STD_F2008)
#undef NAMED_INTCST #undef NAMED_INTCST
#undef NAMED_KINDARRAY #undef NAMED_KINDARRAY
#undef NAMED_FUNCTION
...@@ -5207,6 +5207,38 @@ gfc_dump_module (const char *name, int dump_flag) ...@@ -5207,6 +5207,38 @@ gfc_dump_module (const char *name, int dump_flag)
} }
static void
create_intrinsic_function (const char *name, gfc_isym_id id,
const char *modname, intmod_id module)
{
gfc_intrinsic_sym *isym;
gfc_symtree *tmp_symtree;
gfc_symbol *sym;
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
if (tmp_symtree)
{
if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
return;
gfc_error ("Symbol '%s' already declared", name);
}
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
sym = tmp_symtree->n.sym;
isym = gfc_intrinsic_function_by_id (id);
gcc_assert (isym);
sym->attr.flavor = FL_PROCEDURE;
sym->attr.intrinsic = 1;
sym->module = gfc_get_string (modname);
sym->attr.use_assoc = 1;
sym->from_intmod = module;
sym->intmod_sym_id = id;
}
/* Import the intrinsic ISO_C_BINDING module, generating symbols in /* Import the intrinsic ISO_C_BINDING module, generating symbols in
the current namespace for all named constants, pointer types, and the current namespace for all named constants, pointer types, and
procedures in the module unless the only clause was used or a rename procedures in the module unless the only clause was used or a rename
...@@ -5252,14 +5284,45 @@ import_iso_c_binding_module (void) ...@@ -5252,14 +5284,45 @@ import_iso_c_binding_module (void)
{ {
u->found = 1; u->found = 1;
found = true; found = true;
generate_isocbinding_symbol (iso_c_module_name, switch (i)
(iso_c_binding_symbol) i, {
u->local_name); #define NAMED_FUNCTION(a,b,c,d) \
case a: \
create_intrinsic_function (u->local_name[0] ? u->local_name \
: u->use_name, \
(gfc_isym_id) c, \
iso_c_module_name, \
INTMOD_ISO_C_BINDING); \
break;
#include "iso-c-binding.def"
#undef NAMED_FUNCTION
default:
generate_isocbinding_symbol (iso_c_module_name,
(iso_c_binding_symbol) i,
u->local_name[0] ? u->local_name
: u->use_name);
}
} }
if (!found && !only_flag) if (!found && !only_flag)
generate_isocbinding_symbol (iso_c_module_name, switch (i)
(iso_c_binding_symbol) i, NULL); {
#define NAMED_FUNCTION(a,b,c,d) \
case a: \
if ((gfc_option.allow_std & d) == 0) \
continue; \
create_intrinsic_function (b, (gfc_isym_id) c, \
iso_c_module_name, \
INTMOD_ISO_C_BINDING); \
break;
#include "iso-c-binding.def"
#undef NAMED_FUNCTION
default:
generate_isocbinding_symbol (iso_c_module_name,
(iso_c_binding_symbol) i, NULL);
}
} }
for (u = gfc_rename_list; u; u = u->next) for (u = gfc_rename_list; u; u = u->next)
...@@ -5367,6 +5430,9 @@ use_iso_fortran_env_module (void) ...@@ -5367,6 +5430,9 @@ use_iso_fortran_env_module (void)
#define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d }, #define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d },
#include "iso-fortran-env.def" #include "iso-fortran-env.def"
#undef NAMED_KINDARRAY #undef NAMED_KINDARRAY
#define NAMED_FUNCTION(a,b,c,d) { a, b, c, d },
#include "iso-fortran-env.def"
#undef NAMED_FUNCTION
{ ISOFORTRANENV_INVALID, NULL, -1234, 0 } }; { ISOFORTRANENV_INVALID, NULL, -1234, 0 } };
i = 0; i = 0;
...@@ -5448,6 +5514,16 @@ use_iso_fortran_env_module (void) ...@@ -5448,6 +5514,16 @@ use_iso_fortran_env_module (void)
#include "iso-fortran-env.def" #include "iso-fortran-env.def"
#undef NAMED_KINDARRAY #undef NAMED_KINDARRAY
#define NAMED_FUNCTION(a,b,c,d) \
case a:
#include "iso-fortran-env.def"
#undef NAMED_FUNCTION
create_intrinsic_function (u->local_name[0] ? u->local_name
: u->use_name,
(gfc_isym_id) symbol[i].value, mod,
INTMOD_ISO_FORTRAN_ENV);
break;
default: default:
gcc_unreachable (); gcc_unreachable ();
} }
...@@ -5491,6 +5567,15 @@ use_iso_fortran_env_module (void) ...@@ -5491,6 +5567,15 @@ use_iso_fortran_env_module (void)
#include "iso-fortran-env.def" #include "iso-fortran-env.def"
#undef NAMED_KINDARRAY #undef NAMED_KINDARRAY
#define NAMED_FUNCTION(a,b,c,d) \
case a:
#include "iso-fortran-env.def"
#undef NAMED_FUNCTION
create_intrinsic_function (symbol[i].name,
(gfc_isym_id) symbol[i].value, mod,
INTMOD_ISO_FORTRAN_ENV);
break;
default: default:
gcc_unreachable (); gcc_unreachable ();
} }
......
...@@ -1396,7 +1396,7 @@ is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context) ...@@ -1396,7 +1396,7 @@ is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context)
static gfc_try static gfc_try
resolve_intrinsic (gfc_symbol *sym, locus *loc) resolve_intrinsic (gfc_symbol *sym, locus *loc)
{ {
gfc_intrinsic_sym* isym; gfc_intrinsic_sym* isym = NULL;
const char* symstd; const char* symstd;
if (sym->formal) if (sym->formal)
...@@ -1407,7 +1407,12 @@ resolve_intrinsic (gfc_symbol *sym, locus *loc) ...@@ -1407,7 +1407,12 @@ resolve_intrinsic (gfc_symbol *sym, locus *loc)
gfc_find_subroutine directly to check whether it is a function or gfc_find_subroutine directly to check whether it is a function or
subroutine. */ subroutine. */
if ((isym = gfc_find_function (sym->name))) if (sym->intmod_sym_id)
isym = gfc_intrinsic_function_by_id ((gfc_isym_id) sym->intmod_sym_id);
else
isym = gfc_find_function (sym->name);
if (isym)
{ {
if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising
&& !sym->attr.implicit_type) && !sym->attr.implicit_type)
......
...@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see
#include "intrinsic.h" #include "intrinsic.h"
#include "target-memory.h" #include "target-memory.h"
#include "constructor.h" #include "constructor.h"
#include "version.h" /* For version_string. */
gfc_expr gfc_bad_expr; gfc_expr gfc_bad_expr;
...@@ -6733,3 +6734,21 @@ gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind) ...@@ -6733,3 +6734,21 @@ gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind)
else else
return NULL; return NULL;
} }
gfc_expr *
gfc_simplify_compiler_options (void)
{
/* FIXME: PR40569 - return the proper compiler arguments. */
return gfc_get_character_expr (gfc_default_character_kind,
&gfc_current_locus, "", 0);
}
gfc_expr *
gfc_simplify_compiler_version (void)
{
return gfc_get_character_expr (gfc_default_character_kind,
&gfc_current_locus, version_string,
strlen (version_string));
}
...@@ -4280,6 +4280,13 @@ std_for_isocbinding_symbol (int id) ...@@ -4280,6 +4280,13 @@ std_for_isocbinding_symbol (int id)
return d; return d;
#include "iso-c-binding.def" #include "iso-c-binding.def"
#undef NAMED_INTCST #undef NAMED_INTCST
#define NAMED_FUNCTION(a,b,c,d) \
case a:\
return d;
#include "iso-c-binding.def"
#undef NAMED_FUNCTION
default: default:
return GFC_STD_F2003; return GFC_STD_F2003;
} }
......
...@@ -333,6 +333,11 @@ void init_c_interop_kinds (void) ...@@ -333,6 +333,11 @@ void init_c_interop_kinds (void)
c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \ c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
c_interop_kinds_table[a].value = 0; c_interop_kinds_table[a].value = 0;
#include "iso-c-binding.def" #include "iso-c-binding.def"
#define NAMED_FUNCTION(a,b,c,d) \
strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
c_interop_kinds_table[a].value = c;
#include "iso-c-binding.def"
} }
......
2010-09-27 Tobias Burnus <burnus@net-b.de>
PR fortran/40569
PR fortran/40568
* gfortran.dg/storage_size_2.f08: Fix test.
* gfortran.dg/c_sizeof_1.f90: Fix test.
* gfortran.dg/c_sizeof_2.f90: Update dg-error.
* gfortran.dg/c_sizeof_3.f90: New.
* gfortran.dg/c_sizeof_4.f90: New.
* gfortran.dg/iso_c_binding_compiler_1.f90: New.
* gfortran.dg/iso_c_binding_compiler_2.f90: New.
2010-09-26 Daniel Kraft <d@domob.eu> 2010-09-26 Daniel Kraft <d@domob.eu>
PR fortran/45783 PR fortran/45783
......
! { dg-do run } ! { dg-do run }
! Support F2008's c_sizeof() ! Support F2008's c_sizeof()
! !
use iso_c_binding, only: c_int, c_char, c_ptr, c_intptr_t, c_null_ptr use iso_c_binding, only: c_int, c_char, c_ptr, c_intptr_t, c_null_ptr, c_sizeof
integer(kind=c_int) :: i, j(10) integer(kind=c_int) :: i, j(10)
character(kind=c_char,len=4),parameter :: str(1) = "abcd" character(kind=c_char,len=4),parameter :: str(1) = "abcd"
......
...@@ -2,8 +2,8 @@ ...@@ -2,8 +2,8 @@
! { dg-options "-std=f2003 -Wall -Wno-conversion" } ! { dg-options "-std=f2003 -Wall -Wno-conversion" }
! Support F2008's c_sizeof() ! Support F2008's c_sizeof()
! !
USE ISO_C_BINDING USE ISO_C_BINDING, only: C_SIZE_T, c_sizeof ! { dg-error "new in Fortran 2008" }
integer(C_SIZE_T) :: i integer(C_SIZE_T) :: i
i = c_sizeof(i) ! { dg-warning "Fortran 2008" } i = c_sizeof(i)
end end
! { dg-do link }
!
! PR fortran/40568
!
! Module checks for C_SIZEOF (part of ISO_C_BINDING)
!
subroutine test
use iso_c_binding, only: foo => c_sizeof, bar=> c_sizeof, c_sizeof, c_int
integer(c_int) :: i
print *, c_sizeof(i), bar(i), foo(i)
end
use iso_c_binding
implicit none
integer(c_int) :: i
print *, c_sizeof(i)
call test()
end
! { dg-do link }
!
! PR fortran/40568
!
! Module checks for C_SIZEOF (part of ISO_C_BINDING)
!
implicit none
intrinsic c_sizeof ! { dg-error "does not exist" }
end
! { dg-do link }
!
! PR fortran/40569
!
! Check compiler_version/compiler_options intrinsics
!
subroutine test()
use iso_fortran_env, only: compiler_version
print '(3a)', '>>',compiler_version(),'<<'
end
use iso_fortran_env, foo => compiler_version, bar => compiler_version
implicit none
print *, foo()
print *, bar()
print '(3a)', '>',compiler_options(),'<'
call test()
end
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR fortran/40569
!
! Check compiler_version/compiler_options intrinsics
!
use iso_fortran_env, only: compiler_options ! { dg-error "is not in the selected standard" }
use iso_fortran_env, only: compiler_version ! { dg-error "is not in the selected standard" }
implicit none
end
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
! !
! Contributed by Janus Weil <janus@gcc.gnu.org> ! Contributed by Janus Weil <janus@gcc.gnu.org>
use iso_c_binding, only: c_int use iso_c_binding, only: c_int, c_sizeof
type, bind(c) :: t type, bind(c) :: t
integer(c_int) :: j integer(c_int) :: j
......
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