forked from OSchip/llvm-project
337 lines
7.2 KiB
Fortran
337 lines
7.2 KiB
Fortran
! RUN: %flang_fc1 -fsyntax-only -fdebug-pre-fir-tree %s | FileCheck %s
|
|
|
|
! Test Pre-FIR Tree captures all the intended nodes from the parse-tree
|
|
! Coarray and OpenMP related nodes are tested in other files.
|
|
|
|
! CHECK: Program test_prog
|
|
program test_prog
|
|
! Check specification part is not part of the tree.
|
|
interface
|
|
subroutine incr(i)
|
|
integer, intent(inout) :: i
|
|
end subroutine
|
|
end interface
|
|
integer :: i, j, k
|
|
real, allocatable, target :: x(:)
|
|
real :: y(100)
|
|
! CHECK-NOT: node
|
|
! CHECK: <<DoConstruct>>
|
|
! CHECK: NonLabelDoStmt
|
|
do i=1,5
|
|
! CHECK: PrintStmt
|
|
print *, "hey"
|
|
! CHECK: <<DoConstruct>>
|
|
! CHECK: NonLabelDoStmt
|
|
do j=1,5
|
|
! CHECK: PrintStmt
|
|
print *, "hello", i, j
|
|
! CHECK: EndDoStmt
|
|
end do
|
|
! CHECK: <<End DoConstruct>>
|
|
! CHECK: EndDoStmt
|
|
end do
|
|
! CHECK: <<End DoConstruct>>
|
|
|
|
! CHECK: <<AssociateConstruct>>
|
|
! CHECK: AssociateStmt
|
|
associate (k => i + j)
|
|
! CHECK: AllocateStmt
|
|
allocate(x(k))
|
|
! CHECK: EndAssociateStmt
|
|
end associate
|
|
! CHECK: <<End AssociateConstruct>>
|
|
|
|
! CHECK: <<BlockConstruct!>>
|
|
! CHECK: BlockStmt
|
|
block
|
|
integer :: k, l
|
|
real, pointer :: p(:)
|
|
! CHECK: PointerAssignmentStmt
|
|
p => x
|
|
! CHECK: AssignmentStmt
|
|
k = size(p)
|
|
! CHECK: AssignmentStmt
|
|
l = 1
|
|
! CHECK: <<CaseConstruct!>>
|
|
! CHECK: SelectCaseStmt
|
|
select case (k)
|
|
! CHECK: CaseStmt
|
|
case (:0)
|
|
! CHECK: NullifyStmt
|
|
nullify(p)
|
|
! CHECK: CaseStmt
|
|
case (1)
|
|
! CHECK: <<IfConstruct>>
|
|
! CHECK: IfThenStmt
|
|
if (p(1)>0.) then
|
|
! CHECK: PrintStmt
|
|
print *, "+"
|
|
! CHECK: ElseIfStmt
|
|
else if (p(1)==0.) then
|
|
! CHECK: PrintStmt
|
|
print *, "0."
|
|
! CHECK: ElseStmt
|
|
else
|
|
! CHECK: PrintStmt
|
|
print *, "-"
|
|
! CHECK: EndIfStmt
|
|
end if
|
|
! CHECK: <<End IfConstruct>>
|
|
! CHECK: CaseStmt
|
|
case (2:10)
|
|
! CHECK: CaseStmt
|
|
case default
|
|
! Note: label-do-loop are canonicalized into do constructs
|
|
! CHECK: <<DoConstruct!>>
|
|
! CHECK: NonLabelDoStmt
|
|
do 22 while(l<=k)
|
|
! CHECK: IfStmt
|
|
if (p(l)<0.) p(l)=cos(p(l))
|
|
! CHECK: CallStmt
|
|
22 call incr(l)
|
|
! CHECK: EndDoStmt
|
|
! CHECK: <<End DoConstruct!>>
|
|
! CHECK: CaseStmt
|
|
case (100:)
|
|
! CHECK: EndSelectStmt
|
|
end select
|
|
! CHECK: <<End CaseConstruct!>>
|
|
! CHECK: EndBlockStmt
|
|
end block
|
|
! CHECK: <<End BlockConstruct!>>
|
|
|
|
! CHECK-NOT: WhereConstruct
|
|
! CHECK: WhereStmt
|
|
where (x > 1.) x = x/2.
|
|
|
|
! CHECK: <<WhereConstruct>>
|
|
! CHECK: WhereConstructStmt
|
|
where (x == 0.)
|
|
! CHECK: AssignmentStmt
|
|
x = 0.01
|
|
! CHECK: MaskedElsewhereStmt
|
|
elsewhere (x < 0.5)
|
|
! CHECK: AssignmentStmt
|
|
x = x*2.
|
|
! CHECK: <<WhereConstruct>>
|
|
where (y > 0.4)
|
|
! CHECK: AssignmentStmt
|
|
y = y/2.
|
|
end where
|
|
! CHECK: <<End WhereConstruct>>
|
|
! CHECK: ElsewhereStmt
|
|
elsewhere
|
|
! CHECK: AssignmentStmt
|
|
x = x + 1.
|
|
! CHECK: EndWhereStmt
|
|
end where
|
|
! CHECK: <<End WhereConstruct>>
|
|
|
|
! CHECK-NOT: ForAllConstruct
|
|
! CHECK: ForallStmt
|
|
forall (i = 1:5) x(i) = y(i)
|
|
|
|
! CHECK: <<ForallConstruct>>
|
|
! CHECK: ForallConstructStmt
|
|
forall (i = 1:5)
|
|
! CHECK: AssignmentStmt
|
|
x(i) = x(i) + y(10*i)
|
|
! CHECK: EndForallStmt
|
|
end forall
|
|
! CHECK: <<End ForallConstruct>>
|
|
|
|
! CHECK: DeallocateStmt
|
|
deallocate(x)
|
|
end
|
|
|
|
! CHECK: ModuleLike
|
|
module test
|
|
!! When derived type processing is implemented, remove all instances of:
|
|
!! - !![disable]
|
|
!! - COM:
|
|
!![disable]type :: a_type
|
|
!![disable] integer :: x
|
|
!![disable]end type
|
|
!![disable]type, extends(a_type) :: b_type
|
|
!![disable] integer :: y
|
|
!![disable]end type
|
|
contains
|
|
! CHECK: Function foo
|
|
function foo(x)
|
|
real x(..)
|
|
integer :: foo
|
|
! CHECK: <<SelectRankConstruct!>>
|
|
! CHECK: SelectRankStmt
|
|
select rank(x)
|
|
! CHECK: SelectRankCaseStmt
|
|
rank (0)
|
|
! CHECK: AssignmentStmt
|
|
foo = 0
|
|
! CHECK: SelectRankCaseStmt
|
|
rank (*)
|
|
! CHECK: AssignmentStmt
|
|
foo = -1
|
|
! CHECK: SelectRankCaseStmt
|
|
rank (1)
|
|
! CHECK: AssignmentStmt
|
|
foo = 1
|
|
! CHECK: SelectRankCaseStmt
|
|
rank default
|
|
! CHECK: AssignmentStmt
|
|
foo = 2
|
|
! CHECK: EndSelectStmt
|
|
end select
|
|
! CHECK: <<End SelectRankConstruct!>>
|
|
end function
|
|
|
|
! CHECK: Function bar
|
|
function bar(x)
|
|
class(*) :: x
|
|
! CHECK: <<SelectTypeConstruct!>>
|
|
! CHECK: SelectTypeStmt
|
|
select type(x)
|
|
! CHECK: TypeGuardStmt
|
|
type is (integer)
|
|
! CHECK: AssignmentStmt
|
|
bar = 0
|
|
!![disable]! COM: CHECK: TypeGuardStmt
|
|
!![disable]class is (a_type)
|
|
!![disable] ! COM: CHECK: AssignmentStmt
|
|
!![disable] bar = 1
|
|
!![disable] ! COM: CHECK: ReturnStmt
|
|
!![disable] return
|
|
! CHECK: TypeGuardStmt
|
|
class default
|
|
! CHECK: AssignmentStmt
|
|
bar = -1
|
|
! CHECK: EndSelectStmt
|
|
end select
|
|
! CHECK: <<End SelectTypeConstruct!>>
|
|
end function
|
|
|
|
! CHECK: Subroutine sub
|
|
subroutine sub(a)
|
|
real(4):: a
|
|
! CompilerDirective
|
|
! CHECK: <<CompilerDirective>>
|
|
!DIR$ IGNORE_TKR a
|
|
end subroutine
|
|
|
|
|
|
end module
|
|
|
|
! CHECK: Subroutine altreturn
|
|
subroutine altreturn(i, j, *, *)
|
|
! CHECK: <<IfConstruct!>>
|
|
if (i>j) then
|
|
! CHECK: ReturnStmt
|
|
return 1
|
|
else
|
|
! CHECK: ReturnStmt
|
|
return 2
|
|
end if
|
|
! CHECK: <<End IfConstruct!>>
|
|
end subroutine
|
|
|
|
|
|
! Remaining TODO
|
|
|
|
! CHECK: Subroutine iostmts
|
|
subroutine iostmts(filename, a, b, c)
|
|
character(*) :: filename
|
|
integer :: length
|
|
logical :: file_is_opened
|
|
real, a, b ,c
|
|
! CHECK: InquireStmt
|
|
inquire(file=filename, opened=file_is_opened)
|
|
! CHECK: <<IfConstruct>>
|
|
if (file_is_opened) then
|
|
! CHECK: OpenStmt
|
|
open(10, FILE=filename)
|
|
end if
|
|
! CHECK: <<End IfConstruct>>
|
|
! CHECK: ReadStmt
|
|
read(10, *) length
|
|
! CHECK: RewindStmt
|
|
rewind 10
|
|
! CHECK: NamelistStmt
|
|
namelist /nlist/ a, b, c
|
|
! CHECK: WriteStmt
|
|
write(10, NML=nlist)
|
|
! CHECK: BackspaceStmt
|
|
backspace(10)
|
|
! CHECK: FormatStmt
|
|
1 format (1PE12.4)
|
|
! CHECK: WriteStmt
|
|
write (10, 1) a
|
|
! CHECK: EndfileStmt
|
|
endfile 10
|
|
! CHECK: FlushStmt
|
|
flush 10
|
|
! CHECK: WaitStmt
|
|
wait(10)
|
|
! CHECK: CloseStmt
|
|
close(10)
|
|
end subroutine
|
|
|
|
|
|
! CHECK: Subroutine sub2
|
|
subroutine sub2()
|
|
integer :: i, j, k, l
|
|
i = 0
|
|
1 j = i
|
|
! CHECK: ContinueStmt
|
|
2 continue
|
|
i = i+1
|
|
3 j = j+1
|
|
! CHECK: ArithmeticIfStmt
|
|
if (j-i) 3, 4, 5
|
|
! CHECK: GotoStmt
|
|
4 goto 6
|
|
|
|
! FIXME: is name resolution on assigned goto broken/todo ?
|
|
! WILLCHECK: AssignStmt
|
|
!55 assign 6 to label
|
|
! WILLCHECK: AssignedGotoStmt
|
|
!66 go to label (5, 6)
|
|
|
|
! CHECK: ComputedGotoStmt
|
|
go to (5, 6), 1 + mod(i, 2)
|
|
5 j = j + 1
|
|
6 i = i + j/2
|
|
|
|
! CHECK: <<DoConstruct!>>
|
|
do1: do k=1,10
|
|
! CHECK: <<DoConstruct!>>
|
|
do2: do l=5,20
|
|
! CHECK: CycleStmt
|
|
cycle do1
|
|
! CHECK: ExitStmt
|
|
exit do2
|
|
end do do2
|
|
! CHECK: <<End DoConstruct!>>
|
|
end do do1
|
|
! CHECK: <<End DoConstruct!>>
|
|
|
|
! CHECK: PauseStmt
|
|
pause 7
|
|
! CHECK: StopStmt
|
|
stop
|
|
end subroutine
|
|
|
|
|
|
! CHECK: Subroutine sub3
|
|
subroutine sub3()
|
|
print *, "normal"
|
|
! CHECK: EntryStmt
|
|
entry sub4entry()
|
|
print *, "test"
|
|
end subroutine
|
|
|
|
! CHECK: Subroutine sub4
|
|
subroutine sub4()
|
|
integer :: i
|
|
print*, "test"
|
|
data i /1/
|
|
end subroutine
|