]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
fortran: Generate array reallocation out of loops
authorMikael Morin <mikael@gcc.gnu.org>
Tue, 15 Jul 2025 07:58:26 +0000 (09:58 +0200)
committerMikael Morin <mikael@gcc.gnu.org>
Tue, 15 Jul 2025 07:58:26 +0000 (09:58 +0200)
Generate the array reallocation on assignment code before entering the
scalarization loops.  This doesn't move the generated code itself,
which was already put before the outermost loop, but only changes the
current scope at the time the code is generated.  This is a prerequisite
for a followup patch that makes the reallocation code create new
variables.  Without this change the new variables would be declared in
the innermost loop body and couldn't be used outside of it.

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_trans_assignment_1): Generate array
reallocation code before entering the scalarisation loops.

gcc/fortran/trans-expr.cc

index 3e0d763d2fb08a13eedaf436da31cb3e1e4f81a0..760c8c4e72bd29c0012e3d429c37a381494b0d85 100644 (file)
@@ -12943,6 +12943,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
       rhs_caf_attr = gfc_caf_attr (expr2, false, &rhs_refs_comp);
     }
 
+  tree reallocation = NULL_TREE;
   if (lss != gfc_ss_terminator)
     {
       /* The assignment needs scalarization.  */
@@ -13011,6 +13012,15 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
          ompws_flags |= OMPWS_SCALARIZER_WS | OMPWS_SCALARIZER_BODY;
        }
 
+      /* F2003: Allocate or reallocate lhs of allocatable array.  */
+      if (realloc_flag)
+       {
+         realloc_lhs_warning (expr1->ts.type, true, &expr1->where);
+         ompws_flags &= ~OMPWS_SCALARIZER_WS;
+         reallocation = gfc_alloc_allocatable_for_assignment (&loop, expr1,
+                                                              expr2);
+       }
+
       /* Start the scalarized loop body.  */
       gfc_start_scalarized_body (&loop, &body);
     }
@@ -13319,15 +13329,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
          gfc_add_expr_to_block (&body, tmp);
        }
 
-      /* F2003: Allocate or reallocate lhs of allocatable array.  */
-      if (realloc_flag)
-       {
-         realloc_lhs_warning (expr1->ts.type, true, &expr1->where);
-         ompws_flags &= ~OMPWS_SCALARIZER_WS;
-         tmp = gfc_alloc_allocatable_for_assignment (&loop, expr1, expr2);
-         if (tmp != NULL_TREE)
-           gfc_add_expr_to_block (&loop.code[expr1->rank - 1], tmp);
-       }
+      if (reallocation != NULL_TREE)
+       gfc_add_expr_to_block (&loop.code[loop.dimen - 1], reallocation);
 
       if (maybe_workshare)
        ompws_flags &= ~OMPWS_SCALARIZER_BODY;