1! Related to PR 15326.  Test calls to string functions whose lengths
2! depend on various types of scalar value.
3! { dg-do run }
4pure function select (selector, iftrue, iffalse)
5  logical, intent (in) :: selector
6  integer, intent (in) :: iftrue, iffalse
7  integer :: select
8
9  if (selector) then
10    select = iftrue
11  else
12    select = iffalse
13  end if
14end function select
15
16program main
17  implicit none
18
19  interface
20    pure function select (selector, iftrue, iffalse)
21      logical, intent (in) :: selector
22      integer, intent (in) :: iftrue, iffalse
23      integer :: select
24    end function select
25  end interface
26
27  type pair
28    integer :: left, right
29  end type pair
30
31  integer, target :: i
32  integer, pointer :: ip
33  real, target :: r
34  real, pointer :: rp
35  logical, target :: l
36  logical, pointer :: lp
37  complex, target :: c
38  complex, pointer :: cp
39  character, target :: ch
40  character, pointer :: chp
41  type (pair), target :: p
42  type (pair), pointer :: pp
43
44  character (len = 10) :: dig
45
46  i = 100
47  r = 50.5
48  l = .true.
49  c = (10.9, 11.2)
50  ch = '1'
51  p%left = 40
52  p%right = 50
53
54  ip => i
55  rp => r
56  lp => l
57  cp => c
58  chp => ch
59  pp => p
60
61  dig = '1234567890'
62
63  call test (f1 (i), 200)
64  call test (f1 (ip), 200)
65  call test (f1 (-30), 60)
66  call test (f1 (i / (-4)), 50)
67
68  call test (f2 (r), 100)
69  call test (f2 (rp), 100)
70  call test (f2 (70.1), 140)
71  call test (f2 (r / 4), 24)
72  call test (f2 (real (i)), 200)
73
74  call test (f3 (l), 50)
75  call test (f3 (lp), 50)
76  call test (f3 (.false.), 55)
77  call test (f3 (i < 30), 55)
78
79  call test (f4 (c), 10)
80  call test (f4 (cp), 10)
81  call test (f4 (cmplx (60.0, r)), 60)
82  call test (f4 (cmplx (r, 1.0)), 50)
83
84  call test (f5 (ch), 11)
85  call test (f5 (chp), 11)
86  call test (f5 ('23'), 12)
87  call test (f5 (dig (3:)), 13)
88  call test (f5 (dig (10:)), 10)
89
90  call test (f6 (p), 145)
91  call test (f6 (pp), 145)
92  call test (f6 (pair (20, 10)), 85)
93  call test (f6 (pair (i / 2, 1)), 106)
94contains
95  function f1 (i)
96    integer :: i
97    character (len = abs (i) * 2) :: f1
98    f1 = ''
99  end function f1
100
101  function f2 (r)
102    real :: r
103    character (len = floor (r) * 2) :: f2
104    f2 = ''
105  end function f2
106
107  function f3 (l)
108    logical :: l
109    character (len = select (l, 50, 55)) :: f3
110    f3 = ''
111  end function f3
112
113  function f4 (c)
114    complex :: c
115    character (len = int (c)) :: f4
116    f4 = ''
117  end function f4
118
119  function f5 (c)
120    character :: c
121    character (len = scan ('123456789', c) + 10) :: f5
122    f5 = ''
123  end function f5
124
125  function f6 (p)
126    type (pair) :: p
127    integer :: i
128    character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
129    f6 = ''
130  end function f6
131
132  subroutine test (string, length)
133    character (len = *) :: string
134    integer, intent (in) :: length
135    if (len (string) .ne. length) call abort
136  end subroutine test
137end program main
138