https://gcc.gnu.org/g:d64ca15351029164bac30b49fb3c4f9723e755de
commit r15-6820-gd64ca15351029164bac30b49fb3c4f9723e755de
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Sat Jan 11 08:23:48 2025 +0000
Fortran: Fix error recovery for bad component arrayspecs [PR108434]
2025-01-11 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran/
PR fortran/108434
* class.cc (generate_finalization_wrapper): To avoid memory
leaks from callocs, return immediately if the derived type
error flag is set.
* decl.cc (build_struct): If the declaration of a derived type
or class component does not have a deferred arrayspec, correct,
set the error flag of the derived type and emit an immediate
error.
gcc/testsuite/
PR fortran/108434
* gfortran.dg/pr108434.f90 : Add tests from comment 1.
Diff:
---
gcc/fortran/class.cc | 2 +-
gcc/fortran/decl.cc | 19 ++++++++++++++++---
gcc/testsuite/gfortran.dg/pr108434.f90 | 10 +++++++++-
3 files changed, 26 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 3e0dce1b54d8..97ff54df5e1c 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 1bc86ae54bf7..0c597607bd8b 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 e1768a575744..b7f435338051 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
