xref: /llvm-project/flang/test/Parser/OpenMP/depobj-construct.f90 (revision bde79c0e27fd0fb1e31c9b8b34ae71716c51a8e8)
1!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=52 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s
2!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=52 %s | FileCheck --check-prefix="PARSE-TREE" %s
3
4subroutine f00
5  integer :: x, y
6  !$omp depobj(x) depend(in: y)
7end
8
9!UNPARSE: SUBROUTINE f00
10!UNPARSE:  INTEGER x, y
11!UNPARSE: !$OMP DEPOBJ(x) DEPEND(IN: y)
12!UNPARSE: END SUBROUTINE
13
14!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPDepobjConstruct
15!PARSE-TREE: | Verbatim
16!PARSE-TREE: | OmpObject -> Designator -> DataRef -> Name = 'x'
17!PARSE-TREE: | OmpClause -> Depend -> OmpDependClause -> TaskDep
18!PARSE-TREE: | | Modifier -> OmpTaskDependenceType -> Value = In
19!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'y'
20
21subroutine f01
22  integer :: x
23  !$omp depobj(x) update(out)
24end
25
26!UNPARSE: SUBROUTINE f01
27!UNPARSE:  INTEGER x
28!UNPARSE: !$OMP DEPOBJ(x) UPDATE(OUT)
29!UNPARSE: END SUBROUTINE
30
31!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPDepobjConstruct
32!PARSE-TREE: | Verbatim
33!PARSE-TREE: | OmpObject -> Designator -> DataRef -> Name = 'x'
34!PARSE-TREE: | OmpClause -> Update -> OmpUpdateClause -> OmpTaskDependenceType -> Value = Out
35
36subroutine f02
37  integer :: x
38  !$omp depobj(x) destroy(x)
39end
40
41!UNPARSE: SUBROUTINE f02
42!UNPARSE:  INTEGER x
43!UNPARSE: !$OMP DEPOBJ(x) DESTROY(x)
44!UNPARSE: END SUBROUTINE
45
46!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPDepobjConstruct
47!PARSE-TREE: | Verbatim
48!PARSE-TREE: | OmpObject -> Designator -> DataRef -> Name = 'x'
49!PARSE-TREE: | OmpClause -> Destroy -> OmpDestroyClause -> OmpObject -> Designator -> DataRef -> Name = 'x'
50
51subroutine f03
52  integer :: x
53  !$omp depobj(x) destroy
54end
55
56!UNPARSE: SUBROUTINE f03
57!UNPARSE:  INTEGER x
58!UNPARSE: !$OMP DEPOBJ(x) DESTROY
59!UNPARSE: END SUBROUTINE
60
61!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPDepobjConstruct
62!PARSE-TREE: | Verbatim
63!PARSE-TREE: | OmpObject -> Designator -> DataRef -> Name = 'x'
64!PARSE-TREE: | OmpClause -> Destroy ->
65