fortran: Amend descriptor bounds init if unallocated

Always generate the conditional initialization of unallocated variables
regardless of the basic variable allocation tracking done in the
frontend and with an additional always false condition.

The scalarizer used to always evaluate array bounds, including in the
case of unallocated arrays on the left hand side of an assignment.  This
was (correctly) causing uninitialized warnings, even if the
uninitialized values were in the end discarded.

Since the fix for PR fortran/108889, an initialization of the descriptor
bounds is added to silent the uninitialized warnings, conditional on the
array being unallocated.  This initialization is not useful in the
execution of the program, and it is removed if the compiler can prove
that the variable is unallocated (in the case of a local variable for
example).  Unfortunately, the compiler is not always able to prove it
and the useless initialization may remain in the final code.
Moreover, the generated code that was causing the evaluation of
uninitialized variables has ben changed to avoid them, so we can try to
remove or revisit that unallocated variable bounds initialization tweak.

Unfortunately, just removing the extra initialization restores the
warnings at -O0, as there is no dead code removal at that optimization
level.  Instead, this change keeps the initialization and modifies its
guarding condition with an extra always false variable, so that if
optimizations are enabled the whole initialization block is removed, and
if they are disabled it remains and is sufficient to prevent the
warning.

The new variable requires the code generation to be done earlier in the
function so that the variable declaration and usage are in the same
scope.

As the modified condition guarantees the removal of the block with
optimizations, we can emit it more broadly and remove the basic
allocation tracking that was done in the frontend to limit its emission.

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_symbol): Remove field allocated_in_scope.
	* trans-array.cc (gfc_array_allocate): Don't set it.
	(gfc_alloc_allocatable_for_assignment): Likewise.
	Generate the unallocated descriptor bounds initialisation
	before the opening of the reallocation code block.  Create a
	variable and use it as additional condition to the unallocated
	descriptor bounds initialisation.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4c85548bc305c40784efc6faa13834508287dc42..d85095c4da912f8ac61ec920ac1889ac98610f17 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2028,10 +2028,6 @@ typedef struct gfc_symbol
   /* Set if this should be passed by value, but is not a VALUE argument
      according to the Fortran standard.  */
   unsigned pass_as_value:1;
-  /* Set if an allocatable array variable has been allocated in the current
-     scope. Used in the suppression of uninitialized warnings in reallocation
-     on assignment.  */
-  unsigned allocated_in_scope:1;
   /* Set if an external dummy argument is called with different argument lists.
      This is legal in Fortran, but can cause problems with autogenerated
      C prototypes for C23.  */

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7b83d3fab8d71a5675fceb9c2701333ce6acb560..1561936daf1c09303c1e6c8473a5e22d7272bfac 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6800,8 +6800,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   else
       gfc_add_expr_to_block (&se->pre, set_descriptor);
 
-  expr->symtree->n.sym->allocated_in_scope = 1;
-
   return true;
 }
 
@@ -11495,14 +11493,61 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       && !expr2->value.function.isym)
     expr2->ts.u.cl->backend_decl = rss->info->string_length;
 
-  gfc_start_block (&fblock);
-
   /* Since the lhs is allocatable, this must be a descriptor type.
      Get the data and array size.  */
   desc = linfo->descriptor;
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
   array1 = gfc_conv_descriptor_data_get (desc);
 
+  /* If the data is null, set the descriptor bounds and offset.  This suppresses
+     the maybe used uninitialized warning.  Note that the always false variable
+     prevents this block from ever being executed, and makes sure that the
+     optimizers are able to remove it.  Component references are not subject to
+     the warnings, so we don't uselessly complicate the generated code for them.
+     */
+  for (ref = expr1->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      break;
+
+  if (!ref)
+    {
+      stmtblock_t unalloc_init_block;
+      gfc_init_block (&unalloc_init_block);
+      tree guard = gfc_create_var (logical_type_node, "unallocated_init_guard");
+      gfc_add_modify (&unalloc_init_block, guard, logical_false_node);
+
+      gfc_start_block (&loop_pre_block);
+      for (n = 0; n < expr1->rank; n++)
+       {
+         gfc_conv_descriptor_lbound_set (&loop_pre_block, desc,
+                                         gfc_rank_cst[n],
+                                         gfc_index_one_node);
+         gfc_conv_descriptor_ubound_set (&loop_pre_block, desc,
+                                         gfc_rank_cst[n],
+                                         gfc_index_zero_node);
+         gfc_conv_descriptor_stride_set (&loop_pre_block, desc,
+                                         gfc_rank_cst[n],
+                                         gfc_index_zero_node);
+       }
+
+      tmp = gfc_conv_descriptor_offset (desc);
+      gfc_add_modify (&loop_pre_block, tmp, gfc_index_zero_node);
+
+      tmp = fold_build2_loc (input_location, EQ_EXPR,
+                            logical_type_node, array1,
+                            build_int_cst (TREE_TYPE (array1), 0));
+      tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+                            logical_type_node, tmp, guard);
+      tmp = build3_v (COND_EXPR, tmp,
+                     gfc_finish_block (&loop_pre_block),
+                     build_empty_stmt (input_location));
+      gfc_prepend_expr_to_block (&loop->pre, tmp);
+      gfc_prepend_expr_to_block (&loop->pre,
+                                gfc_finish_block (&unalloc_init_block));
+    }
+
+  gfc_start_block (&fblock);
+
   if (expr2)
     desc2 = rss->info->data.array.descriptor;
   else
@@ -11615,45 +11660,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
                         array1, build_int_cst (TREE_TYPE (array1), 0));
   cond_null= gfc_evaluate_now (cond_null, &fblock);
 
-  /* If the data is null, set the descriptor bounds and offset. This suppresses
-     the maybe used uninitialized warning and forces the use of malloc because
-     the size is zero in all dimensions. Note that this block is only executed
-     if the lhs is unallocated and is only applied once in any namespace.
-     Component references are not subject to the warnings.  */
-  for (ref = expr1->ref; ref; ref = ref->next)
-    if (ref->type == REF_COMPONENT)
-      break;
-
-  if (!expr1->symtree->n.sym->allocated_in_scope && !ref)
-    {
-      gfc_start_block (&loop_pre_block);
-      for (n = 0; n < expr1->rank; n++)
-       {
-         gfc_conv_descriptor_lbound_set (&loop_pre_block, desc,
-                                         gfc_rank_cst[n],
-                                         gfc_index_one_node);
-         gfc_conv_descriptor_ubound_set (&loop_pre_block, desc,
-                                         gfc_rank_cst[n],
-                                         gfc_index_zero_node);
-         gfc_conv_descriptor_stride_set (&loop_pre_block, desc,
-                                         gfc_rank_cst[n],
-                                         gfc_index_zero_node);
-       }
-
-      tmp = gfc_conv_descriptor_offset (desc);
-      gfc_add_modify (&loop_pre_block, tmp, gfc_index_zero_node);
-
-      tmp = fold_build2_loc (input_location, EQ_EXPR,
-                            logical_type_node, array1,
-                            build_int_cst (TREE_TYPE (array1), 0));
-      tmp = build3_v (COND_EXPR, tmp,
-                     gfc_finish_block (&loop_pre_block),
-                     build_empty_stmt (input_location));
-      gfc_prepend_expr_to_block (&loop->pre, tmp);
-
-      expr1->symtree->n.sym->allocated_in_scope = 1;
-    }
-
   tmp = build3_v (COND_EXPR, cond_null,
                  build1_v (GOTO_EXPR, jump_label1),
                  build_empty_stmt (input_location));