gcc/testsuite/gfortran.dg/char_result_13.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR38538, where the character length for the
   3 ! argument of 'func' was not calculated.
   4 !
   5 ! Contributed by Vivek Rao <vivekrao4@yahoo.com>
   6 !
   7 module abc
   8   implicit none
   9 contains
  10   subroutine xmain (i, j)
  11     integer i, j
  12     call foo (func ("_"//bar (i)//"x"//bar (j)//"x"), "_abcxabx")  ! original was elemental
  13     call foo (nfunc("_"//bar (j)//"x"//bar (i)//"x"), "_abxabcx")
  14   end subroutine xmain
  15 !
  16   function bar (i) result(yy)
  17     integer i, j, k
  18     character (len = i) :: yy(2)
  19     do j = 1, size (yy, 1)
  20       do k = 1, i
  21         yy(j)(k:k) = char (96+k)
  22       end do
  23     end do
  24   end function bar
  25 !
  26   elemental function func (yy) result(xy)
  27     character (len = *), intent(in) :: yy
  28     character (len = len (yy)) :: xy
  29     xy = yy
  30   end function func
  31 !
  32   function nfunc (yy) result(xy)
  33     character (len = *), intent(in) :: yy(:)
  34     character (len = len (yy)) :: xy(size (yy))
  35     xy = yy
  36   end function nfunc
  37 !
  38   subroutine foo(cc, teststr)
  39     character (len=*), intent(in) :: cc(:)
  40     character (len=*), intent(in) :: teststr
  41     if (any (cc .ne. teststr)) call abort
  42   end subroutine foo
  43 end module abc
  44
  45   use abc
  46   call xmain(3, 2)
  47 end
  48 ! { dg-final { cleanup-modules "abc" } }
  49