From bca41a8d55e830c882b0f39246afead4fcfae6f7 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 29 Apr 2024 11:52:11 +0100 Subject: [PATCH] Fortran: Fix regression caused by r14-9752 [PR114959] 2024-04-29 Paul Thomas 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 not be EXEC_INIT_ASSIGN and that the object be an INTENT_OUT dummy. * trans-stmt.cc (gfc_trans_allocate): Change the initializer code for allocate with mold to EXEC_ALLOCATE to allow an initializer with all NULL fields. gcc/testsuite/ PR fortran/114959 * gfortran.dg/pr114959.f90: New test. --- gcc/fortran/trans-expr.cc | 28 ++++++++++++++-------- gcc/fortran/trans-stmt.cc | 5 ++-- gcc/testsuite/gfortran.dg/pr114959.f90 | 33 ++++++++++++++++++++++++++ 3 files changed, 54 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr114959.f90 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 +! Problem isolated by Jakub Jelinek 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" } }