|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-options "-std=legacy" }
|
|
|
3 !
|
|
|
4 ! Tests passing of character array initialiser as actual argument.
|
|
|
5 ! Fixes PR18109.
|
|
|
6 ! Contributed by Paul Thomas pault@gcc.gnu.org
|
|
|
7 program char_initialiser
|
|
|
8 character*5, dimension(3) :: x
|
|
|
9 character*5, dimension(:), pointer :: y
|
|
|
10 x=(/"is Ja","ne Fo","nda "/)
|
|
|
11 call sfoo ("is Ja", x(1))
|
|
|
12 call afoo ((/"is Ja","ne Fo","nda "/), x)
|
|
|
13 y => pfoo ((/"is Ja","ne Fo","nda "/))
|
|
|
14 call afoo (y, x)
|
|
|
15 contains
|
|
|
16 subroutine sfoo(ch1, ch2)
|
|
|
17 character*(*) :: ch1, ch2
|
|
|
18 if (ch1 /= ch2) call abort ()
|
|
|
19 end subroutine sfoo
|
|
|
20 subroutine afoo(ch1, ch2)
|
|
|
21 character*(*), dimension(:) :: ch1, ch2
|
|
|
22 if (any(ch1 /= ch2)) call abort ()
|
|
|
23 end subroutine afoo
|
|
|
24 function pfoo(ch2)
|
|
|
25 character*5, dimension(:), target :: ch2
|
|
|
26 character*5, dimension(:), pointer :: pfoo
|
|
|
27 allocate(pfoo(size(ch2)))
|
|
|
28 pfoo = ch2
|
|
|
29 end function pfoo
|
|
|
30 end program
|
