gcc/testsuite/gfortran.dg/char_initialiser_actual.f90

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