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