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   call test (f2 (double, 70), 140)
  20
  21   call indirect (double)
  22 contains
  23   function f1 (fn, i)
  24     integer :: i
  25     interface
  26       integer pure function fn (x)
  27         integer, intent (in) :: x
  28       end function fn
  29     end interface
  30     character (len = fn (i)) :: f1
  31     f1 = ''
  32   end function f1
  33
  34   function f2 (fn, i)
  35     integer :: i, fn
  36     character (len = fn (i)) :: f2
  37     f2 = ''
  38   end function f2
  39
  40   subroutine indirect (fn)
  41     interface
  42       integer pure function fn (x)
  43         integer, intent (in) :: x
  44       end function fn
  45     end interface
  46     call test (f1 (fn, 100), 200)
  47     call test (f2 (fn, 70), 140)
  48   end subroutine indirect
  49
  50   subroutine test (string, length)
  51     character (len = *) :: string
  52     integer, intent (in) :: length
  53     if (len (string) .ne. length) call abort
  54   end subroutine test
  55 end program main