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) STOP 1
  19   end subroutine sfoo
  20   subroutine afoo(ch1, ch2)
  21      character*(*), dimension(:) :: ch1, ch2
  22      if (any(ch1 /= ch2)) STOP 2
  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