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

commit deac09f715c2b3e0e91a6227871576632687809e
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Fri Feb 7 21:59:48 2025 +0100

    Correction régression alloc_comp_constructor_1.f90

Diff:
---
 gcc/fortran/trans-array.cc |  4 ++--
 gcc/fortran/trans-expr.cc  | 15 +++++++++++++--
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b11bf5c1036e..d0f0e8465743 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1514,10 +1514,8 @@ static void
 conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree 
to_desc, int dim,
                              tree new_lbound, tree offset, bool zero_based)
 {
-  /* Set lbound to the value we want.  */
   new_lbound = fold_convert (gfc_array_index_type, new_lbound);
   new_lbound = gfc_evaluate_now (new_lbound, block);
-  gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim], 
new_lbound);
 
   tree lbound = gfc_conv_descriptor_lbound_get (from_desc, gfc_rank_cst[dim]);
   tree ubound = gfc_conv_descriptor_ubound_get (from_desc, gfc_rank_cst[dim]);
@@ -1539,6 +1537,8 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree 
from_desc, tree to_desc,
   tree tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
                               ubound, diff);
   gfc_conv_descriptor_ubound_set (block, to_desc, gfc_rank_cst[dim], tmp1);
+  /* Set lbound to the value we want.  */
+  gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim], 
new_lbound);
 
   tree offs_diff = fold_build2_loc (input_location, MULT_EXPR, 
gfc_array_index_type,
                                    diff, stride);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 13a1ec1e8fe3..4f5c0782fda8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9335,11 +9335,22 @@ gfc_trans_alloc_subarray_assign (tree dest, 
gfc_component * cm,
        && expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
     arg = expr->value.function.actual->expr;
 
+  stmtblock_t shift_block;
+  gfc_init_block (&shift_block);
+  gfc_conv_shift_descriptor_subarray (&shift_block, dest, expr, arg);
+
+  tree data = gfc_conv_descriptor_data_get (se.expr);
+  data = fold_convert (pvoid_type_node, data);
+  tree non_null = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+                                   data, null_pointer_node);
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+                         non_null, gfc_finish_block (&shift_block),
+                         build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block, tmp);
+
   if (expr->expr_type != EXPR_VARIABLE)
     gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
 
-  gfc_conv_shift_descriptor_subarray (&block, dest, expr, arg);
-
   if (arg)
     {
       /* If a conversion expression has a null data pointer

Reply via email to