[PATCH] Fortran: Mark internal symbols as artificial [PR88009,PR68800]

[Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1760 bytes --]

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?

[-- Attachment #2: class-data-artificial_incr.00.patch --]
[-- Type: text/plain, Size: 1073 bytes --]

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)
 	    {

[-- Attachment #3: 0001-Fortran-Mark-internal-symbols-as-artificial.patch --]
[-- Type: text/plain, Size: 23176 bytes --]

From 764a41d4afc1a03e1e8a380f4f92242a5bc9bd65 Mon Sep 17 00:00:00 2001
From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
Date: Sun, 7 Nov 2021 11:15:56 +0100
Subject: [PATCH] Fortran: Mark internal symbols as artificial
To: fortran@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, &copy);
 		  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