gcc/testsuite/gfortran.dg/class_70.f03

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR57284 - [OOP] ICE with find_array_spec for polymorphic
   4 ! arrays. Once thw ICE was fixed, work was needed to fix a segfault while
   5 ! determining the size of 'z'.
   6 !
   7 ! Contributed by Lorenz Huedepohl  <bugs@stellardeath.org>
   8 !
   9 module testmod
  10   type type_t
  11     integer :: idx
  12   end type type_t
  13   type type_u
  14      type(type_t), allocatable :: cmp(:)
  15   end type
  16 contains
  17   function foo(a, b) result(add)
  18     class(type_t), intent(in) :: a(:), b(size(a))
  19     type(type_t) :: add(size(a))
  20     add%idx = a%idx + b%idx
  21   end function
  22 end module testmod
  23 program p
  24   use testmod
  25   class(type_t), allocatable, dimension(:) :: x, y, z
  26   class(type_u), allocatable :: w
  27   allocate (x, y, source = [type_t (1), type_t(2)])
  28   z = foo (x, y)
  29   if (any (z%idx .ne. [2, 4])) stop 1
  30
  31 ! Try something a bit more complicated than the original.
  32
  33   allocate (w)
  34   allocate (w%cmp, source = [type_t (2), type_t(3)])
  35   z = foo (w%cmp, y)
  36   if (any (z%idx .ne. [3, 5])) stop 2
  37   deallocate (w, x, y, z)
  38 end program