https://gcc.gnu.org/g:e976bef1579086e6e83c6a47f6c5f8f996208f99

commit r14-10153-ge976bef1579086e6e83c6a47f6c5f8f996208f99
Author: Paul Thomas <pa...@gcc.gnu.org>
Date:   Mon Apr 29 11:52:11 2024 +0100

    Fortran: Fix regression caused by r14-9752 [PR114959]
    
    2024-04-29  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 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.
    
    (cherry picked from commit bca41a8d55e830c882b0f39246afead4fcfae6f7)

Diff:
---
 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(-)

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" } }

Reply via email to