https://gcc.gnu.org/g:104cbf542ab61a9047d9a4f906273f011812cc97
commit 104cbf542ab61a9047d9a4f906273f011812cc97 Author: Mikael Morin <[email protected]> Date: Tue Aug 18 12:39:32 2026 +0200 fortran: array descriptor: Guess size from declared type [PR122521] Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline? -- >8 -- When associating a polymorphic scalar with a polymorphic assumed-rank dummy, make sure that the type size is guessed from the declared type and not the class descriptor type, to initialize the array descriptor elem_len field. Before this change, the size was set to that of the class descriptor, causing the intrinsic SIZEOF to return a wrong value. Fortunately, I couldn't find any observable effect outside of this (non-standard) intrinsic. The use of the declared type as source of type size makes it possible to have void that comes out as source, in the unlimited polymorphic case. This causes the dtype value construction to trip on an assert because it's not prepared for a void type, as there's no size that can be guessed from it. This is corrected by skipping the element length initialization if the input type is void. PR fortran/122521 gcc/fortran/ChangeLog: * trans-descriptor.cc (gfc_build_dtype_constructor): Accept NULL size argument. Don't build any initialization of the elem_len field if size is NULL. * trans-types.cc (get_class_declared_type): New function. (gfc_get_dtype_rank_type): Clear the size by default. Don't set it if the input type is void. If the type is a class container type, use the data target type to guess the size. gcc/testsuite/ChangeLog: * gfortran.dg/sizeof_7.f90: New test. Diff: --- gcc/fortran/trans-descriptor.cc | 18 +++++++------ gcc/fortran/trans-types.cc | 46 +++++++++++++++++++++++++++++++--- gcc/testsuite/gfortran.dg/sizeof_7.f90 | 30 ++++++++++++++++++++++ 3 files changed, 82 insertions(+), 12 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 2139cd9fc311..fc467c99d15b 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -646,15 +646,17 @@ gfc_build_dtype_constructor (tree size, int type, int rank) tree field; vec<constructor_elt, va_gc> *v = NULL; - gcc_assert (size); - - STRIP_NOPS (size); - size = fold_convert (size_type_node, size); tree dtype_type_node = get_dtype_type_node (); - field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node), - GFC_DTYPE_ELEM_LEN); - CONSTRUCTOR_APPEND_ELT (v, field, - fold_convert (TREE_TYPE (field), size)); + if (size) + { + STRIP_NOPS (size); + size = fold_convert (size_type_node, size); + field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node), + GFC_DTYPE_ELEM_LEN); + CONSTRUCTOR_APPEND_ELT (v, field, + fold_convert (TREE_TYPE (field), size)); + } + field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node), GFC_DTYPE_VERSION); CONSTRUCTOR_APPEND_ELT (v, field, diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index ef80cd8feabb..c0debdd1de97 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -1698,6 +1698,35 @@ gfc_get_desc_dim_type (void) } +/* Return the type that will be inherited by any entity accessible through a + class container of type CLASS_TYPE. In other words, given class(foo), return + foo. */ + +static tree +get_class_declared_type (tree class_type) +{ + gcc_assert (GFC_CLASS_TYPE_P (class_type)); + tree data_field = TYPE_FIELDS (class_type); + gcc_checking_assert (TREE_CODE (data_field) == FIELD_DECL + && DECL_NAME (data_field) + && strcmp (IDENTIFIER_POINTER (DECL_NAME (data_field)), + "_data") + == 0); + + tree data_type = TREE_TYPE (data_field); + tree declared_type; + if (GFC_DESCRIPTOR_TYPE_P (data_type)) + declared_type = gfc_get_element_type (data_type); + else + { + gcc_assert (POINTER_TYPE_P (data_type)); + declared_type = TREE_TYPE (data_type); + } + + return declared_type; +} + + /* Return the DTYPE for an array. This describes the type and type parameters of the array. */ /* TODO: Only call this when the value is actually used, and make all the @@ -1707,7 +1736,6 @@ tree gfc_get_dtype_rank_type (int rank, tree etype) { tree ptype; - tree size; int n; ptype = etype; @@ -1749,7 +1777,10 @@ gfc_get_dtype_rank_type (int rank, tree etype) case RECORD_TYPE: if (GFC_CLASS_TYPE_P (etype)) - n = BT_CLASS; + { + n = BT_CLASS; + etype = get_class_declared_type (etype); + } else n = BT_DERIVED; break; @@ -1765,6 +1796,7 @@ gfc_get_dtype_rank_type (int rank, tree etype) gcc_unreachable (); } + tree size = NULL_TREE; switch (n) { case BT_CHARACTER: @@ -1772,9 +1804,15 @@ gfc_get_dtype_rank_type (int rank, tree etype) size = gfc_get_character_len_in_bytes (ptype); break; case BT_VOID: - gcc_assert (TREE_CODE (ptype) == POINTER_TYPE); - size = size_in_bytes (ptype); + if (TREE_CODE (ptype) == POINTER_TYPE) + size = size_in_bytes (ptype); break; + case BT_CLASS: + if (VOID_TYPE_P (etype)) + break; + /* For classes, the element length isn't a known constant, we set it to + the declared type length instead if possible. */ + /* Fall through. */ default: size = size_in_bytes (etype); break; diff --git a/gcc/testsuite/gfortran.dg/sizeof_7.f90 b/gcc/testsuite/gfortran.dg/sizeof_7.f90 new file mode 100644 index 000000000000..47b77c2ac800 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/sizeof_7.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! +! Check the element length value set in a scalar descriptor associated with a +! polymorphic assumed-rank dummy. The value set in the descriptor passed to s1 +! used to be that of the class descriptor, instead of that of the type t, +! causing failure in s2. + +program prog + implicit none + type :: t + integer :: c1 + end type + type(t) :: x + class(t), allocatable :: y + x = t(5) + y = x + call s1(y, sizeof(x)) +contains + subroutine s1(a, e) + class(t), intent(in) :: a(..) + integer(kind=8), intent(in) :: e + call s2(a, e) + end subroutine + subroutine s2(a, e) + type(*), intent(in) :: a(..) + integer(kind=8), intent(in) :: e + !print *, sizeof(a), e + if (sizeof(a) /= e) error stop 1 + end subroutine +end program
