Hi!
Amend fix for PR88009 to mark all these class components as artificial.
gcc/fortran/ChangeLog:
* class.c (gfc_build_class_symbol, generate_finalization_wrapper,
(gfc_find_derived_vtab, find_intrinsic_vtab): Use stringpool for
names. Mark internal symbols as artificial.
* decl.c (gfc_match_decl_type_spec, gfc_match_end): Fix
indentation.
(gfc_match_derived_decl): Fix indentation. Check extension level
before incrementing refs counter.
* parse.c (parse_derived): Fix style.
* resolve.c (resolve_global_procedure): Likewise.
* symbol.c (gfc_check_conflict): Do not ignore artificial symbols.
(gfc_add_flavor): Reorder condition, cheapest first.
(gfc_new_symbol, gfc_get_sym_tree,
generate_isocbinding_symbol): Fix style.
* trans-expr.c (gfc_trans_subcomponent_assign): Remove
restriction on !artificial.
* match.c (gfc_match_equivalence): Special-case CLASS_DATA for
warnings.
---
gfc_match_equivalence(), too, should not bail-out early on the first
error but should diagnose all errors. I.e. not goto cleanup but set
err=true and continue in order to diagnose all constraints of a
statement. Maybe Sandra or somebody else will eventually find time to
tweak that.
I think it also plugs a very minor leak of name in gfc_find_derived_vtab
so i also tagged it [PR68800]. At least that was the initial
motiviation to look at that spot.
We were doing
- name = xasprintf ("__vtab_%s", tname);
...
gfc_set_sym_referenced (vtab);
- name = xasprintf ("__vtype_%s", tname);
Bootstrapped and regtested without regressions on x86_64-unknown-linux.
Ok for trunk?
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2bf21434a42..94e7dce1675 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5706,11 +5706,22 @@ gfc_match_equivalence (void)
if (!gfc_add_in_equivalence (&sym->attr, sym->name, NULL))
goto cleanup;
- if (sym->ts.type == BT_CLASS
- && CLASS_DATA (sym)
- && !gfc_add_in_equivalence (&CLASS_DATA (sym)->attr,
- sym->name, NULL))
- goto cleanup;
+ if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
+ {
+ bool ret;
+ /* The check above should have seen allocatable and some more.
+ But gfc_build_class_symbol clears
+ allocatable, pointer, dimension, codimension on the
+ base symbol. Cheat by temporarily pretending our class data
+ has the real symbol's attribs.
+ */
+ CLASS_DATA (sym)->attr.artificial = 0;
+ ret = gfc_add_in_equivalence (&CLASS_DATA (sym)->attr,
+ sym->name, NULL);
+ CLASS_DATA (sym)->attr.artificial = 1;
+ if (!ret)
+ goto cleanup;
+ }
if (sym->attr.in_common)
{
>From 764a41d4afc1a03e1e8a380f4f92242a5bc9bd65 Mon Sep 17 00:00:00 2001
From: Bernhard Reutner-Fischer <al...@gcc.gnu.org>
Date: Sun, 7 Nov 2021 11:15:56 +0100
Subject: [PATCH] Fortran: Mark internal symbols as artificial
To: fort...@gcc.gnu.org
Amend fix for PR88009 to mark all these as artificial.
gcc/fortran/ChangeLog:
* class.c (gfc_build_class_symbol, generate_finalization_wrapper,
(gfc_find_derived_vtab, find_intrinsic_vtab): Use stringpool for
names. Mark internal symbols as artificial.
* decl.c (gfc_match_decl_type_spec, gfc_match_end): Fix
indentation.
(gfc_match_derived_decl): Fix indentation. Check extension level
before incrementing refs counter.
* parse.c (parse_derived): Fix style.
* resolve.c (resolve_global_procedure): Likewise.
* symbol.c (gfc_check_conflict): Do not ignore artificial symbols.
(gfc_add_flavor): Reorder condition, cheapest first.
(gfc_new_symbol, gfc_get_sym_tree,
generate_isocbinding_symbol): Fix style.
* trans-expr.c (gfc_trans_subcomponent_assign): Remove
restriction on !artificial.
* match.c (gfc_match_equivalence): Special-case CLASS_DATA for
warnings.
---
gfc_match_equivalence(), too, should not bail-out early on the first
error but should diagnose all errors. I.e. not goto cleanup but set
err=true and continue in order to diagnose all constraints of a
statement.
---
gcc/fortran/class.c | 70 +++++++++++++++++++++++-----------------
gcc/fortran/decl.c | 49 ++++++++++++++--------------
gcc/fortran/match.c | 21 +++++++++---
gcc/fortran/parse.c | 5 ++-
gcc/fortran/resolve.c | 2 +-
gcc/fortran/symbol.c | 20 ++++--------
gcc/fortran/trans-expr.c | 2 +-
7 files changed, 92 insertions(+), 77 deletions(-)
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 6b017667600..44fccced7b9 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -637,7 +637,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute
*attr,
gfc_array_spec **as)
{
char tname[GFC_MAX_SYMBOL_LEN+1];
- char *name;
+ const char *name;
gfc_symbol *fclass;
gfc_symbol *vtab;
gfc_component *c;
@@ -665,17 +665,17 @@ gfc_build_class_symbol (gfc_typespec *ts,
symbol_attribute *attr,
get_unique_hashed_string (tname, ts->u.derived);
if ((*as) && attr->allocatable)
- name = xasprintf ("__class_%s_%d_%da", tname, rank, (*as)->corank);
+ name = gfc_get_string ("__class_%s_%d_%da", tname, rank, (*as)->corank);
else if ((*as) && attr->pointer)
- name = xasprintf ("__class_%s_%d_%dp", tname, rank, (*as)->corank);
+ name = gfc_get_string ("__class_%s_%d_%dp", tname, rank, (*as)->corank);
else if ((*as))
- name = xasprintf ("__class_%s_%d_%dt", tname, rank, (*as)->corank);
+ name = gfc_get_string ("__class_%s_%d_%dt", tname, rank, (*as)->corank);
else if (attr->pointer)
- name = xasprintf ("__class_%s_p", tname);
+ name = gfc_get_string ("__class_%s_p", tname);
else if (attr->allocatable)
- name = xasprintf ("__class_%s_a", tname);
+ name = gfc_get_string ("__class_%s_a", tname);
else
- name = xasprintf ("__class_%s_t", tname);
+ name = gfc_get_string ("__class_%s_t", tname);
if (ts->u.derived->attr.unlimited_polymorphic)
{
@@ -695,7 +695,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute
*attr,
if (attr->dummy && !attr->codimension && (*as)
&& !((*as)->type == AS_DEFERRED || (*as)->type == AS_ASSUMED_RANK))
{
- char *sname;
+ const char *sname;
ns = gfc_current_ns;
gfc_find_symbol (name, ns, 0, &fclass);
/* If a local class type with this name already exists, update the
@@ -703,8 +703,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute
*attr,
if (fclass)
{
fclass = NULL;
- sname = xasprintf ("%s_%d", name, ++ctr);
- free (name);
+ sname = gfc_get_string ("%s_%d", name, ++ctr);
name = sname;
}
}
@@ -735,6 +734,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute
*attr,
c->ts.type = BT_DERIVED;
c->attr.access = ACCESS_PRIVATE;
c->ts.u.derived = ts->u.derived;
+ c->attr.artificial = 1;
c->attr.class_pointer = attr->pointer;
c->attr.pointer = attr->pointer || (attr->dummy && !attr->allocatable)
|| attr->select_type_temporary;
@@ -742,7 +742,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute
*attr,
c->attr.dimension = attr->dimension;
c->attr.codimension = attr->codimension;
c->attr.abstract = fclass->attr.abstract;
- c->as = (*as);
+ c->as = *as;
c->initializer = NULL;
/* Add component '_vptr'. */
@@ -751,6 +751,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute
*attr,
c->ts.type = BT_DERIVED;
c->attr.access = ACCESS_PRIVATE;
c->attr.pointer = 1;
+ c->attr.artificial = 1;
if (ts->u.derived->attr.unlimited_polymorphic)
{
@@ -792,8 +793,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute
*attr,
fclass->attr.is_class = 1;
ts->u.derived = fclass;
attr->allocatable = attr->pointer = attr->dimension = attr->codimension = 0;
- (*as) = NULL;
- free (name);
+ *as = NULL;
return true;
}
@@ -1600,7 +1600,7 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
gfc_component *comp;
gfc_namespace *sub_ns;
gfc_code *last_code, *block;
- char *name;
+ const char *name;
bool finalizable_comp = false;
gfc_expr *ancestor_wrapper = NULL, *rank;
gfc_iterator *iter;
@@ -1681,7 +1681,7 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
sub_ns->resolved = 1;
/* Set up the procedure symbol. */
- name = xasprintf ("__final_%s", tname);
+ name = gfc_get_string ("__final_%s", tname);
gfc_get_symbol (name, sub_ns, &final);
sub_ns->proc_name = final;
final->attr.flavor = FL_PROCEDURE;
@@ -2238,7 +2238,6 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
gfc_free_expr (rank);
vtab_final->initializer = gfc_lval_expr_from_sym (final);
vtab_final->ts.interface = final;
- free (name);
}
@@ -2313,10 +2312,10 @@ gfc_find_derived_vtab (gfc_symbol *derived)
if (ns)
{
char tname[GFC_MAX_SYMBOL_LEN+1];
- char *name;
+ const char *name;
get_unique_hashed_string (tname, derived);
- name = xasprintf ("__vtab_%s", tname);
+ name = gfc_get_string ("__vtab_%s", tname);
/* Look for the vtab symbol in various namespaces. */
if (gsym && gsym->ns)
@@ -2344,7 +2343,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
vtab->attr.vtab = 1;
vtab->attr.access = ACCESS_PUBLIC;
gfc_set_sym_referenced (vtab);
- name = xasprintf ("__vtype_%s", tname);
+ name = gfc_get_string ("__vtype_%s", tname);
gfc_find_symbol (name, ns, 0, &vtype);
if (vtype == NULL)
@@ -2372,6 +2371,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
goto cleanup;
vtype->attr.access = ACCESS_PUBLIC;
vtype->attr.vtype = 1;
+ vtype->attr.artificial = 1;
gfc_set_sym_referenced (vtype);
/* Add component '_hash'. */
@@ -2380,6 +2380,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, derived->hash_value);
@@ -2389,6 +2390,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->ts.type = BT_INTEGER;
c->ts.kind = gfc_size_kind;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
/* Remember the derived type in ts.u.derived,
so that the correct initializer can be set later on
(in gfc_conv_structure). */
@@ -2401,6 +2403,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
if (!derived->attr.unlimited_polymorphic)
parent = gfc_get_derived_super_type (derived);
else
@@ -2447,7 +2450,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
else
{
/* Construct default initialization variable. */
- name = xasprintf ("__def_init_%s", tname);
+ name = gfc_get_string ("__def_init_%s", tname);
gfc_get_symbol (name, ns, &def_init);
def_init->attr.target = 1;
def_init->attr.artificial = 1;
@@ -2467,6 +2470,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
if (derived->attr.unlimited_polymorphic
@@ -2480,7 +2484,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
ns->contained = sub_ns;
sub_ns->resolved = 1;
/* Set up procedure symbol. */
- name = xasprintf ("__copy_%s", tname);
+ name = gfc_get_string ("__copy_%s", tname);
gfc_get_symbol (name, sub_ns, ©);
sub_ns->proc_name = copy;
copy->attr.flavor = FL_PROCEDURE;
@@ -2543,6 +2547,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
if (derived->attr.unlimited_polymorphic
@@ -2558,7 +2563,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
ns->contained = sub_ns;
sub_ns->resolved = 1;
/* Set up procedure symbol. */
- name = xasprintf ("__deallocate_%s", tname);
+ name = gfc_get_string ("__deallocate_%s", tname);
gfc_get_symbol (name, sub_ns, &dealloc);
sub_ns->proc_name = dealloc;
dealloc->attr.flavor = FL_PROCEDURE;
@@ -2607,7 +2612,6 @@ have_vtype:
vtab->ts.u.derived = vtype;
vtab->value = gfc_default_initializer (&vtab->ts);
}
- free (name);
}
found_sym = vtab;
@@ -2700,13 +2704,13 @@ find_intrinsic_vtab (gfc_typespec *ts)
if (ns)
{
char tname[GFC_MAX_SYMBOL_LEN+1];
- char *name;
+ const char *name;
/* Encode all types as TYPENAME_KIND_ including especially character
arrays, whose length is now consistently stored in the _len component
of the class-variable. */
sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind);
- name = xasprintf ("__vtab_%s", tname);
+ name = gfc_get_string ("__vtab_%s", tname);
/* Look for the vtab symbol in the top-level namespace only. */
gfc_find_symbol (name, ns, 0, &vtab);
@@ -2722,8 +2726,9 @@ find_intrinsic_vtab (gfc_typespec *ts)
vtab->attr.save = SAVE_IMPLICIT;
vtab->attr.vtab = 1;
vtab->attr.access = ACCESS_PUBLIC;
+ vtab->attr.artificial = 1;
gfc_set_sym_referenced (vtab);
- name = xasprintf ("__vtype_%s", tname);
+ name = gfc_get_string ("__vtype_%s", tname);
gfc_find_symbol (name, ns, 0, &vtype);
if (vtype == NULL)
@@ -2740,6 +2745,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
&gfc_current_locus))
goto cleanup;
vtype->attr.access = ACCESS_PUBLIC;
+ vtype->attr.artificial = 1;
vtype->attr.vtype = 1;
gfc_set_sym_referenced (vtype);
@@ -2749,6 +2755,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
hash = gfc_intrinsic_hash_value (ts);
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, hash);
@@ -2759,6 +2766,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
c->ts.type = BT_INTEGER;
c->ts.kind = gfc_size_kind;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
/* Build a minimal expression to make use of
target-memory.c/gfc_element_size for 'size'. Special handling
@@ -2782,6 +2790,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->ts.type = BT_VOID;
c->initializer = gfc_get_null_expr (NULL);
@@ -2790,6 +2799,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->ts.type = BT_VOID;
c->initializer = gfc_get_null_expr (NULL);
@@ -2798,16 +2808,17 @@ find_intrinsic_vtab (gfc_typespec *ts)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
if (ts->type != BT_CHARACTER)
- name = xasprintf ("__copy_%s", tname);
+ name = gfc_get_string ("__copy_%s", tname);
else
{
/* __copy is always the same for characters.
Check to see if copy function already exists. */
- name = xasprintf ("__copy_character_%d", ts->kind);
+ name = gfc_get_string ("__copy_character_%d", ts->kind);
contained = ns->contained;
for (; contained; contained = contained->sibling)
if (contained->proc_name
@@ -2829,6 +2840,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
copy->attr.flavor = FL_PROCEDURE;
copy->attr.subroutine = 1;
copy->attr.pure = 1;
+ copy->attr.artificial = 1;
copy->attr.if_source = IFSRC_DECL;
/* This is elemental so that arrays are automatically
treated correctly by the scalarizer. */
@@ -2851,6 +2863,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
dst->ts.kind = ts->kind;
dst->attr.flavor = FL_VARIABLE;
dst->attr.dummy = 1;
+ dst->attr.artificial = 1;
dst->attr.intent = INTENT_INOUT;
gfc_set_sym_referenced (dst);
copy->formal->next = gfc_get_formal_arglist ();
@@ -2877,7 +2890,6 @@ find_intrinsic_vtab (gfc_typespec *ts)
vtab->ts.u.derived = vtype;
vtab->value = gfc_default_initializer (&vtab->ts);
}
- free (name);
}
found_sym = vtab;
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index ab88ab5e9c1..04aa43af1d5 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -4458,7 +4458,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int
implicit_flag)
upe->attr.zero_comp = 1;
if (!gfc_add_flavor (&upe->attr, FL_DERIVED, NULL,
&gfc_current_locus))
- return MATCH_ERROR;
+ return MATCH_ERROR;
}
else
{
@@ -8342,7 +8342,7 @@ gfc_match_end (gfc_statement *st)
case COMP_SUBROUTINE:
*st = ST_END_SUBROUTINE;
if (!abreviated_modproc_decl)
- target = " subroutine";
+ target = " subroutine";
else
target = " procedure";
eos_ok = !contained_procedure ();
@@ -8351,7 +8351,7 @@ gfc_match_end (gfc_statement *st)
case COMP_FUNCTION:
*st = ST_END_FUNCTION;
if (!abreviated_modproc_decl)
- target = " function";
+ target = " function";
else
target = " procedure";
eos_ok = !contained_procedure ();
@@ -10473,7 +10473,7 @@ gfc_match_derived_decl (void)
match m;
match is_type_attr_spec = MATCH_NO;
bool seen_attr = false;
- gfc_interface *intr = NULL, *head;
+ gfc_interface *intr = NULL;
bool parameterized_type = false;
bool seen_colons = false;
@@ -10498,16 +10498,15 @@ gfc_match_derived_decl (void)
been added to 'attr' but now the parent type must be found and
checked. */
if (parent[0])
- extended = check_extended_derived_type (parent);
-
- if (parent[0] && !extended)
- return MATCH_ERROR;
+ {
+ extended = check_extended_derived_type (parent);
+ if (extended == NULL)
+ return MATCH_ERROR;
+ }
m = gfc_match (" ::");
if (m == MATCH_YES)
- {
- seen_colons = true;
- }
+ seen_colons = true;
else if (seen_attr)
{
gfc_error ("Expected :: in TYPE definition at %C");
@@ -10582,7 +10581,7 @@ gfc_match_derived_decl (void)
if (gensym->attr.dummy)
{
gfc_error ("Dummy argument %qs at %L cannot be a derived type at %C",
- name, &gensym->declared_at);
+ gensym->name, &gensym->declared_at);
return MATCH_ERROR;
}
@@ -10599,13 +10598,12 @@ gfc_match_derived_decl (void)
{
/* Use upper case to save the actual derived-type symbol. */
gfc_get_symbol (gfc_dt_upper_string (gensym->name), NULL, &sym);
- sym->name = gfc_get_string ("%s", gensym->name);
- head = gensym->generic;
+ sym->name = gensym->name;
+ sym->declared_at = gfc_current_locus;
intr = gfc_get_interface ();
intr->sym = sym;
intr->where = gfc_current_locus;
- intr->sym->declared_at = gfc_current_locus;
- intr->next = head;
+ intr->next = gensym->generic;
gensym->generic = intr;
gensym->attr.if_source = IFSRC_DECL;
}
@@ -10662,15 +10660,6 @@ gfc_match_derived_decl (void)
gfc_component *p;
gfc_formal_arglist *f, *g, *h;
- /* Add the extended derived type as the first component. */
- gfc_add_component (sym, parent, &p);
- extended->refs++;
- gfc_set_sym_referenced (extended);
-
- p->ts.type = BT_DERIVED;
- p->ts.u.derived = extended;
- p->initializer = gfc_default_initializer (&p->ts);
-
/* Set extension level. */
if (extended->attr.extension == 255)
{
@@ -10680,6 +10669,16 @@ gfc_match_derived_decl (void)
extended->name, &extended->declared_at);
return MATCH_ERROR;
}
+
+ /* Add the extended derived type as the first component. */
+ gfc_add_component (sym, parent, &p);
+ extended->refs++;
+ gfc_set_sym_referenced (extended);
+
+ p->ts.type = BT_DERIVED;
+ p->ts.u.derived = extended;
+ p->initializer = gfc_default_initializer (&p->ts);
+
sym->attr.extension = extended->attr.extension + 1;
/* Provide the links between the extended type and its extension. */
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2bf21434a42..94e7dce1675 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5706,11 +5706,22 @@ gfc_match_equivalence (void)
if (!gfc_add_in_equivalence (&sym->attr, sym->name, NULL))
goto cleanup;
- if (sym->ts.type == BT_CLASS
- && CLASS_DATA (sym)
- && !gfc_add_in_equivalence (&CLASS_DATA (sym)->attr,
- sym->name, NULL))
- goto cleanup;
+ if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
+ {
+ bool ret;
+ /* The check above should have seen allocatable and some more.
+ But gfc_build_class_symbol clears
+ allocatable, pointer, dimension, codimension on the
+ base symbol. Cheat by temporarily pretending our class data
+ has the real symbol's attribs.
+ */
+ CLASS_DATA (sym)->attr.artificial = 0;
+ ret = gfc_add_in_equivalence (&CLASS_DATA (sym)->attr,
+ sym->name, NULL);
+ CLASS_DATA (sym)->attr.artificial = 1;
+ if (!ret)
+ goto cleanup;
+ }
if (sym->attr.in_common)
{
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 12aa80ec45c..fcbff0c1dcf 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -3581,6 +3581,7 @@ parse_derived (void)
{
case ST_NONE:
unexpected_eof ();
+ break; /* never reached */
case ST_DATA_DECL:
case ST_PROCEDURE:
@@ -3640,9 +3641,7 @@ endType:
"TYPE statement");
if (seen_sequence)
- {
- gfc_error ("Duplicate SEQUENCE statement at %C");
- }
+ gfc_error ("Duplicate SEQUENCE statement at %C");
seen_sequence = 1;
gfc_add_sequence (&gfc_current_block ()->attr,
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1f4abd08720..a9a1103e049 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2588,7 +2588,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
int sub)
gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name,
sym->binding_label != NULL);
- if ((gsym->type != GSYM_UNKNOWN && gsym->type != type))
+ if (gsym->type != GSYM_UNKNOWN && gsym->type != type)
gfc_global_used (gsym, where);
if ((sym->attr.if_source == IFSRC_UNKNOWN
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 91798f2a3a5..9df23f314df 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -440,9 +440,6 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
const char *a1, *a2;
int standard;
- if (attr->artificial)
- return true;
-
if (where == NULL)
where = &gfc_current_locus;
@@ -901,6 +898,10 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
return true;
conflict:
+ /* It would be wrong to complain about artificial code. */
+ if (attr->artificial)
+ return false;
+
if (name == NULL)
gfc_error ("%s attribute conflicts with %s attribute at %L",
a1, a2, where);
@@ -1773,7 +1774,7 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f,
const char *name,
/* Copying a procedure dummy argument for a module procedure in a
submodule results in the flavor being copied and would result in
an error without this. */
- if (attr->flavor == f && f == FL_PROCEDURE
+ if (f == FL_PROCEDURE && attr->flavor == f
&& gfc_new_block && gfc_new_block->abr_modproc_decl)
return true;
@@ -3155,7 +3156,6 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
gfc_symbol *p;
p = XCNEW (gfc_symbol);
-
gfc_clear_ts (&p->ts);
gfc_clear_attr (&p->attr);
p->ns = ns;
@@ -3397,7 +3397,6 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns,
gfc_symtree **result,
p = gfc_new_symbol (name, ns);
/* Add to the list of tentative symbols. */
- p->old_symbol = NULL;
p->mark = 1;
p->gfc_new = 1;
latest_undo_chgset->syms.safe_push (p);
@@ -3405,7 +3404,6 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns,
gfc_symtree **result,
st = gfc_new_symtree (&ns->sym_root, name);
st->n.sym = p;
p->refs++;
-
}
else
{
@@ -4835,9 +4833,7 @@ generate_isocbinding_symbol (const char *mod_name,
iso_c_binding_symbol s,
gfc_derived_types->dt_next = tmp_sym;
}
else
- {
- tmp_sym->dt_next = tmp_sym;
- }
+ tmp_sym->dt_next = tmp_sym;
gfc_derived_types = tmp_sym;
}
@@ -5013,9 +5009,7 @@ generate_isocbinding_symbol (const char *mod_name,
iso_c_binding_symbol s,
gfc_derived_types->dt_next = dt_sym;
}
else
- {
- dt_sym->dt_next = dt_sym;
- }
+ dt_sym->dt_next = dt_sym;
gfc_derived_types = dt_sym;
gfc_add_component (dt_sym, "c_address", &tmp_comp);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e7aec3845d3..56ddb6629bc 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -9033,7 +9033,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component *
cm, gfc_expr * expr,
gfc_add_expr_to_block (&block, tmp);
}
}
- else if (!cm->attr.artificial)
+ else
{
/* Scalar component (excluding deferred parameters). */
gfc_init_se (&se, NULL);
--
2.33.0
