1! { dg-do run }
2! Tests the fix for pr28174, in which the fix for pr28118 was
3! corrupting the character lengths of arrays that shared a
4! character length structure.  In addition, in developing the
5! fix, it was noted that intent(out/inout) arguments were not
6! getting written back to the calling scope.
7!
8! Based on the testscase by Harald Anlauf  <anlauf@gmx.de>
9!
10program pr28174
11  implicit none
12  character(len=12) :: teststring(2) = (/ "abc def ghij", &
13                                          "klm nop qrst" /)
14  character(len=12) :: a(2), b(2), c(2), d(2)
15  integer :: m = 7, n
16  a = teststring
17  b = a
18  c = a
19  d = a
20  n = m - 4
21
22! Make sure that variable substring references work.
23  call foo (a(:)(m:m+5), c(:)(n:m+2), d(:)(5:9))
24  if (any (a .ne. teststring)) call abort ()
25  if (any (b .ne. teststring)) call abort ()
26  if (any (c .ne. (/"ab456789#hij", &
27                    "kl7654321rst"/))) call abort ()
28  if (any (d .ne. (/"abc 23456hij", &
29                    "klm 98765rst"/))) call abort ()
30contains
31  subroutine foo (w, x, y)
32    character(len=*), intent(in) :: w(:)
33    character(len=*), intent(inOUT) :: x(:)
34    character(len=*), intent(OUT) :: y(:)
35    character(len=12) :: foostring(2) = (/"0123456789#$" , &
36                                          "$#9876543210"/)
37! This next is not required by the standard but tests the
38! functioning of the gfortran implementation.
39!   if (all (x(:)(3:7) .eq. y)) call abort ()
40    x = foostring (:)(5 : 4 + len (x))
41    y = foostring (:)(3 : 2 + len (y))
42  end subroutine foo
43end program pr28174
44
45