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(x) 5 integer :: x 6 !$omp target map(ompx_hold, always, present, close, to: x) 7 x = x + 1 8 !$omp end target 9end 10 11!UNPARSE: SUBROUTINE f00 (x) 12!UNPARSE: INTEGER x 13!UNPARSE: !$OMP TARGET MAP(OMPX_HOLD, ALWAYS, PRESENT, CLOSE, TO: x) 14!UNPARSE: x=x+1_4 15!UNPARSE: !$OMP END TARGET 16!UNPARSE: END SUBROUTINE 17 18!PARSE-TREE: OmpBeginBlockDirective 19!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 20!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 21!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Ompx_Hold 22!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Always 23!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 24!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Close 25!PARSE-TREE: | | Modifier -> OmpMapType -> Value = To 26!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x' 27!PARSE-TREE: | | bool = 'true' 28 29subroutine f01(x) 30 integer :: x 31 !$omp target map(ompx_hold, always, present, close: x) 32 x = x + 1 33 !$omp end target 34end 35 36!UNPARSE: SUBROUTINE f01 (x) 37!UNPARSE: INTEGER x 38!UNPARSE: !$OMP TARGET MAP(OMPX_HOLD, ALWAYS, PRESENT, CLOSE: x) 39!UNPARSE: x=x+1_4 40!UNPARSE: !$OMP END TARGET 41!UNPARSE: END SUBROUTINE 42 43!PARSE-TREE: OmpBeginBlockDirective 44!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 45!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 46!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Ompx_Hold 47!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Always 48!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 49!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Close 50!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x' 51!PARSE-TREE: | | bool = 'true' 52 53subroutine f02(x) 54 integer :: x 55 !$omp target map(from: x) 56 x = x + 1 57 !$omp end target 58end 59 60!UNPARSE: SUBROUTINE f02 (x) 61!UNPARSE: INTEGER x 62!UNPARSE: !$OMP TARGET MAP(FROM: x) 63!UNPARSE: x=x+1_4 64!UNPARSE: !$OMP END TARGET 65!UNPARSE: END SUBROUTINE 66 67!PARSE-TREE: OmpBeginBlockDirective 68!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 69!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 70!PARSE-TREE: | | Modifier -> OmpMapType -> Value = From 71!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x' 72!PARSE-TREE: | | bool = 'true' 73 74subroutine f03(x) 75 integer :: x 76 !$omp target map(x) 77 x = x + 1 78 !$omp end target 79end 80 81!UNPARSE: SUBROUTINE f03 (x) 82!UNPARSE: INTEGER x 83!UNPARSE: !$OMP TARGET MAP(x) 84!UNPARSE: x=x+1_4 85!UNPARSE: !$OMP END TARGET 86!UNPARSE: END SUBROUTINE 87 88!PARSE-TREE: OmpBeginBlockDirective 89!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 90!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 91!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x' 92!PARSE-TREE: | | bool = 'true' 93 94subroutine f04(x) 95 integer :: x 96 !$omp target map(ompx_hold always, present, close, to: x) 97 x = x + 1 98 !$omp end target 99end 100 101!UNPARSE: SUBROUTINE f04 (x) 102!UNPARSE: INTEGER x 103!UNPARSE: !$OMP TARGET MAP(OMPX_HOLD, ALWAYS, PRESENT, CLOSE, TO: x) 104!UNPARSE: x=x+1_4 105!UNPARSE: !$OMP END TARGET 106!UNPARSE: END SUBROUTINE 107 108!PARSE-TREE: OmpBeginBlockDirective 109!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 110!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 111!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Ompx_Hold 112!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Always 113!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 114!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Close 115!PARSE-TREE: | | Modifier -> OmpMapType -> Value = To 116!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x' 117!PARSE-TREE: | | bool = 'false' 118 119subroutine f05(x) 120 integer :: x 121 !$omp target map(ompx_hold, always, present, close: x) 122 x = x + 1 123 !$omp end target 124end 125 126!UNPARSE: SUBROUTINE f05 (x) 127!UNPARSE: INTEGER x 128!UNPARSE: !$OMP TARGET MAP(OMPX_HOLD, ALWAYS, PRESENT, CLOSE: x) 129!UNPARSE: x=x+1_4 130!UNPARSE: !$OMP END TARGET 131!UNPARSE: END SUBROUTINE 132 133!PARSE-TREE: OmpBeginBlockDirective 134!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 135!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 136!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Ompx_Hold 137!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Always 138!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 139!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Close 140!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x' 141 142!PARSE-TREE: | | bool = 'true' 143 144subroutine f10(x) 145 integer :: x(10) 146 !$omp target map(present, iterator(integer :: i = 1:10), to: x(i)) 147 x = x + 1 148 !$omp end target 149end 150 151!UNPARSE: SUBROUTINE f10 (x) 152!UNPARSE: INTEGER x(10_4) 153!UNPARSE: !$OMP TARGET MAP(PRESENT, ITERATOR(INTEGER i = 1_4:10_4), TO: x(i)) 154!UNPARSE: x=x+1_4 155!UNPARSE: !$OMP END TARGET 156!UNPARSE: END SUBROUTINE 157 158!PARSE-TREE: OmpBeginBlockDirective 159!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 160!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 161!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 162!PARSE-TREE: | | Modifier -> OmpIterator -> OmpIteratorSpecifier 163!PARSE-TREE: | | | TypeDeclarationStmt 164!PARSE-TREE: | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> 165!PARSE-TREE: | | | | EntityDecl 166!PARSE-TREE: | | | | | Name = 'i' 167!PARSE-TREE: | | | SubscriptTriplet 168!PARSE-TREE: | | | | Scalar -> Integer -> Expr = '1_4' 169!PARSE-TREE: | | | | | LiteralConstant -> IntLiteralConstant = '1' 170!PARSE-TREE: | | | | Scalar -> Integer -> Expr = '10_4' 171!PARSE-TREE: | | | | | LiteralConstant -> IntLiteralConstant = '10' 172!PARSE-TREE: | | Modifier -> OmpMapType -> Value = To 173!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> ArrayElement 174!PARSE-TREE: | | | DataRef -> Name = 'x' 175!PARSE-TREE: | | | SectionSubscript -> Integer -> Expr = 'i' 176!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'i' 177!PARSE-TREE: | | bool = 'true' 178 179subroutine f11(x) 180 integer :: x(10) 181 !$omp target map(present, iterator(i = 1:10), to: x(i)) 182 x = x + 1 183 !$omp end target 184end 185 186!UNPARSE: SUBROUTINE f11 (x) 187!UNPARSE: INTEGER x(10_4) 188!UNPARSE: !$OMP TARGET MAP(PRESENT, ITERATOR(INTEGER i = 1_4:10_4), TO: x(i)) 189!UNPARSE: x=x+1_4 190!UNPARSE: !$OMP END TARGET 191!UNPARSE: END SUBROUTINE 192 193!PARSE-TREE: OmpBeginBlockDirective 194!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 195!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 196!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 197!PARSE-TREE: | | Modifier -> OmpIterator -> OmpIteratorSpecifier 198!PARSE-TREE: | | | TypeDeclarationStmt 199!PARSE-TREE: | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> 200!PARSE-TREE: | | | | EntityDecl 201!PARSE-TREE: | | | | | Name = 'i' 202!PARSE-TREE: | | | SubscriptTriplet 203!PARSE-TREE: | | | | Scalar -> Integer -> Expr = '1_4' 204!PARSE-TREE: | | | | | LiteralConstant -> IntLiteralConstant = '1' 205!PARSE-TREE: | | | | Scalar -> Integer -> Expr = '10_4' 206!PARSE-TREE: | | | | | LiteralConstant -> IntLiteralConstant = '10' 207!PARSE-TREE: | | Modifier -> OmpMapType -> Value = To 208!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> ArrayElement 209!PARSE-TREE: | | | DataRef -> Name = 'x' 210!PARSE-TREE: | | | SectionSubscript -> Integer -> Expr = 'i' 211!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'i' 212!PARSE-TREE: | | bool = 'true' 213 214subroutine f12(x) 215 integer :: x(10) 216 !$omp target map(present, iterator(i = 1:10, integer :: j = 1:10), to: x((i + j) / 2)) 217 x = x + 1 218 !$omp end target 219end 220 221!UNPARSE: SUBROUTINE f12 (x) 222!UNPARSE: INTEGER x(10_4) 223!UNPARSE: !$OMP TARGET MAP(PRESENT, ITERATOR(INTEGER i = 1_4:10_4, INTEGER j = 1_4:10_4), TO: x((i+j)/2_4)) 224!UNPARSE: x=x+1_4 225!UNPARSE: !$OMP END TARGET 226!UNPARSE: END SUBROUTINE 227 228!PARSE-TREE: OmpBeginBlockDirective 229!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 230!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 231!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 232!PARSE-TREE: | | Modifier -> OmpIterator -> OmpIteratorSpecifier 233!PARSE-TREE: | | | TypeDeclarationStmt 234!PARSE-TREE: | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> 235!PARSE-TREE: | | | | EntityDecl 236!PARSE-TREE: | | | | | Name = 'i' 237!PARSE-TREE: | | | SubscriptTriplet 238!PARSE-TREE: | | | | Scalar -> Integer -> Expr = '1_4' 239!PARSE-TREE: | | | | | LiteralConstant -> IntLiteralConstant = '1' 240!PARSE-TREE: | | | | Scalar -> Integer -> Expr = '10_4' 241!PARSE-TREE: | | | | | LiteralConstant -> IntLiteralConstant = '10' 242!PARSE-TREE: | | | OmpIteratorSpecifier 243!PARSE-TREE: | | | | TypeDeclarationStmt 244!PARSE-TREE: | | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> 245!PARSE-TREE: | | | | | EntityDecl 246!PARSE-TREE: | | | | | | Name = 'j' 247!PARSE-TREE: | | | | SubscriptTriplet 248!PARSE-TREE: | | | | | Scalar -> Integer -> Expr = '1_4' 249!PARSE-TREE: | | | | | | LiteralConstant -> IntLiteralConstant = '1' 250!PARSE-TREE: | | | | | Scalar -> Integer -> Expr = '10_4' 251!PARSE-TREE: | | | | | | LiteralConstant -> IntLiteralConstant = '10' 252!PARSE-TREE: | | Modifier -> OmpMapType -> Value = To 253!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> ArrayElement 254!PARSE-TREE: | | | DataRef -> Name = 'x' 255!PARSE-TREE: | | | SectionSubscript -> Integer -> Expr = '(i+j)/2_4' 256!PARSE-TREE: | | | | Divide 257!PARSE-TREE: | | | | | Expr = '(i+j)' 258!PARSE-TREE: | | | | | | Parentheses -> Expr = 'i+j' 259!PARSE-TREE: | | | | | | | Add 260!PARSE-TREE: | | | | | | | | Expr = 'i' 261!PARSE-TREE: | | | | | | | | | Designator -> DataRef -> Name = 'i' 262!PARSE-TREE: | | | | | | | | Expr = 'j' 263!PARSE-TREE: | | | | | | | | | Designator -> DataRef -> Name = 'j' 264!PARSE-TREE: | | | | | Expr = '2_4' 265!PARSE-TREE: | | | | | | LiteralConstant -> IntLiteralConstant = '2' 266!PARSE-TREE: | | bool = 'true' 267 268subroutine f20(x, y) 269 integer :: x(10) 270 integer :: y 271 integer, parameter :: p = 23 272 !$omp target map(present, iterator(i, j = y:p, k = i:j), to: x(k)) 273 x = x + 1 274 !$omp end target 275end 276 277!UNPARSE: SUBROUTINE f20 (x, y) 278!UNPARSE: INTEGER x(10_4) 279!UNPARSE: INTEGER y 280!UNPARSE: INTEGER, PARAMETER :: p = 23_4 281!UNPARSE: !$OMP TARGET MAP(PRESENT, ITERATOR(INTEGER i, j = y:23_4, INTEGER k = i:j), TO: x(k)) 282!UNPARSE: x=x+1_4 283!UNPARSE: !$OMP END TARGET 284!UNPARSE: END SUBROUTINE 285 286!PARSE-TREE: OmpBeginBlockDirective 287!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 288!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 289!PARSE-TREE: | | Modifier -> OmpMapTypeModifier -> Value = Present 290!PARSE-TREE: | | Modifier -> OmpIterator -> OmpIteratorSpecifier 291!PARSE-TREE: | | | TypeDeclarationStmt 292!PARSE-TREE: | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> 293!PARSE-TREE: | | | | EntityDecl 294!PARSE-TREE: | | | | | Name = 'i' 295!PARSE-TREE: | | | | EntityDecl 296!PARSE-TREE: | | | | | Name = 'j' 297!PARSE-TREE: | | | SubscriptTriplet 298!PARSE-TREE: | | | | Scalar -> Integer -> Expr = 'y' 299!PARSE-TREE: | | | | | Designator -> DataRef -> Name = 'y' 300!PARSE-TREE: | | | | Scalar -> Integer -> Expr = '23_4' 301!PARSE-TREE: | | | | | Designator -> DataRef -> Name = 'p' 302!PARSE-TREE: | | | OmpIteratorSpecifier 303!PARSE-TREE: | | | | TypeDeclarationStmt 304!PARSE-TREE: | | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> 305!PARSE-TREE: | | | | | EntityDecl 306!PARSE-TREE: | | | | | | Name = 'k' 307!PARSE-TREE: | | | | SubscriptTriplet 308!PARSE-TREE: | | | | | Scalar -> Integer -> Expr = 'i' 309!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'i' 310!PARSE-TREE: | | | | | Scalar -> Integer -> Expr = 'j' 311!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'j' 312!PARSE-TREE: | | Modifier -> OmpMapType -> Value = To 313!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> ArrayElement 314!PARSE-TREE: | | | DataRef -> Name = 'x' 315!PARSE-TREE: | | | SectionSubscript -> Integer -> Expr = 'k' 316!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'k' 317!PARSE-TREE: | | bool = 'true' 318 319subroutine f21(x, y) 320 integer :: x(10) 321 integer :: y 322 integer, parameter :: p = 23 323 !$omp target map(mapper(xx), from: x) 324 x = x + 1 325 !$omp end target 326end 327 328!UNPARSE: SUBROUTINE f21 (x, y) 329!UNPARSE: INTEGER x(10_4) 330!UNPARSE: INTEGER y 331!UNPARSE: INTEGER, PARAMETER :: p = 23_4 332!UNPARSE: !$OMP TARGET MAP(MAPPER(XX), FROM: X) 333!UNPARSE: x=x+1_4 334!UNPARSE: !$OMP END TARGET 335!UNPARSE: END SUBROUTINE 336 337!PARSE-TREE: OmpBeginBlockDirective 338!PARSE-TREE: | OmpBlockDirective -> llvm::omp::Directive = target 339!PARSE-TREE: | OmpClauseList -> OmpClause -> Map -> OmpMapClause 340!PARSE-TREE: | | Modifier -> OmpMapper -> Name = 'xx' 341!PARSE-TREE: | | Modifier -> OmpMapType -> Value = From 342!PARSE-TREE: | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x' 343 344subroutine f22(x) 345 integer :: x(10) 346 !$omp target map(present, iterator(i = 1:10), always, from: x(i)) 347 x = x + 1 348 !$omp end target 349end 350 351!UNPARSE: SUBROUTINE f22 (x) 352!UNPARSE: INTEGER x(10_4) 353!UNPARSE: !$OMP TARGET MAP(PRESENT, ITERATOR(INTEGER i = 1_4:10_4), ALWAYS, FROM: x(i)) 354!UNPARSE: x=x+1_4 355!UNPARSE: !$OMP END TARGET 356!UNPARSE: END SUBROUTINE 357 358!PARSE-TREE: OmpBlockDirective -> llvm::omp::Directive = target 359!PARSE-TREE: OmpClauseList -> OmpClause -> Map -> OmpMapClause 360!PARSE-TREE: | Modifier -> OmpMapTypeModifier -> Value = Present 361!PARSE-TREE: | Modifier -> OmpIterator -> OmpIteratorSpecifier 362!PARSE-TREE: | | TypeDeclarationStmt 363!PARSE-TREE: | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> 364!PARSE-TREE: | | | EntityDecl 365!PARSE-TREE: | | | | Name = 'i' 366!PARSE-TREE: | | SubscriptTriplet 367!PARSE-TREE: | | | Scalar -> Integer -> Expr = '1_4' 368!PARSE-TREE: | | | | LiteralConstant -> IntLiteralConstant = '1' 369!PARSE-TREE: | | | Scalar -> Integer -> Expr = '10_4' 370!PARSE-TREE: | | | | LiteralConstant -> IntLiteralConstant = '10' 371!PARSE-TREE: | Modifier -> OmpMapTypeModifier -> Value = Always 372!PARSE-TREE: | Modifier -> OmpMapType -> Value = From 373!PARSE-TREE: | OmpObjectList -> OmpObject -> Designator -> DataRef -> ArrayElement 374!PARSE-TREE: | | DataRef -> Name = 'x' 375!PARSE-TREE: | | SectionSubscript -> Integer -> Expr = 'i' 376!PARSE-TREE: | | | Designator -> DataRef -> Name = 'i' 377!PARSE-TREE: | bool = 'true' 378 379