GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
for more details.
You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
/* The syntax of gfortran modules resembles that of lisp lists, ie a
sequence of atoms, which can be left or right parenthesis, names,
}
module_locus;
+/* Structure for list of symbols of intrinsic modules. */
+typedef struct
+{
+ int id;
+ const char *name;
+ int value;
+}
+intmod_sym;
+
typedef enum
{
module_locus where;
fixup_t *stfixup;
gfc_symtree *symtree;
+ char binding_label[GFC_MAX_SYMBOL_LEN + 1];
}
rsym;
== FAILURE))
goto cleanup;
+ if (type == INTERFACE_USER_OP)
+ new->operator = INTRINSIC_USER;
+
if (only_flag)
{
if (m != MATCH_YES)
"an external module name.", module_name);
goto cleanup;
}
-
- if (type == INTERFACE_USER_OP)
- new->operator = operator;
-
break;
case INTERFACE_INTRINSIC_OP:
/* Given a name and a number, inst, return the inst name
under which to load this symbol. Returns NULL if this
symbol shouldn't be loaded. If inst is zero, returns
- the number of instances of this name. */
+ the number of instances of this name. If interface is
+ true, a user-defined operator is sought, otherwise only
+ non-operators are sought. */
static const char *
-find_use_name_n (const char *name, int *inst)
+find_use_name_n (const char *name, int *inst, bool interface)
{
gfc_use_rename *u;
int i;
i = 0;
for (u = gfc_rename_list; u; u = u->next)
{
- if (strcmp (u->use_name, name) != 0)
+ if (strcmp (u->use_name, name) != 0
+ || (u->operator == INTRINSIC_USER && !interface)
+ || (u->operator != INTRINSIC_USER && interface))
continue;
if (++i == *inst)
break;
Returns NULL if this symbol shouldn't be loaded. */
static const char *
-find_use_name (const char *name)
+find_use_name (const char *name, bool interface)
{
int i = 1;
- return find_use_name_n (name, &i);
+ return find_use_name_n (name, &i, interface);
}
/* Given a real name, return the number of use names associated with it. */
static int
-number_use_names (const char *name)
+number_use_names (const char *name, bool interface)
{
int i = 0;
const char *c;
- c = find_use_name_n (name, &i);
+ c = find_use_name_n (name, &i, interface);
return i;
}
}
+ if(p == NULL || *p == '\0')
+ len = 0;
+ else
len = strlen (p);
if (atom != ATOM_RPAREN)
if (atom == ATOM_STRING)
write_char ('\'');
- while (*p)
+ while (p != NULL && *p)
{
if (atom == ATOM_STRING && *p == '\'')
write_char ('\'');
typedef enum
{ AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
- AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
+ AB_POINTER, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE,
AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
- AB_VALUE, AB_VOLATILE, AB_PROTECTED
+ 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_attribute;
minit ("INTRINSIC", AB_INTRINSIC),
minit ("OPTIONAL", AB_OPTIONAL),
minit ("POINTER", AB_POINTER),
- minit ("SAVE", AB_SAVE),
- minit ("VALUE", AB_VALUE),
minit ("VOLATILE", AB_VOLATILE),
minit ("TARGET", AB_TARGET),
minit ("THREADPRIVATE", AB_THREADPRIVATE),
minit ("ALWAYS_EXPLICIT", AB_ALWAYS_EXPLICIT),
minit ("CRAY_POINTER", AB_CRAY_POINTER),
minit ("CRAY_POINTEE", AB_CRAY_POINTEE),
+ minit ("IS_BIND_C", AB_IS_BIND_C),
+ minit ("IS_C_INTEROP", AB_IS_C_INTEROP),
+ minit ("IS_ISO_C", AB_IS_ISO_C),
+ minit ("VALUE", AB_VALUE),
minit ("ALLOC_COMP", AB_ALLOC_COMP),
+ minit ("POINTER_COMP", AB_POINTER_COMP),
+ minit ("PRIVATE_COMP", AB_PRIVATE_COMP),
minit ("PROTECTED", AB_PROTECTED),
minit (NULL, -1)
};
+
/* Specialization of mio_name. */
DECL_MIO_NAME (ab_attribute)
DECL_MIO_NAME (ar_type)
DECL_MIO_NAME (gfc_access)
DECL_MIO_NAME (gfc_intrinsic_op)
DECL_MIO_NAME (ifsrc)
+DECL_MIO_NAME (save_state)
DECL_MIO_NAME (procedure_type)
DECL_MIO_NAME (ref_type)
DECL_MIO_NAME (sym_flavor)
attr->intent = MIO_NAME (sym_intent) (attr->intent, intents);
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);
if (iomode == IO_OUTPUT)
{
MIO_NAME (ab_attribute) (AB_POINTER, attr_bits);
if (attr->protected)
MIO_NAME (ab_attribute) (AB_PROTECTED, attr_bits);
- if (attr->save)
- MIO_NAME (ab_attribute) (AB_SAVE, attr_bits);
if (attr->value)
MIO_NAME (ab_attribute) (AB_VALUE, attr_bits);
if (attr->volatile_)
MIO_NAME (ab_attribute) (AB_CRAY_POINTER, attr_bits);
if (attr->cray_pointee)
MIO_NAME (ab_attribute) (AB_CRAY_POINTEE, attr_bits);
+ if (attr->is_bind_c)
+ MIO_NAME(ab_attribute) (AB_IS_BIND_C, attr_bits);
+ if (attr->is_c_interop)
+ MIO_NAME(ab_attribute) (AB_IS_C_INTEROP, attr_bits);
+ if (attr->is_iso_c)
+ MIO_NAME(ab_attribute) (AB_IS_ISO_C, attr_bits);
if (attr->alloc_comp)
MIO_NAME (ab_attribute) (AB_ALLOC_COMP, attr_bits);
+ if (attr->pointer_comp)
+ MIO_NAME (ab_attribute) (AB_POINTER_COMP, attr_bits);
+ if (attr->private_comp)
+ MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits);
mio_rparen ();
case AB_PROTECTED:
attr->protected = 1;
break;
- case AB_SAVE:
- attr->save = 1;
- break;
case AB_VALUE:
attr->value = 1;
break;
case AB_CRAY_POINTEE:
attr->cray_pointee = 1;
break;
+ case AB_IS_BIND_C:
+ attr->is_bind_c = 1;
+ break;
+ case AB_IS_C_INTEROP:
+ attr->is_c_interop = 1;
+ break;
+ case AB_IS_ISO_C:
+ attr->is_iso_c = 1;
+ break;
case AB_ALLOC_COMP:
attr->alloc_comp = 1;
break;
+ case AB_POINTER_COMP:
+ attr->pointer_comp = 1;
+ break;
+ case AB_PRIVATE_COMP:
+ attr->private_comp = 1;
+ break;
}
}
}
minit ("DERIVED", BT_DERIVED),
minit ("PROCEDURE", BT_PROCEDURE),
minit ("UNKNOWN", BT_UNKNOWN),
+ minit ("VOID", BT_VOID),
minit (NULL, -1)
};
}
-/* Return a symtree node with a name that is guaranteed to be unique
- within the namespace and corresponds to an illegal fortran name. */
-
-static gfc_symtree *
-get_unique_symtree (gfc_namespace *ns)
-{
- char name[GFC_MAX_SYMBOL_LEN + 1];
- static int serial = 0;
-
- sprintf (name, "@%d", serial++);
- return gfc_new_symtree (&ns->sym_root, name);
-}
-
-
/* See if a name is a generated name. */
static int
else
mio_symbol_ref (&ts->derived);
+ /* Add info for C interop and is_iso_c. */
+ mio_integer (&ts->is_c_interop);
+ mio_integer (&ts->is_iso_c);
+
+ /* If the typespec is for an identifier either from iso_c_binding, or
+ a constant that was initialized to an identifier from it, use the
+ f90_type. Otherwise, use the ts->type, since it shouldn't matter. */
+ if (ts->is_iso_c)
+ ts->f90_type = MIO_NAME (bt) (ts->f90_type, bt_types);
+ else
+ ts->f90_type = MIO_NAME (bt) (ts->type, bt_types);
+
if (ts->type != BT_CHARACTER)
{
/* ts->cl is only valid for BT_CHARACTER. */
if (in_load_equiv && p->u.rsym.symtree == NULL)
{
/* Since this is not used, it must have a unique name. */
- p->u.rsym.symtree = get_unique_symtree (gfc_current_ns);
+ p->u.rsym.symtree = gfc_get_unique_symtree (gfc_current_ns);
/* Make the symbol. */
if (p->u.rsym.sym == NULL)
minit ("OR", INTRINSIC_OR),
minit ("EQV", INTRINSIC_EQV),
minit ("NEQV", INTRINSIC_NEQV),
- minit ("EQ", INTRINSIC_EQ),
- minit ("NE", INTRINSIC_NE),
- minit ("GT", INTRINSIC_GT),
- minit ("GE", INTRINSIC_GE),
- minit ("LT", INTRINSIC_LT),
- minit ("LE", INTRINSIC_LE),
+ minit ("==", INTRINSIC_EQ),
+ minit ("EQ", INTRINSIC_EQ_OS),
+ minit ("/=", INTRINSIC_NE),
+ minit ("NE", INTRINSIC_NE_OS),
+ minit (">", INTRINSIC_GT),
+ minit ("GT", INTRINSIC_GT_OS),
+ minit (">=", INTRINSIC_GE),
+ minit ("GE", INTRINSIC_GE_OS),
+ minit ("<", INTRINSIC_LT),
+ minit ("LT", INTRINSIC_LT_OS),
+ minit ("<=", INTRINSIC_LE),
+ minit ("LE", INTRINSIC_LE_OS),
minit ("NOT", INTRINSIC_NOT),
minit ("PARENTHESES", INTRINSIC_PARENTHESES),
minit (NULL, -1)
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
case INTRINSIC_EQ:
+ case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
+ case INTRINSIC_NE_OS:
case INTRINSIC_GT:
+ case INTRINSIC_GT_OS:
case INTRINSIC_GE:
+ case INTRINSIC_GE_OS:
case INTRINSIC_LT:
+ case INTRINSIC_LT_OS:
case INTRINSIC_LE:
+ case INTRINSIC_LE_OS:
mio_expr (&e->value.op.op1);
mio_expr (&e->value.op.op2);
break;
conditionally? */
if (sym->attr.flavor == FL_NAMELIST)
{
- check_name = find_use_name (sym->name);
+ check_name = find_use_name (sym->name, false);
if (check_name && strcmp (check_name, sym->name) != 0)
gfc_error ("Namelist %s cannot be renamed by USE "
"association to %s", sym->name, check_name);
static void
mio_symbol (gfc_symbol *sym)
{
+ int intmod = INTMOD_NONE;
+
gfc_formal_arglist *formal;
mio_lparen ();
= MIO_NAME (gfc_access) (sym->component_access, access_types);
mio_namelist (sym);
+
+ /* Add the fields that say whether this is from an intrinsic module,
+ and if so, what symbol it is within the module. */
+/* mio_integer (&(sym->from_intmod)); */
+ if (iomode == IO_OUTPUT)
+ {
+ intmod = sym->from_intmod;
+ mio_integer (&intmod);
+ }
+ else
+ {
+ mio_integer (&intmod);
+ sym->from_intmod = intmod;
+ }
+
+ mio_integer (&(sym->intmod_sym_id));
+
mio_rparen ();
}
mio_internal_string (module);
/* Decide if we need to load this one or not. */
- p = find_use_name (name);
+ p = find_use_name (name, true);
if (p == NULL)
{
while (parse_atom () != ATOM_RPAREN);
mio_internal_string (name);
mio_internal_string (module);
- n = number_use_names (name);
+ n = number_use_names (name, false);
n = n ? n : 1;
for (i = 1; i <= n; i++)
{
/* Decide if we need to load this one or not. */
- p = find_use_name_n (name, &i);
+ p = find_use_name_n (name, &i, false);
if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym))
{
while (parse_atom () != ATOM_RPAREN);
- continue;
+ continue;
}
if (sym == NULL)
p->threadprivate = 1;
p->use_assoc = 1;
+ /* Get whether this was a bind(c) common or not. */
+ mio_integer (&p->is_bind_c);
+ /* Get the binding label. */
+ mio_internal_string (p->binding_label);
+
mio_rparen ();
}
{
/* Add hidden symbols to the symtree. */
q = get_integer (p->u.rsym.ns);
- st = get_unique_symtree ((gfc_namespace *) q->u.pointer);
+ st = gfc_get_unique_symtree ((gfc_namespace *) q->u.pointer);
st->n.sym = p->u.rsym.sym;
st->n.sym->refs++;
mio_internal_string (info->u.rsym.true_name);
mio_internal_string (info->u.rsym.module);
+ mio_internal_string (info->u.rsym.binding_label);
+
require_atom (ATOM_INTEGER);
info->u.rsym.ns = atom_int;
/* See how many use names there are. If none, go through the start
of the loop at least once. */
- nuse = number_use_names (name);
+ nuse = number_use_names (name, false);
if (nuse == 0)
nuse = 1;
for (j = 1; j <= nuse; j++)
{
/* Get the jth local name for this symbol. */
- p = find_use_name_n (name, &j);
+ p = find_use_name_n (name, &j, false);
if (p == NULL && strcmp (name, module_name) == 0)
p = name;
/* Create a symtree node in the current namespace for this
symbol. */
st = check_unique_name (p)
- ? get_unique_symtree (gfc_current_ns)
+ ? gfc_get_unique_symtree (gfc_current_ns)
: gfc_new_symtree (&gfc_current_ns->sym_root, p);
st->ambiguous = ambiguous;
gfc_current_ns);
sym = info->u.rsym.sym;
sym->module = gfc_get_string (info->u.rsym.module);
+
+ /* TODO: hmm, can we test this? Do we know it will be
+ initialized to zeros? */
+ if (info->u.rsym.binding_label[0] != '\0')
+ strcpy (sym->binding_label, info->u.rsym.binding_label);
}
st->n.sym = sym;
if (specific_access == ACCESS_PRIVATE)
return FALSE;
- return default_access != ACCESS_PRIVATE;
+ if (gfc_option.flag_module_private)
+ return default_access == ACCESS_PUBLIC;
+ else
+ return default_access != ACCESS_PRIVATE;
}
gfc_common_head *p;
const char * name;
int flags;
-
+ const char *label;
+
if (st == NULL)
return;
if (p->threadprivate) flags |= 2;
mio_integer (&flags);
+ /* Write out whether the common block is bind(c) or not. */
+ mio_integer (&(p->is_bind_c));
+
+ /* Write out the binding label, or the com name if no label given. */
+ if (p->is_bind_c)
+ {
+ label = p->binding_label;
+ mio_pool_string (&label);
+ }
+ else
+ {
+ label = p->name;
+ mio_pool_string (&label);
+ }
+
mio_rparen ();
}
-/* Write the blank common block to the module */
+
+/* Write the blank common block to the module. */
static void
write_blank_common (void)
{
const char * name = BLANK_COMMON_NAME;
int saved;
+ /* TODO: Blank commons are not bind(c). The F2003 standard probably says
+ this, but it hasn't been checked. Just making it so for now. */
+ int is_bind_c = 0;
if (gfc_current_ns->blank_common.head == NULL)
return;
saved = gfc_current_ns->blank_common.saved;
mio_integer (&saved);
+ /* Write out whether the common block is bind(c) or not. */
+ mio_integer (&is_bind_c);
+
+ /* Write out the binding label, which is BLANK_COMMON_NAME, though
+ it doesn't matter because the label isn't used. */
+ mio_pool_string (&name);
+
mio_rparen ();
}
static void
write_symbol (int n, gfc_symbol *sym)
{
+ const char *label;
if (sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL)
gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name);
mio_pool_string (&sym->name);
mio_pool_string (&sym->module);
+ if (sym->attr.is_bind_c || sym->attr.is_iso_c)
+ {
+ label = sym->binding_label;
+ mio_pool_string (&label);
+ }
+ else
+ mio_pool_string (&sym->name);
+
mio_pointer_ref (&sym->ns);
mio_symbol (sym);
write_symbol (p->integer, sym);
p->u.wsym.state = WRITTEN;
-
- return;
}
static void
write_generic (gfc_symbol *sym)
{
+ const char *p;
+ int nuse, j;
+
if (sym->generic == NULL
|| !gfc_check_access (sym->attr.access, sym->ns->default_access))
return;
if (sym->module == NULL)
sym->module = gfc_get_string (module_name);
- mio_symbol_interface (&sym->name, &sym->module, &sym->generic);
+ /* See how many use names there are. If none, use the symbol name. */
+ nuse = number_use_names (sym->name, false);
+ if (nuse == 0)
+ {
+ mio_symbol_interface (&sym->name, &sym->module, &sym->generic);
+ return;
+ }
+
+ for (j = 1; j <= nuse; j++)
+ {
+ /* Get the jth local name for this symbol. */
+ p = find_use_name_n (sym->name, &j, false);
+
+ mio_symbol_interface (&p, &sym->module, &sym->generic);
+ }
}
}
+static void
+sort_iso_c_rename_list (void)
+{
+ gfc_use_rename *tmp_list = NULL;
+ gfc_use_rename *curr;
+ gfc_use_rename *kinds_used[ISOCBINDING_NUMBER] = {NULL};
+ int c_kind;
+ int i;
+
+ for (curr = gfc_rename_list; curr; curr = curr->next)
+ {
+ c_kind = get_c_kind (curr->use_name, c_interop_kinds_table);
+ if (c_kind == ISOCBINDING_INVALID || c_kind == ISOCBINDING_LAST)
+ {
+ gfc_error ("Symbol '%s' referenced at %L does not exist in "
+ "intrinsic module ISO_C_BINDING.", curr->use_name,
+ &curr->where);
+ }
+ else
+ /* Put it in the list. */
+ kinds_used[c_kind] = curr;
+ }
+
+ /* Make a new (sorted) rename list. */
+ i = 0;
+ while (i < ISOCBINDING_NUMBER && kinds_used[i] == NULL)
+ i++;
+
+ if (i < ISOCBINDING_NUMBER)
+ {
+ tmp_list = kinds_used[i];
+
+ i++;
+ curr = tmp_list;
+ for (; i < ISOCBINDING_NUMBER; i++)
+ if (kinds_used[i] != NULL)
+ {
+ curr->next = kinds_used[i];
+ curr = curr->next;
+ curr->next = NULL;
+ }
+ }
+
+ gfc_rename_list = tmp_list;
+}
+
+
+/* Import the intrinsic ISO_C_BINDING module, generating symbols in
+ the current namespace for all named constants, pointer types, and
+ procedures in the module unless the only clause was used or a rename
+ list was provided. */
+
+static void
+import_iso_c_binding_module (void)
+{
+ gfc_symbol *mod_sym = NULL;
+ gfc_symtree *mod_symtree = NULL;
+ const char *iso_c_module_name = "__iso_c_binding";
+ gfc_use_rename *u;
+ int i;
+ char *local_name;
+
+ /* Look only in the current namespace. */
+ mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name);
+
+ if (mod_symtree == NULL)
+ {
+ /* symtree doesn't already exist in current namespace. */
+ gfc_get_sym_tree (iso_c_module_name, gfc_current_ns, &mod_symtree);
+
+ if (mod_symtree != NULL)
+ mod_sym = mod_symtree->n.sym;
+ else
+ gfc_internal_error ("import_iso_c_binding_module(): Unable to "
+ "create symbol for %s", iso_c_module_name);
+
+ mod_sym->attr.flavor = FL_MODULE;
+ mod_sym->attr.intrinsic = 1;
+ mod_sym->module = gfc_get_string (iso_c_module_name);
+ mod_sym->from_intmod = INTMOD_ISO_C_BINDING;
+ }
+
+ /* Generate the symbols for the named constants representing
+ the kinds for intrinsic data types. */
+ if (only_flag)
+ {
+ /* Sort the rename list because there are dependencies between types
+ and procedures (e.g., c_loc needs c_ptr). */
+ sort_iso_c_rename_list ();
+
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ i = get_c_kind (u->use_name, c_interop_kinds_table);
+
+ if (i == ISOCBINDING_INVALID || i == ISOCBINDING_LAST)
+ {
+ gfc_error ("Symbol '%s' referenced at %L does not exist in "
+ "intrinsic module ISO_C_BINDING.", u->use_name,
+ &u->where);
+ continue;
+ }
+
+ generate_isocbinding_symbol (iso_c_module_name, i, u->local_name);
+ }
+ }
+ else
+ {
+ for (i = 0; i < ISOCBINDING_NUMBER; i++)
+ {
+ local_name = NULL;
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0)
+ {
+ local_name = u->local_name;
+ u->found = 1;
+ break;
+ }
+ }
+ generate_isocbinding_symbol (iso_c_module_name, i, local_name);
+ }
+
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ if (u->found)
+ continue;
+
+ gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+ "module ISO_C_BINDING", u->use_name, &u->where);
+ }
+ }
+}
+
+
/* Add an integer named constant from a given module. */
+
static void
-create_int_parameter (const char *name, int value, const char *modname)
+create_int_parameter (const char *name, int value, const char *modname,
+ intmod_id module, int id)
{
gfc_symtree *tmp_symtree;
gfc_symbol *sym;
sym->ts.kind = gfc_default_integer_kind;
sym->value = gfc_int_expr (value);
sym->attr.use_assoc = 1;
+ sym->from_intmod = module;
+ sym->intmod_sym_id = id;
}
gfc_symtree *mod_symtree;
int i;
- mstring symbol[] = {
-#define NAMED_INTCST(a,b,c) minit(b,0),
+ intmod_sym symbol[] = {
+#define NAMED_INTCST(a,b,c) { a, b, 0 },
#include "iso-fortran-env.def"
#undef NAMED_INTCST
- minit (NULL, -1234) };
+ { ISOFORTRANENV_INVALID, NULL, -1234 } };
i = 0;
-#define NAMED_INTCST(a,b,c) symbol[i++].tag = c;
+#define NAMED_INTCST(a,b,c) symbol[i++].value = c;
#include "iso-fortran-env.def"
#undef NAMED_INTCST
mod_sym->attr.flavor = FL_MODULE;
mod_sym->attr.intrinsic = 1;
mod_sym->module = gfc_get_string (mod);
+ mod_sym->from_intmod = INTMOD_ISO_FORTRAN_ENV;
}
else
if (!mod_symtree->n.sym->attr.intrinsic)
if (only_flag)
for (u = gfc_rename_list; u; u = u->next)
{
- for (i = 0; symbol[i].string; i++)
- if (strcmp (symbol[i].string, u->use_name) == 0)
+ for (i = 0; symbol[i].name; i++)
+ if (strcmp (symbol[i].name, u->use_name) == 0)
break;
- if (symbol[i].string == NULL)
+ if (symbol[i].name == NULL)
{
gfc_error ("Symbol '%s' referenced at %L does not exist in "
"intrinsic module ISO_FORTRAN_ENV", u->use_name,
}
if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
- && strcmp (symbol[i].string, "numeric_storage_size") == 0)
+ && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
"from intrinsic module ISO_FORTRAN_ENV at %L is "
"incompatible with option %s", &u->where,
? "-fdefault-integer-8" : "-fdefault-real-8");
create_int_parameter (u->local_name[0] ? u->local_name
- : symbol[i].string,
- symbol[i].tag, mod);
+ : symbol[i].name,
+ symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV,
+ symbol[i].id);
}
else
{
- for (i = 0; symbol[i].string; i++)
+ for (i = 0; symbol[i].name; i++)
{
local_name = NULL;
for (u = gfc_rename_list; u; u = u->next)
{
- if (strcmp (symbol[i].string, u->use_name) == 0)
+ if (strcmp (symbol[i].name, u->use_name) == 0)
{
local_name = u->local_name;
u->found = 1;
}
if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
- && strcmp (symbol[i].string, "numeric_storage_size") == 0)
+ && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
"from intrinsic module ISO_FORTRAN_ENV at %C is "
"incompatible with option %s",
gfc_option.flag_default_integer
? "-fdefault-integer-8" : "-fdefault-real-8");
- create_int_parameter (local_name ? local_name : symbol[i].string,
- symbol[i].tag, mod);
+ create_int_parameter (local_name ? local_name : symbol[i].name,
+ symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV,
+ symbol[i].id);
}
for (u = gfc_rename_list; u; u = u->next)
return;
}
+ if (strcmp (module_name, "iso_c_binding") == 0
+ && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
+ "ISO_C_BINDING module at %C") != FAILURE)
+ {
+ import_iso_c_binding_module();
+ return;
+ }
+
module_fp = gfc_open_intrinsic_module (filename);
if (module_fp == NULL && specified_int)
- gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
- module_name);
+ gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
+ module_name);
}
if (module_fp == NULL)