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