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