OSDN Git Service

d123aca136d6b120a631bbc6b25644521db4884f
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / char_initialiser_actual.f90
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      pfoo => ch2
28   end function pfoo
29 end program