gcc/testsuite/gfortran.dg/allocate_with_source_17.f03

   1 ! { dg-do compile }
   2 !
   3 ! Tests the fix for PR67564 in which allocate with source for an unlimited
   4 ! polymorphic array and a character source would ICE.
   5 !
   6 ! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
   7 !
   8 program main
   9   type :: any_vector
  10     class(*), allocatable :: x(:)
  11   end type
  12   type(any_vector) :: a
  13   character(kind = 1, len = 5) :: chr1(3) = ["one  ","two  ","three"]
  14   character(kind = 4, len = 2) :: chr4(2) = [character(kind=4) :: 4_"ab", 4_"cd"]
  15   real(8) :: r(2) = [1d0,2d0]
  16
  17   allocate (a%x(3), source = chr1)
  18   call check
  19   allocate (a%x(2), source = chr4)
  20   call check
  21   allocate (a%x(2), source = r)
  22   call check
  23
  24 contains
  25   subroutine check
  26     select type (z => a%x)
  27       type is (real(8))
  28         if (any (z .ne. r)) STOP 1
  29       type is (character(kind = 1, len = *))
  30         if (any(z .ne. chr1)) STOP 2
  31       type is (character(kind = 4, len = *))
  32         if (any(z .ne. chr4)) STOP 3
  33     end select
  34     deallocate (a%x)
  35   end subroutine
  36 end program