| Message ID | CAGkQGiLcj_Ht_SRkEXML0MboiRyLmhWFt=7rQxpkDgFeY=DLYA@mail.gmail.com |
|---|---|
| State | New |
| Headers | show |
| Series | [fortran] PR108434 - [12/13/14/15 Regression] ICE in class_allocatable, at fortran/expr.cc:5000 | expand |
On 1/10/25 9:19 AM, Paul Richard Thomas wrote: > 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 > > OK Paul, thanks for fix. Jerry
On Fri, Jan 10, 2025 at 05:19:34PM +0000, Paul Richard Thomas wrote: > > 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 :-) > When I was much more active in all things gfortran, I found Gerhard's bug reports to be some of the best. Small, self-contained code snippets made debugging easiers. Seems PR 77415 is fixed. I've converted the codes in the PR to testcases. diff --git a/gcc/testsuite/gfortran.dg/pr77415_1.f90 b/gcc/testsuite/gfortran.dg/pr77415_1.f90 new file mode 100644 index 00000000000..00488009044 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr77415_1.f90 @@ -0,0 +1,6 @@ +integer function f() + f(g) = 0 ! { dg-error "Statement function" } +contains + integer function g() + end +end diff --git a/gcc/testsuite/gfortran.dg/pr77415_2.f90 b/gcc/testsuite/gfortran.dg/pr77415_2.f90 new file mode 100644 index 00000000000..858c8223b84 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr77415_2.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +function f() + f(g) = 0 ! { dg-error "Statement function" } +contains + function g() + end +end +
On Fri, Jan 10, 2025 at 05:19:34PM +0000, Paul Richard Thomas wrote: > > 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 :-) > This patch fixes PR71844. As the error message indicates, the source-expr in 'allocate(x, source=null())' cannot be null(). diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index dab0c3af601..538917fe56a 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -8965,6 +8965,13 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) gfc_component *c; bool t; + /* source-expr in either SOURCE= or MODE= cannot be NULL(). */ + if (code->expr3 && code->expr3->expr_type == EXPR_NULL) + { + gfc_error ("Source-expr at %L cannot be NULL()", &code->expr3->where); + goto failure; + } + /* Mark the utmost array component as being in allocate to allow DIMEN_STAR checking of coarrays. */ for (ref = e->ref; ref; ref = ref->next) diff --git a/gcc/testsuite/gfortran.dg/pr71844.f90 b/gcc/testsuite/gfortran.dg/pr71844.f90 new file mode 100644 index 00000000000..af990f32fbb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr71844.f90 @@ -0,0 +1,10 @@ +! +! { dg-do compile } +! +program p + class(*), allocatable :: x, y + character(:), allocatable :: z + allocate (x, source=null()) ! { dg-error "cannot be NULL" } + allocate (y, mold=null()) ! { dg-error "cannot be NULL" } + allocate (character(*) :: z) ! { dg-error "Incompatible allocate-object" } +end
On Fri, Jan 10, 2025 at 05:19:34PM +0000, Paul Richard Thomas wrote: > > 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 :-) > PR 70949 appears to have been fixed at some point in the past. The following patch converts Gerhard's code into testcases. diff --git a/gcc/testsuite/gfortran.dg/pr70949_1.f90 b/gcc/testsuite/gfortran.dg/pr70949_1.f90 new file mode 100644 index 00000000000..91cd18069fc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr70949_1.f90 @@ -0,0 +1,27 @@ +! +! { dg-do run} +! +program p + + type t1 + end type + + type t2 + type(t1), pointer :: q + end type + + type(t1), pointer :: a + type(t2) :: c + + allocate(a) + c%q => a + if (.not. associated(a, f(c))) stop 1 + + contains + + function f(x) result (z) + type(t2), intent(in) :: x + class(t1), pointer :: z + z => x%q + end function f +end diff --git a/gcc/testsuite/gfortran.dg/pr70949_2.f90 b/gcc/testsuite/gfortran.dg/pr70949_2.f90 new file mode 100644 index 00000000000..eb064b6fa80 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr70949_2.f90 @@ -0,0 +1,27 @@ +! +! { dg-do run} +! +program p + + type t1 + end type + + type t2 + type(t1), pointer :: q + end type + + type(t1), pointer :: a + type(t2) :: c + + allocate(a) + c%q => a + if (.not. associated(a, f(c))) stop 1 + + contains + + function f(x) result (z) + type(t2), intent(in) :: x + type(t1), pointer :: z + z => x%q + end function f +end
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 <gscfq@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