From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline?
-- >8 --
Add an initialization of the array descriptor elem_len field with the size
from the class descriptor, when associating a polymorphic scalar with a
polymorphic assumed-rank dummy.
Before this change, the array descriptor element length field was not set
after the initialization of the dtype with a constructor of constant
values. This means the element length was set to the only value known at
compile time, the size of the declared type. This change adds an
assignment setting the elem_len field after the dtype initialization, using
the value from the class descriptor. The elem_len initialization is not
removed from the dtype initialization, so that it is the declared type size
that prevails instead of an unitialized value when the actual reference is
absent, unallocated or unassociated.
PR fortran/122521
gcc/fortran/ChangeLog:
* trans-descriptor.cc (gfc_set_descriptor_from_scalar_class): Add an
initialization of the element length with the size from the class
descriptor.
gcc/testsuite/ChangeLog:
* gfortran.dg/sizeof_8.f90: New test.
---
gcc/fortran/trans-descriptor.cc | 16 +++++++++++++
gcc/testsuite/gfortran.dg/sizeof_8.f90 | 33 ++++++++++++++++++++++++++
2 files changed, 49 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/sizeof_8.f90
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index a6136b22015..0f4e973f27b 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -976,6 +976,22 @@ gfc_set_descriptor_from_scalar_class (stmtblock_t *block,
tree descr,
set_descriptor_from_scalar (block, descr, TREE_TYPE (class_ref), tmp,
NULL_TREE);
+
+ /* Set the elem_len field... */
+ tree vptr = gfc_class_vptr_get (class_ref);
+ stmtblock_t b;
+ gfc_init_block (&b);
+ gfc_conv_descriptor_elem_len_set (&b, descr,
+ gfc_vptr_size_get (vptr));
+ tree len_init = gfc_finish_block (&b);
+ /* ... if the vptr is non-NULL. */
+ tree vptr_non_null = fold_build2_loc (input_location, NE_EXPR,
+ boolean_type_node, vptr,
+ build_zero_cst (TREE_TYPE (vptr)));
+ len_init = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+ vptr_non_null, len_init,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (block, len_init);
}
diff --git a/gcc/testsuite/gfortran.dg/sizeof_8.f90
b/gcc/testsuite/gfortran.dg/sizeof_8.f90
new file mode 100644
index 00000000000..d0bf2cf248b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sizeof_8.f90
@@ -0,0 +1,33 @@
+! { 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 declared type t1, instead of that of the effective
+! type t2, causing failure in s2.
+
+program prog
+ implicit none
+ type :: t1
+ integer :: c1
+ end type
+ type, extends(t1) :: t2
+ integer :: c2
+ end type
+ type(t2) :: x
+ class(t1), allocatable :: y
+ x = t2(5, 13)
+ y = x
+ call s1(y, sizeof(x))
+contains
+ subroutine s1(a, e)
+ class(t1), 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
--
2.53.0
