gcc/testsuite/gfortran.dg/char_result_7.f90

   1 ! Related to PR 15326.  Try calling string functions whose lengths depend
   2 ! on a dummy procedure.
   3 ! { dg-do run }
   4 integer pure function double (x)
   5   integer, intent (in) :: x
   6   double = x * 2
   7 end function double
   8
   9 program main
  10   implicit none
  11
  12   interface
  13     integer pure function double (x)
  14       integer, intent (in) :: x
  15     end function double
  16   end interface
  17
  18   call test (f1 (double, 100), 200)
  19
  20   call indirect (double)
  21 contains
  22   function f1 (fn, i)
  23     integer :: i
  24     interface
  25       integer pure function fn (x)
  26         integer, intent (in) :: x
  27       end function fn
  28     end interface
  29     character (len = fn (i)) :: f1
  30     f1 = ''
  31   end function f1
  32
  33   subroutine indirect (fn)
  34     interface
  35       integer pure function fn (x)
  36         integer, intent (in) :: x
  37       end function fn
  38     end interface
  39     call test (f1 (fn, 100), 200)
  40   end subroutine indirect
  41
  42   subroutine test (string, length)
  43     character (len = *) :: string
  44     integer, intent (in) :: length
  45     if (len (string) .ne. length) STOP 1
  46   end subroutine test
  47 end program main