1! Test expression rewrites, in case where the expression cannot be 2! folded to constant values. 3! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s 4 5! Test rewrites of inquiry intrinsics with arguments whose shape depends 6! on a function reference with non constant shape. The function reference 7! must be retained. 8module some_mod 9contains 10function returns_array(n, m) 11 integer :: returns_array(10:n+10,10:m+10) 12 returns_array = 0 13end function 14 15function returns_array_2(n) 16 integer, intent(in) :: n 17 integer :: returns_array_2(n) 18 returns_array_2 = 0 19end function 20 21function returns_array_3() 22 integer :: returns_array_3(7:46+2) 23 returns_array_3 = 0 24end function 25 26subroutine ubound_test(x, n, m) 27 integer :: x(n, m) 28 integer :: y(0:n, 0:m) ! UBOUND could be 0 if n or m are < 0 29 !CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1,kind=8),kind=4),int(size(x,dim=2,kind=8),kind=4)] 30 print *, ubound(x) 31 !CHECK: PRINT *, ubound(returns_array(n,m)) 32 print *, ubound(returns_array(n, m)) 33 !CHECK: PRINT *, ubound(returns_array(n,m),dim=1_4) 34 print *, ubound(returns_array(n, m), dim=1) 35 !CHECK: PRINT *, ubound(returns_array_2(m)) 36 print *, ubound(returns_array_2(m)) 37 !CHECK: PRINT *, 42_8 38 print *, ubound(returns_array_3(), dim=1, kind=8) 39 !CHECK: PRINT *, ubound(y) 40 print *, ubound(y) 41 !CHECK: PRINT *, ubound(y,1_4) 42 print *, ubound(y, 1) 43end subroutine 44 45subroutine size_test(x, n, m) 46 integer :: x(n, m) 47 !CHECK: PRINT *, int(size(x,dim=1,kind=8)*size(x,dim=2,kind=8),kind=4) 48 print *, size(x) 49 !CHECK: PRINT *, size(returns_array(n,m)) 50 print *, size(returns_array(n, m)) 51 !CHECK: PRINT *, size(returns_array(n,m),dim=1_4) 52 print *, size(returns_array(n, m), dim=1) 53 !CHECK: PRINT *, size(returns_array_2(m)) 54 print *, size(returns_array_2(m)) 55 !CHECK: PRINT *, 42_8 56 print *, size(returns_array_3(), kind=8) 57end subroutine 58 59subroutine shape_test(x, n, m) 60 abstract interface 61 function foo(n) 62 integer, intent(in) :: n 63 real, pointer :: foo(:,:) 64 end function 65 end interface 66 procedure(foo), pointer :: pf 67 integer :: x(n, m) 68 !CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1,kind=8),kind=4),int(size(x,dim=2,kind=8),kind=4)] 69 print *, shape(x) 70 !CHECK: PRINT *, shape(returns_array(n,m)) 71 print *, shape(returns_array(n, m)) 72 !CHECK: PRINT *, shape(returns_array_2(m)) 73 print *, shape(returns_array_2(m)) 74 !CHECK: PRINT *, [INTEGER(8)::42_8] 75 print *, shape(returns_array_3(), kind=8) 76 !CHECK: PRINT *, 2_4 77 print *, rank(pf(1)) 78end subroutine 79 80subroutine lbound_test(x, n, m) 81 integer :: x(n, m) 82 integer :: y(0:n, 0:m) ! LBOUND could be 1 if n or m are < 0 83 type t 84 real, pointer :: p(:, :) 85 end type 86 type(t) :: a(10) 87 !CHECK: PRINT *, [INTEGER(4)::1_4,1_4] 88 print *, lbound(x) 89 !CHECK: PRINT *, [INTEGER(4)::1_4,1_4] 90 print *, lbound(returns_array(n, m)) 91 !CHECK: PRINT *, 1_4 92 print *, lbound(returns_array(n, m), dim=1) 93 !CHECK: PRINT *, 1_4 94 print *, lbound(returns_array_2(m), dim=1) 95 !CHECK: PRINT *, 1_4 96 print *, lbound(returns_array_3(), dim=1) 97 !CHECK: PRINT *, lbound(y) 98 print *, lbound(y) 99 !CHECK: PRINT *, lbound(y,1_4) 100 print *, lbound(y, 1) 101 !CHECK: PRINT *, lbound(a(1_8)%p,dim=1,kind=8) 102 print *, lbound(a(1)%p, 1, kind=8) 103end subroutine 104 105!CHECK: len_test 106subroutine len_test(a,b, c, d, e, n, m) 107 character(*), intent(in) :: a 108 character(*) :: b 109 external b 110 character(10), intent(in) :: c 111 character(10) :: d 112 external d 113 integer, intent(in) :: n, m 114 character(n), intent(in) :: e 115 character(5), parameter :: cparam = "abc " 116 interface 117 function fun1(L) 118 character(L) :: fun1 119 integer :: L 120 end function fun1 121 end interface 122 interface 123 function mofun(L) 124 character(L) :: mofun 125 integer, intent(in) :: L 126 end function mofun 127 end interface 128 129 !CHECK: PRINT *, int(int(a%len,kind=8),kind=4) 130 print *, len(a) 131 !CHECK: PRINT *, 5_4 132 print *, len(a(1:5)) 133 !CHECK: PRINT *, len(b(a)) 134 print *, len(b(a)) 135 !CHECK: PRINT *, len(b(a)//a) 136 print *, len(b(a) // a) 137 !CHECK: PRINT *, 10_4 138 print *, len(c) 139 !CHECK: PRINT *, len(c(int(i,kind=8):int(j,kind=8))) 140 print *, len(c(i:j)) 141 !CHECK: PRINT *, 5_4 142 print *, len(c(1:5)) 143 !CHECK: PRINT *, 10_4 144 print *, len(d(c)) 145 !CHECK: PRINT *, 20_4 146 print *, len(d(c) // c) 147 !CHECK: PRINT *, 0_4 148 print *, len(a(10:4)) 149 !CHECK: PRINT *, int(max(0_8,int(m,kind=8)-int(n,kind=8)+1_8),kind=4) 150 print *, len(a(n:m)) 151 !CHECK: PRINT *, len(b(a(int(n,kind=8):int(m,kind=8)))) 152 print *, len(b(a(n:m))) 153 !CHECK: PRINT *, int(max(0_8,max(0_8,int(n,kind=8))-4_8+1_8),kind=4) 154 print *, len(e(4:)) 155 !CHECK: PRINT *, len(fun1(n-m)) 156 print *, len(fun1(n-m)) 157 !CHECK: PRINT *, len(mofun(m+1_4)) 158 print *, len(mofun(m+1)) 159 !CHECK: PRINT *, 3_4 160 print *, len(trim(cparam)) 161 !CHECK: PRINT *, len(trim(c)) 162 print *, len(trim(c)) 163 !CHECK: PRINT *, 40_4 164 print *, len(repeat(c, 4)) 165 !CHECK: PRINT *, len(repeat(c,int(i,kind=8))) 166 print *, len(repeat(c, i)) 167end subroutine len_test 168 169!CHECK-LABEL: associate_tests 170subroutine associate_tests(p) 171 real, pointer :: p(:) 172 real :: a(10:20) 173 interface 174 subroutine may_change_p_bounds(p) 175 real, pointer :: p(:) 176 end subroutine 177 end interface 178 associate(x => p) 179 call may_change_p_bounds(p) 180 !CHECK: PRINT *, lbound(x,dim=1,kind=8), size(x,dim=1,kind=8)+lbound(x,dim=1,kind=8)-1_8, size(x,dim=1,kind=8) 181 print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8) 182 end associate 183 associate(x => p+1) 184 call may_change_p_bounds(p) 185 !CHECK: PRINT *, 1_8, size(x,dim=1,kind=8), size(x,dim=1,kind=8) 186 print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8) 187 end associate 188 associate(x => a) 189 !CHECK: PRINT *, 10_8, 20_8, 11_8 190 print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8) 191 end associate 192 associate(x => a+42.) 193 !CHECK: PRINT *, 1_8, 11_8, 11_8 194 print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8) 195 end associate 196end subroutine 197 198!CHECK-LABEL: array_constructor 199subroutine array_constructor(a, u, v, w, x, y, z) 200 real :: a(4) 201 integer :: u(:), v(1), w(2), x(4), y(4), z(2, 2) 202 interface 203 function return_allocatable() 204 real, allocatable :: return_allocatable(:) 205 end function 206 end interface 207 !CHECK: PRINT *, size([REAL(4)::return_allocatable(),return_allocatable()]) 208 print *, size([return_allocatable(), return_allocatable()]) 209 !CHECK: PRINT *, [INTEGER(4)::x+y] 210 print *, (/x/) + (/y/) 211 !CHECK: PRINT *, [INTEGER(4)::x]+[INTEGER(4)::z] 212 print *, (/x/) + (/z/) 213 !CHECK: PRINT *, [INTEGER(4)::x+y,x+y] 214 print *, (/x, x/) + (/y, y/) 215 !CHECK: PRINT *, [INTEGER(4)::x,x]+[INTEGER(4)::x,z] 216 print *, (/x, x/) + (/x, z/) 217 !CHECK: PRINT *, [INTEGER(4)::x,w,w]+[INTEGER(4)::w,w,x] 218 print *, (/x, w, w/) + (/w, w, x/) 219 !CHECK: PRINT *, [INTEGER(4)::x]+[INTEGER(4)::1_4,2_4,3_4,4_4] 220 print *, (/x/) + (/1, 2, 3, 4/) 221 !CHECK: PRINT *, [INTEGER(4)::v]+[INTEGER(4)::1_4] 222 print *, (/v/) + (/1/) 223 !CHECK: PRINT *, [INTEGER(4)::x]+[INTEGER(4)::u] 224 print *, (/x/) + (/u/) 225 !CHECK: PRINT *, [INTEGER(4)::u]+[INTEGER(4)::u] 226 print *, (/u/) + (/u/) 227 !CHECK: PRINT *, [REAL(4)::a**x] 228 print *, (/a/) ** (/x/) 229 !CHECK: PRINT *, [REAL(4)::a]**[INTEGER(4)::z] 230 print *, (/a/) ** (/z/) 231end subroutine 232 233!CHECK-LABEL: array_ctor_implied_do_index 234subroutine array_ctor_implied_do_index(x, j) 235 integer :: x(:) 236 integer(8) :: j 237 character(10) :: c 238 !CHECK: PRINT *, size([INTEGER(4)::(x(1_8:i:1_8),INTEGER(8)::i=1_8,2_8,1_8)]) 239 print *, size([(x(1:i), integer(8)::i=1,2)]) 240 !CHECK: PRINT *, int(0_8+2_8*(0_8+max((j-1_8+1_8)/1_8,0_8)),kind=4) 241 print *, size([(x(1:j), integer(8)::i=1,2)]) 242 !CHECK: PRINT *, len([(c(i:i),INTEGER(8)::i=1_8,4_8,1_8)]) 243 print *, len([(c(i:i), integer(8)::i = 1,4)]) 244end subroutine 245 246end module 247