1! REQUIRES: openmp_runtime 2 3! RUN: %flang_fc1 -fdebug-unparse-no-sema %openmp_flags %s | FileCheck --ignore-case %s 4! RUN: %flang_fc1 -fdebug-dump-parse-tree %openmp_flags %s | FileCheck --check-prefix="PARSE-TREE" %s 5! Checks the parsing of Openmp 5.0 Target Device constructs 6! 7PROGRAM main 8 USE OMP_LIB 9 IMPLICIT NONE 10 INTEGER :: X, Y 11 INTEGER :: M = 1 12 13 14!------------------------------------------------------ 15! Check Device clause with a constant argument 16!------------------------------------------------------ 17!CHECK: !$OMP TARGET DEVICE(1) 18!$OMP TARGET DEVICE(1) 19 M = M + 1 20!CHECK: !$OMP END TARGET 21!$OMP END TARGET 22 23!PARSE-TREE: OmpBeginBlockDirective 24!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 25!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 26!PARSE-TREE: Scalar -> Integer -> Expr = '1_4' 27!PARSE-TREE: LiteralConstant -> IntLiteralConstant = '1' 28!PARSE-TREE: OmpEndBlockDirective 29!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 30!PARSE-TREE: OmpClauseList -> 31 32!------------------------------------------------------ 33! Check Device clause with a constant integer expression argument 34!------------------------------------------------------ 35!CHECK: !$OMP TARGET DEVICE(2-1) 36!$OMP TARGET DEVICE(2-1) 37 M = M + 1 38!CHECK: !$OMP END TARGET 39!$OMP END TARGET 40 41!PARSE-TREE: OmpBeginBlockDirective 42!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 43!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 44!PARSE-TREE: Scalar -> Integer -> Expr = '1_4' 45!PARSE-TREE: Subtract 46!PARSE-TREE: Expr = '2_4' 47!PARSE-TREE: LiteralConstant -> IntLiteralConstant = '2' 48!PARSE-TREE: Expr = '1_4' 49!PARSE-TREE: LiteralConstant -> IntLiteralConstant = '1' 50!PARSE-TREE: OmpEndBlockDirective 51!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 52!PARSE-TREE: OmpClauseList -> 53 54 55!------------------------------------------------------ 56! Check Device clause with a variable argument 57!------------------------------------------------------ 58!CHECK: !$OMP TARGET DEVICE(X) 59!$OMP TARGET DEVICE(X) 60 M = M + 1 61!CHECK: !$OMP END TARGET 62!$OMP END TARGET 63 64!PARSE-TREE: OmpBeginBlockDirective 65!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 66!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 67!PARSE-TREE: Scalar -> Integer -> Expr = 'x' 68!PARSE-TREE: Designator -> DataRef -> Name = 'x' 69!PARSE-TREE: OmpEndBlockDirective 70!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 71!PARSE-TREE: OmpClauseList -> 72 73 74!------------------------------------------------------ 75! Check Device clause with an variable integer expression 76!------------------------------------------------------ 77!CHECK: !$OMP TARGET DEVICE(X+Y) 78!$OMP TARGET DEVICE(X+Y) 79 M = M + 1 80!CHECK: !$OMP END TARGET 81!$OMP END TARGET 82 83!PARSE-TREE: OmpBeginBlockDirective 84!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 85!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 86!PARSE-TREE: Scalar -> Integer -> Expr = 'x+y' 87!PARSE-TREE: Add 88!PARSE-TREE: Expr = 'x' 89!PARSE-TREE: Designator -> DataRef -> Name = 'x' 90!PARSE-TREE: Expr = 'y' 91!PARSE-TREE: Designator -> DataRef -> Name = 'y' 92!PARSE-TREE: OmpEndBlockDirective 93!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 94!PARSE-TREE: OmpClauseList -> 95 96!------------------------------------------------------ 97! Check Device Ancestor clause with a constant argument 98!------------------------------------------------------ 99!CHECK: !$OMP TARGET DEVICE(ANCESTOR: 1) 100!$OMP TARGET DEVICE(ANCESTOR: 1) 101 M = M + 1 102!CHECK: !$OMP END TARGET 103!$OMP END TARGET 104 105!PARSE-TREE: OmpBeginBlockDirective 106!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 107!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 108!PARSE-TREE: OmpDeviceModifier -> Value = Ancestor 109!PARSE-TREE: Scalar -> Integer -> Expr = '1_4' 110!PARSE-TREE: LiteralConstant -> IntLiteralConstant = '1' 111!PARSE-TREE: OmpEndBlockDirective 112!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 113!PARSE-TREE: OmpClauseList -> 114 115 116!-------------------------------------------------------- 117! Check Device Devive-Num clause with a constant argument 118!-------------------------------------------------------- 119!CHECK: !$OMP TARGET DEVICE(DEVICE_NUM: 2) 120!$OMP TARGET DEVICE(DEVICE_NUM: 2) 121 M = M + 1 122!CHECK: !$OMP END TARGET 123!$OMP END TARGET 124 125!PARSE-TREE: OmpBeginBlockDirective 126!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 127!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 128!PARSE-TREE: OmpDeviceModifier -> Value = Device_Num 129!PARSE-TREE: Scalar -> Integer -> Expr = '2_4' 130!PARSE-TREE: LiteralConstant -> IntLiteralConstant = '2' 131!PARSE-TREE: OmpEndBlockDirective 132!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 133!PARSE-TREE: OmpClauseList -> 134 135 136!------------------------------------------------------------------- 137! Check Device Ancestor clause with a variable expression argument 138!------------------------------------------------------------------- 139!CHECK: !$OMP TARGET DEVICE(ANCESTOR: X+Y) 140!$OMP TARGET DEVICE(ANCESTOR: X + Y) 141 M = M + 1 142!CHECK: !$OMP END TARGET 143!$OMP END TARGET 144 145!PARSE-TREE: OmpBeginBlockDirective 146!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 147!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 148!PARSE-TREE: OmpDeviceModifier -> Value = Ancestor 149!PARSE-TREE: Scalar -> Integer -> Expr = 'x+y' 150!PARSE-TREE: Add 151!PARSE-TREE: Expr = 'x' 152!PARSE-TREE: Designator -> DataRef -> Name = 'x' 153!PARSE-TREE: Expr = 'y' 154!PARSE-TREE: Designator -> DataRef -> Name = 'y' 155!PARSE-TREE: OmpEndBlockDirective 156!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 157!PARSE-TREE: OmpClauseList -> 158 159 160!------------------------------------------------------------------- 161! Check Device Devive-Num clause with a variable expression argument 162!------------------------------------------------------------------- 163!CHECK: !$OMP TARGET DEVICE(DEVICE_NUM: X-Y) 164!$OMP TARGET DEVICE(DEVICE_NUM: X - Y) 165 M = M + 1 166!CHECK: !$OMP END TARGET 167!$OMP END TARGET 168 169!PARSE-TREE: OmpBeginBlockDirective 170!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 171!PARSE-TREE: OmpClauseList -> OmpClause -> Device -> OmpDeviceClause 172!PARSE-TREE: OmpDeviceModifier -> Value = Device_Num 173!PARSE-TREE: Scalar -> Integer -> Expr = 'x-y' 174!PARSE-TREE: Subtract 175!PARSE-TREE: Expr = 'x' 176!PARSE-TREE: Designator -> DataRef -> Name = 'x' 177!PARSE-TREE: Expr = 'y' 178!PARSE-TREE: Designator -> DataRef -> Name = 'y' 179!PARSE-TREE: OmpEndBlockDirective 180!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 181END PROGRAM 182