1 files changed, 30 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 b/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90
new file mode 100644
index 000000000..dbd78909e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90
@@ -0,0 +1,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