gcc/testsuite/gfortran.dg/unlimited_polymorphic_30.f03

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR83318.
   4 !
   5 ! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
   6 !
   7 type :: any_vector
   8   class(*), allocatable :: v(:)
   9 end type
  10 type(any_vector) :: x, y
  11
  12 ! This did not work correctly
  13   x%v = ['foo','bar']
  14   call foo (x, 1)
  15
  16 ! This was reported as not working correctly but was OK before the above was fixed
  17   y = x
  18   call foo (y, 2)
  19
  20   x%v = [1_4,2_4]
  21   call foo (x, 3)
  22
  23   y = x
  24   call foo (y, 4)
  25
  26 contains
  27
  28   subroutine foo (arg, n)
  29     type (any_vector) :: arg
  30     integer :: n
  31     select type (v => arg%v)
  32         type is (character(*))
  33            if (any (v .ne. ["foo","bar"])) stop n
  34         type is (integer(4))
  35            if (any (v .ne. [1_4,2_4])) stop n
  36     end select
  37   end subroutine
  38 end