https://gcc.gnu.org/g:2949e1945a6758ece303c61a94003b44434a7977
commit 2949e1945a6758ece303c61a94003b44434a7977 Author: Mikael Morin <[email protected]> Date: Wed Aug 19 14:21:58 2026 +0200 fortran: array descriptor: Mark polymorphic descriptors as such [PR122521] TODO -- >8 -- Make sure that when associating a scalar polymorphic reference with an assumed rank dummy, the resulting descriptor is initialized with a class type. Before this change, the descriptor for polymorphic scalar coarrays had a type set to derived, that is non-polymorphic, because the type that was passed as source for the initialization of the dtype field was not the type of the class descriptor. That source type was taken from the value reference which for coarrays matches class->_data.data, that is includes a a reference to class container's _data and array descriptor's data fields. This is corrected by walking the reference chain up to the class descriptor and then using its type for the dtype values. The type field of descriptors is hardly used, so I'm not aware of any observable behaviour change caused by this, that could be checked by a testcase. There could be a tree dump check, but I'm not sure how useful that is if there is no observable effect. PR fortran/122521 gcc/fortran/ChangeLog: * trans-descriptor.cc (is_polymorphic_ref): New helper. (gfc_set_descriptor_from_scalar_class): Find the class descriptor ref and always pass its type to build the dtype value from. Diff: --- gcc/fortran/trans-descriptor.cc | 58 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 52 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 9eb82c352ddb..802d20f807b1 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -899,6 +899,53 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree scalar) } +/* Return true if EXPR is a polymorphic reference; otherwise return false. If + CLASS_REF isn't nullptr, set its target to a reference to the class container + in the true case, and leave it unmodified in the false case. */ + +static bool +is_polymorphic_ref (tree expr, tree *class_ref = nullptr) +{ + tree e = expr; + while (true) + { + STRIP_NOPS (e); + if (TREE_CODE (e) == ADDR_EXPR) + ; + else if (POINTER_TYPE_P (TREE_TYPE (e)) + && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_TYPE (e)))) + { + if (class_ref != nullptr) + *class_ref = build_fold_indirect_ref_loc (input_location, e); + return true; + } + else if (GFC_CLASS_TYPE_P (TREE_TYPE (e))) + { + if (class_ref != nullptr) + *class_ref = e; + return true; + } + else if (TREE_CODE (e) == COMPONENT_REF) + { + tree base_obj = TREE_OPERAND (e, 0); + tree field_decl = TREE_OPERAND (e, 1); + tree field_name = DECL_NAME (field_decl); + if (!((GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (base_obj)) + && strcmp (IDENTIFIER_POINTER (field_name), "data") == 0) + || (GFC_CLASS_TYPE_P (TREE_TYPE (base_obj)) + && strcmp (IDENTIFIER_POINTER (field_name), "_data") == 0))) + return false; + } + else if (!(TREE_CODE (e) == INDIRECT_REF + || TREE_CODE (e) == ARRAY_REF + || TREE_CODE (e) == POINTER_PLUS_EXPR)) + return false; + + e = TREE_OPERAND (e, 0); + } +} + + /* Add code to BLOCK initializing the zero-rank array descriptor DESCR, so that it represents the same data as the class descriptor reference SCALAR corresponding to the scalar polymorphic expression SCALAR_EXPR. This is used @@ -909,12 +956,11 @@ void gfc_set_descriptor_from_scalar_class (stmtblock_t *block, tree descr, tree scalar) { - tree scalar_type = TREE_TYPE (scalar); - tree etype = POINTER_TYPE_P (scalar_type) - ? TREE_TYPE (scalar_type) - : scalar_type; - gfc_conv_descriptor_dtype_set (block, descr, - gfc_get_dtype_rank_type (0, etype)); + tree class_ref; + if (!is_polymorphic_ref (scalar, &class_ref)) + gcc_unreachable (); + tree dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (class_ref)); + gfc_conv_descriptor_dtype_set (block, descr, dtype_val); tree tmp = scalar; if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)) || (POINTER_TYPE_P (TREE_TYPE (tmp))
