gcc/testsuite/gfortran.dg/char_result_2.f90

   1 ! Like char_result_1.f90, but the string arguments are pointers.
   2 ! { dg-do run }
   3 pure function double (string)
   4   character (len = *), intent (in) :: string
   5   character (len = len (string) * 2) :: double
   6   double = string // string
   7 end function double
   8
   9 function f1 (string)
  10   character (len = *), pointer :: string
  11   character (len = len (string)) :: f1
  12   f1 = ''
  13 end function f1
  14
  15 function f2 (string1, string2)
  16   character (len = *), pointer :: string1
  17   character (len = len (string1) - 20), pointer :: string2
  18   character (len = len (string1) + len (string2) / 2) :: f2
  19   f2 = ''
  20 end function f2
  21
  22 program main
  23   implicit none
  24
  25   interface
  26     pure function double (string)
  27       character (len = *), intent (in) :: string
  28       character (len = len (string) * 2) :: double
  29     end function double
  30     function f1 (string)
  31       character (len = *), pointer :: string
  32       character (len = len (string)) :: f1
  33     end function f1
  34     function f2 (string1, string2)
  35       character (len = *), pointer :: string1
  36       character (len = len (string1) - 20), pointer :: string2
  37       character (len = len (string1) + len (string2) / 2) :: f2
  38     end function f2
  39   end interface
  40
  41   integer :: a
  42   character (len = 80), target :: text
  43   character (len = 70), pointer :: textp
  44
  45   a = 42
  46   textp => text
  47
  48   call test (f1 (textp), 70)
  49   call test (f2 (textp, textp), 95)
  50   call test (f3 (textp), 105)
  51   call test (f4 (textp), 192)
  52   call test (f5 (textp), 140)
  53   call test (f6 (textp), 29)
  54
  55   call indirect (textp)
  56 contains
  57   function f3 (string)
  58     integer, parameter :: l1 = 30
  59     character (len = *), pointer :: string
  60     character (len = len (string) + l1 + 5) :: f3
  61     f3 = ''
  62   end function f3
  63
  64   function f4 (string)
  65     character (len = len (text) - 10), pointer :: string
  66     character (len = len (string) + len (text) + a) :: f4
  67     f4 = ''
  68   end function f4
  69
  70   function f5 (string)
  71     character (len = *), pointer :: string
  72     character (len = len (double (string))) :: f5
  73     f5 = ''
  74   end function f5
  75
  76   function f6 (string)
  77     character (len = *), pointer :: string
  78     character (len = len (string (a:))) :: f6
  79     f6 = ''
  80   end function f6
  81
  82   subroutine indirect (textp2)
  83     character (len = 50), pointer :: textp2
  84
  85     call test (f1 (textp), 70)
  86     call test (f2 (textp, textp), 95)
  87     call test (f3 (textp), 105)
  88     call test (f4 (textp), 192)
  89     call test (f5 (textp), 140)
  90     call test (f6 (textp), 29)
  91
  92     call test (f1 (textp2), 50)
  93     call test (f2 (textp2, textp), 65)
  94     call test (f3 (textp2), 85)
  95     call test (f4 (textp2), 192)
  96     call test (f5 (textp2), 100)
  97     call test (f6 (textp2), 9)
  98   end subroutine indirect
  99
 100   subroutine test (string, length)
 101     character (len = *) :: string
 102     integer, intent (in) :: length
 103     if (len (string) .ne. length) call abort
 104   end subroutine test
 105 end program main