|
111
|
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))
|
|
131
|
28 if (any (z .ne. r)) STOP 1
|
|
111
|
29 type is (character(kind = 1, len = *))
|
|
131
|
30 if (any(z .ne. chr1)) STOP 2
|
|
111
|
31 type is (character(kind = 4, len = *))
|
|
131
|
32 if (any(z .ne. chr4)) STOP 3
|
|
111
|
33 end select
|
|
|
34 deallocate (a%x)
|
|
|
35 end subroutine
|
|
|
36 end program
|
