gcc/testsuite/gfortran.dg/char_result_1.f90

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