https://gcc.gnu.org/g:0c3926f84e335e3a044e2e74ccb80bec6c1488bb

commit 0c3926f84e335e3a044e2e74ccb80bec6c1488bb
Author: Mikael Morin <[email protected]>
Date:   Wed Aug 26 21:18:43 2026 +0200

    fortran: array descriptor: Add a check for class container type [PR122521]
    
    TODO
    
    -- >8 --
    
    Before accessing the data component from a polymorphic reference to get
    the initialization pointer of the data component of a descriptor, add a
    check that the base reference really has class descriptor type.  It used to
    not be the case sometimes, causing a spurious extra component reference to
    the first field to be generated.  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 descriptor
    and to the data field of the array descriptor.
    
    The problem fixed here is less serious than it looks.  An extra reference to
    the first component, that has offset 0, doesn't change the resulting
    address.  Except if the type has no component at all, as in the testcase.
    
            PR fortran/122521
    
    gcc/fortran/ChangeLog:
    
            * trans-descriptor.cc (is_class_container_type): New function.
            (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.

Diff:
---
 gcc/fortran/trans-descriptor.cc               |  6 +++++-
 gcc/testsuite/gfortran.dg/assumed_rank_26.f90 | 26 ++++++++++++++++++++++++++
 2 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6277ebd31135..9eb82c352ddb 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -915,7 +915,11 @@ gfc_set_descriptor_from_scalar_class (stmtblock_t *block, 
tree descr,
               : scalar_type;
   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 000000000000..5f34c171e5b3
--- /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

Reply via email to