gcc/testsuite/gfortran.dg/char_result_3.f90

   1 ! Related to PR 15326.  Try calling string functions whose lengths involve
   2 ! some sort of array calculation.
   3 ! { dg-do run }
   4 pure elemental function double (x)
   5   integer, intent (in) :: x
   6   integer :: double
   7   double = x * 2
   8 end function double
   9
  10 program main
  11   implicit none
  12
  13   interface
  14     pure elemental function double (x)
  15       integer, intent (in) :: x
  16       integer :: double
  17     end function double
  18   end interface
  19
  20   integer, dimension (100:104), target :: a
  21   integer, dimension (:), pointer :: ap
  22   integer :: i, lower
  23
  24   a = (/ (i + 5, i = 0, 4) /)
  25   ap => a
  26   lower = 11
  27
  28   call test (f1 (a), 35)
  29   call test (f1 (ap), 35)
  30   call test (f1 ((/ 5, 10, 50 /)), 65)
  31   call test (f1 (a (101:103)), 21)
  32
  33   call test (f2 (a), 115)
  34   call test (f2 (ap), 115)
  35   call test (f2 ((/ 5, 10, 50 /)), 119)
  36   call test (f2 (a (101:103)), 116)
  37
  38   call test (f3 (a), 60)
  39   call test (f3 (ap), 60)
  40   call test (f3 ((/ 5, 10, 50 /)), 120)
  41   call test (f3 (a (101:103)), 30)
  42
  43   call test (f4 (a, 13, 1), 21)
  44   call test (f4 (ap, 13, 2), 14)
  45   call test (f4 ((/ 5, 10, 50 /), 12, 1), 60)
  46   call test (f4 (a (101:103), 12, 1), 15)
  47 contains
  48   function f1 (array)
  49     integer, dimension (10:) :: array
  50     character (len = sum (array)) :: f1
  51     f1 = ''
  52   end function f1
  53
  54   function f2 (array)
  55     integer, dimension (10:) :: array
  56     character (len = array (11) + a (104) + 100) :: f2
  57     f2 = ''
  58   end function f2
  59
  60   function f3 (array)
  61     integer, dimension (:) :: array
  62     character (len = sum (double (array (2:)))) :: f3
  63     f3 = ''
  64   end function f3
  65
  66   function f4 (array, upper, stride)
  67     integer, dimension (10:) :: array
  68     integer :: upper, stride
  69     character (len = sum (array (lower:upper:stride))) :: f4
  70     f4 = ''
  71   end function f4
  72
  73   subroutine test (string, length)
  74     character (len = *) :: string
  75     integer, intent (in) :: length
  76     if (len (string) .ne. length) call abort
  77   end subroutine test
  78 end program main