From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline?
-- >8 --
In the function generating descriptor initialization from a scalar
polymorphic reference, the data descriptor component is initialized with
the _data component of the class container reference provided as input.
Add a check that the input reference really has class container type before
adding a subreference to the _data component.
The input used to not have class container type sometimes, but as that was
nowhere checked, a subcomponent reference was generated nevertheless to the
first field of the polymorphic content. With polymorphic scalar coarrays,
for example, the input reference matches the class->_data.data pattern, i.e.
it already includes a reference to the _data field of the class container
and to the data field of the array descriptor, and there is no need to add
any subcomponent.
The problem fixed here is less serious than it looks. A spurious reference
to the first component, that has offset 0, doesn't change the resulting
address. But if the type has no component at all, as in the testcase, it
can cause the compilation to abort.
PR fortran/122521
gcc/fortran/ChangeLog:
* trans-descriptor.cc: (gfc_set_descriptor_from_scalar_class): Don't
add a reference to the _data component if the base reference hasn't
class container type.
gcc/testsuite/ChangeLog:
* gfortran.dg/assumed_rank_26.f90: New test.
---
gcc/fortran/trans-descriptor.cc | 6 ++++-
gcc/testsuite/gfortran.dg/assumed_rank_26.f90 | 26 +++++++++++++++++++
2 files changed, 31 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/assumed_rank_26.f90
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index c7f40b46ddb..d3304f443f6 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -916,7 +916,11 @@ gfc_set_descriptor_from_scalar_class (stmtblock_t *block,
tree descr,
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype_rank_type (0, etype));
- tree tmp = gfc_class_data_get (scalar);
+ tree tmp = scalar;
+ if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
+ || (POINTER_TYPE_P (TREE_TYPE (tmp))
+ && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_TYPE (tmp)))))
+ tmp = gfc_class_data_get (tmp);
if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_26.f90
b/gcc/testsuite/gfortran.dg/assumed_rank_26.f90
new file mode 100644
index 00000000000..5f34c171e5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_26.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=single" }
+!
+! The following program used to cause an ICE because the initialization of the
+! array descriptor for the call to `as' was generating a reference to the first
+! component of `a', which has none in its declared type.
+
+program prog
+ implicit none
+ type :: t0
+ end type
+ type, extends(t0) :: t1
+ integer :: c1
+ end type
+ type(t1) :: x[*]
+ x = t1(17)
+ call s(x)
+contains
+ subroutine s(a)
+ class(t0), intent(in) :: a[*]
+ call as(a)
+ end subroutine
+ subroutine as(a)
+ class(t0), intent(in) :: a(..)
+ end subroutine
+end program
--
2.53.0
