flang/test/Evaluate/rewrite01.f90

   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.
   8 module some_mod
   9 contains
  10 function returns_array(n, m)
  11   integer :: returns_array(10:n+10,10:m+10)
  12   returns_array = 0
  13 end function
  14
  15 function returns_array_2(n)
  16   integer, intent(in) :: n
  17   integer :: returns_array_2(n)
  18   returns_array_2 = 0
  19 end function
  20
  21 function returns_array_3()
  22   integer :: returns_array_3(7:46+2)
  23   returns_array_3 = 0
  24 end function
  25
  26 subroutine 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)
  43 end subroutine
  44
  45 subroutine 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)
  57 end subroutine
  58
  59 subroutine 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))
  78 end subroutine
  79
  80 subroutine 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)
 103 end subroutine
 104
 105 !CHECK: len_test
 106 subroutine 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))
 167 end subroutine len_test
 168
 169 !CHECK-LABEL: associate_tests
 170 subroutine 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
 196 end subroutine
 197
 198 !CHECK-LABEL: array_constructor
 199 subroutine 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/)
 231 end subroutine
 232
 233 !CHECK-LABEL: array_ctor_implied_do_index
 234 subroutine 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)])
 244 end subroutine
 245
 246 end module