| ! 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 |