247 lines
7.6 KiB
Fortran
247 lines
7.6 KiB
Fortran
|
! Test expression rewrites, in case where the expression cannot be
|
||
|
|
! folded to constant values.
|
||
|
|
! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
|
||
|
|
|
||
|
|
! Test rewrites of inquiry intrinsics with arguments whose shape depends
|
||
|
|
! on a function reference with non constant shape. The function reference
|
||
|
|
! must be retained.
|
||
|
|
module some_mod
|
||
|
|
contains
|
||
|
|
function returns_array(n, m)
|
||
|
|
integer :: returns_array(10:n+10,10:m+10)
|
||
|
|
returns_array = 0
|
||
|
|
end function
|
||
|
|
|
||
|
|
function returns_array_2(n)
|
||
|
|
integer, intent(in) :: n
|
||
|
|
integer :: returns_array_2(n)
|
||
|
|
returns_array_2 = 0
|
||
|
|
end function
|
||
|
|
|
||
|
|
function returns_array_3()
|
||
|
|
integer :: returns_array_3(7:46+2)
|
||
|
|
returns_array_3 = 0
|
||
|
|
end function
|
||
|
|
|
||
|
|
subroutine ubound_test(x, n, m)
|
||
|
|
integer :: x(n, m)
|
||
|
|
integer :: y(0:n, 0:m) ! UBOUND could be 0 if n or m are < 0
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1,kind=8),kind=4),int(size(x,dim=2,kind=8),kind=4)]
|
||
|
|
print *, ubound(x)
|
||
|
|
!CHECK: PRINT *, ubound(returns_array(n,m))
|
||
|
|
print *, ubound(returns_array(n, m))
|
||
|
|
!CHECK: PRINT *, ubound(returns_array(n,m),dim=1_4)
|
||
|
|
print *, ubound(returns_array(n, m), dim=1)
|
||
|
|
!CHECK: PRINT *, ubound(returns_array_2(m))
|
||
|
|
print *, ubound(returns_array_2(m))
|
||
|
|
!CHECK: PRINT *, 42_8
|
||
|
|
print *, ubound(returns_array_3(), dim=1, kind=8)
|
||
|
|
!CHECK: PRINT *, ubound(y)
|
||
|
|
print *, ubound(y)
|
||
|
|
!CHECK: PRINT *, ubound(y,1_4)
|
||
|
|
print *, ubound(y, 1)
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
subroutine size_test(x, n, m)
|
||
|
|
integer :: x(n, m)
|
||
|
|
!CHECK: PRINT *, int(size(x,dim=1,kind=8)*size(x,dim=2,kind=8),kind=4)
|
||
|
|
print *, size(x)
|
||
|
|
!CHECK: PRINT *, size(returns_array(n,m))
|
||
|
|
print *, size(returns_array(n, m))
|
||
|
|
!CHECK: PRINT *, size(returns_array(n,m),dim=1_4)
|
||
|
|
print *, size(returns_array(n, m), dim=1)
|
||
|
|
!CHECK: PRINT *, size(returns_array_2(m))
|
||
|
|
print *, size(returns_array_2(m))
|
||
|
|
!CHECK: PRINT *, 42_8
|
||
|
|
print *, size(returns_array_3(), kind=8)
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
subroutine shape_test(x, n, m)
|
||
|
|
abstract interface
|
||
|
|
function foo(n)
|
||
|
|
integer, intent(in) :: n
|
||
|
|
real, pointer :: foo(:,:)
|
||
|
|
end function
|
||
|
|
end interface
|
||
|
|
procedure(foo), pointer :: pf
|
||
|
|
integer :: x(n, m)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1,kind=8),kind=4),int(size(x,dim=2,kind=8),kind=4)]
|
||
|
|
print *, shape(x)
|
||
|
|
!CHECK: PRINT *, shape(returns_array(n,m))
|
||
|
|
print *, shape(returns_array(n, m))
|
||
|
|
!CHECK: PRINT *, shape(returns_array_2(m))
|
||
|
|
print *, shape(returns_array_2(m))
|
||
|
|
!CHECK: PRINT *, [INTEGER(8)::42_8]
|
||
|
|
print *, shape(returns_array_3(), kind=8)
|
||
|
|
!CHECK: PRINT *, 2_4
|
||
|
|
print *, rank(pf(1))
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
subroutine lbound_test(x, n, m)
|
||
|
|
integer :: x(n, m)
|
||
|
|
integer :: y(0:n, 0:m) ! LBOUND could be 1 if n or m are < 0
|
||
|
|
type t
|
||
|
|
real, pointer :: p(:, :)
|
||
|
|
end type
|
||
|
|
type(t) :: a(10)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::1_4,1_4]
|
||
|
|
print *, lbound(x)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::1_4,1_4]
|
||
|
|
print *, lbound(returns_array(n, m))
|
||
|
|
!CHECK: PRINT *, 1_4
|
||
|
|
print *, lbound(returns_array(n, m), dim=1)
|
||
|
|
!CHECK: PRINT *, 1_4
|
||
|
|
print *, lbound(returns_array_2(m), dim=1)
|
||
|
|
!CHECK: PRINT *, 1_4
|
||
|
|
print *, lbound(returns_array_3(), dim=1)
|
||
|
|
!CHECK: PRINT *, lbound(y)
|
||
|
|
print *, lbound(y)
|
||
|
|
!CHECK: PRINT *, lbound(y,1_4)
|
||
|
|
print *, lbound(y, 1)
|
||
|
|
!CHECK: PRINT *, lbound(a(1_8)%p,dim=1,kind=8)
|
||
|
|
print *, lbound(a(1)%p, 1, kind=8)
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
!CHECK: len_test
|
||
|
|
subroutine len_test(a,b, c, d, e, n, m)
|
||
|
|
character(*), intent(in) :: a
|
||
|
|
character(*) :: b
|
||
|
|
external b
|
||
|
|
character(10), intent(in) :: c
|
||
|
|
character(10) :: d
|
||
|
|
external d
|
||
|
|
integer, intent(in) :: n, m
|
||
|
|
character(n), intent(in) :: e
|
||
|
|
character(5), parameter :: cparam = "abc "
|
||
|
|
interface
|
||
|
|
function fun1(L)
|
||
|
|
character(L) :: fun1
|
||
|
|
integer :: L
|
||
|
|
end function fun1
|
||
|
|
end interface
|
||
|
|
interface
|
||
|
|
function mofun(L)
|
||
|
|
character(L) :: mofun
|
||
|
|
integer, intent(in) :: L
|
||
|
|
end function mofun
|
||
|
|
end interface
|
||
|
|
|
||
|
|
!CHECK: PRINT *, int(int(a%len,kind=8),kind=4)
|
||
|
|
print *, len(a)
|
||
|
|
!CHECK: PRINT *, 5_4
|
||
|
|
print *, len(a(1:5))
|
||
|
|
!CHECK: PRINT *, len(b(a))
|
||
|
|
print *, len(b(a))
|
||
|
|
!CHECK: PRINT *, len(b(a)//a)
|
||
|
|
print *, len(b(a) // a)
|
||
|
|
!CHECK: PRINT *, 10_4
|
||
|
|
print *, len(c)
|
||
|
|
!CHECK: PRINT *, len(c(int(i,kind=8):int(j,kind=8)))
|
||
|
|
print *, len(c(i:j))
|
||
|
|
!CHECK: PRINT *, 5_4
|
||
|
|
print *, len(c(1:5))
|
||
|
|
!CHECK: PRINT *, 10_4
|
||
|
|
print *, len(d(c))
|
||
|
|
!CHECK: PRINT *, 20_4
|
||
|
|
print *, len(d(c) // c)
|
||
|
|
!CHECK: PRINT *, 0_4
|
||
|
|
print *, len(a(10:4))
|
||
|
|
!CHECK: PRINT *, int(max(0_8,int(m,kind=8)-int(n,kind=8)+1_8),kind=4)
|
||
|
|
print *, len(a(n:m))
|
||
|
|
!CHECK: PRINT *, len(b(a(int(n,kind=8):int(m,kind=8))))
|
||
|
|
print *, len(b(a(n:m)))
|
||
|
|
!CHECK: PRINT *, int(max(0_8,max(0_8,int(n,kind=8))-4_8+1_8),kind=4)
|
||
|
|
print *, len(e(4:))
|
||
|
|
!CHECK: PRINT *, len(fun1(n-m))
|
||
|
|
print *, len(fun1(n-m))
|
||
|
|
!CHECK: PRINT *, len(mofun(m+1_4))
|
||
|
|
print *, len(mofun(m+1))
|
||
|
|
!CHECK: PRINT *, 3_4
|
||
|
|
print *, len(trim(cparam))
|
||
|
|
!CHECK: PRINT *, len(trim(c))
|
||
|
|
print *, len(trim(c))
|
||
|
|
!CHECK: PRINT *, 40_4
|
||
|
|
print *, len(repeat(c, 4))
|
||
|
|
!CHECK: PRINT *, len(repeat(c,int(i,kind=8)))
|
||
|
|
print *, len(repeat(c, i))
|
||
|
|
end subroutine len_test
|
||
|
|
|
||
|
|
!CHECK-LABEL: associate_tests
|
||
|
|
subroutine associate_tests(p)
|
||
|
|
real, pointer :: p(:)
|
||
|
|
real :: a(10:20)
|
||
|
|
interface
|
||
|
|
subroutine may_change_p_bounds(p)
|
||
|
|
real, pointer :: p(:)
|
||
|
|
end subroutine
|
||
|
|
end interface
|
||
|
|
associate(x => p)
|
||
|
|
call may_change_p_bounds(p)
|
||
|
|
!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)
|
||
|
|
print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8)
|
||
|
|
end associate
|
||
|
|
associate(x => p+1)
|
||
|
|
call may_change_p_bounds(p)
|
||
|
|
!CHECK: PRINT *, 1_8, size(x,dim=1,kind=8), size(x,dim=1,kind=8)
|
||
|
|
print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8)
|
||
|
|
end associate
|
||
|
|
associate(x => a)
|
||
|
|
!CHECK: PRINT *, 10_8, 20_8, 11_8
|
||
|
|
print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8)
|
||
|
|
end associate
|
||
|
|
associate(x => a+42.)
|
||
|
|
!CHECK: PRINT *, 1_8, 11_8, 11_8
|
||
|
|
print *, lbound(x, 1, kind=8), ubound(x, 1, kind=8), size(x, 1, kind=8)
|
||
|
|
end associate
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
!CHECK-LABEL: array_constructor
|
||
|
|
subroutine array_constructor(a, u, v, w, x, y, z)
|
||
|
|
real :: a(4)
|
||
|
|
integer :: u(:), v(1), w(2), x(4), y(4), z(2, 2)
|
||
|
|
interface
|
||
|
|
function return_allocatable()
|
||
|
|
real, allocatable :: return_allocatable(:)
|
||
|
|
end function
|
||
|
|
end interface
|
||
|
|
!CHECK: PRINT *, size([REAL(4)::return_allocatable(),return_allocatable()])
|
||
|
|
print *, size([return_allocatable(), return_allocatable()])
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::x+y]
|
||
|
|
print *, (/x/) + (/y/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::x]+[INTEGER(4)::z]
|
||
|
|
print *, (/x/) + (/z/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::x+y,x+y]
|
||
|
|
print *, (/x, x/) + (/y, y/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::x,x]+[INTEGER(4)::x,z]
|
||
|
|
print *, (/x, x/) + (/x, z/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::x,w,w]+[INTEGER(4)::w,w,x]
|
||
|
|
print *, (/x, w, w/) + (/w, w, x/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::x]+[INTEGER(4)::1_4,2_4,3_4,4_4]
|
||
|
|
print *, (/x/) + (/1, 2, 3, 4/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::v]+[INTEGER(4)::1_4]
|
||
|
|
print *, (/v/) + (/1/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::x]+[INTEGER(4)::u]
|
||
|
|
print *, (/x/) + (/u/)
|
||
|
|
!CHECK: PRINT *, [INTEGER(4)::u]+[INTEGER(4)::u]
|
||
|
|
print *, (/u/) + (/u/)
|
||
|
|
!CHECK: PRINT *, [REAL(4)::a**x]
|
||
|
|
print *, (/a/) ** (/x/)
|
||
|
|
!CHECK: PRINT *, [REAL(4)::a]**[INTEGER(4)::z]
|
||
|
|
print *, (/a/) ** (/z/)
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
!CHECK-LABEL: array_ctor_implied_do_index
|
||
|
|
subroutine array_ctor_implied_do_index(x, j)
|
||
|
|
integer :: x(:)
|
||
|
|
integer(8) :: j
|
||
|
|
character(10) :: c
|
||
|
|
!CHECK: PRINT *, size([INTEGER(4)::(x(1_8:i:1_8),INTEGER(8)::i=1_8,2_8,1_8)])
|
||
|
|
print *, size([(x(1:i), integer(8)::i=1,2)])
|
||
|
|
!CHECK: PRINT *, int(0_8+2_8*(0_8+max((j-1_8+1_8)/1_8,0_8)),kind=4)
|
||
|
|
print *, size([(x(1:j), integer(8)::i=1,2)])
|
||
|
|
!CHECK: PRINT *, len([(c(i:i),INTEGER(8)::i=1_8,4_8,1_8)])
|
||
|
|
print *, len([(c(i:i), integer(8)::i = 1,4)])
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
end module
|