gcc/testsuite/gfortran.dg/actual_array_substr_2.f90

   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 !
  10 program 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 ()
  30 contains
  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
  43 end program pr28174
  44