gcc/testsuite/gfortran.dg/char_result_8.f90

   1 ! Related to PR 15326.  Compare functions that return string pointers with
   2 ! functions that return strings.
   3 ! { dg-do run }
   4 program main
   5   implicit none
   6
   7   character (len = 30), target :: string
   8
   9   call test (f1 (), 30)
  10   call test (f2 (50), 50)
  11   call test (f3 (), 30)
  12   call test (f4 (70), 70)
  13
  14   call indirect (100)
  15 contains
  16   function f1 ()
  17     character (len = 30) :: f1
  18     f1 = ''
  19   end function f1
  20
  21   function f2 (i)
  22     integer :: i
  23     character (len = i) :: f2
  24     f2 = ''
  25   end function f2
  26
  27   function f3 ()
  28     character (len = 30), pointer :: f3
  29     f3 => string
  30   end function f3
  31
  32   function f4 (i)
  33     integer :: i
  34     character (len = i), pointer :: f4
  35     f4 => string
  36   end function f4
  37
  38   subroutine indirect (i)
  39     integer :: i
  40     call test (f1 (), 30)
  41     call test (f2 (i), i)
  42     call test (f3 (), 30)
  43     call test (f4 (i), i)
  44   end subroutine indirect
  45
  46   subroutine test (string, length)
  47     character (len = *) :: string
  48     integer, intent (in) :: length
  49     if (len (string) .ne. length) STOP 1
  50   end subroutine test
  51 end program main