/* Handle modules, which amounts to loading and saving symbols and
their attendant structures.
- Copyright (C) 2000-2017 Free Software Foundation, Inc.
+ Copyright (C) 2000-2020 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
/* Don't put any single quote (') in MOD_VERSION, if you want it to be
recognized. */
-#define MOD_VERSION "14"
+#define MOD_VERSION "15"
/* Structure that describes a position within a module file. */
typedef struct pointer_info
{
BBT_HEADER (pointer_info);
- int integer;
+ HOST_WIDE_INT integer;
pointer_t type;
/* The first component of each member of the union is the pointer
/* The gzFile for the module we're reading or writing. */
static gzFile module_fp;
+/* Fully qualified module path */
+static char *module_fullpath = NULL;
/* The name of the module we're reading (USE'ing) or writing. */
static const char *module_name;
creating the node if not found. */
static pointer_info *
-get_integer (int integer)
+get_integer (HOST_WIDE_INT integer)
{
pointer_info *p, t;
int c;
sometime later. Returns the pointer_info structure. */
static pointer_info *
-add_fixup (int integer, void *gp)
+add_fixup (HOST_WIDE_INT integer, void *gp)
{
pointer_info *p;
fixup_t *f;
gfc_intrinsic_op op;
match m;
gfc_use_list *use_list;
+ gfc_symtree *st;
+ locus loc;
use_list = gfc_get_use_list ();
case INTERFACE_USER_OP:
case INTERFACE_GENERIC:
case INTERFACE_DTIO:
+ loc = gfc_current_locus;
+
m = gfc_match (" =>");
if (type == INTERFACE_USER_OP && m == MATCH_YES
if (type == INTERFACE_USER_OP)
new_use->op = INTRINSIC_USER;
+ st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+ if (st && type != INTERFACE_USER_OP)
+ {
+ if (m == MATCH_YES)
+ gfc_error ("Symbol %qs at %L conflicts with the rename symbol "
+ "at %L", name, &st->n.sym->declared_at, &loc);
+ else
+ gfc_error ("Symbol %qs at %L conflicts with the symbol "
+ "at %L", name, &st->n.sym->declared_at, &loc);
+ goto cleanup;
+ }
+
if (use_list->only_flag)
{
if (m != MATCH_YES)
if (gfc_cpp_makedep ())
gfc_cpp_add_dep (fullname, system);
+ free (module_fullpath);
+ module_fullpath = xstrdup (fullname);
return f;
}
}
if (IS_ABSOLUTE_PATH (name) || include_cwd)
{
f = gzopen (name, "r");
- if (f && gfc_cpp_makedep ())
- gfc_cpp_add_dep (name, false);
+ if (f)
+ {
+ if (gfc_cpp_makedep ())
+ gfc_cpp_add_dep (name, false);
+
+ free (module_fullpath);
+ module_fullpath = xstrdup (name);
+ }
}
if (!f)
if (IS_ABSOLUTE_PATH (name))
{
f = gzopen (name, "r");
- if (f && gfc_cpp_makedep ())
- gfc_cpp_add_dep (name, true);
+ if (f)
+ {
+ if (gfc_cpp_makedep ())
+ gfc_cpp_add_dep (name, true);
+
+ free (module_fullpath);
+ module_fullpath = xstrdup (name);
+ }
}
if (!f)
#define MAX_ATOM_SIZE 100
-static int atom_int;
+static HOST_WIDE_INT atom_int;
static char *atom_string, atom_name[MAX_ATOM_SIZE];
{
case IO_INPUT:
gfc_fatal_error ("Reading module %qs at line %d column %d: %s",
- module_name, module_line, module_column, msgid);
+ module_fullpath, module_line, module_column, msgid);
break;
case IO_OUTPUT:
gfc_fatal_error ("Writing module %qs at line %d column %d: %s",
}
-/* Parse a small integer. */
+/* Parse an integer. Should fit in a HOST_WIDE_INT. */
static void
parse_integer (int c)
}
atom_int = 10 * atom_int + c - '0';
- if (atom_int > 99999999)
- bad_module ("Integer overflow");
}
}
static void
write_atom (atom_type atom, const void *v)
{
- char buffer[20];
+ char buffer[32];
/* Workaround -Wmaybe-uninitialized false positive during
profiledbootstrap by initializing them. */
- int i = 0, len;
+ int len;
+ HOST_WIDE_INT i = 0;
const char *p;
switch (atom)
break;
case ATOM_INTEGER:
- i = *((const int *) v);
- if (i < 0)
- gfc_internal_error ("write_atom(): Writing negative integer");
+ i = *((const HOST_WIDE_INT *) v);
- sprintf (buffer, "%d", i);
+ snprintf (buffer, sizeof (buffer), HOST_WIDE_INT_PRINT_DEC, i);
p = buffer;
break;
mio_integer (int *ip)
{
if (iomode == IO_OUTPUT)
- write_atom (ATOM_INTEGER, ip);
+ {
+ HOST_WIDE_INT hwi = *ip;
+ write_atom (ATOM_INTEGER, &hwi);
+ }
else
{
require_atom (ATOM_INTEGER);
}
}
+static void
+mio_hwi (HOST_WIDE_INT *hwi)
+{
+ if (iomode == IO_OUTPUT)
+ write_atom (ATOM_INTEGER, hwi);
+ else
+ {
+ require_atom (ATOM_INTEGER);
+ *hwi = atom_int;
+ }
+}
+
/* Read or write a gfc_intrinsic_op value. */
/* FIXME: Would be nicer to do this via the operators symbolic name. */
if (iomode == IO_OUTPUT)
{
- int converted = (int) *op;
+ HOST_WIDE_INT converted = (HOST_WIDE_INT) *op;
write_atom (ATOM_INTEGER, &converted);
}
else
AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK,
- AB_OMP_DECLARE_TARGET_LINK
+ AB_OMP_DECLARE_TARGET_LINK, AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE,
+ AB_PDT_TEMPLATE, AB_PDT_ARRAY, AB_PDT_STRING,
+ AB_OACC_ROUTINE_LOP_GANG, AB_OACC_ROUTINE_LOP_WORKER,
+ AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ
};
static const mstring attr_bits[] =
minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT),
minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK),
minit ("OMP_DECLARE_TARGET_LINK", AB_OMP_DECLARE_TARGET_LINK),
+ minit ("PDT_KIND", AB_PDT_KIND),
+ minit ("PDT_LEN", AB_PDT_LEN),
+ minit ("PDT_TYPE", AB_PDT_TYPE),
+ minit ("PDT_TEMPLATE", AB_PDT_TEMPLATE),
+ minit ("PDT_ARRAY", AB_PDT_ARRAY),
+ minit ("PDT_STRING", AB_PDT_STRING),
+ minit ("OACC_ROUTINE_LOP_GANG", AB_OACC_ROUTINE_LOP_GANG),
+ minit ("OACC_ROUTINE_LOP_WORKER", AB_OACC_ROUTINE_LOP_WORKER),
+ minit ("OACC_ROUTINE_LOP_VECTOR", AB_OACC_ROUTINE_LOP_VECTOR),
+ minit ("OACC_ROUTINE_LOP_SEQ", AB_OACC_ROUTINE_LOP_SEQ),
minit (NULL, -1)
};
DECL_MIO_NAME (ref_type)
DECL_MIO_NAME (sym_flavor)
DECL_MIO_NAME (sym_intent)
+DECL_MIO_NAME (inquiry_type)
#undef DECL_MIO_NAME
+/* Verify OACC_ROUTINE_LOP_NONE. */
+
+static void
+verify_OACC_ROUTINE_LOP_NONE (enum oacc_routine_lop lop)
+{
+ if (lop != OACC_ROUTINE_LOP_NONE)
+ bad_module ("Unsupported: multiple OpenACC 'routine' levels of parallelism");
+}
+
/* Symbol attributes are stored in list with the first three elements
being the enumerated fields, while the remaining elements (if any)
indicate the individual attribute bits. The access field is not
MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits);
if (attr->omp_declare_target_link)
MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LINK, attr_bits);
+ if (attr->pdt_kind)
+ MIO_NAME (ab_attribute) (AB_PDT_KIND, attr_bits);
+ if (attr->pdt_len)
+ MIO_NAME (ab_attribute) (AB_PDT_LEN, attr_bits);
+ if (attr->pdt_type)
+ MIO_NAME (ab_attribute) (AB_PDT_TYPE, attr_bits);
+ if (attr->pdt_template)
+ MIO_NAME (ab_attribute) (AB_PDT_TEMPLATE, attr_bits);
+ if (attr->pdt_array)
+ MIO_NAME (ab_attribute) (AB_PDT_ARRAY, attr_bits);
+ if (attr->pdt_string)
+ MIO_NAME (ab_attribute) (AB_PDT_STRING, attr_bits);
+ switch (attr->oacc_routine_lop)
+ {
+ case OACC_ROUTINE_LOP_NONE:
+ /* This is the default anyway, and for maintaining compatibility with
+ the current MOD_VERSION, we're not emitting anything in that
+ case. */
+ break;
+ case OACC_ROUTINE_LOP_GANG:
+ MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_LOP_GANG, attr_bits);
+ break;
+ case OACC_ROUTINE_LOP_WORKER:
+ MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_LOP_WORKER, attr_bits);
+ break;
+ case OACC_ROUTINE_LOP_VECTOR:
+ MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_LOP_VECTOR, attr_bits);
+ break;
+ case OACC_ROUTINE_LOP_SEQ:
+ MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_LOP_SEQ, attr_bits);
+ break;
+ case OACC_ROUTINE_LOP_ERROR:
+ /* ... intentionally omitted here; it's only unsed internally. */
+ default:
+ gcc_unreachable ();
+ }
mio_rparen ();
case AB_OACC_DECLARE_LINK:
attr->oacc_declare_link = 1;
break;
+ case AB_PDT_KIND:
+ attr->pdt_kind = 1;
+ break;
+ case AB_PDT_LEN:
+ attr->pdt_len = 1;
+ break;
+ case AB_PDT_TYPE:
+ attr->pdt_type = 1;
+ break;
+ case AB_PDT_TEMPLATE:
+ attr->pdt_template = 1;
+ break;
+ case AB_PDT_ARRAY:
+ attr->pdt_array = 1;
+ break;
+ case AB_PDT_STRING:
+ attr->pdt_string = 1;
+ break;
+ case AB_OACC_ROUTINE_LOP_GANG:
+ verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop);
+ attr->oacc_routine_lop = OACC_ROUTINE_LOP_GANG;
+ break;
+ case AB_OACC_ROUTINE_LOP_WORKER:
+ verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop);
+ attr->oacc_routine_lop = OACC_ROUTINE_LOP_WORKER;
+ break;
+ case AB_OACC_ROUTINE_LOP_VECTOR:
+ verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop);
+ attr->oacc_routine_lop = OACC_ROUTINE_LOP_VECTOR;
+ break;
+ case AB_OACC_ROUTINE_LOP_SEQ:
+ verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop);
+ attr->oacc_routine_lop = OACC_ROUTINE_LOP_SEQ;
+ break;
}
}
}
{
for (i = 0; i < ar->dimen; i++)
{
- int tmp = (int)ar->dimen_type[i];
+ HOST_WIDE_INT tmp = (HOST_WIDE_INT)ar->dimen_type[i];
write_atom (ATOM_INTEGER, &tmp);
}
}
if (iomode == IO_OUTPUT)
{
p = get_pointer (*((char **) gp));
- write_atom (ATOM_INTEGER, &p->integer);
+ HOST_WIDE_INT hwi = p->integer;
+ write_atom (ATOM_INTEGER, &hwi);
}
else
{
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_actual_arglist (gfc_actual_arglist **ap, bool pdt);
static void
mio_component (gfc_component *c, int vtype)
{
pointer_info *p;
- int n;
mio_lparen ();
if (iomode == IO_OUTPUT)
{
p = get_pointer (c);
- mio_integer (&p->integer);
+ mio_hwi (&p->integer);
}
else
{
- mio_integer (&n);
+ HOST_WIDE_INT n;
+ mio_hwi (&n);
p = get_integer (n);
associate_integer_pointer (p, c);
}
mio_typespec (&c->ts);
mio_array_spec (&c->as);
+ /* PDT templates store the expression for the kind of a component here. */
+ mio_expr (&c->kind_expr);
+
+ /* PDT types store the component specification list here. */
+ mio_actual_arglist (&c->param_list, true);
+
mio_symbol_attribute (&c->attr);
if (c->ts.type == BT_CLASS)
c->attr.class_ok = 1;
if (c->attr.proc_pointer)
mio_typebound_proc (&c->tb);
+ c->loc = gfc_current_locus;
+
mio_rparen ();
}
static void
-mio_actual_arg (gfc_actual_arglist *a)
+mio_actual_arg (gfc_actual_arglist *a, bool pdt)
{
mio_lparen ();
mio_pool_string (&a->name);
mio_expr (&a->expr);
+ if (pdt)
+ mio_integer ((int *)&a->spec_type);
mio_rparen ();
}
static void
-mio_actual_arglist (gfc_actual_arglist **ap)
+mio_actual_arglist (gfc_actual_arglist **ap, bool pdt)
{
gfc_actual_arglist *a, *tail;
if (iomode == IO_OUTPUT)
{
for (a = *ap; a; a = a->next)
- mio_actual_arg (a);
+ mio_actual_arg (a, pdt);
}
else
tail->next = a;
tail = a;
- mio_actual_arg (a);
+ mio_actual_arg (a, pdt);
}
}
minit ("ARRAY", REF_ARRAY),
minit ("COMPONENT", REF_COMPONENT),
minit ("SUBSTRING", REF_SUBSTRING),
+ minit ("INQUIRY", REF_INQUIRY),
+ minit (NULL, -1)
+};
+
+static const mstring inquiry_types[] = {
+ minit ("RE", INQUIRY_RE),
+ minit ("IM", INQUIRY_IM),
+ minit ("KIND", INQUIRY_KIND),
+ minit ("LEN", INQUIRY_LEN),
minit (NULL, -1)
};
mio_expr (&r->u.ss.end);
mio_charlen (&r->u.ss.length);
break;
+
+ case REF_INQUIRY:
+ r->u.i = MIO_NAME (inquiry_type) (r->u.i, inquiry_types);
+ break;
}
mio_rparen ();
static void
mio_gmp_real (mpfr_t *real)
{
- mp_exp_t exponent;
+ mpfr_exp_t exponent;
char *p;
if (iomode == IO_INPUT)
static void
mio_expr (gfc_expr **ep)
{
+ HOST_WIDE_INT hwi;
gfc_expr *e;
atom_type t;
int flag;
case EXPR_FUNCTION:
mio_symtree_ref (&e->symtree);
- mio_actual_arglist (&e->value.function.actual);
+ mio_actual_arglist (&e->value.function.actual, false);
if (iomode == IO_OUTPUT)
{
break;
case BT_CHARACTER:
- mio_integer (&e->value.character.length);
+ hwi = e->value.character.length;
+ mio_hwi (&hwi);
+ e->value.character.length = hwi;
e->value.character.string
= CONST_CAST (gfc_char_t *,
mio_allocated_wide_string (e->value.character.string,
case EXPR_COMPCALL:
case EXPR_PPC:
+ case EXPR_UNKNOWN:
gcc_unreachable ();
break;
}
+ /* PDT types store the expression specification list here. */
+ mio_actual_arglist (&e->param_list, true);
+
mio_rparen ();
}
mio_namelist (gfc_symbol *sym)
{
gfc_namelist *n, *m;
- const char *check_name;
mio_lparen ();
}
else
{
- /* This departure from the standard is flagged as an error.
- It does, in fact, work correctly. TODO: Allow it
- conditionally? */
- if (sym->attr.flavor == FL_NAMELIST)
- {
- 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);
- }
-
m = NULL;
while (peek_atom () != ATOM_RPAREN)
{
{
if (peek_atom () != ATOM_RPAREN)
{
+ gfc_namespace *ns;
+
sym->f2k_derived = gfc_get_namespace (NULL, 0);
+
+ /* PDT templates make use of the mechanisms for formal args
+ and so the parameter symbols are stored in the formal
+ namespace. Transfer the sym_root to f2k_derived and then
+ free the formal namespace since it is uneeded. */
+ if (sym->attr.pdt_template && sym->formal && sym->formal->sym)
+ {
+ ns = sym->formal->sym->ns;
+ sym->f2k_derived->sym_root = ns->sym_root;
+ ns->sym_root = NULL;
+ ns->refs++;
+ gfc_free_namespace (ns);
+ ns = NULL;
+ }
+
mio_f2k_derived (sym->f2k_derived);
}
else
minit ("UNIFORM", 3),
minit ("LINEAR", 4),
minit ("ALIGNED", 5),
+ minit ("LINEAR_REF", 33),
+ minit ("LINEAR_VAL", 34),
+ minit ("LINEAR_UVAL", 35),
minit (NULL, -1)
};
}
for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next)
{
- mio_name (4, omp_declare_simd_clauses);
+ if (n->u.linear_op == OMP_LINEAR_DEFAULT)
+ mio_name (4, omp_declare_simd_clauses);
+ else
+ mio_name (32 + n->u.linear_op, omp_declare_simd_clauses);
mio_symbol_ref (&n->sym);
mio_expr (&n->expr);
}
case 4:
case 5:
*ptrs[t - 3] = n = gfc_get_omp_namelist ();
+ finish_namelist:
+ n->where = gfc_current_locus;
ptrs[t - 3] = &n->next;
mio_symbol_ref (&n->sym);
if (t != 3)
mio_expr (&n->expr);
break;
+ case 33:
+ case 34:
+ case 35:
+ *ptrs[1] = n = gfc_get_omp_namelist ();
+ n->u.linear_op = (enum gfc_omp_linear_op) (t - 32);
+ t = 4;
+ goto finish_namelist;
}
}
}
int flag;
mio_name (1, omp_declare_reduction_stmt);
mio_symtree_ref (&ns->code->symtree);
- mio_actual_arglist (&ns->code->ext.actual);
+ mio_actual_arglist (&ns->code->ext.actual, false);
flag = ns->code->resolved_isym != NULL;
mio_integer (&flag);
int flag;
ns->code = gfc_get_code (EXEC_CALL);
mio_symtree_ref (&ns->code->symtree);
- mio_actual_arglist (&ns->code->ext.actual);
+ mio_actual_arglist (&ns->code->ext.actual, false);
mio_integer (&flag);
if (flag)
/* Load/save the f2k_derived namespace of a derived-type symbol. */
mio_full_f2k_derived (sym);
+ /* PDT types store the symbol specification list here. */
+ mio_actual_arglist (&sym->param_list, true);
+
mio_namelist (sym);
/* Add the fields that say whether this is from an intrinsic module,
/* Decide if we need to load this one or not. */
p = find_use_name_n (name, &i, false);
- st = find_symbol (gfc_current_ns->sym_root,
- name, module_name, 1);
-
if (!p || gfc_find_symbol (p, NULL, 0, &sym))
{
/* Skip the specific names for these cases. */
continue;
}
+ st = find_symbol (gfc_current_ns->sym_root,
+ name, module_name, 1);
+
/* If the symbol exists already and is being USEd without being
in an ONLY clause, do not load a new symtree(11.3.2). */
if (!only_flag && st)
while (peek_atom () != ATOM_RPAREN)
{
- int flags;
+ int flags = 0;
char* label;
mio_lparen ();
mio_internal_string (name);
mio_pool_string (&name);
gfc_clear_ts (&ts);
mio_typespec (&ts);
- if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0)
+ if (gfc_str_startswith (name, "operator "))
{
const char *p = name + sizeof ("operator ") - 1;
if (strcmp (p, "+") == 0)
for (c = sym->components; c; c = c->next)
{
pointer_info *p;
- const char *comp_name;
- int n;
+ const char *comp_name = NULL;
+ int n = 0;
mio_lparen (); /* component opening. */
mio_integer (&n);
if (p->u.pointer == NULL)
associate_integer_pointer (p, c);
mio_pool_string (&comp_name);
- gcc_assert (comp_name == c->name);
+ if (comp_name != c->name)
+ {
+ gfc_fatal_error ("Mismatch in components of derived type "
+ "%qs from %qs at %C: expecting %qs, "
+ "but got %qs", sym->name, sym->module,
+ c->name, comp_name);
+ }
skip_list (1); /* component end. */
}
mio_rparen (); /* component list closing. */
/* Exception: Always import vtabs & vtypes. */
if (p == NULL && name[0] == '_'
- && (strncmp (name, "__vtab_", 5) == 0
- || strncmp (name, "__vtype_", 6) == 0))
+ && (gfc_str_startswith (name, "__vtab_")
+ || gfc_str_startswith (name, "__vtype_")))
p = name;
/* Skip symtree nodes not in an ONLY clause, unless there
sym->attr.use_rename = 1;
if (name[0] != '_'
- || (strncmp (name, "__vtab_", 5) != 0
- && strncmp (name, "__vtype_", 6) != 0))
+ || (!gfc_str_startswith (name, "__vtab_")
+ && !gfc_str_startswith (name, "__vtype_")))
sym->attr.use_only = only_flag;
/* Store the symtree pointing to this symbol. */
mio_pool_string (&st->name);
mio_integer (&st->ambiguous);
- mio_integer (&p->integer);
+ mio_hwi (&p->integer);
}
{
int i;
+ /* Initialize the column counter. */
+ module_column = 1;
+
/* Write the operator interfaces. */
mio_lparen ();
/* Write the module to the temporary file. */
module_fp = gzopen (filename_tmp, "w");
if (module_fp == NULL)
- gfc_fatal_error ("Can't open module file %qs for writing at %C: %s",
+ gfc_fatal_error ("Cannot open module file %qs for writing at %C: %s",
filename_tmp, xstrerror (errno));
+ /* Use lbasename to ensure module files are reproducible regardless
+ of the build path (see the reproducible builds project). */
gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n",
- MOD_VERSION, gfc_source_file);
+ MOD_VERSION, lbasename (gfc_source_file));
/* Write the module itself. */
iomode = IO_OUTPUT;
{
/* Module file have changed, replace the old one. */
if (remove (filename) && errno != ENOENT)
- gfc_fatal_error ("Can't delete module file %qs: %s", filename,
+ gfc_fatal_error ("Cannot delete module file %qs: %s", filename,
xstrerror (errno));
if (rename (filename_tmp, filename))
- gfc_fatal_error ("Can't rename module file %qs to %qs: %s",
+ gfc_fatal_error ("Cannot rename module file %qs to %qs: %s",
filename_tmp, filename, xstrerror (errno));
}
else
{
if (remove (filename_tmp))
- gfc_fatal_error ("Can't delete temporary module file %qs: %s",
+ gfc_fatal_error ("Cannot delete temporary module file %qs: %s",
filename_tmp, xstrerror (errno));
}
}
"standard", symbol[i].name, &u->where))
continue;
- if ((flag_default_integer || flag_default_real)
+ if ((flag_default_integer || flag_default_real_8)
&& symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
gfc_warning_now (0, "Use of the NUMERIC_STORAGE_SIZE named "
"constant from intrinsic module "
if ((gfc_option.allow_std & symbol[i].standard) == 0)
continue;
- if ((flag_default_integer || flag_default_real)
+ if ((flag_default_integer || flag_default_real_8)
&& symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
gfc_warning_now (0,
"Use of the NUMERIC_STORAGE_SIZE named constant "
module_fp = gzopen_intrinsic_module (filename);
if (module_fp == NULL && module->intrinsic)
- gfc_fatal_error ("Can't find an intrinsic module named %qs at %C",
+ gfc_fatal_error ("Cannot find an intrinsic module named %qs at %C",
module_name);
/* Check for the IEEE modules, so we can mark their symbols
{
if (gfc_state_stack->state != COMP_SUBMODULE
&& module->submodule_name == NULL)
- gfc_fatal_error ("Can't open module file %qs for reading at %C: %s",
+ gfc_fatal_error ("Cannot open module file %qs for reading at %C: %s",
filename, xstrerror (errno));
else
gfc_fatal_error ("Module file %qs has not been generated, either "
if ((start == 1 && strcmp (atom_name, "GFORTRAN") != 0)
|| (start == 2 && strcmp (atom_name, " module") != 0))
gfc_fatal_error ("File %qs opened at %C is not a GNU Fortran"
- " module file", filename);
+ " module file", module_fullpath);
if (start == 3)
{
if (strcmp (atom_name, " version") != 0
|| strcmp (atom_string, MOD_VERSION))
gfc_fatal_error ("Cannot read module file %qs opened at %C,"
" because it was created by a different"
- " version of GNU Fortran", filename);
+ " version of GNU Fortran", module_fullpath);
free (atom_string);
}
for (p = gfc_state_stack; p; p = p->previous)
if ((p->state == COMP_MODULE || p->state == COMP_SUBMODULE)
&& strcmp (p->sym->name, module_name) == 0)
- gfc_fatal_error ("Can't USE the same %smodule we're building",
- p->state == COMP_SUBMODULE ? "sub" : "");
+ {
+ if (p->state == COMP_SUBMODULE)
+ gfc_fatal_error ("Cannot USE a submodule that is currently built");
+ else
+ gfc_fatal_error ("Cannot USE a module that is currently built");
+ }
init_pi_tree ();
init_true_name_tree ();
projects / thirdparty / gcc.git / blobdiff