]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
fortran: Use array descriptor data setter when possible
authorMikael Morin <mikael@gcc.gnu.org>
Sun, 3 Aug 2025 13:21:06 +0000 (15:21 +0200)
committerMikael Morin <mikael@gcc.gnu.org>
Tue, 5 Aug 2025 14:20:40 +0000 (16:20 +0200)
Regression-tested on x86_64-pc-linux-gnu.
OK for master?

-- >8 --

In some places, a write to an array descriptor data field was generated
simply by adding a modification of a reference to it that was already
available.  This change uses the existing setter function instead in
those places, to generate the same code.  It makes it more explicit that
in those areas a write to the field is generated.

We have to be careful because in some of the places, the pointer that is
to be modified is an array descriptor field only under some conditions.
Add a conditional in those places to separate the cases, and keep
generating the reference modification as before if the conditions are
not met.

gcc/fortran/ChangeLog:

* trans.cc (gfc_finalize_tree_expr): Use the data setter instead
of writing to the value returned by the data getter.
* trans-decl.cc (gfc_trans_deferred_vars): Likewise.
* trans-stmt.cc (trans_associate_var): Use the data setter
instead of writing to the value dereferenced from the data
address.

gcc/fortran/trans-decl.cc
gcc/fortran/trans-stmt.cc
gcc/fortran/trans.cc

index 3b49b18287ae4bdf1c257ca29aa66d3ef9ce6fb7..e9112116adb0d55e21eccec5f29d2d3976b762df 100644 (file)
@@ -5156,10 +5156,24 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
                  if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
                    {
                      /* Nullify when entering the scope.  */
-                     tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-                                            TREE_TYPE (se.expr), se.expr,
-                                            fold_convert (TREE_TYPE (se.expr),
-                                                          null_pointer_node));
+                     if (sym->ts.type == BT_CLASS
+                         && (CLASS_DATA (sym)->attr.dimension
+                             || CLASS_DATA (sym)->attr.codimension))
+                       {
+                         stmtblock_t nullify;
+                         gfc_init_block (&nullify);
+                         gfc_conv_descriptor_data_set (&nullify, descriptor,
+                                                       null_pointer_node);
+                         tmp = gfc_finish_block (&nullify);
+                       }
+                     else
+                       {
+                         tree typed_null = fold_convert (TREE_TYPE (se.expr),
+                                                         null_pointer_node);
+                         tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+                                                TREE_TYPE (se.expr), se.expr,
+                                                typed_null);
+                       }
                      if (sym->attr.optional)
                        {
                          tree present = gfc_conv_expr_present (sym);
index b4ddf7592c9657f1d0aa9bb2cc2b280507a1d893..4f2f4da2f2810ef8d70c25171d06a340ac529294 100644 (file)
@@ -2494,9 +2494,10 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
        {
          tmp = sym->backend_decl;
          if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
-           tmp = gfc_conv_descriptor_data_get (tmp);
-         gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
-                                                   null_pointer_node));
+           gfc_conv_descriptor_data_set (&se.pre, tmp, null_pointer_node);
+         else
+           gfc_add_modify (&se.pre, tmp,
+                           fold_convert (TREE_TYPE (tmp), null_pointer_node));
        }
 
       lhs = gfc_lval_expr_from_sym (sym);
index 13fd5ad498daf857188eaabeb09f1473fead6bd0..47396c3cbab1f767087d6598e7b2e68a378e539e 100644 (file)
@@ -1740,7 +1740,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
                             gfc_call_free (data_ptr),
                             build_empty_stmt (input_location));
       gfc_add_expr_to_block (&se->loop->post, tmp);
-      gfc_add_modify (&se->loop->post, data_ptr, data_null);
+      gfc_conv_descriptor_data_set (&se->loop->post, desc, data_null);
     }
   else
     {
@@ -1754,7 +1754,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
                                 gfc_call_free (data_ptr),
                                 build_empty_stmt (input_location));
          gfc_add_expr_to_block (&se->finalblock, tmp);
-         gfc_add_modify (&se->finalblock, data_ptr, data_null);
+         gfc_conv_descriptor_data_set (&se->finalblock, desc, data_null);
        }
     }
 }