X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Ffortran%2Fmodule.c;h=20e4836a8c22282ba5b4a6bb4a224ae0bf182760;hb=44956e822fc9102a6e36cede143494a2bee4ff3b;hp=f16f8d3f72e6c116418b1ce56dc1988f71a2f097;hpb=f51077c71a31c0500a7f01ebe24cc1430088e96f;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index f16f8d3f72e..20e4836a8c2 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1,6 +1,7 @@ /* Handle modules, which amounts to loading and saving symbols and their attendant structures. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, + 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -72,12 +73,13 @@ along with GCC; see the file COPYING3. If not see #include "match.h" #include "parse.h" /* FIXME */ #include "md5.h" +#include "constructor.h" #define MODULE_EXTENSION ".mod" /* Don't put any single quote (') in MOD_VERSION, if yout want it to be recognized. */ -#define MOD_VERSION "1" +#define MOD_VERSION "5" /* Structure that describes a position within a module file. */ @@ -741,8 +743,7 @@ static int number_use_names (const char *name, bool interface) { int i = 0; - const char *c; - c = find_use_name_n (name, &i, interface); + find_use_name_n (name, &i, interface); return i; } @@ -1461,6 +1462,25 @@ mio_integer (int *ip) } +/* Read or write a gfc_intrinsic_op value. */ + +static void +mio_intrinsic_op (gfc_intrinsic_op* op) +{ + /* FIXME: Would be nicer to do this via the operators symbolic name. */ + if (iomode == IO_OUTPUT) + { + int converted = (int) *op; + write_atom (ATOM_INTEGER, &converted); + } + else + { + require_atom (ATOM_INTEGER); + *op = (gfc_intrinsic_op) atom_int; + } +} + + /* Read or write a character pointer that points to a string on the heap. */ static const char * @@ -1653,14 +1673,17 @@ typedef enum AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED, AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP, - AB_EXTENSION, AB_PROCEDURE, AB_PROC_POINTER + AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION, + AB_COARRAY_COMP, AB_VTYPE, AB_VTAB } ab_attribute; static const mstring attr_bits[] = { minit ("ALLOCATABLE", AB_ALLOCATABLE), + minit ("ASYNCHRONOUS", AB_ASYNCHRONOUS), minit ("DIMENSION", AB_DIMENSION), + minit ("CODIMENSION", AB_CODIMENSION), minit ("EXTERNAL", AB_EXTERNAL), minit ("INTRINSIC", AB_INTRINSIC), minit ("OPTIONAL", AB_OPTIONAL), @@ -1688,14 +1711,17 @@ static const mstring attr_bits[] = minit ("IS_ISO_C", AB_IS_ISO_C), minit ("VALUE", AB_VALUE), minit ("ALLOC_COMP", AB_ALLOC_COMP), + minit ("COARRAY_COMP", AB_COARRAY_COMP), minit ("POINTER_COMP", AB_POINTER_COMP), minit ("PRIVATE_COMP", AB_PRIVATE_COMP), minit ("ZERO_COMP", AB_ZERO_COMP), minit ("PROTECTED", AB_PROTECTED), minit ("ABSTRACT", AB_ABSTRACT), - minit ("EXTENSION", AB_EXTENSION), + minit ("IS_CLASS", AB_IS_CLASS), minit ("PROCEDURE", AB_PROCEDURE), minit ("PROC_POINTER", AB_PROC_POINTER), + minit ("VTYPE", AB_VTYPE), + minit ("VTAB", AB_VTAB), minit (NULL, -1) }; @@ -1719,7 +1745,12 @@ static const mstring binding_generic[] = minit ("GENERIC", 1), minit (NULL, -1) }; - +static const mstring binding_ppc[] = +{ + minit ("NO_PPC", 0), + minit ("PPC", 1), + minit (NULL, -1) +}; /* Specialization of mio_name. */ DECL_MIO_NAME (ab_attribute) @@ -1747,6 +1778,7 @@ static void mio_symbol_attribute (symbol_attribute *attr) { atom_type t; + unsigned ext_attr,extension_level; mio_lparen (); @@ -1755,13 +1787,25 @@ mio_symbol_attribute (symbol_attribute *attr) attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures); attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types); attr->save = MIO_NAME (save_state) (attr->save, save_status); + + ext_attr = attr->ext_attr; + mio_integer ((int *) &ext_attr); + attr->ext_attr = ext_attr; + + extension_level = attr->extension; + mio_integer ((int *) &extension_level); + attr->extension = extension_level; if (iomode == IO_OUTPUT) { if (attr->allocatable) MIO_NAME (ab_attribute) (AB_ALLOCATABLE, attr_bits); + if (attr->asynchronous) + MIO_NAME (ab_attribute) (AB_ASYNCHRONOUS, attr_bits); if (attr->dimension) MIO_NAME (ab_attribute) (AB_DIMENSION, attr_bits); + if (attr->codimension) + MIO_NAME (ab_attribute) (AB_CODIMENSION, attr_bits); if (attr->external) MIO_NAME (ab_attribute) (AB_EXTERNAL, attr_bits); if (attr->intrinsic) @@ -1828,14 +1872,20 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_POINTER_COMP, attr_bits); if (attr->private_comp) MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits); + if (attr->coarray_comp) + MIO_NAME (ab_attribute) (AB_COARRAY_COMP, attr_bits); if (attr->zero_comp) MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits); - if (attr->extension) - MIO_NAME (ab_attribute) (AB_EXTENSION, attr_bits); + if (attr->is_class) + MIO_NAME (ab_attribute) (AB_IS_CLASS, attr_bits); if (attr->procedure) MIO_NAME (ab_attribute) (AB_PROCEDURE, attr_bits); if (attr->proc_pointer) MIO_NAME (ab_attribute) (AB_PROC_POINTER, attr_bits); + if (attr->vtype) + MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits); + if (attr->vtab) + MIO_NAME (ab_attribute) (AB_VTAB, attr_bits); mio_rparen (); @@ -1855,9 +1905,15 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_ALLOCATABLE: attr->allocatable = 1; break; + case AB_ASYNCHRONOUS: + attr->asynchronous = 1; + break; case AB_DIMENSION: attr->dimension = 1; break; + case AB_CODIMENSION: + attr->codimension = 1; + break; case AB_EXTERNAL: attr->external = 1; break; @@ -1945,6 +2001,9 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_ALLOC_COMP: attr->alloc_comp = 1; break; + case AB_COARRAY_COMP: + attr->coarray_comp = 1; + break; case AB_POINTER_COMP: attr->pointer_comp = 1; break; @@ -1954,8 +2013,8 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_ZERO_COMP: attr->zero_comp = 1; break; - case AB_EXTENSION: - attr->extension = 1; + case AB_IS_CLASS: + attr->is_class = 1; break; case AB_PROCEDURE: attr->procedure = 1; @@ -1963,6 +2022,12 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_PROC_POINTER: attr->proc_pointer = 1; break; + case AB_VTYPE: + attr->vtype = 1; + break; + case AB_VTAB: + attr->vtab = 1; + break; } } } @@ -1976,6 +2041,7 @@ static const mstring bt_types[] = { minit ("LOGICAL", BT_LOGICAL), minit ("CHARACTER", BT_CHARACTER), minit ("DERIVED", BT_DERIVED), + minit ("CLASS", BT_CLASS), minit ("PROCEDURE", BT_PROCEDURE), minit ("UNKNOWN", BT_UNKNOWN), minit ("VOID", BT_VOID), @@ -2000,13 +2066,9 @@ mio_charlen (gfc_charlen **clp) { if (peek_atom () != ATOM_RPAREN) { - cl = gfc_get_charlen (); + cl = gfc_new_charlen (gfc_current_ns, NULL); mio_expr (&cl->length); - *clp = cl; - - cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = cl; } } @@ -2030,10 +2092,10 @@ mio_typespec (gfc_typespec *ts) ts->type = MIO_NAME (bt) (ts->type, bt_types); - if (ts->type != BT_DERIVED) + if (ts->type != BT_DERIVED && ts->type != BT_CLASS) mio_integer (&ts->kind); else - mio_symbol_ref (&ts->derived); + mio_symbol_ref (&ts->u.derived); /* Add info for C interop and is_iso_c. */ mio_integer (&ts->is_c_interop); @@ -2049,12 +2111,12 @@ mio_typespec (gfc_typespec *ts) if (ts->type != BT_CHARACTER) { - /* ts->cl is only valid for BT_CHARACTER. */ + /* ts->u.cl is only valid for BT_CHARACTER. */ mio_lparen (); mio_rparen (); } else - mio_charlen (&ts->cl); + mio_charlen (&ts->u.cl); mio_rparen (); } @@ -2095,9 +2157,10 @@ mio_array_spec (gfc_array_spec **asp) } mio_integer (&as->rank); + mio_integer (&as->corank); as->type = MIO_NAME (array_type) (as->type, array_spec_types); - for (i = 0; i < as->rank; i++) + for (i = 0; i < as->rank + as->corank; i++) { mio_expr (&as->lower[i]); mio_expr (&as->upper[i]); @@ -2264,7 +2327,7 @@ mio_component_ref (gfc_component **cp, gfc_symbol *sym) static void mio_namespace_ref (gfc_namespace **nsp); static void mio_formal_arglist (gfc_formal_arglist **formal); - +static void mio_typebound_proc (gfc_typebound_proc** proc); static void mio_component (gfc_component *c) @@ -2299,28 +2362,33 @@ mio_component (gfc_component *c) mio_expr (&c->initializer); - if (iomode == IO_OUTPUT) + if (c->attr.proc_pointer) { - formal = c->formal; - while (formal && !formal->sym) - formal = formal->next; + if (iomode == IO_OUTPUT) + { + formal = c->formal; + while (formal && !formal->sym) + formal = formal->next; - if (formal) - mio_namespace_ref (&formal->sym->ns); + if (formal) + mio_namespace_ref (&formal->sym->ns); + else + mio_namespace_ref (&c->formal_ns); + } else - mio_namespace_ref (&c->formal_ns); - } - else - { - mio_namespace_ref (&c->formal_ns); - /* TODO: if (c->formal_ns) { - c->formal_ns->proc_name = c; - c->refs++; - }*/ - } + mio_namespace_ref (&c->formal_ns); + /* TODO: if (c->formal_ns) + { + c->formal_ns->proc_name = c; + c->refs++; + }*/ + } + + mio_formal_arglist (&c->formal); - mio_formal_arglist (&c->formal); + mio_typebound_proc (&c->tb); + } mio_rparen (); } @@ -2573,15 +2641,15 @@ done: static void -mio_constructor (gfc_constructor **cp) +mio_constructor (gfc_constructor_base *cp) { - gfc_constructor *c, *tail; + gfc_constructor *c; mio_lparen (); if (iomode == IO_OUTPUT) { - for (c = *cp; c; c = c->next) + for (c = gfc_constructor_first (*cp); c; c = gfc_constructor_next (c)) { mio_lparen (); mio_expr (&c->expr); @@ -2591,19 +2659,9 @@ mio_constructor (gfc_constructor **cp) } else { - *cp = NULL; - tail = NULL; - while (peek_atom () != ATOM_RPAREN) { - c = gfc_get_constructor (); - - if (tail == NULL) - *cp = c; - else - tail->next = c; - - tail = c; + c = gfc_constructor_append_expr (cp, NULL, NULL); mio_lparen (); mio_expr (&c->expr); @@ -2886,6 +2944,8 @@ fix_mio_expr (gfc_expr *e) } else if (e->expr_type == EXPR_FUNCTION && e->value.function.name) { + gfc_symbol *sym; + /* In some circumstances, a function used in an initialization expression, in one use associated module, can fail to be coupled to its symtree when used in a specification @@ -2893,6 +2953,19 @@ fix_mio_expr (gfc_expr *e) fname = e->value.function.esym ? e->value.function.esym->name : e->value.function.isym->name; e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname); + + if (e->symtree) + return; + + /* This is probably a reference to a private procedure from another + module. To prevent a segfault, make a generic with no specific + instances. If this module is used, without the required + specific coming from somewhere, the appropriate error message + is issued. */ + gfc_get_symbol (fname, gfc_current_ns, &sym); + sym->attr.flavor = FL_PROCEDURE; + sym->attr.generic = 1; + e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname); } } @@ -3269,9 +3342,9 @@ mio_typebound_proc (gfc_typebound_proc** proc) (*proc)->nopass = mio_name ((*proc)->nopass, binding_passing); (*proc)->is_generic = mio_name ((*proc)->is_generic, binding_generic); + (*proc)->ppc = mio_name((*proc)->ppc, binding_ppc); - if (iomode == IO_INPUT) - (*proc)->pass_arg = NULL; + mio_pool_string (&((*proc)->pass_arg)); flag = (int) (*proc)->pass_arg_num; mio_integer (&flag); @@ -3308,12 +3381,13 @@ mio_typebound_proc (gfc_typebound_proc** proc) mio_rparen (); } - else + else if (!(*proc)->ppc) mio_symtree_ref (&(*proc)->u.specific); mio_rparen (); } +/* Walker-callback function for this purpose. */ static void mio_typebound_symtree (gfc_symtree* st) { @@ -3331,6 +3405,33 @@ mio_typebound_symtree (gfc_symtree* st) mio_rparen (); } +/* IO a full symtree (in all depth). */ +static void +mio_full_typebound_tree (gfc_symtree** root) +{ + mio_lparen (); + + if (iomode == IO_OUTPUT) + gfc_traverse_symtree (*root, &mio_typebound_symtree); + else + { + while (peek_atom () == ATOM_LPAREN) + { + gfc_symtree* st; + + mio_lparen (); + + require_atom (ATOM_STRING); + st = gfc_get_tbp_symtree (root, atom_string); + gfc_free (atom_string); + + mio_typebound_symtree (st); + } + } + + mio_rparen (); +} + static void mio_finalizer (gfc_finalizer **f) { @@ -3378,24 +3479,40 @@ mio_f2k_derived (gfc_namespace *f2k) mio_rparen (); /* Handle type-bound procedures. */ + mio_full_typebound_tree (&f2k->tb_sym_root); + + /* Type-bound user operators. */ + mio_full_typebound_tree (&f2k->tb_uop_root); + + /* Type-bound intrinsic operators. */ mio_lparen (); if (iomode == IO_OUTPUT) - gfc_traverse_symtree (f2k->tb_sym_root, &mio_typebound_symtree); - else { - while (peek_atom () == ATOM_LPAREN) + int op; + for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op) { - gfc_symtree* st; + gfc_intrinsic_op realop; - mio_lparen (); - - require_atom (ATOM_STRING); - st = gfc_get_tbp_symtree (&f2k->tb_sym_root, atom_string); - gfc_free (atom_string); + if (op == INTRINSIC_USER || !f2k->tb_op[op]) + continue; - mio_typebound_symtree (st); + mio_lparen (); + realop = (gfc_intrinsic_op) op; + mio_intrinsic_op (&realop); + mio_typebound_proc (&f2k->tb_op[op]); + mio_rparen (); } } + else + while (peek_atom () != ATOM_RPAREN) + { + gfc_intrinsic_op op = GFC_INTRINSIC_BEGIN; /* Silence GCC. */ + + mio_lparen (); + mio_intrinsic_op (&op); + mio_typebound_proc (&f2k->tb_op[op]); + mio_rparen (); + } mio_rparen (); } @@ -3493,7 +3610,10 @@ mio_symbol (gfc_symbol *sym) } mio_integer (&(sym->intmod_sym_id)); - + + if (sym->attr.flavor == FL_DERIVED) + mio_integer (&(sym->hash_value)); + mio_rparen (); } @@ -3663,8 +3783,9 @@ load_generic_interfaces (void) const char *p; char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; - gfc_interface *generic = NULL; + gfc_interface *generic = NULL, *gen = NULL; int n, i, renamed; + bool ambiguous_set = false; mio_lparen (); @@ -3749,9 +3870,13 @@ load_generic_interfaces (void) sym = st->n.sym; if (st && !sym->attr.generic + && !st->ambiguous && sym->module && strcmp(module, sym->module)) - st->ambiguous = 1; + { + ambiguous_set = true; + st->ambiguous = 1; + } } sym->attr.use_only = only_flag; @@ -3767,6 +3892,26 @@ load_generic_interfaces (void) sym->generic = generic; sym->attr.generic_copy = 1; } + + /* If a procedure that is not generic has generic interfaces + that include itself, it is generic! We need to take care + to retain symbols ambiguous that were already so. */ + if (sym->attr.use_assoc + && !sym->attr.generic + && sym->attr.flavor == FL_PROCEDURE) + { + for (gen = generic; gen; gen = gen->next) + { + if (gen->sym == sym) + { + sym->attr.generic = 1; + if (ambiguous_set) + st->ambiguous = 0; + break; + } + } + } + } } @@ -3889,6 +4034,71 @@ load_equiv (void) } +/* This function loads the sym_root of f2k_derived with the extensions to + the derived type. */ +static void +load_derived_extensions (void) +{ + int symbol, j; + gfc_symbol *derived; + gfc_symbol *dt; + gfc_symtree *st; + pointer_info *info; + char name[GFC_MAX_SYMBOL_LEN + 1]; + char module[GFC_MAX_SYMBOL_LEN + 1]; + const char *p; + + mio_lparen (); + while (peek_atom () != ATOM_RPAREN) + { + mio_lparen (); + mio_integer (&symbol); + info = get_integer (symbol); + derived = info->u.rsym.sym; + + /* This one is not being loaded. */ + if (!info || !derived) + { + while (peek_atom () != ATOM_RPAREN) + skip_list (); + continue; + } + + gcc_assert (derived->attr.flavor == FL_DERIVED); + if (derived->f2k_derived == NULL) + derived->f2k_derived = gfc_get_namespace (NULL, 0); + + while (peek_atom () != ATOM_RPAREN) + { + mio_lparen (); + mio_internal_string (name); + mio_internal_string (module); + + /* Only use one use name to find the symbol. */ + j = 1; + p = find_use_name_n (name, &j, false); + if (p) + { + st = gfc_find_symtree (gfc_current_ns->sym_root, p); + dt = st->n.sym; + st = gfc_find_symtree (derived->f2k_derived->sym_root, name); + if (st == NULL) + { + /* Only use the real name in f2k_derived to ensure a single + symtree. */ + st = gfc_new_symtree (&derived->f2k_derived->sym_root, name); + st->n.sym = dt; + st->n.sym->refs++; + } + } + mio_rparen (); + } + mio_rparen (); + } + mio_rparen (); +} + + /* Recursive function to traverse the pointer_info tree and load a needed symbol. We return nonzero if we load a symbol and stop the traversal, because the act of loading can alter the tree. */ @@ -4003,6 +4213,9 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info) if (st_sym == rsym) return false; + if (st_sym->attr.vtab || st_sym->attr.vtype) + return false; + /* If the existing symbol is generic from a different module and the new symbol is generic there can be no ambiguity. */ if (st_sym->attr.generic @@ -4030,7 +4243,7 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info) static void read_module (void) { - module_locus operator_interfaces, user_operators; + module_locus operator_interfaces, user_operators, extensions; const char *p; char name[GFC_MAX_SYMBOL_LEN + 1]; int i; @@ -4047,10 +4260,13 @@ read_module (void) skip_list (); skip_list (); - /* Skip commons and equivalences for now. */ + /* Skip commons, equivalences and derived type extensions for now. */ skip_list (); skip_list (); + get_module_locus (&extensions); + skip_list (); + mio_lparen (); /* Create the fixup nodes for all the symbols. */ @@ -4301,7 +4517,10 @@ read_module (void) module_name); } - gfc_check_interfaces (gfc_current_ns); + /* Now we should be in a position to fill f2k_derived with derived type + extensions, since everything has been loaded. */ + set_module_locus (&extensions); + load_derived_extensions (); /* Clean up symbol nodes that were never loaded, create references to hidden symbols. */ @@ -4511,6 +4730,40 @@ write_equiv (void) } +/* Write derived type extensions to the module. */ + +static void +write_dt_extensions (gfc_symtree *st) +{ + if (!gfc_check_access (st->n.sym->attr.access, + st->n.sym->ns->default_access)) + return; + + mio_lparen (); + mio_pool_string (&st->n.sym->name); + if (st->n.sym->module != NULL) + mio_pool_string (&st->n.sym->module); + else + mio_internal_string (module_name); + mio_rparen (); +} + +static void +write_derived_extensions (gfc_symtree *st) +{ + if (!((st->n.sym->attr.flavor == FL_DERIVED) + && (st->n.sym->f2k_derived != NULL) + && (st->n.sym->f2k_derived->sym_root != NULL))) + return; + + mio_lparen (); + mio_symbol_ref (&(st->n.sym)); + gfc_traverse_symtree (st->n.sym->f2k_derived->sym_root, + write_dt_extensions); + mio_rparen (); +} + + /* Write a symbol to the module. */ static void @@ -4737,6 +4990,13 @@ write_module (void) write_char ('\n'); write_char ('\n'); + mio_lparen (); + gfc_traverse_symtree (gfc_current_ns->sym_root, + write_derived_extensions); + mio_rparen (); + write_char ('\n'); + write_char ('\n'); + /* Write symbol information. First we traverse all symbols in the primary namespace, writing those that need to be written. Sometimes writing one symbol will cause another to need to be @@ -5089,7 +5349,7 @@ create_int_parameter (const char *name, int value, const char *modname, sym->attr.flavor = FL_PARAMETER; sym->ts.type = BT_INTEGER; sym->ts.kind = gfc_default_integer_kind; - sym->value = gfc_int_expr (value); + sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL, value); sym->attr.use_assoc = 1; sym->from_intmod = module; sym->intmod_sym_id = id; @@ -5161,6 +5421,11 @@ use_iso_fortran_env_module (void) gfc_option.flag_default_integer ? "-fdefault-integer-8" : "-fdefault-real-8"); + if (gfc_notify_std (symbol[i].standard, "The symbol '%s', referrenced " + "at %C, is not in the selected standard", + symbol[i].name) == FAILURE) + continue; + create_int_parameter (u->local_name[0] ? u->local_name : symbol[i].name, symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV, @@ -5171,6 +5436,10 @@ use_iso_fortran_env_module (void) for (i = 0; symbol[i].name; i++) { local_name = NULL; + + if ((gfc_option.allow_std & symbol[i].standard) == 0) + break; + for (u = gfc_rename_list; u; u = u->next) { if (strcmp (symbol[i].name, u->use_name) == 0) @@ -5181,6 +5450,13 @@ use_iso_fortran_env_module (void) } } + if (u && gfc_notify_std (symbol[i].standard, "The symbol '%s', " + "referrenced at %C, is not in the selected " + "standard", symbol[i].name) == FAILURE) + continue; + else if ((gfc_option.allow_std & symbol[i].standard) == 0) + continue; + if ((gfc_option.flag_default_integer || gfc_option.flag_default_real) && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE) gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant " @@ -5296,9 +5572,9 @@ gfc_use_module (void) if (strcmp (atom_string, MOD_VERSION)) { - gfc_fatal_error ("Wrong module version '%s' (expected '" - MOD_VERSION "') for file '%s' opened" - " at %C", atom_string, filename); + gfc_fatal_error ("Wrong module version '%s' (expected '%s') " + "for file '%s' opened at %C", atom_string, + MOD_VERSION, filename); } }