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), target :: text
  44   character (len = 70), pointer :: textp
  45
  46   a = 42
  47   textp => text
  48
  49   call test (f1 (text), 80)
  50   call test (f2 (text, text), 110)
  51   call test (f3 (text), 115)
  52   call test (f4 (text), 192)
  53   call test (f5 (text), 160)
  54   call test (f6 (text), 39)
  55
  56   call test (f1 (textp), 70)
  57   call test (f2 (textp, text), 95)
  58   call test (f3 (textp), 105)
  59   call test (f4 (textp), 192)
  60   call test (f5 (textp), 140)
  61   call test (f6 (textp), 29)
  62
  63   call indirect (textp)
  64 contains
  65   function f3 (string)
  66     integer, parameter :: l1 = 30
  67     character (len = *) :: string
  68     character (len = len (string) + l1 + 5) :: f3
  69     f3 = ''
  70   end function f3
  71
  72   function f4 (string)
  73     character (len = len (text) - 10) :: string
  74     character (len = len (string) + len (text) + a) :: f4
  75     f4 = ''
  76   end function f4
  77
  78   function f5 (string)
  79     character (len = *) :: string
  80     character (len = len (double (string))) :: f5
  81     f5 = ''
  82   end function f5
  83
  84   function f6 (string)
  85     character (len = *) :: string
  86     character (len = len (string (a:))) :: f6
  87     f6 = ''
  88   end function f6
  89
  90   subroutine indirect (text2)
  91     character (len = *) :: text2
  92
  93     call test (f1 (text), 80)
  94     call test (f2 (text, text), 110)
  95     call test (f3 (text), 115)
  96     call test (f4 (text), 192)
  97     call test (f5 (text), 160)
  98     call test (f6 (text), 39)
  99
 100     call test (f1 (text2), 70)
 101     call test (f2 (text2, text2), 95)
 102     call test (f3 (text2), 105)
 103     call test (f4 (text2), 192)
 104     call test (f5 (text2), 140)
 105     call test (f6 (text2), 29)
 106   end subroutine indirect
 107
 108   subroutine test (string, length)
 109     character (len = *) :: string
 110     integer, intent (in) :: length
 111     if (len (string) .ne. length) call abort
 112   end subroutine test
 113 end program main