[Patch, fortran] PR108434 - [12/13/14/15 Regression] ICE in class_allocatable, at fortran/expr.cc:5000

[Paul Richard Thomas]

Hi Harald, hi all,

As of today, Gerhard Steinmetz has no fewer than 33 regressions to his name
out of a total of 54 for fortran and libgfortran. It's time that some of
these bugs are swatted, I think :-)

As well as this PR, 106946 seems to have fixed itself and I have fixes for
102333 and 96087 waiting for this one to be OK'd.

The attached is the patch posted on the PR, modified for a translator
friendly error message as requested by Harald.

Regtests OK. OK for trunk and backporting to 13- and 14-branches?

Paul

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 64a0e726eeb..1054e7d2510 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -1739,7 +1739,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   gfc_expr *ancestor_wrapper = NULL, *rank;
   gfc_iterator *iter;
 
-  if (derived->attr.unlimited_polymorphic)
+  if (derived->attr.unlimited_polymorphic || derived->error)
     {
       vtab_final->initializer = gfc_get_null_expr (NULL);
       return;
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index fbcc782261f..6242520aaed 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -2421,11 +2421,24 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
     }
   else if (c->attr.allocatable)
     {
+      const char *err = G_("Allocatable component of structure at %C must have "
+			   "a deferred shape");
       if (c->as->type != AS_DEFERRED)
 	{
-	  gfc_error ("Allocatable component of structure at %C must have a "
-		     "deferred shape");
-	  return false;
+	  if (c->ts.type == BT_CLASS || c->ts.type == BT_DERIVED)
+	    {
+	      /* Issue an immediate error and allow this component to pass for
+		 the sake of clean error recovery.  Set the error flag for the
+		 containing derived type so that finalizers are not built.  */
+	      gfc_error_now (err);
+	      s->sym->error = 1;
+	      c->as->type = AS_DEFERRED;
+	    }
+	  else
+	    {
+	      gfc_error (err);
+	      return false;
+	    }
 	}
     }
   else
diff --git a/gcc/testsuite/gfortran.dg/pr108434.f90 b/gcc/testsuite/gfortran.dg/pr108434.f90
index e1768a57574..b7f43533805 100644
--- a/gcc/testsuite/gfortran.dg/pr108434.f90
+++ b/gcc/testsuite/gfortran.dg/pr108434.f90
@@ -1,11 +1,19 @@
 ! { dg-do compile }
 ! PR fortran/108434 - ICE in class_allocatable
-! Contributed by G.Steinmetz
+! Contributed by G.Steinmetz  <gs...@t-online.de>
 
 program p
   type t
      class(c), pointer :: a(2) ! { dg-error "must have a deferred shape" }
   end type t
+  type s
+     class(d), allocatable :: a(2) ! { dg-error "must have a deferred shape|not been declared" }
+  end type
+  type u
+     type(e),  allocatable :: b(2) ! { dg-error "must have a deferred shape|not been declared" }
+  end type
   class(t), allocatable :: x
   class(t), pointer     :: y
+  class(s), allocatable :: x2
+  class(s), pointer :: y2
 end

Change.Logs
Description: Binary data