On Sat, 6 Nov 2021 13:04:07 +0100
Mikael Morin <morin-mik...@orange.fr> wrote:
> Le 05/11/2021 à 23:08, Bernhard Reutner-Fischer a écrit :
> > On Fri, 5 Nov 2021 19:46:16 +0100
> > Mikael Morin <morin-mik...@orange.fr> wrote:
> >
> >> Le 29/10/2021 à 01:58, Bernhard Reutner-Fischer via Fortran a écrit :
> >>> On Wed, 27 Oct 2021 23:39:43 +0200
> >>> Bernhard Reutner-Fischer <rep.dot....@gmail.com> wrote:
> >>>
> >>>> On Mon, 15 Oct 2018 10:23:06 +0200
> >>>> Bernhard Reutner-Fischer <rep.dot....@gmail.com> wrote:
> >>>>
> >>>>> If a finalization is not required we created a namespace containing
> >>>>> formal arguments for an internal interface definition but never used
> >>>>> any of these. So the whole sub_ns namespace was not wired up to the
> >>>>> program and consequently was never freed. The fix is to simply not
> >>>>> generate any finalization wrappers if we know that it will be unused.
> >>>>> Note that this reverts back to the original r190869
> >>>>> (8a96d64282ac534cb597f446f02ac5d0b13249cc) handling for this case
> >>>>> by reverting this specific part of r194075
> >>>>> (f1ee56b4be7cc3892e6ccc75d73033c129098e87) for PR fortran/37336.
> >>>>>
> >> I’m a bit concerned by the loss of the null_expr’s type interface.
> >> I can’t convince myself that it’s either absolutely necessary or
> >> completely useless.
> >
> > It's a delicate spot, yes, but i do think they are completely useless.
> > If we do NOT need a finalization, the initializer can (and has to be
> > AFAIU) be a null_expr and AFAICS then does not need an interface.
> >
> Well, the null pointer itself doesn’t need a type, but I think it’s
> better if the pointer it’s assigned to has a type different from void*.
> It will (hopefully) help the middle-end optimizers downstream.
I would not expect this to help all that much or at all TBH.
So i compiled
for i in $(grep -li final $(grep -L dg-error
/scratch/src/gcc-12.mine/gcc/testsuite/gfortran.dg/*.f*)); do gfortran -O2
-fcoarray=single -c $i -g -g3 -ggdb3 -fdump-tree-original
-fdump-tree-optimized;done
and diffed all .original and .optimized dumps against pristine trunk
and they are identical.
I inspected and ran the binary from finalize_14 and there is no change
in the leaks compared to pristine trunk. The 3 shape_w in p leak as
they used to. I do remember that finalize_14 was a good testcase, in
sum i glared at it for quite some time ;)
>
> I will see if I can manage to create a testcase where it makes a
> difference (don’t hold your breath, I don’t even have a bootstrapped
> compiler ready yet).
>
That'd be great, TIA!
[]
btw.. Just because it's vagely related.
I think f8add009ce300f24b75e9c2e2cc5dd944a020c28 for
PR fortran/88009 (ICE in find_intrinsic_vtab, at fortran/class.c:2761)
is incomplete in that i think all the internal class helpers should be
flagged artificial. All these symbols built in gfc_build_class_symbol,
generate_finalization_wrapper, gfc_find_derived_vtab etc.
Looking at the history it seems the artificial bit often was forgotten.
And most importantly i think it is not correct to ignore artificial in
gfc_check_conflict!
I'm attaching my notes on this to illustrate what i mean.
Not a patch, even if it regtests cleanly..
The hunk in gfc_match_derived_decl() plugs another leak by first
checking if the max extension level is reached before adding the
component. Maybe i should split that hunk out.
Similar to the removal of *head in gfc_match_derived_decl, there's
another spot in gfc_match_decl_type_spec which should get rid of the
*head and just wire the interface up as usual. Just cosmetics.
Several tests do exercise this code: alloc_comp_class_1.f90,
class_19.f03 and 62, unlimited_polymorphic_8.f90 and others.
> >> The rest of the changes (appart from class.c) are mostly OK with the nit
> >> below and should be put in their own commit.
> >>
> >> >>> @@ -3826,10 +3828,8 @@ free_tb_tree (gfc_symtree *t)
> >> >>>
> >> >>> free_tb_tree (t->left);
> >> >>> free_tb_tree (t->right);
> >> >>> -
> >> >>> - /* TODO: Free type-bound procedure structs themselves; probably
> >> needs some
> >> >>> - sort of ref-counting mechanism. */
> >> >>> free (t->n.tb);
> >>
> >> Please keep a comment; it remains somehow valid but could be updated
> >> maybe: gfc_typebound_proc’s u.generic field for example is nowhere freed
> >> as far as I know.
> >
> > Well that's a valid point, not sure where they are freed indeed.
> > Do you have a specific testcase in mind that leaks tbp's u.generic (or
> > specific for that matter) for me to look at?
> >
> Any testcase with generic typebound procedures, I guess.
> typebound_generic_3.f03 for example seems like a good candidate.
I'll have a look at these later, thanks for the pointer.
>
> > I'm happy to change the comment to
> > TODO: Free type-bound procedure u.generic and u.specific fields
> > to reflect the current state. Ok?
> >
> I don’t think specific leaks because it’s one of gfc_namespace’s
> sym_root sub-nodes, and it’s freed with gfc_namespace.
> OK without "and u.specific".
Ah right. Done.
Thanks so far!
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/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..1a1e4551355 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;
@@ -1773,7 +1770,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 +3152,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 +3393,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 +3400,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 +4829,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 +5005,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);
