Hi All,
Could this be looked at quickly? The timing of this regression is more than
a little embarrassing on the eve of the 14.1 release. The testcase and the
comment in gfc_trans_class_init_assign explain what this problem is all
about and how the patch fixes it.
OK for 15-branch and backporting to 14-branch (hopefully to the RC as well)?
Paul
Fortran: Fix regression caused by r14-9752 [PR114959]
2024-04-28 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/114959
* trans-expr.cc (gfc_trans_class_init_assign): Return NULL_TREE
if the default initializer has all NULL fields. Guard this
by a requirement that the code be EXEC_INIT_ASSIGN and that the
object be an INTENT_IN dummy.
* trans-stmt.cc (gfc_trans_allocate): Change the initializer
code for allocate with mold to EXEC_ASSIGN to allow initializer
with all NULL fields..
gcc/testsuite/
PR fortran/114959
* gfortran.dg/pr114959.f90: New test.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 072adf3fe77..0280c441ced 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1720,6 +1720,7 @@ gfc_trans_class_init_assign (gfc_code *code)
gfc_se dst,src,memsz;
gfc_expr *lhs, *rhs, *sz;
gfc_component *cmp;
+ gfc_symbol *sym;
gfc_start_block (&block);
@@ -1736,18 +1737,25 @@ gfc_trans_class_init_assign (gfc_code *code)
/* The _def_init is always scalar. */
rhs->rank = 0;
- /* Check def_init for initializers. If this is a dummy with all default
- initializer components NULL, return NULL_TREE and use the passed value as
- required by F2018(8.5.10). */
- if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
+ /* Check def_init for initializers. If this is an INTENT(OUT) dummy with all
+ default initializer components NULL, return NULL_TREE and use the passed
+ value as required by F2018(8.5.10). */
+ sym = code->expr1->expr_type == EXPR_VARIABLE ? code->expr1->symtree->n.sym
+ : NULL;
+ if (code->op != EXEC_ALLOCATE
+ && sym && sym->attr.dummy
+ && sym->attr.intent == INTENT_OUT)
{
- cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
- for (; cmp; cmp = cmp->next)
+ if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
{
- if (cmp->initializer)
- break;
- else if (!cmp->next)
- return build_empty_stmt (input_location);
+ cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
+ for (; cmp; cmp = cmp->next)
+ {
+ if (cmp->initializer)
+ break;
+ else if (!cmp->next)
+ return NULL_TREE;
+ }
}
}
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index c34e0b4c0cd..d355009fa5e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7262,11 +7262,12 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
{
/* Use class_init_assign to initialize expr. */
gfc_code *ini;
- ini = gfc_get_code (EXEC_INIT_ASSIGN);
+ ini = gfc_get_code (EXEC_ALLOCATE);
ini->expr1 = gfc_find_and_cut_at_last_class_ref (expr, true);
tmp = gfc_trans_class_init_assign (ini);
gfc_free_statements (ini);
- gfc_add_expr_to_block (&block, tmp);
+ if (tmp != NULL_TREE)
+ gfc_add_expr_to_block (&block, tmp);
}
else if ((init_expr = allocate_get_initializer (code, expr)))
{
diff --git a/gcc/testsuite/gfortran.dg/pr114959.f90 b/gcc/testsuite/gfortran.dg/pr114959.f90
new file mode 100644
index 00000000000..5cc3c052c1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114959.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Fix the regression caused by r14-9752 (fix for PR112407)
+! Contributed by Orion Poplawski <or...@nwra.com>
+! Problem isolated by Jakub Jelinek <ja...@gcc.gnu.org> and further
+! reduced here.
+!
+module m
+ type :: smoother_type
+ integer :: i
+ end type
+ type :: onelev_type
+ class(smoother_type), allocatable :: sm
+ class(smoother_type), allocatable :: sm2a
+ end type
+contains
+ subroutine save_smoothers(level,save1, save2)
+ Implicit None
+ type(onelev_type), intent(inout) :: level
+ class(smoother_type), allocatable , intent(inout) :: save1, save2
+ integer(4) :: info
+
+ info = 0
+! r14-9752 causes the 'stat' declaration from the first ALLOCATE statement
+! to disappear, which triggers an ICE in gimplify_var_or_parm_decl. The
+! second ALLOCATE statement has to be present for the ICE to occur.
+ allocate(save1, mold=level%sm,stat=info)
+ allocate(save2, mold=level%sm2a,stat=info)
+ end subroutine save_smoothers
+end module m
+! Two 'stat's from the allocate statements and two from the final wrapper.
+! { dg-final { scan-tree-dump-times "integer\\(kind..\\) stat" 4 "original" } }
