https://gcc.gnu.org/g:59e39f5f5816d7b41b2f1962f871b1f988a97673
commit 59e39f5f5816d7b41b2f1962f871b1f988a97673
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sat Mar 15 18:57:13 2025 +0100
Extraction get_descr_caf_token
Diff:
---
gcc/fortran/trans-descriptor.cc | 89 +++++++++++++++++++++++++++--------------
1 file changed, 58 insertions(+), 31 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index afb6b0b59a60..c7763a73b2b4 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1015,8 +1015,6 @@ class modify_info
public:
virtual bool use_tree_type () const { return false; }
virtual bool is_initialization () const { return false; }
- virtual bool set_token () const { return true; }
- virtual tree get_caf_token () const { return null_pointer_node; }
virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
virtual tree get_length (gfc_typespec *ts) const { return get_size_info
(*ts); }
};
@@ -1091,7 +1089,6 @@ public:
virtual gfc_typespec *get_type () const { return ts; }
virtual bool use_tree_type () const { return use_tree_type_; }
virtual bool set_token () const { return clear_token || caf_token !=
NULL_TREE; }
- virtual tree get_caf_token () const;
virtual bt get_type_type (const gfc_typespec &) const;
virtual tree get_length (gfc_typespec *ts) const;
};
@@ -1113,7 +1110,13 @@ struct descr_change_info {
class modify_info *unknown_info;
class nullification *nullification_info;
class init_info *initialization_info;
- class scalar_value *scalar_value_info;
+ struct
+ {
+ class scalar_value *info;
+ tree caf_token;
+ bool clear_token;
+ }
+ scalar_value;
}
u;
};
@@ -1134,7 +1137,7 @@ get_internal_info (const descr_change_info &info)
return info.u.initialization_info;
case SCALAR_VALUE:
- return info.u.scalar_value_info;
+ return info.u.scalar_value.info;
default:
gcc_unreachable ();
@@ -1157,7 +1160,7 @@ get_descr_data_value (const descr_change_info &info)
return info.u.initialization_info->get_data_value ();
case SCALAR_VALUE:
- return info.u.scalar_value_info->get_data_value ();
+ return info.u.scalar_value.info->get_data_value ();
default:
gcc_unreachable ();
@@ -1188,6 +1191,32 @@ get_descr_span (const descr_change_info &info)
}
+static tree
+get_descr_caf_token (const descr_change_info &info)
+{
+ switch (info.type)
+ {
+ case UNKNOWN_CHANGE:
+ case EXPLICIT_NULLIFICATION:
+ case INITIALISATION:
+ return null_pointer_node;
+
+ case SCALAR_VALUE:
+ {
+ if (info.u.scalar_value.caf_token != NULL_TREE)
+ return info.u.scalar_value.caf_token;
+ else if (info.u.scalar_value.clear_token)
+ return null_pointer_node;
+ else
+ return NULL_TREE;
+ }
+
+ default:
+ gcc_unreachable ();
+ }
+}
+
+
tree
scalar_value::get_data_value () const
{
@@ -1254,16 +1283,6 @@ scalar_value::get_length (gfc_typespec * type_info) const
return size;
}
-tree
-scalar_value::get_caf_token () const
-{
- if (set_token ()
- && caf_token != NULL_TREE)
- return caf_token;
- else
- return modify_info::get_caf_token ();
-}
-
static tree
build_dtype (gfc_typespec *ts, int rank, const symbol_attribute &,
@@ -1351,20 +1370,24 @@ get_descriptor_init (tree type, gfc_typespec *ts, int
rank,
CONSTRUCTOR_APPEND_ELT (v, span_field, span_value);
}
- if (flag_coarray == GFC_FCOARRAY_LIB && attr->codimension
- && init.set_token ())
+ if (flag_coarray == GFC_FCOARRAY_LIB && attr->codimension)
{
- /* Declare the variable static so its array descriptor stays present
- after leaving the scope. It may still be accessed through another
- image. This may happen, for example, with the caf_mpi
- implementation. */
- bool dim_present = GFC_TYPE_ARRAY_RANK (type) > 0
- || GFC_TYPE_ARRAY_CORANK (type) > 0;
- tree token_field = gfc_advance_chain (fields,
- CAF_TOKEN_FIELD - (!dim_present));
- tree token_value = fold_convert (TREE_TYPE (token_field),
- init.get_caf_token ());
- CONSTRUCTOR_APPEND_ELT (v, token_field, token_value);
+ tree caf_token = get_descr_caf_token (change);
+ if (caf_token != NULL_TREE)
+ {
+ /* Declare the variable static so its array descriptor stays present
+ after leaving the scope. It may still be accessed through another
+ image. This may happen, for example, with the caf_mpi
+ implementation. */
+ bool dim_present = GFC_TYPE_ARRAY_RANK (type) > 0
+ || GFC_TYPE_ARRAY_CORANK (type) > 0;
+ tree token_field = gfc_advance_chain (fields,
+ CAF_TOKEN_FIELD
+ - (!dim_present));
+ tree token_value = fold_convert (TREE_TYPE (token_field),
+ caf_token);
+ CONSTRUCTOR_APPEND_ELT (v, token_field, token_value);
+ }
}
return v;
@@ -1879,7 +1902,9 @@ gfc_set_scalar_descriptor (stmtblock_t *block, tree
descriptor,
struct descr_change_info info;
info.type = SCALAR_VALUE;
info.descriptor_type = TREE_TYPE (descriptor);
- info.u.scalar_value_info = &sv;
+ info.u.scalar_value.info = &sv;
+ info.u.scalar_value.caf_token = value;
+ info.u.scalar_value.clear_token = true;
init_struct (block, descriptor,
get_descriptor_init (TREE_TYPE (descriptor), &sym->ts, 0,
@@ -1895,7 +1920,9 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
desc, tree scalar,
struct descr_change_info info;
info.type = SCALAR_VALUE;
info.descriptor_type = TREE_TYPE (desc);
- info.u.scalar_value_info = &sv;
+ info.u.scalar_value.info = &sv;
+ info.u.scalar_value.caf_token = caf_token;
+ info.u.scalar_value.clear_token = false;
init_struct (block, desc,
get_descriptor_init (TREE_TYPE (desc), nullptr, 0, attr, info));
