https://gcc.gnu.org/g:da18138ddf3cb02a62942f474c88da40d9377803
commit da18138ddf3cb02a62942f474c88da40d9377803
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Jul 15 18:28:30 2025 +0200
Extraction gfc_init_descriptor_variable
Correction nom block
Correction libgomp.fortran/allocators-1.f90
Renommage gfc_clear_descriptor -> gfc_init_descriptor_variable
Diff:
---
gcc/fortran/trans-array.cc | 18 ++--------------
gcc/fortran/trans-descriptor.cc | 24 ++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 4 ++--
libgomp/testsuite/libgomp.fortran/allocators-1.f90 | 4 ++--
4 files changed, 30 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index acf643f6adbd..4cb21a42c1a8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11828,10 +11828,8 @@ gfc_trans_deferred_array (gfc_symbol * sym,
gfc_wrapped_block * block)
/* NULLIFY the data pointer for non-saved allocatables, or for non-saved
pointers when -fcheck=pointer is specified. */
if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save
- && (sym->attr.allocatable
- || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER))))
+ && (sym->attr.allocatable || sym->attr.pointer))
{
- gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
{
/* Declare the variable static so its array descriptor stays present
@@ -11839,22 +11837,10 @@ gfc_trans_deferred_array (gfc_symbol * sym,
gfc_wrapped_block * block)
image. This may happen, for example, with the caf_mpi
implementation. */
TREE_STATIC (descriptor) = 1;
- gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
}
+ gfc_init_descriptor_variable (&init, sym, descriptor);
}
- /* Set initial TKR for pointers and allocatables */
- if (GFC_DESCRIPTOR_TYPE_P (type)
- && (sym->attr.pointer || sym->attr.allocatable))
- {
- tree etype;
-
- gcc_assert (sym->as && sym->as->rank>=0);
- etype = gfc_get_element_type (type);
- gfc_conv_descriptor_dtype_set (&init, descriptor,
- gfc_get_dtype_rank_type (sym->as->rank,
- etype));
- }
input_location = loc;
gfc_init_block (&cleanup);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e5f0076ab855..f89ad587f62f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -668,3 +668,27 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
#undef STRIDE_SUBFIELD
#undef LBOUND_SUBFIELD
#undef UBOUND_SUBFIELD
+
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+{
+ /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
+ pointers when -fcheck=pointer is specified. */
+ if (sym->attr.allocatable
+ || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+ {
+ gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+ if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+ gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
+ }
+
+ tree etype;
+
+ gcc_assert (sym->as && sym->as->rank>=0);
+ etype = gfc_get_element_type (TREE_TYPE (descr));
+ gfc_conv_descriptor_dtype_set (block, descr,
+ gfc_get_dtype_rank_type (sym->as->rank,
+ etype));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 3f602219c284..6058f54fc5fd 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -22,9 +22,7 @@ along with GCC; see the file COPYING3. If not see
/* Build a null array descriptor constructor. */
tree gfc_build_null_descriptor (tree);
tree gfc_build_default_class_descriptor (tree, gfc_typespec &);
-void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, tree);
void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
-void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, tree);
void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -94,4 +92,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
tree *stride_suboff, tree *lower_suboff,
tree *upper_suboff);
+void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree
descr);
+
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-1.f90
b/libgomp/testsuite/libgomp.fortran/allocators-1.f90
index 935a37cd9594..f1d81d58677a 100644
--- a/libgomp/testsuite/libgomp.fortran/allocators-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/allocators-1.f90
@@ -48,8 +48,8 @@ end
! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\)
__builtin_GOMP_alloc \\(512, 20, D\\.\[0-9\]+\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\)
__builtin_GOMP_alloc \\(4, 28, 0B\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dtype.version = 1;" 2 "original" } }
-! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\)
\\(a.dtype.version == 1 \\? __builtin_omp_realloc \\(\\(void \\*\\) a.data, 4,
0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) a.data, 4\\)\\);" 2 "original"
} }
-! { dg-final { scan-tree-dump-times "if \\(a.dtype.version == 1\\)" 3
"original" } }
+! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\)
\\((?:NON_LVALUE_EXPR <)?a.dtype.version>? == 1 \\? __builtin_omp_realloc
\\(\\(void \\*\\) a.data, 4, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\)
a.data, 4\\)\\);" 2 "original" } }
+! { dg-final { scan-tree-dump-times "if \\((?:NON_LVALUE_EXPR
<)?a.dtype.version>? == 1\\)" 3 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_GOMP_free
\\(\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) a.data, 0B\\);" 3
"original" } }
! { dg-final { scan-tree-dump-times "a.dtype.version = 0;" 3 "original" } }
