gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90

   1 ! { dg-do compile }
   2 ! Tests the patch for PR28890, in which a reference to a legal reference
   3 ! to an assumed character length function, passed as a dummy, would
   4 ! cause an ICE.
   5 !
   6 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   7 !
   8 character(*) function charrext (n)  ! { dg-warning "Obsolescent feature" }
   9   character(26) :: alpha ="abcdefghijklmnopqrstuvwxyz"
  10   charrext = alpha (1:n)
  11 end function charrext
  12
  13   character(26), external :: charrext
  14   interface
  15     integer(4) function test(charr, i)  ! { dg-warning "Obsolescent feature" }
  16      character(*), external :: charr
  17      integer :: i
  18     end function test
  19   end interface
  20
  21   do j = 1 , 26
  22     m = test (charrext, j)
  23     m = ctest (charrext, 27 - j)
  24   end do
  25 contains
  26   integer(4) function ctest(charr, i)  ! { dg-warning "Obsolescent feature" }
  27     character(*) :: charr
  28     integer :: i
  29     print *, charr(i)
  30     ctest = 1
  31   end function ctest
  32 end
  33
  34 integer(4) function test(charr, i)  ! { dg-warning "Obsolescent feature" }
  35   character(*) :: charr
  36   integer :: i
  37   print *, charr(i)
  38   test = 1
  39 end function test
  40