diff gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90	Fri Oct 27 22:46:09 2017 +0900
@@ -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