[gcc(refs/users/mikael/heads/refactor_descriptor_v07)] Suppression gfc_conv_descriptor_version compil' OK

Mikael Morin mikael@gcc.gnu.org
Mon Jun 30 17:48:41 GMT 2025


https://gcc.gnu.org/g:273df6bf14a66f2c587db97651715e033ec1ebb1

commit 273df6bf14a66f2c587db97651715e033ec1ebb1
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Sun Jun 29 12:58:32 2025 +0200

    Suppression gfc_conv_descriptor_version compil' OK

Diff:
---
 gcc/fortran/trans-array.cc      | 24 +++++++++++++-----------
 gcc/fortran/trans-descriptor.cc | 18 ++++++++++++++++--
 gcc/fortran/trans-descriptor.h  |  3 ++-
 gcc/fortran/trans.cc            |  5 ++---
 4 files changed, 33 insertions(+), 17 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 861872303d18..a301b0d06aa6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6205,10 +6205,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 		     build_tree_list (NULL_TREE, alloc),
 		     DECL_ATTRIBUTES (omp_alt_alloc));
       omp_alt_alloc = build_call_expr (omp_alt_alloc, 3, align, sz, alloc);
-      succ_add_expr = fold_build2_loc (input_location, MODIFY_EXPR,
-				       void_type_node,
-				       gfc_conv_descriptor_version (se->expr),
+      stmtblock_t tmp_block;
+      gfc_init_block (&tmp_block);
+      gfc_conv_descriptor_version_set (&tmp_block, se->expr,
 				       build_int_cst (integer_type_node, 1));
+      succ_add_expr = gfc_finish_block (&tmp_block);
     }
 
   /* The allocatable variant takes the old pointer as first argument.  */
@@ -10340,10 +10341,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 		{
 		  tree cd, t;
 		  if (c->attr.pdt_array)
-		    cd = fold_build2_loc (input_location, EQ_EXPR,
-					  boolean_type_node,
-					  gfc_conv_descriptor_version (comp),
-					  build_int_cst (integer_type_node, 1));
+		    {
+		      tree version = gfc_conv_descriptor_version_get (comp);
+		      cd = fold_build2_loc (input_location, EQ_EXPR,
+					    boolean_type_node, version,
+					    build_int_cst (integer_type_node, 1));
+		    }
 		  else
 		    cd = gfc_omp_call_is_alloc (tmp);
 		  t = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
@@ -10353,8 +10356,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 		  gfc_init_block (&tblock);
 		  gfc_add_expr_to_block (&tblock, t);
 		  if (c->attr.pdt_array)
-		    gfc_add_modify (&tblock, gfc_conv_descriptor_version (comp),
-				    integer_zero_node);
+		    gfc_conv_descriptor_version_set (&tblock, comp,
+						     integer_zero_node);
 		  tmp = build3_loc (input_location, COND_EXPR, void_type_node,
 				    cd, gfc_finish_block (&tblock),
 				    gfc_call_free (tmp));
@@ -11361,7 +11364,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 	{
 	  tree cond, omp_tmp;
 	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-				  gfc_conv_descriptor_version (desc),
+				  gfc_conv_descriptor_version_get (desc),
 				  build_int_cst (integer_type_node, 1));
 	  omp_tmp = builtin_decl_explicit (BUILT_IN_GOMP_REALLOC);
 	  omp_tmp = build_call_expr_loc (input_location, omp_tmp, 4,
@@ -11472,7 +11475,6 @@ void
 gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
 {
   tree type, etype;
-  tree tmp;
   tree descriptor;
   stmtblock_t init;
   int rank;
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 0956343aad92..f488e87663e9 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -298,8 +298,8 @@ gfc_conv_descriptor_rank (tree desc)
 }
 
 
-tree
-gfc_conv_descriptor_version (tree desc)
+static tree
+get_descriptor_version (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -312,6 +312,20 @@ gfc_conv_descriptor_version (tree desc)
 			  dtype, tmp, NULL_TREE);
 }
 
+tree
+gfc_conv_descriptor_version_get (tree desc)
+{
+  return non_lvalue_loc (input_location, get_descriptor_version (desc));
+}
+
+void
+gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc,
+				 tree value)
+{
+  tree t = get_descriptor_version (desc);
+  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
 
 /* Return the element length from the descriptor dtype field.  */
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 6149dc295ed5..3f4fd92df117 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -30,7 +30,6 @@ tree gfc_get_cfi_dim_sm (tree desc, tree idx);
 
 
 tree gfc_conv_descriptor_rank (tree desc);
-tree gfc_conv_descriptor_version (tree desc);
 tree gfc_conv_descriptor_attribute (tree desc);
 tree gfc_conv_descriptor_type (tree desc);
 tree gfc_get_descriptor_dimension (tree desc);
@@ -41,6 +40,7 @@ tree gfc_conv_descriptor_data_get (tree desc);
 tree gfc_conv_descriptor_offset_get (tree desc);
 tree gfc_conv_descriptor_dtype_get (tree desc);
 tree gfc_conv_descriptor_elem_len_get (tree desc);
+tree gfc_conv_descriptor_version_get (tree desc);
 tree gfc_conv_descriptor_span_get (tree desc);
 
 tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
@@ -52,6 +52,7 @@ void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
 void gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value);
 void gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree desc, tree value);
 void gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree desc, tree value);
+void gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree value);
 void gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value);
 void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim, tree value);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim, tree value);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 2a5ec3bba67e..9d525e0c51ee 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1915,7 +1915,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, tree errlen,
 	  tree cond, omp_tmp;
 	  if (descr)
 	    cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-				    gfc_conv_descriptor_version (descr),
+				    gfc_conv_descriptor_version_get (descr),
 				    integer_one_node);
 	  else
 	    cond = gfc_omp_call_is_alloc (pointer);
@@ -1929,8 +1929,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, tree errlen,
       gfc_add_modify (&non_null, pointer, build_int_cst (TREE_TYPE (pointer),
 							 0));
       if (flag_openmp_allocators && descr)
-	gfc_add_modify (&non_null, gfc_conv_descriptor_version (descr),
-			integer_zero_node);
+	gfc_conv_descriptor_version_set (&non_null, descr, integer_zero_node);
 
       if (status != NULL_TREE && !integer_zerop (status))
 	{


More information about the Gcc-cvs mailing list