247 lines · plain
1! Test expression rewrites, in case where the expression cannot be2! folded to constant values.3! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s4 5! Test rewrites of inquiry intrinsics with arguments whose shape depends6! on a function reference with non constant shape. The function reference7! must be retained.8module some_mod9contains10function returns_array(n, m)11 integer :: returns_array(10:n+10,10:m+10)12 returns_array = 013end function14 15function returns_array_2(n)16 integer, intent(in) :: n17 integer :: returns_array_2(n)18 returns_array_2 = 019end function20 21function returns_array_3()22 integer :: returns_array_3(7:46+2)23 returns_array_3 = 024end function25 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 < 029 !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_838 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 subroutine44 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_856 print *, size(returns_array_3(), kind=8)57end subroutine58 59subroutine shape_test(x, n, m)60 abstract interface61 function foo(n)62 integer, intent(in) :: n63 real, pointer :: foo(:,:)64 end function65 end interface66 procedure(foo), pointer :: pf67 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_477 print *, rank(pf(1))78end subroutine79 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 < 083 type t84 real, pointer :: p(:, :)85 end type86 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_492 print *, lbound(returns_array(n, m), dim=1)93 !CHECK: PRINT *, 1_494 print *, lbound(returns_array_2(m), dim=1)95 !CHECK: PRINT *, 1_496 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 subroutine104 105!CHECK: len_test106subroutine len_test(a,b, c, d, e, n, m)107 character(*), intent(in) :: a108 character(*) :: b109 external b110 character(10), intent(in) :: c111 character(10) :: d112 external d113 integer, intent(in) :: n, m114 character(n), intent(in) :: e115 character(5), parameter :: cparam = "abc "116 interface117 function fun1(L)118 character(L) :: fun1119 integer :: L120 end function fun1121 end interface122 interface123 function mofun(L)124 character(L) :: mofun125 integer, intent(in) :: L126 end function mofun127 end interface128 129 !CHECK: PRINT *, int(int(a%len,kind=8),kind=4)130 print *, len(a)131 !CHECK: PRINT *, 5_4132 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_4138 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_4142 print *, len(c(1:5))143 !CHECK: PRINT *, 10_4144 print *, len(d(c))145 !CHECK: PRINT *, 20_4146 print *, len(d(c) // c)147 !CHECK: PRINT *, 0_4148 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_4160 print *, len(trim(cparam))161 !CHECK: PRINT *, len(trim(c))162 print *, len(trim(c))163 !CHECK: PRINT *, 40_4164 print *, len(repeat(c, 4))165 !CHECK: PRINT *, len(repeat(c,int(i,kind=8)))166 print *, len(repeat(c, i))167end subroutine len_test168 169!CHECK-LABEL: associate_tests170subroutine associate_tests(p)171 real, pointer :: p(:)172 real :: a(10:20)173 interface174 subroutine may_change_p_bounds(p)175 real, pointer :: p(:)176 end subroutine177 end interface178 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 associate183 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 associate188 associate(x => a)189 !CHECK: PRINT *, 10_8, 20_8, 11_8190 print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8)191 end associate192 associate(x => a+42.)193 !CHECK: PRINT *, 1_8, 11_8, 11_8194 print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8)195 end associate196end subroutine197 198!CHECK-LABEL: array_constructor199subroutine 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 interface203 function return_allocatable()204 real, allocatable :: return_allocatable(:)205 end function206 end interface207 !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 subroutine232 233!CHECK-LABEL: array_ctor_implied_do_index234subroutine array_ctor_implied_do_index(x, j)235 integer :: x(:)236 integer(8) :: j237 character(10) :: c238 !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 subroutine245 246end module247