[flang] CUDA Fortran - part 2/5: symbols & scopes

[klausler]

Summary

Add representations of CUDA Fortran data and subprogram attributes
to the symbol table and scopes of semantics. Set them in name
resolution, and emit them to module files.

Depends on https://reviews.llvm.org/D150159.

[klausler]

Remove redundantly added tests.

[clementval]

LGTM

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3526

Can launch_bounds take third argument of max cluster rank for Hopper?

3551

Can cluster_dim take variable argument such as "cluster_dim(x,y,z)", where x, y, and z are integer variables?

[wangzpgi]

flang/include/flang/Semantics/symbol.h

152

misspelling: LANCH_BOUNDS -> LAUNCH_BOUNDS

[klausler]

flang/lib/Semantics/resolve-names.cpp

3526

Not according to https://docs.nvidia.com/hpc-sdk/compilers/cuda-fortran-prog-guide/index.html#cfref-new-subs-func-attr which has "The form used in CUDA Fortran is:

attributes(global) launch_bounds(maxTPB, minBPM) subroutine sub(...)

where maxTPB is the maxThreadsPerBlock, the maximum number of threads per block with which the application will ever launch, and minBPM is the desired minimum number of resident blocks per multiprocessor. Both values must be numeric constants." in 3.1.2.

3551

No, not according to https://docs.nvidia.com/hpc-sdk/compilers/cuda-fortran-prog-guide/index.html#cfref-new-subs-func-attr , which has "Beginning with the 23.3 release, support for thread block clusters is enabled for Hopper (cc90) and later targets. To specify the dimensions of the cluster, use the cluster_dims syntax and specify each x, y, and z dimension. Values must be numeric constants." in 3.1.3.

[klausler]

Fix misspelling in comment.

[klausler]

Generate diff against part 1 rather than main (oops).

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3551

It mentioned at the end of 3.1.2: "Also, as part of the Hopper support, the launch_bounds syntax has been extended to accept a third argument, an upper bound on the cluster size."

[klausler]

flang/lib/Semantics/resolve-names.cpp

3551

That's for LAUNCH_BOUNDS(), not CLUSTER_DIMS().

[klausler]

Allow third parameter to LAUNCH_BOUNDS().

[klausler]

Upload correct diff (sorry).

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3551

Yes, allowing third argument was for launch_bounds, not cluster_dims, I commented at the wrong place. Not quite sure how this Phabricator review works.

For cluster_dims as well as launch_bounds, Brent has requested to take maybe const expressions. He would like to use module parameters, for global routines that are in that module. Neither Michael nor I implemented that in nvfortran.

[wangzpgi]

Is there checks for CUDA Version that some features are allowed for certain CUDA Version?

[klausler]

In D150161#4331054, @wangzpgi wrote:

Is there checks for CUDA Version that some features are allowed for certain CUDA Version?

Not yet.

flang/lib/Semantics/resolve-names.cpp

3551

That's what I implemented -- any expression that can be folded to a constant value at compilation time will work. They don't have to integer literals.

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3551

Great. Thanks.

[klausler]

Rebase to current head.

[klausler]

Rebasing to current head in preparation for merging.

flang/docs/ParserCombinators.md

 * `defaulted(p)` matches p, and when p fails it returns a
   default-constructed instance of p's resultType.  It always succeeds.
 * `nonemptySeparated(p, q)` repeatedly matches "p q p q p q ... p",
   returning a `std::list<>` of only the values of the p's.  It fails if
   p immediately fails.
-* `extension(p)` parses p if strict standard compliance is disabled,
-   or with a warning if nonstandard usage warnings are enabled.
+* `extension<feature>([msg,]p)` parses p if strict standard compliance is
+  disabled, or with an optional warning when nonstandard usage warnings
+  are enabled.
 * `deprecated(p)` parses p if strict standard compliance is disabled,
   with a warning if deprecated usage warnings are enabled.
 * `inContext(msg, p)` runs p within an error message context; any
   message that `p` generates will be tagged with `msg` as its
   context.  Contexts may nest.

    free form source.
 * `"..."_id` is a string match for a complete identifier (not a prefix of
    a longer identifier or keyword).
 * `parenthesized(p)` is shorthand for `"(" >> p / ")"`.
 * `bracketed(p)` is shorthand for `"[" >> p / "]"`.
-* `nonEmptyList(p)` matches a comma-separated list of one or more
+* `nonemptyList(p)` matches a comma-separated list of one or more
   instances of p.
-* `nonEmptyList(errorMessage, p)` is equivalent to
+* `nonemptyList(errorMessage, p)` is equivalent to
   `withMessage(errorMessage, nonemptyList(p))`, which allows one to supply
   a meaningful error message in the event of an empty list.
 * `optionalList(p)` is the same thing, but can be empty, and always succeeds.
 
 ### Debugging Parser

flang/include/flang/Common/Fortran-features.h

     SlashInitialization, TripletInArrayConstructor, MissingColons,
     SignedComplexLiteral, OldStyleParameter, ComplexConstructor, PercentLOC,
     SignedPrimary, FileName, Carriagecontrol, Convert, Dispose,
     IOListLeadingComma, AbbreviatedEditDescriptor, ProgramParentheses,
     PercentRefAndVal, OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF,
-    Assign, AssignedGOTO, Pause, OpenACC, OpenMP, CruftAfterAmpersand,
+    Assign, AssignedGOTO, Pause, OpenACC, OpenMP, CUDA, CruftAfterAmpersand,
     ClassicCComments, AdditionalFormats, BigIntLiterals, RealDoControls,
     EquivalenceNumericWithCharacter, EquivalenceNonDefaultNumeric,
     EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents,
     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
     ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,

   LanguageFeatureControl() {
     // These features must be explicitly enabled by command line options.
     disable_.set(LanguageFeature::OldDebugLines);
     disable_.set(LanguageFeature::OpenACC);
     disable_.set(LanguageFeature::OpenMP);
+    disable_.set(LanguageFeature::CUDA); // !@cuf
     disable_.set(LanguageFeature::ImplicitNoneTypeNever);
     disable_.set(LanguageFeature::ImplicitNoneTypeAlways);
     disable_.set(LanguageFeature::DefaultSave);
     disable_.set(LanguageFeature::SaveMainProgram);
     // These features, if enabled, conflict with valid standard usage,

flang/include/flang/Common/Fortran.h

 // once here to avoid redundancy and needless translation.
 
 #include "enum-set.h"
 #include "idioms.h"
 #include <cinttypes>
+#include <optional>
 #include <string>
 
 namespace Fortran::common {
 
 // Fortran has five kinds of intrinsic data types, plus the derived types.

 using Label = std::uint64_t;
 
 // Fortran arrays may have up to 15 dimensions (See Fortran 2018 section 5.4.6).
 static constexpr int maxRank{15};
 
+// CUDA subprogram attribute combinations
+ENUM_CLASS(CUDASubprogramAttrs, Host, Device, HostDevice, Global, Grid_Global)
+
+// CUDA data attributes; mutually exclusive
+ENUM_CLASS(CUDADataAttr, Constant, Device, Managed, Pinned, Shared, Texture)
+
 // Fortran names may have up to 63 characters (See Fortran 2018 C601).
 static constexpr int maxNameLen{63};
 
 // !DIR$ IGNORE_TKR [[(letters) name] ... letters
 // "A" expands to all of TKRDM

 // IGNORE_TKR(A) = IGNORE_TKR(TKRDM)
 static constexpr IgnoreTKRSet ignoreTKRAll{IgnoreTKR::Type, IgnoreTKR::Kind,
     IgnoreTKR::Rank, IgnoreTKR::Device, IgnoreTKR::Managed};
 std::string AsFortran(IgnoreTKRSet);
 
+bool AreCompatibleCUDADataAttrs(
+    std::optional<CUDADataAttr>, std::optional<CUDADataAttr>, IgnoreTKRSet);
+
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_FORTRAN_H_

flang/include/flang/Common/indirection.h

 
   A &operator*() const { return *p_; }
   A *operator->() const { return p_; }
   operator bool() const { return p_ != nullptr; }
   A *get() { return p_; }
+  auto get() const { return reinterpret_cast<std::add_const_t<A> *>(p_); }
   A *release() {
     A *result{p_};
     p_ = nullptr;
     return result;
   }

flang/include/flang/Common/template.h

 constexpr int SearchMembers{
     OverMembers<SearchMembersHelper<PREDICATE>::template Scanner,
         TUPLEorVARIANT>::value()};
 
 template <typename A, typename TUPLEorVARIANT>
-constexpr bool HasMember{
-    SearchMembers<MatchType<A>::template Match, TUPLEorVARIANT> >= 0};
+constexpr int FindMember{
+    SearchMembers<MatchType<A>::template Match, TUPLEorVARIANT>};
+template <typename A, typename TUPLEorVARIANT>
+constexpr bool HasMember{FindMember<A, TUPLEorVARIANT> >= 0};
 
 // std::optional<std::optional<A>> -> std::optional<A>
 template <typename A>
 std::optional<A> JoinOptional(std::optional<std::optional<A>> &&x) {
   if (x) {

flang/include/flang/Frontend/FrontendOptions.h

 
 /// \param suffix The file extension
 /// \return True if the file should be preprocessed
 bool isToBePreprocessed(llvm::StringRef suffix);
 
+/// \param suffix The file extension
+/// \return True if the file contains CUDA Fortran
+bool isCUDAFortranSuffix(llvm::StringRef suffix);
+
 enum class Language : uint8_t {
   Unknown,
 
   /// MLIR: we accept this so that we can run the optimizer on it, and compile
   /// it to LLVM IR, assembly or object code.

   /// always run. This flag is used to control whether predefined and command
   /// line preprocessor macros are enabled or not. In practice, this is
   /// sufficient to implement gfortran`s logic controlled with `-cpp/-nocpp`.
   unsigned mustBePreprocessed : 1;
 
+  /// Whether to enable CUDA Fortran language extensions
+  bool isCUDAFortran{false};
+
 public:
   FrontendInputFile() = default;
   FrontendInputFile(llvm::StringRef file, InputKind inKind)
       : file(file.str()), kind(inKind) {
 

     // file.
     auto pathDotIndex{file.rfind(".")};
     std::string pathSuffix{file.substr(pathDotIndex + 1)};
     isFixedForm = isFixedFormSuffix(pathSuffix);
     mustBePreprocessed = isToBePreprocessed(pathSuffix);
+    isCUDAFortran = isCUDAFortranSuffix(pathSuffix);
   }
 
   FrontendInputFile(const llvm::MemoryBuffer *memBuf, InputKind inKind)
       : buffer(memBuf), kind(inKind) {}
 

 
   bool isEmpty() const { return file.empty() && buffer == nullptr; }
   bool isFile() const { return (buffer == nullptr); }
   bool getIsFixedForm() const { return isFixedForm; }
   bool getMustBePreprocessed() const { return mustBePreprocessed; }
+  bool getIsCUDAFortran() const { return isCUDAFortran; }
 
   llvm::StringRef getFile() const {
     assert(isFile());
     return file;
   }

flang/include/flang/Parser/dump-parse-tree.h

 #include "format-specification.h"
 #include "parse-tree-visitor.h"
 #include "parse-tree.h"
 #include "tools.h"
 #include "unparse.h"
+#include "flang/Common/Fortran.h"
 #include "flang/Common/idioms.h"
 #include "flang/Common/indirection.h"
 #include "llvm/Support/raw_ostream.h"
 #include <string>
 #include <type_traits>

   NODE_NAME(bool, "bool")
   NODE_NAME(int, "int")
   NODE(std, string)
   NODE(std, int64_t)
   NODE(std, uint64_t)
+  NODE_ENUM(common, CUDADataAttr)
+  NODE_ENUM(common, CUDASubprogramAttrs)
   NODE(format, ControlEditDesc)
   NODE(format::ControlEditDesc, Kind)
   NODE(format, DerivedTypeDataEditDesc)
   NODE(format, FormatItem)
   NODE(format, FormatSpecification)

   NODE(parser, ActualArgSpec)
   NODE(AcValue, Triplet)
   NODE(parser, AllocOpt)
   NODE(AllocOpt, Mold)
   NODE(AllocOpt, Source)
+  NODE(AllocOpt, Stream)
+  NODE(AllocOpt, Pinned)
   NODE(parser, Allocatable)
   NODE(parser, AllocatableStmt)
   NODE(parser, AllocateCoarraySpec)
   NODE(parser, AllocateObject)
   NODE(parser, AllocateShapeSpec)

   NODE(parser, BlockStmt)
   NODE(parser, BoundsRemapping)
   NODE(parser, BoundsSpec)
   NODE(parser, Call)
   NODE(parser, CallStmt)
+  NODE(CallStmt, Chevrons)
   NODE(parser, CaseConstruct)
   NODE(CaseConstruct, Case)
   NODE(parser, CaseSelector)
   NODE(parser, CaseStmt)
   NODE(parser, CaseValueRange)

   NODE(parser, Contiguous)
   NODE(parser, ContiguousStmt)
   NODE(parser, ContinueStmt)
   NODE(parser, CriticalConstruct)
   NODE(parser, CriticalStmt)
+  NODE(parser, CUDAAttributesStmt)
+  NODE(parser, CUFKernelDoConstruct)
+  NODE(CUFKernelDoConstruct, Directive)
   NODE(parser, CycleStmt)
   NODE(parser, DataComponentDefStmt)
   NODE(parser, DataIDoObject)
   NODE(parser, DataImpliedDo)
   NODE(parser, DataRef)

   NODE(PrefixSpec, Impure)
   NODE(PrefixSpec, Module)
   NODE(PrefixSpec, Non_Recursive)
   NODE(PrefixSpec, Pure)
   NODE(PrefixSpec, Recursive)
+  NODE(PrefixSpec, Attributes)
+  NODE(PrefixSpec, Launch_Bounds)
+  NODE(PrefixSpec, Cluster_Dims)
   NODE(parser, PrintStmt)
   NODE(parser, PrivateStmt)
   NODE(parser, PrivateOrSequence)
   NODE(parser, ProcAttrSpec)
   NODE(parser, ProcComponentAttrSpec)

flang/include/flang/Parser/message.h

   constexpr MessageFixedText(MessageFixedText &&) = default;
   constexpr MessageFixedText &operator=(const MessageFixedText &) = default;
   constexpr MessageFixedText &operator=(MessageFixedText &&) = default;
 
   CharBlock text() const { return text_; }
+  bool empty() const { return text_.empty(); }
   Severity severity() const { return severity_; }
   MessageFixedText &set_severity(Severity severity) {
     severity_ = severity;
     return *this;
   }

flang/include/flang/Parser/parse-tree-visitor.h

     Walk(x.source, mutator);
     Walk(x.u, mutator);
     mutator.Post(x);
   }
 }
-template <typename V> void Walk(const Call &x, V &visitor) {
+template <typename V> void Walk(const FunctionReference &x, V &visitor) {
   if (visitor.Pre(x)) {
     Walk(x.source, visitor);
-    Walk(x.t, visitor);
+    Walk(x.v, visitor);
     visitor.Post(x);
   }
 }
-template <typename M> void Walk(Call &x, M &mutator) {
+template <typename M> void Walk(FunctionReference &x, M &mutator) {
   if (mutator.Pre(x)) {
     Walk(x.source, mutator);
-    Walk(x.t, mutator);
+    Walk(x.v, mutator);
+    mutator.Post(x);
+  }
+}
+template <typename V> void Walk(const CallStmt &x, V &visitor) {
+  if (visitor.Pre(x)) {
+    Walk(x.source, visitor);
+    Walk(x.call, visitor);
+    Walk(x.chevrons, visitor);
+    visitor.Post(x);
+  }
+}
+template <typename M> void Walk(CallStmt &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.source, mutator);
+    Walk(x.call, mutator);
+    Walk(x.chevrons, mutator);
     mutator.Post(x);
   }
 }
 template <typename V> void Walk(const PartRef &x, V &visitor) {
   if (visitor.Pre(x)) {

flang/include/flang/Parser/parse-tree.h

 // Expressions in the parse tree have owning pointers that can be set to
 // type-checked generic expression representations by semantic analysis.
 namespace Fortran::evaluate {
 struct GenericExprWrapper; // forward definition, wraps Expr<SomeType>
 struct GenericAssignmentWrapper; // forward definition, represent assignment
-class ProcedureRef; // forward definition, represents a CALL statement
+class ProcedureRef; // forward definition, represents a CALL or function ref
 } // namespace Fortran::evaluate
 
 // Most non-template classes in this file use these default definitions
 // for their move constructor and move assignment operator=, and disable
 // their copy constructor and copy assignment operator=.

 struct StmtFunctionStmt; // R1544
 
 // Directives, extensions, and deprecated statements
 struct CompilerDirective;
 struct BasedPointerStmt;
+struct CUDAAttributesStmt;
 struct StructureDef;
 struct ArithmeticIfStmt;
 struct AssignStmt;
 struct AssignedGotoStmt;
 struct PauseStmt;

 struct AccEndCombinedDirective;
 struct OpenACCDeclarativeConstruct;
 struct OpenMPConstruct;
 struct OpenMPDeclarativeConstruct;
 struct OmpEndLoopDirective;
+struct CUFKernelDoConstruct;
 
 // Cooked character stream locations
 using Location = const char *;
 
 // A parse tree node with provenance only

 //        codimension-stmt | contiguous-stmt | dimension-stmt | external-stmt |
 //        intent-stmt | intrinsic-stmt | namelist-stmt | optional-stmt |
 //        pointer-stmt | protected-stmt | save-stmt | target-stmt |
 //        volatile-stmt | value-stmt | common-stmt | equivalence-stmt
 // Extension: (Cray) based POINTER statement
+// Extension: CUDA data attribute statement
 struct OtherSpecificationStmt {
   UNION_CLASS_BOILERPLATE(OtherSpecificationStmt);
   std::variant<common::Indirection<AccessStmt>,
       common::Indirection<AllocatableStmt>,
       common::Indirection<AsynchronousStmt>, common::Indirection<BindStmt>,

       common::Indirection<NamelistStmt>, common::Indirection<OptionalStmt>,
       common::Indirection<PointerStmt>, common::Indirection<ProtectedStmt>,
       common::Indirection<SaveStmt>, common::Indirection<TargetStmt>,
       common::Indirection<ValueStmt>, common::Indirection<VolatileStmt>,
       common::Indirection<CommonStmt>, common::Indirection<EquivalenceStmt>,
-      common::Indirection<BasedPointerStmt>>
+      common::Indirection<BasedPointerStmt>,
+      common::Indirection<CUDAAttributesStmt>>
       u;
 };
 
 // R508 specification-construct ->
 //        derived-type-def | enum-def | generic-stmt | interface-block |

 
 // R514 executable-construct ->
 //        action-stmt | associate-construct | block-construct |
 //        case-construct | change-team-construct | critical-construct |
 //        do-construct | if-construct | select-rank-construct |
-//        select-type-construct | where-construct | forall-construct
+//        select-type-construct | where-construct | forall-construct |
+// (CUDA) CUF-kernel-do-construct
 struct ExecutableConstruct {
   UNION_CLASS_BOILERPLATE(ExecutableConstruct);
   std::variant<Statement<ActionStmt>, common::Indirection<AssociateConstruct>,
       common::Indirection<BlockConstruct>, common::Indirection<CaseConstruct>,
       common::Indirection<ChangeTeamConstruct>,

       common::Indirection<WhereConstruct>, common::Indirection<ForallConstruct>,
       common::Indirection<CompilerDirective>,
       common::Indirection<OpenACCConstruct>,
       common::Indirection<AccEndCombinedDirective>,
       common::Indirection<OpenMPConstruct>,
-      common::Indirection<OmpEndLoopDirective>>
+      common::Indirection<OmpEndLoopDirective>,
+      common::Indirection<CUFKernelDoConstruct>>
       u;
 };
 
 // R510 execution-part-construct ->
 //        executable-construct | format-stmt | entry-stmt | data-stmt

 };
 
 // R738 component-attr-spec ->
 //        access-spec | ALLOCATABLE |
 //        CODIMENSION lbracket coarray-spec rbracket |
-//        CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER
+//        CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER |
+// (CUDA) CONSTANT | DEVICE | MANAGED | PINNED | SHARED | TEXTURE
 EMPTY_CLASS(Allocatable);
 EMPTY_CLASS(Pointer);
 EMPTY_CLASS(Contiguous);
 struct ComponentAttrSpec {
   UNION_CLASS_BOILERPLATE(ComponentAttrSpec);
   std::variant<AccessSpec, Allocatable, CoarraySpec, Contiguous,
-      ComponentArraySpec, Pointer, ErrorRecovery>
+      ComponentArraySpec, Pointer, common::CUDADataAttr, ErrorRecovery>
       u;
 };
 
 // R806 null-init -> function-reference   ... which must be NULL()
 WRAPPER_CLASS(NullInit, common::Indirection<Expr>);

 // R802 attr-spec ->
 //        access-spec | ALLOCATABLE | ASYNCHRONOUS |
 //        CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |
 //        DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |
 //        INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |
-//        PROTECTED | SAVE | TARGET | VALUE | VOLATILE
+//        PROTECTED | SAVE | TARGET | VALUE | VOLATILE |
+// (CUDA) CONSTANT | DEVICE | MANAGED | PINNED | SHARED | TEXTURE
 EMPTY_CLASS(Asynchronous);
 EMPTY_CLASS(External);
 EMPTY_CLASS(Intrinsic);
 EMPTY_CLASS(Optional);
 EMPTY_CLASS(Parameter);

 EMPTY_CLASS(Volatile);
 struct AttrSpec {
   UNION_CLASS_BOILERPLATE(AttrSpec);
   std::variant<AccessSpec, Allocatable, Asynchronous, CoarraySpec, Contiguous,
       ArraySpec, External, IntentSpec, Intrinsic, LanguageBindingSpec, Optional,
-      Parameter, Pointer, Protected, Save, Target, Value, Volatile>
+      Parameter, Pointer, Protected, Save, Target, Value, Volatile,
+      common::CUDADataAttr>
       u;
 };
 
 // R803 entity-decl ->
 //        object-name [( array-spec )] [lbracket coarray-spec rbracket]

   std::variant<StatVariable, MsgVariable> u;
 };
 
 // R928 alloc-opt ->
 //        ERRMSG = errmsg-variable | MOLD = source-expr |
-//        SOURCE = source-expr | STAT = stat-variable
+//        SOURCE = source-expr | STAT = stat-variable |
+// (CUDA) STREAM = scalar-int-expr
+//        PINNED = scalar-logical-variable
 // R931 source-expr -> expr
 struct AllocOpt {
   UNION_CLASS_BOILERPLATE(AllocOpt);
   WRAPPER_CLASS(Mold, common::Indirection<Expr>);
   WRAPPER_CLASS(Source, common::Indirection<Expr>);
-  std::variant<Mold, Source, StatOrErrmsg> u;
+  WRAPPER_CLASS(Stream, common::Indirection<ScalarIntExpr>);
+  WRAPPER_CLASS(Pinned, common::Indirection<ScalarLogicalVariable>);
+  std::variant<Mold, Source, StatOrErrmsg, Stream, Pinned> u;
 };
 
 // R927 allocate-stmt ->
 //        ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] )
 struct AllocateStmt {

       t;
 };
 
 // R1527 prefix-spec ->
 //         declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
-//         NON_RECURSIVE | PURE | RECURSIVE
+//         NON_RECURSIVE | PURE | RECURSIVE |
+// (CUDA)  ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... )
+//         LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
 struct PrefixSpec {
   UNION_CLASS_BOILERPLATE(PrefixSpec);
   EMPTY_CLASS(Elemental);
   EMPTY_CLASS(Impure);
   EMPTY_CLASS(Module);
   EMPTY_CLASS(Non_Recursive);
   EMPTY_CLASS(Pure);
   EMPTY_CLASS(Recursive);
+  WRAPPER_CLASS(Attributes, std::list<common::CUDASubprogramAttrs>);
+  WRAPPER_CLASS(Launch_Bounds, std::list<ScalarIntConstantExpr>);
+  WRAPPER_CLASS(Cluster_Dims, std::list<ScalarIntConstantExpr>);
   std::variant<DeclarationTypeSpec, Elemental, Impure, Module, Non_Recursive,
-      Pure, Recursive>
+      Pure, Recursive, Attributes, Launch_Bounds, Cluster_Dims>
       u;
 };
 
 // R1532 suffix ->
 //         proc-language-binding-spec [RESULT ( result-name )] |

 struct ActualArgSpec {
   TUPLE_CLASS_BOILERPLATE(ActualArgSpec);
   std::tuple<std::optional<Keyword>, ActualArg> t;
 };
 
-// R1520 function-reference -> procedure-designator ( [actual-arg-spec-list] )
+// R1520 function-reference -> procedure-designator
+//         ( [actual-arg-spec-list] )
 struct Call {
   TUPLE_CLASS_BOILERPLATE(Call);
-  CharBlock source;
   std::tuple<ProcedureDesignator, std::list<ActualArgSpec>> t;
 };
 
 struct FunctionReference {
   WRAPPER_CLASS_BOILERPLATE(FunctionReference, Call);
+  CharBlock source;
   Designator ConvertToArrayElementRef();
   StructureConstructor ConvertToStructureConstructor(
       const semantics::DerivedTypeSpec &);
 };
 
-// R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )]
+// R1521 call-stmt -> CALL procedure-designator [ chevrons ]
+//         [( [actual-arg-spec-list] )]
+// (CUDA) chevrons -> <<< scalar-expr, scalar-expr [,
+//          scalar-int-expr [, scalar-int-expr ] ] >>>
 struct CallStmt {
-  WRAPPER_CLASS_BOILERPLATE(CallStmt, Call);
+  BOILERPLATE(CallStmt);
+  struct Chevrons {
+    TUPLE_CLASS_BOILERPLATE(Chevrons);
+    std::tuple<ScalarExpr, ScalarExpr, std::optional<ScalarIntExpr>,
+        std::optional<ScalarIntExpr>>
+        t;
+  };
+  explicit CallStmt(ProcedureDesignator &&pd, std::optional<Chevrons> &&ch,
+      std::list<ActualArgSpec> &&args)
+      : call{std::move(pd), std::move(args)}, chevrons{std::move(ch)} {}
+  Call call;
+  std::optional<Chevrons> chevrons;
+  CharBlock source;
   mutable common::ForwardOwningPointer<evaluate::ProcedureRef>
       typedCall; // filled by semantics
 };
 
 // R1529 function-subprogram ->

   };
   CharBlock source;
   std::variant<std::list<IgnoreTKR>, LoopCount, std::list<NameValue>> u;
 };
 
+// (CUDA) ATTRIBUTE(attribute) [::] name-list
+struct CUDAAttributesStmt {
+  TUPLE_CLASS_BOILERPLATE(CUDAAttributesStmt);
+  std::tuple<common::CUDADataAttr, std::list<Name>> t;
+};
+
 // Legacy extensions
 struct BasedPointer {
   TUPLE_CLASS_BOILERPLATE(BasedPointer);
   std::tuple<ObjectName, ObjectName, std::optional<ArraySpec>> t;
 };

       OpenACCLoopConstruct, OpenACCStandaloneConstruct, OpenACCCacheConstruct,
       OpenACCWaitConstruct, OpenACCAtomicConstruct>
       u;
 };
 
+// CUF-kernel-do-construct ->
+//     !$CUF KERNEL DO [ (scalar-int-constant-expr) ] <<< grid, block [, stream]
+//     >>> do-construct
+// grid -> * | scalar-int-expr | ( scalar-int-expr-list )
+// block -> * | scalar-int-expr | ( scalar-int-expr-list )
+// stream -> 0, scalar-int-expr | STREAM = scalar-int-expr
+struct CUFKernelDoConstruct {
+  TUPLE_CLASS_BOILERPLATE(CUFKernelDoConstruct);
+  struct Directive {
+    TUPLE_CLASS_BOILERPLATE(Directive);
+    CharBlock source;
+    std::tuple<std::optional<ScalarIntConstantExpr>, std::list<ScalarIntExpr>,
+        std::list<ScalarIntExpr>, std::optional<ScalarIntExpr>>
+        t;
+  };
+  std::tuple<Directive, std::optional<DoConstruct>> t;
+};
+
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_PARSE_TREE_H_

flang/include/flang/Semantics/scope.h

 
   // Create the Global scope -- the root of the scope tree
   explicit Scope(SemanticsContext &context)
       : Scope{*this, Kind::Global, nullptr, context} {}
   Scope(Scope &parent, Kind kind, Symbol *symbol, SemanticsContext &context)
-      : parent_{parent}, kind_{kind}, symbol_{symbol}, context_{context} {
+      : parent_{&parent}, kind_{kind}, symbol_{symbol}, context_{context} {
     if (symbol) {
       symbol->set_scope(this);
     }
   }
   Scope(const Scope &) = delete;
 
   bool operator==(const Scope &that) const { return this == &that; }
   bool operator!=(const Scope &that) const { return this != &that; }
 
   Scope &parent() {
-    CHECK(&parent_ != this);
-    return parent_;
+    CHECK(parent_ != this);
+    return *parent_;
   }
   const Scope &parent() const {
-    CHECK(&parent_ != this);
-    return parent_;
+    CHECK(parent_ != this);
+    return *parent_;
   }
   Kind kind() const { return kind_; }
   bool IsGlobal() const { return kind_ == Kind::Global; }
   bool IsIntrinsicModules() const { return kind_ == Kind::IntrinsicModules; }
   bool IsTopLevel() const {

   inline std::optional<SourceName> GetName() const;
   // Returns true if this scope contains, or is, another scope.
   bool Contains(const Scope &) const;
   /// Make a scope nested in this one
   Scope &MakeScope(Kind kind, Symbol *symbol = nullptr);
+
   SemanticsContext &GetMutableSemanticsContext() const {
     return const_cast<SemanticsContext &>(context());
   }
 
   using size_type = mapType::size_type;

   void set_runtimeDerivedTypeDescription(const Symbol &symbol) {
     runtimeDerivedTypeDescription_ = &symbol;
   }
 
 private:
-  Scope &parent_; // this is enclosing scope, not extended derived type base
+  Scope *parent_{
+      nullptr}; // this is enclosing scope, not extended derived type base
   const Kind kind_;
   std::size_t size_{0}; // size in bytes
   std::optional<std::size_t> alignment_; // required alignment in bytes
   parser::CharBlock sourceRange_;
   Symbol *const symbol_; // if not null, symbol_->scope() == this

flang/include/flang/Semantics/semantics.h

   Scope *GetBuiltinModule(const char *name);
 
   // Defines builtinsScope_ from the __Fortran_builtins module
   void UseFortranBuiltinsModule();
   const Scope *GetBuiltinsScope() const { return builtinsScope_; }
-
+  const Scope *GetCUDABuiltinsScope();
   void UsePPCFortranBuiltinsModule();
   const Scope *GetPPCBuiltinsScope() const { return ppcBuiltinsScope_; }
 
   // Saves a module file's parse tree so that it remains available
   // during semantics.

   void CheckIndexVarRedefine(
       const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
   void CheckError(const Symbol &);
 
   const common::IntrinsicTypeDefaultKinds &defaultKinds_;
-  const common::LanguageFeatureControl languageFeatures_;
+  const common::LanguageFeatureControl &languageFeatures_;
   parser::AllCookedSources &allCookedSources_;
   std::optional<parser::CharBlock> location_;
   std::vector<std::string> searchDirectories_;
   std::vector<std::string> intrinsicModuleDirectories_;
   std::string moduleDirectory_{"."s};

   std::map<SymbolRef, const IndexVarInfo, SymbolAddressCompare>
       activeIndexVars_;
   UnorderedSymbolSet errorSymbols_;
   std::set<std::string> tempNames_;
   const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
+  std::optional<const Scope *> CUDABuiltinsScope_; // module __CUDA_builtins
   const Scope *ppcBuiltinsScope_{nullptr}; // module __Fortran_PPC_intrinsics
   std::list<parser::Program> modFileParseTrees_;
   std::unique_ptr<CommonBlockMap> commonBlockMap_;
   bool anyDefinedIntrinsicOperator_{false};
 };

flang/include/flang/Semantics/symbol.h

     CHECK(result_ != nullptr);
     result_ = &result;
   }
   bool defaultIgnoreTKR() const { return defaultIgnoreTKR_; }
   void set_defaultIgnoreTKR(bool yes) { defaultIgnoreTKR_ = yes; }
+  std::optional<common::CUDASubprogramAttrs> cudaSubprogramAttrs() const {
+    return cudaSubprogramAttrs_;
+  }
+  void set_cudaSubprogramAttrs(common::CUDASubprogramAttrs csas) {
+    cudaSubprogramAttrs_ = csas;
+  }
+  std::vector<std::int64_t> &cudaLaunchBounds() { return cudaLaunchBounds_; }
+  const std::vector<std::int64_t> &cudaLaunchBounds() const {
+    return cudaLaunchBounds_;
+  }
+  void set_cudaLaunchBounds(std::vector<std::int64_t> &&x) {
+    cudaLaunchBounds_ = std::move(x);
+  }
+  std::vector<std::int64_t> &cudaClusterDims() { return cudaClusterDims_; }
+  const std::vector<std::int64_t> &cudaClusterDims() const {
+    return cudaClusterDims_;
+  }
+  void set_cudaClusterDims(std::vector<std::int64_t> &&x) {
+    cudaClusterDims_ = std::move(x);
+  }
 
 private:
   bool isInterface_{false}; // true if this represents an interface-body
   bool isDummy_{false}; // true when interface of dummy procedure
   std::vector<Symbol *> dummyArgs_; // nullptr -> alternate return indicator

   // For MODULE FUNCTION or SUBROUTINE, this is the symbol of its declared
   // interface.  For MODULE PROCEDURE, this is the declared interface if it
   // appeared in an ancestor (sub)module.
   Symbol *moduleInterface_{nullptr};
   bool defaultIgnoreTKR_{false};
+  // CUDA ATTRIBUTES(...) from subroutine/function prefix
+  std::optional<common::CUDASubprogramAttrs> cudaSubprogramAttrs_;
+  // CUDA LAUNCH_BOUNDS(...) & CLUSTER_DIMS(...) from prefix
+  std::vector<std::int64_t> cudaLaunchBounds_, cudaClusterDims_;
 
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const SubprogramDetails &);
 };
 

     return isDummy() && shape_.CanBeAssumedShape();
   }
   bool CanBeDeferredShape() const { return shape_.CanBeDeferredShape(); }
   bool IsAssumedSize() const { return isDummy() && shape_.CanBeAssumedSize(); }
   bool IsAssumedRank() const { return isDummy() && shape_.IsAssumedRank(); }
+  std::optional<common::CUDADataAttr> cudaDataAttr() const {
+    return cudaDataAttr_;
+  }
+  void set_cudaDataAttr(std::optional<common::CUDADataAttr> attr) {
+    cudaDataAttr_ = attr;
+  }
 
 private:
   MaybeExpr init_;
   const parser::Expr *unanalyzedPDTComponentInit_{nullptr};
   ArraySpec shape_;
   ArraySpec coshape_;
   common::IgnoreTKRSet ignoreTKR_;
   const Symbol *commonBlock_{nullptr}; // common block this object is in
+  std::optional<common::CUDADataAttr> cudaDataAttr_;
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const ObjectEntityDetails &);
 };
 
 // Mixin for details with passed-object dummy argument.

   // Be advised: !init().has_value() => uninitialized pointer,
   // while *init() == nullptr => explicit NULL() initialization.
   std::optional<const Symbol *> init() const { return init_; }
   void set_init(const Symbol &symbol) { init_ = &symbol; }
   void set_init(std::nullptr_t) { init_ = nullptr; }
+  bool isCUDAKernel() const { return isCUDAKernel_; }
+  void set_isCUDAKernel(bool yes = true) { isCUDAKernel_ = yes; }
 
 private:
   const Symbol *procInterface_{nullptr};
   std::optional<const Symbol *> init_;
+  bool isCUDAKernel_{false};
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const ProcEntityDetails &);
 };
 
 // These derived type details represent the characteristics of a derived

flang/include/flang/Semantics/tools.h

 bool IsAssumedType(const Symbol &);
 bool IsPolymorphic(const Symbol &);
 bool IsUnlimitedPolymorphic(const Symbol &);
 bool IsPolymorphicAllocatable(const Symbol &);
 
+inline bool IsCUDADeviceContext(const Scope *scope) {
+  if (scope) {
+    if (const Symbol * symbol{scope->symbol()}) {
+      if (const auto *subp{symbol->detailsIf<SubprogramDetails>()}) {
+        if (auto attrs{subp->cudaSubprogramAttrs()}) {
+          return *attrs != common::CUDASubprogramAttrs::Host;
+        }
+      }
+    }
+  }
+  return false;
+}
+
+const Scope *FindCUDADeviceContext(const Scope *);
+std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *);
+
 // Return an error if a symbol is not accessible from a scope
 std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
     const semantics::Scope &, const Symbol &);
 
 // Analysis of image control statements

 //   - Potential subobject components of a derived type are the closure of
 //     its non-POINTER components and the potential subobject components of
 //     its non-POINTER derived type components.  (The lifetime of each
 //     potential subobject component is that of the entire instance.)
 //   - PotentialAndPointer subobject components of a derived type are the
-//   closure of
-//     its components (including POINTERs) and the PotentialAndPointer subobject
-//     components of its non-POINTER derived type components.
+//     closure of its components (including POINTERs) and the
+//     PotentialAndPointer subobject components of its non-POINTER derived type
+//     components.
 // Parent and procedure components are considered against these definitions.
 // For this kind of iterator, the component tree is recursively visited in the
 // following order:
 //  - the parent component first (if relevant)
 //  - then, the components of the parent type (if relevant)

flang/lib/Common/Fortran.cpp

     result += 'C';
   }
   return result;
 }
 
+bool AreCompatibleCUDADataAttrs(std::optional<CUDADataAttr> x,
+    std::optional<CUDADataAttr> y, IgnoreTKRSet ignoreTKR) {
+  if (!x && !y) {
+    return true;
+  } else if (x && y && *x == *y) {
+    return true;
+  } else if (ignoreTKR.test(IgnoreTKR::Device) &&
+      x.value_or(CUDADataAttr::Device) == CUDADataAttr::Device &&
+      y.value_or(CUDADataAttr::Device) == CUDADataAttr::Device) {
+    return true;
+  } else if (ignoreTKR.test(IgnoreTKR::Managed) &&
+      x.value_or(CUDADataAttr::Managed) == CUDADataAttr::Managed &&
+      y.value_or(CUDADataAttr::Managed) == CUDADataAttr::Managed) {
+    return true;
+  } else {
+    return false;
+  }
+}
+
 } // namespace Fortran::common

flang/lib/Frontend/FrontendAction.cpp

        getCurrentInput().getMustBePreprocessed())) {
     invoc.setDefaultPredefinitions();
     invoc.collectMacroDefinitions();
   }
 
+  // Enable CUDA Fortran if source file is *.cuf/*.CUF.
+  invoc.getFortranOpts().features.Enable(Fortran::common::LanguageFeature::CUDA,
+                                         getCurrentInput().getIsCUDAFortran());
+
   // Decide between fixed and free form (if the user didn't express any
   // preference, use the file extension to decide)
   if (invoc.getFrontendOpts().fortranForm == FortranForm::Unknown) {
     invoc.getFortranOpts().isFixedForm = getCurrentInput().getIsFixedForm();
   }

flang/lib/Frontend/FrontendOptions.cpp

          suffix == "FPP";
 }
 
 bool Fortran::frontend::isFreeFormSuffix(llvm::StringRef suffix) {
   // Note: Keep this list in-sync with flang/test/lit.cfg.py
-  // TODO: Add Cuda Fortan files (i.e. `*.cuf` and `*.CUF`).
   return suffix == "f90" || suffix == "F90" || suffix == "ff90" ||
          suffix == "f95" || suffix == "F95" || suffix == "ff95" ||
          suffix == "f03" || suffix == "F03" || suffix == "f08" ||
-         suffix == "F08" || suffix == "f18" || suffix == "F18";
+         suffix == "F08" || suffix == "f18" || suffix == "F18" ||
+         suffix == "cuf" || suffix == "CUF";
 }
 
 bool Fortran::frontend::isToBePreprocessed(llvm::StringRef suffix) {
   return suffix == "F" || suffix == "FOR" || suffix == "fpp" ||
          suffix == "FPP" || suffix == "F90" || suffix == "F95" ||
-         suffix == "F03" || suffix == "F08" || suffix == "F18";
+         suffix == "F03" || suffix == "F08" || suffix == "F18" ||
+         suffix == "CUF";
+}
+
+bool Fortran::frontend::isCUDAFortranSuffix(llvm::StringRef suffix) {
+  return suffix == "cuf" || suffix == "CUF";
 }
 
 InputKind FrontendOptions::getInputKindForExtension(llvm::StringRef extension) {
   if (isFixedFormSuffix(extension) || isFreeFormSuffix(extension)) {
     return Language::Fortran;

flang/lib/Lower/Allocatable.cpp

                 sourceExpr = Fortran::semantics::GetExpr(source.v.value());
               },
               [&](const Fortran::parser::AllocOpt::Mold &mold) {
                 moldExpr = Fortran::semantics::GetExpr(mold.v.value());
               },
+              [&](const Fortran::parser::AllocOpt::Stream &) {
+                TODO(loc, "CUDA ALLOCATE(STREAM=)");
+              },
+              [&](const Fortran::parser::AllocOpt::Pinned &) {
+                TODO(loc, "CUDA ALLOCATE(PINNED=)");
+              },
           },
           allocOption.u);
   }
 
   void lowerAllocation(const Allocation &alloc) {

flang/lib/Lower/Bridge.cpp

 
   /// Lowering of CALL statement
   void genFIR(const Fortran::parser::CallStmt &stmt) {
     Fortran::lower::StatementContext stmtCtx;
     Fortran::lower::pft::Evaluation &eval = getEval();
-    setCurrentPosition(stmt.v.source);
+    setCurrentPosition(stmt.source);
     assert(stmt.typedCall && "Call was not analyzed");
     mlir::Value res{};
     if (lowerToHighLevelFIR()) {
       std::optional<mlir::Type> resultType;
       if (stmt.typedCall->hasAlternateReturns())

     // The call returns an index that selects an alternate return branch target.
     llvm::SmallVector<int64_t> indexList;
     llvm::SmallVector<Fortran::parser::Label> labelList;
     int64_t index = 0;
     for (const Fortran::parser::ActualArgSpec &arg :
-         std::get<std::list<Fortran::parser::ActualArgSpec>>(stmt.v.t)) {
+         std::get<std::list<Fortran::parser::ActualArgSpec>>(stmt.call.t)) {
       const auto &actual = std::get<Fortran::parser::ActualArg>(arg.t);
       if (const auto *altReturn =
               std::get_if<Fortran::parser::AltReturnSpec>(&actual.u)) {
         indexList.push_back(++index);
         labelList.push_back(altReturn->v);

flang/lib/Lower/PFTBuilder.cpp

       eval.visit(common::visitors{
           // Action statements (except IO statements)
           [&](const parser::CallStmt &s) {
             // Look for alternate return specifiers.
             const auto &args =
-                std::get<std::list<parser::ActualArgSpec>>(s.v.t);
+                std::get<std::list<parser::ActualArgSpec>>(s.call.t);
             for (const auto &arg : args) {
               const auto &actual = std::get<parser::ActualArg>(arg.t);
               if (const auto *altReturn =
                       std::get_if<parser::AltReturnSpec>(&actual.u))
                 markBranchTarget(eval, altReturn->v);

flang/lib/Parser/Fortran-parsers.cpp

         Parser<ComponentOrFill>{})))
 
 // R738 component-attr-spec ->
 //        access-spec | ALLOCATABLE |
 //        CODIMENSION lbracket coarray-spec rbracket |
-//        CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER
+//        CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER |
+//        CUDA-data-attr
 TYPE_PARSER(construct<ComponentAttrSpec>(accessSpec) ||
     construct<ComponentAttrSpec>(allocatable) ||
     construct<ComponentAttrSpec>("CODIMENSION" >> coarraySpec) ||
     construct<ComponentAttrSpec>(contiguous) ||
     construct<ComponentAttrSpec>("DIMENSION" >> Parser<ComponentArraySpec>{}) ||
     construct<ComponentAttrSpec>(pointer) ||
+    extension<LanguageFeature::CUDA>(
+        construct<ComponentAttrSpec>(Parser<common::CUDADataAttr>{})) ||
     construct<ComponentAttrSpec>(recovery(
         fail<ErrorRecovery>(
             "type parameter definitions must appear before component declarations"_err_en_US),
         kindOrLen >> construct<ErrorRecovery>())))
 

 // R802 attr-spec ->
 //        access-spec | ALLOCATABLE | ASYNCHRONOUS |
 //        CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |
 //        DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |
 //        INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |
-//        PROTECTED | SAVE | TARGET | VALUE | VOLATILE
+//        PROTECTED | SAVE | TARGET | VALUE | VOLATILE |
+//        CUDA-data-attr
 TYPE_PARSER(construct<AttrSpec>(accessSpec) ||
     construct<AttrSpec>(allocatable) ||
     construct<AttrSpec>(construct<Asynchronous>("ASYNCHRONOUS"_tok)) ||
     construct<AttrSpec>("CODIMENSION" >> coarraySpec) ||
     construct<AttrSpec>(contiguous) ||

     construct<AttrSpec>(construct<Parameter>("PARAMETER"_tok)) ||
     construct<AttrSpec>(pointer) || construct<AttrSpec>(protectedAttr) ||
     construct<AttrSpec>(save) ||
     construct<AttrSpec>(construct<Target>("TARGET"_tok)) ||
     construct<AttrSpec>(construct<Value>("VALUE"_tok)) ||
-    construct<AttrSpec>(construct<Volatile>("VOLATILE"_tok)))
+    construct<AttrSpec>(construct<Volatile>("VOLATILE"_tok)) ||
+    extension<LanguageFeature::CUDA>(
+        construct<AttrSpec>(Parser<common::CUDADataAttr>{})))
+
+// CUDA-data-attr -> CONSTANT | DEVICE | MANAGED | PINNED | SHARED | TEXTURE
+TYPE_PARSER("CONSTANT" >> pure(common::CUDADataAttr::Constant) ||
+    "DEVICE" >> pure(common::CUDADataAttr::Device) ||
+    "MANAGED" >> pure(common::CUDADataAttr::Managed) ||
+    "PINNED" >> pure(common::CUDADataAttr::Pinned) ||
+    "SHARED" >> pure(common::CUDADataAttr::Shared) ||
+    "TEXTURE" >> pure(common::CUDADataAttr::Texture))
 
 // R804 object-name -> name
 constexpr auto objectName{name};
 
 // R803 entity-decl ->

         nonemptyList(Parser<Allocation>{}),
         defaulted("," >> nonemptyList(Parser<AllocOpt>{})) / ")"))
 
 // R928 alloc-opt ->
 //        ERRMSG = errmsg-variable | MOLD = source-expr |
-//        SOURCE = source-expr | STAT = stat-variable
+//        SOURCE = source-expr | STAT = stat-variable |
+// (CUDA) STREAM = scalar-int-expr
+//        PINNED = scalar-logical-variable
 // R931 source-expr -> expr
 TYPE_PARSER(construct<AllocOpt>(
                 construct<AllocOpt::Mold>("MOLD =" >> indirect(expr))) ||
     construct<AllocOpt>(
         construct<AllocOpt::Source>("SOURCE =" >> indirect(expr))) ||
-    construct<AllocOpt>(statOrErrmsg))
+    construct<AllocOpt>(statOrErrmsg) ||
+    extension<LanguageFeature::CUDA>(
+        construct<AllocOpt>(construct<AllocOpt::Stream>(
+            "STREAM =" >> indirect(scalarIntExpr))) ||
+        construct<AllocOpt>(construct<AllocOpt::Pinned>(
+            "PINNED =" >> indirect(scalarLogicalVariable)))))
 
 // R929 stat-variable -> scalar-int-variable
 TYPE_PARSER(construct<StatVariable>(scalar(integer(variable))))
 
 // R932 allocation ->

 
 // Directives, extensions, and deprecated statements
 // !DIR$ IGNORE_TKR [ [(tkrdmac...)] name ]...
 // !DIR$ LOOP COUNT (n1[, n2]...)
 // !DIR$ name...
-constexpr auto beginDirective{skipStuffBeforeStatement >> "!"_ch};
-constexpr auto endDirective{space >> endOfLine};
 constexpr auto ignore_tkr{
     "DIR$ IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>(
                              maybe(parenthesized(many(letter))), name))};
 constexpr auto loopCount{
     "DIR$ LOOP COUNT" >> construct<CompilerDirective::LoopCount>(
                              parenthesized(nonemptyList(digitString64)))};
-
 TYPE_PARSER(beginDirective >>
     sourced(construct<CompilerDirective>(ignore_tkr) ||
         construct<CompilerDirective>(loopCount) ||
         construct<CompilerDirective>(
             "DIR$" >> many(construct<CompilerDirective::NameValue>(name,

     construct<BasedPointerStmt>(
         "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US,
                          construct<BasedPointer>("(" >> objectName / ",",
                              objectName, maybe(Parser<ArraySpec>{}) / ")")))))
 
+// CUDA-attributes-stmt -> ATTRIBUTES (CUDA-data-attr) [::] name-list
+TYPE_PARSER(extension<LanguageFeature::CUDA>(construct<CUDAAttributesStmt>(
+    "ATTRIBUTES" >> parenthesized(Parser<common::CUDADataAttr>{}),
+    defaulted(
+        maybe("::"_tok) >> nonemptyList("expected names"_err_en_US, name)))))
+
 // Subtle: the name includes the surrounding slashes, which avoids
 // clashes with other uses of the name in the same scope.
 TYPE_PARSER(construct<StructureStmt>(
     "STRUCTURE" >> maybe(sourced("/" >> name / "/")), optionalList(entityDecl)))
 

flang/lib/Parser/basic-parsers.h

 public:
   using resultType = typename PA::resultType;
   constexpr NonstandardParser(const NonstandardParser &) = default;
   constexpr NonstandardParser(PA parser, MessageFixedText msg)
       : parser_{parser}, message_{msg} {}
+  constexpr NonstandardParser(PA parser) : parser_{parser} {}
   std::optional<resultType> Parse(ParseState &state) const {
     if (UserState * ustate{state.userState()}) {
       if (!ustate->features().IsEnabled(LF)) {
         return std::nullopt;
       }
     }
     auto at{state.GetLocation()};
     auto result{parser_.Parse(state)};
-    if (result) {
+    if (result && !message_.empty()) {
       state.Nonstandard(
           CharBlock{at, std::max(state.GetLocation(), at + 1)}, LF, message_);
     }
     return result;
   }

 template <LanguageFeature LF, typename PA>
 inline constexpr auto extension(MessageFixedText feature, PA parser) {
   return NonstandardParser<LF, PA>(parser, feature);
 }
 
+template <LanguageFeature LF, typename PA>
+inline constexpr auto extension(PA parser) {
+  return NonstandardParser<LF, PA>(parser);
+}
+
 // If a is a parser for some deprecated or deleted language feature LF,
 // deprecated<LF>(a) is a parser that is optionally enabled, sets a strict
 // conformance violation flag, and may emit a warning message, if enabled.
 template <LanguageFeature LF, typename PA> class DeprecatedParser {
 public:

flang/lib/Parser/executable-parsers.cpp

 //===----------------------------------------------------------------------===//
 
 // Per-type parsers for executable statements
 
 #include "basic-parsers.h"
+#include "debug-parser.h"
 #include "expr-parsers.h"
 #include "misc-parsers.h"
 #include "stmt-parser.h"
 #include "token-parsers.h"
 #include "type-parser-implementation.h"

 
 // R514 executable-construct ->
 //        action-stmt | associate-construct | block-construct |
 //        case-construct | change-team-construct | critical-construct |
 //        do-construct | if-construct | select-rank-construct |
-//        select-type-construct | where-construct | forall-construct
-constexpr auto executableConstruct{
-    first(construct<ExecutableConstruct>(CapturedLabelDoStmt{}),
-        construct<ExecutableConstruct>(EndDoStmtForCapturedLabelDoStmt{}),
-        construct<ExecutableConstruct>(indirect(Parser<DoConstruct>{})),
-        // Attempt DO statements before assignment statements for better
-        // error messages in cases like "DO10I=1,(error)".
-        construct<ExecutableConstruct>(statement(actionStmt)),
-        construct<ExecutableConstruct>(indirect(Parser<AssociateConstruct>{})),
-        construct<ExecutableConstruct>(indirect(Parser<BlockConstruct>{})),
-        construct<ExecutableConstruct>(indirect(Parser<CaseConstruct>{})),
-        construct<ExecutableConstruct>(indirect(Parser<ChangeTeamConstruct>{})),
-        construct<ExecutableConstruct>(indirect(Parser<CriticalConstruct>{})),
-        construct<ExecutableConstruct>(indirect(Parser<IfConstruct>{})),
-        construct<ExecutableConstruct>(indirect(Parser<SelectRankConstruct>{})),
-        construct<ExecutableConstruct>(indirect(Parser<SelectTypeConstruct>{})),
-        construct<ExecutableConstruct>(indirect(whereConstruct)),
-        construct<ExecutableConstruct>(indirect(forallConstruct)),
-        construct<ExecutableConstruct>(indirect(ompEndLoopDirective)),
-        construct<ExecutableConstruct>(indirect(openmpConstruct)),
-        construct<ExecutableConstruct>(indirect(accEndCombinedDirective)),
-        construct<ExecutableConstruct>(indirect(openaccConstruct)),
-        construct<ExecutableConstruct>(indirect(compilerDirective)))};
+//        select-type-construct | where-construct | forall-construct |
+// (CUDA) CUF-kernel-do-construct
+constexpr auto executableConstruct{first(
+    construct<ExecutableConstruct>(CapturedLabelDoStmt{}),
+    construct<ExecutableConstruct>(EndDoStmtForCapturedLabelDoStmt{}),
+    construct<ExecutableConstruct>(indirect(Parser<DoConstruct>{})),
+    // Attempt DO statements before assignment statements for better
+    // error messages in cases like "DO10I=1,(error)".
+    construct<ExecutableConstruct>(statement(actionStmt)),
+    construct<ExecutableConstruct>(indirect(Parser<AssociateConstruct>{})),
+    construct<ExecutableConstruct>(indirect(Parser<BlockConstruct>{})),
+    construct<ExecutableConstruct>(indirect(Parser<CaseConstruct>{})),
+    construct<ExecutableConstruct>(indirect(Parser<ChangeTeamConstruct>{})),
+    construct<ExecutableConstruct>(indirect(Parser<CriticalConstruct>{})),
+    construct<ExecutableConstruct>(indirect(Parser<IfConstruct>{})),
+    construct<ExecutableConstruct>(indirect(Parser<SelectRankConstruct>{})),
+    construct<ExecutableConstruct>(indirect(Parser<SelectTypeConstruct>{})),
+    construct<ExecutableConstruct>(indirect(whereConstruct)),
+    construct<ExecutableConstruct>(indirect(forallConstruct)),
+    construct<ExecutableConstruct>(indirect(ompEndLoopDirective)),
+    construct<ExecutableConstruct>(indirect(openmpConstruct)),
+    construct<ExecutableConstruct>(indirect(accEndCombinedDirective)),
+    construct<ExecutableConstruct>(indirect(openaccConstruct)),
+    construct<ExecutableConstruct>(indirect(compilerDirective)),
+    construct<ExecutableConstruct>(indirect(Parser<CUFKernelDoConstruct>{})))};
 
 // R510 execution-part-construct ->
 //        executable-construct | format-stmt | entry-stmt | data-stmt
 // Extension (PGI/Intel): also accept NAMELIST in execution part
 constexpr auto obsoleteExecutionPartConstruct{recovery(ignoredStatementPrefix >>

 // R1181 unlock-stmt -> UNLOCK ( lock-variable [, sync-stat-list] )
 TYPE_CONTEXT_PARSER("UNLOCK statement"_en_US,
     construct<UnlockStmt>("UNLOCK (" >> lockVariable,
         defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))
 
+// CUF-kernel-do-construct -> CUF-kernel-do-directive do-construct
+// CUF-kernel-do-directive ->
+//     !$CUF KERNEL DO [ (scalar-int-constant-expr) ] <<< grid, block [, stream]
+//     >>> do-construct
+// grid -> * | scalar-int-expr | ( scalar-int-expr-list )
+// block -> * | scalar-int-expr | ( scalar-int-expr-list )
+// stream -> ( 0, | STREAM = ) scalar-int-expr
+TYPE_PARSER(sourced(beginDirective >> "$CUF KERNEL DO"_tok >>
+    construct<CUFKernelDoConstruct::Directive>(
+        maybe(parenthesized(scalarIntConstantExpr)),
+        "<<<" >>
+            ("*" >> pure<std::list<ScalarIntExpr>>() ||
+                parenthesized(nonemptyList(scalarIntExpr)) ||
+                applyFunction(singletonList<ScalarIntExpr>, scalarIntExpr)),
+        "," >> ("*" >> pure<std::list<ScalarIntExpr>>() ||
+                   parenthesized(nonemptyList(scalarIntExpr)) ||
+                   applyFunction(singletonList<ScalarIntExpr>, scalarIntExpr)),
+        maybe((", 0 ,"_tok || ", STREAM ="_tok) >> scalarIntExpr) / ">>>" /
+            endDirective)))
+TYPE_CONTEXT_PARSER("!$CUF KERNEL DO construct"_en_US,
+    extension<LanguageFeature::CUDA>(construct<CUFKernelDoConstruct>(
+        Parser<CUFKernelDoConstruct::Directive>{},
+        maybe(Parser<DoConstruct>{}))))
+
 } // namespace Fortran::parser

flang/lib/Parser/io-parsers.cpp

     construct<WaitSpec>("ERR =" >> errLabel),
     construct<WaitSpec>("ID =" >> idExpr),
     construct<WaitSpec>("IOMSG =" >> msgVariable),
     construct<WaitSpec>("IOSTAT =" >> statVariable)))
 
-template <typename A> common::IfNoLvalue<std::list<A>, A> singletonList(A &&x) {
-  std::list<A> result;
-  result.push_front(std::move(x));
-  return result;
-}
 constexpr auto bareUnitNumberAsList{
     applyFunction(singletonList<PositionOrFlushSpec>,
         construct<PositionOrFlushSpec>(fileUnitNumber))};
 constexpr auto positionOrFlushSpecList{
     parenthesized(nonemptyList(positionOrFlushSpec)) || bareUnitNumberAsList};

flang/lib/Parser/misc-parsers.h

 constexpr auto optional{construct<Optional>("OPTIONAL"_tok)};
 constexpr auto pointer{construct<Pointer>("POINTER"_tok)};
 constexpr auto protectedAttr{construct<Protected>("PROTECTED"_tok)};
 constexpr auto save{construct<Save>("SAVE"_tok)};
 
+template <typename A> common::IfNoLvalue<std::list<A>, A> singletonList(A &&x) {
+  std::list<A> result;
+  result.emplace_back(std::move(x));
+  return result;
+}
 } // namespace Fortran::parser
 #endif

flang/lib/Parser/parse-tree.cpp

                       return WithSource(
                           z.value().source, Expr{std::move(z.value())});
                     },
                     [&](common::Indirection<FunctionReference> &z) {
                       return WithSource(
-                          z.value().v.source, Expr{std::move(z.value())});
+                          z.value().source, Expr{std::move(z.value())});
                     },
                 },
                 y.value().u);
           },
           [&](auto &) -> Expr { common::die("unexpected type"); },

   }
   return common::visit(
       common::visitors{
           [&](const Name &name) {
             return WithSource(
-                v.source, MakeArrayElementRef(name, std::move(args)));
+                source, MakeArrayElementRef(name, std::move(args)));
           },
           [&](ProcComponentRef &pcr) {
-            return WithSource(v.source,
+            return WithSource(source,
                 MakeArrayElementRef(std::move(pcr.v.thing), std::move(args)));
           },
       },
       std::get<ProcedureDesignator>(v.t).u);
 }

             arg.source, Designator{DataRef{Name{arg.source, arg.symbol}}})}});
     source.ExtendToCover(arg.source);
   }
   CHECK(*source.end() == ')');
   source = CharBlock{source.begin(), source.end() + 1};
-  FunctionReference funcRef{WithSource(source,
+  FunctionReference funcRef{
       Call{ProcedureDesignator{Name{funcName.source, funcName.symbol}},
-          std::move(actuals)})};
+          std::move(actuals)}};
+  funcRef.source = source;
   auto variable{Variable{common::Indirection{std::move(funcRef)}}};
   return Statement{std::nullopt,
       ActionStmt{common::Indirection{
           AssignmentStmt{std::move(variable), std::move(funcExpr)}}}};
 }

       common::visitors{
           [&](const common::Indirection<Designator> &des) {
             return des.value().source;
           },
           [&](const common::Indirection<parser::FunctionReference> &call) {
-            return call.value().v.source;
+            return call.value().source;
           },
       },
       u);
 }
 

flang/lib/Parser/parsing.cpp

   }
   if (options.features.IsEnabled(LanguageFeature::OpenMP)) {
     prescanner.AddCompilerDirectiveSentinel("$omp");
     prescanner.AddCompilerDirectiveSentinel("$"); // OMP conditional line
   }
+  if (options.features.IsEnabled(LanguageFeature::CUDA)) {
+    prescanner.AddCompilerDirectiveSentinel("$cuf");
+    prescanner.AddCompilerDirectiveSentinel("@cuf");
+    preprocessor.Define("_CUDA", "1");
+  }
   ProvenanceRange range{allSources.AddIncludedFile(
       *sourceFile, ProvenanceRange{}, options.isModuleFile)};
   prescanner.Prescan(range);
   if (currentCooked_->BufferedBytes() == 0 && !options.isModuleFile) {
     // Input is empty.  Append a newline so that any warning

flang/lib/Parser/preprocessor.cpp

             "#include: expected '>' at end of included file"_port_en_US);
       }
       TokenSequence braced{dir, j + 1, k - j - 1};
       include = braced.ToString();
       j = k;
-    } else if ((include = dir.TokenAt(j).ToString()).substr(0, 1) == "\"" &&
-        include.substr(include.size() - 1, 1) == "\"") { // #include "foo"
+    } else if (((include = dir.TokenAt(j).ToString()).substr(0, 1) == "\"" ||
+                   include.substr(0, 1) == "'") &&
+        include.substr(include.size() - 1, 1) == include.substr(0, 1)) {
+      // #include "foo" and #include 'foo'
       include = include.substr(1, include.size() - 2);
-      // #include "foo" starts search in directory of file containing
-      // the directive
+      // Start search in directory of file containing the directive
       auto prov{dir.GetTokenProvenanceRange(dirOffset).start()};
       if (const auto *currentFile{allSources_.GetSourceFile(prov)}) {
         prependPath = DirectoryName(currentFile->path());
       }
     } else {

flang/lib/Parser/prescan.cpp

       if (inFixedForm_) {
         LabelField(tokens);
       } else {
         SkipSpaces();
       }
+    } else if (directiveSentinel_[0] == '@' && directiveSentinel_[1] == 'c' &&
+        directiveSentinel_[2] == 'u' && directiveSentinel_[3] == 'f' &&
+        directiveSentinel_[4] == '\0') {
+      // CUDA conditional compilation line.  Remove the sentinel and then
+      // treat the line as if it were normal source.
+      at_ += 5, column_ += 5;
+      if (inFixedForm_) {
+        LabelField(tokens);
+      } else {
+        SkipSpaces();
+      }
     } else {
       // Compiler directive.  Emit normalized sentinel.
       EmitChar(tokens, '!');
       ++at_, ++column_;
       for (const char *sp{directiveSentinel_}; *sp != '\0';

flang/lib/Parser/program-parsers.cpp

 // as a specification part in order to improve error recovery.
 // Also note that many instances of specification-part in the standard grammar
 // are in contexts that impose constraints on the kinds of statements that
 // are allowed, and so we have a variant production for declaration-construct
 // that implements those constraints.
-constexpr auto execPartLookAhead{
-    first(actionStmt >> ok, openaccConstruct >> ok, openmpConstruct >> ok,
-        "ASSOCIATE ("_tok, "BLOCK"_tok, "SELECT"_tok, "CHANGE TEAM"_sptok,
-        "CRITICAL"_tok, "DO"_tok, "IF ("_tok, "WHERE ("_tok, "FORALL ("_tok)};
+constexpr auto execPartLookAhead{first(actionStmt >> ok, openaccConstruct >> ok,
+    openmpConstruct >> ok, "ASSOCIATE ("_tok, "BLOCK"_tok, "SELECT"_tok,
+    "CHANGE TEAM"_sptok, "CRITICAL"_tok, "DO"_tok, "IF ("_tok, "WHERE ("_tok,
+    "FORALL ("_tok, "!$CUF"_tok)};
 constexpr auto declErrorRecovery{
     stmtErrorRecoveryStart >> !execPartLookAhead >> skipStmtErrorRecovery};
 constexpr auto misplacedSpecificationStmt{Parser<UseStmt>{} >>
         fail<DeclarationConstruct>("misplaced USE statement"_err_en_US) ||
     Parser<ImportStmt>{} >>

 // R513 other-specification-stmt ->
 //        access-stmt | allocatable-stmt | asynchronous-stmt | bind-stmt |
 //        codimension-stmt | contiguous-stmt | dimension-stmt | external-stmt |
 //        intent-stmt | intrinsic-stmt | namelist-stmt | optional-stmt |
 //        pointer-stmt | protected-stmt | save-stmt | target-stmt |
-//        volatile-stmt | value-stmt | common-stmt | equivalence-stmt
+//        volatile-stmt | value-stmt | common-stmt | equivalence-stmt |
+// (CUDA) CUDA-attributes-stmt
 TYPE_PARSER(first(
     construct<OtherSpecificationStmt>(indirect(Parser<AccessStmt>{})),
     construct<OtherSpecificationStmt>(indirect(Parser<AllocatableStmt>{})),
     construct<OtherSpecificationStmt>(indirect(Parser<AsynchronousStmt>{})),
     construct<OtherSpecificationStmt>(indirect(Parser<BindStmt>{})),

     construct<OtherSpecificationStmt>(indirect(Parser<TargetStmt>{})),
     construct<OtherSpecificationStmt>(indirect(Parser<ValueStmt>{})),
     construct<OtherSpecificationStmt>(indirect(Parser<VolatileStmt>{})),
     construct<OtherSpecificationStmt>(indirect(Parser<CommonStmt>{})),
     construct<OtherSpecificationStmt>(indirect(Parser<EquivalenceStmt>{})),
-    construct<OtherSpecificationStmt>(indirect(Parser<BasedPointerStmt>{}))))
+    construct<OtherSpecificationStmt>(indirect(Parser<BasedPointerStmt>{})),
+    construct<OtherSpecificationStmt>(indirect(Parser<CUDAAttributesStmt>{}))))
 
 // R1401 main-program ->
 //         [program-stmt] [specification-part] [execution-part]
 //         [internal-subprogram-part] end-program-stmt
 TYPE_CONTEXT_PARSER("main program"_en_US,

 
 // R1519 intrinsic-stmt -> INTRINSIC [::] intrinsic-procedure-name-list
 TYPE_PARSER(
     "INTRINSIC" >> maybe("::"_tok) >> construct<IntrinsicStmt>(listOfNames))
 
-// R1520 function-reference -> procedure-designator ( [actual-arg-spec-list] )
+// R1520 function-reference -> procedure-designator
+//                               ( [actual-arg-spec-list] )
 TYPE_CONTEXT_PARSER("function reference"_en_US,
-    construct<FunctionReference>(
-        sourced(construct<Call>(Parser<ProcedureDesignator>{},
+    sourced(construct<FunctionReference>(
+        construct<Call>(Parser<ProcedureDesignator>{},
             parenthesized(optionalList(actualArgSpec))))) /
         !"["_tok)
 
-// R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )]
+// R1521 call-stmt -> CALL procedure-designator [chevrons]
+///                          [( [actual-arg-spec-list] )]
+// (CUDA) chevrons -> <<< scalar-expr, scalar-expr [, scalar-int-expr
+//                      [, scalar-int-expr ] ] >>>
+TYPE_PARSER(extension<LanguageFeature::CUDA>(
+    "<<<" >> construct<CallStmt::Chevrons>(scalarExpr, "," >> scalarExpr,
+                 maybe("," >> scalarIntExpr), maybe("," >> scalarIntExpr)) /
+        ">>>"))
 TYPE_PARSER(construct<CallStmt>(
-    sourced(construct<Call>("CALL" >> Parser<ProcedureDesignator>{},
+    sourced(construct<CallStmt>("CALL" >> Parser<ProcedureDesignator>{},
+        maybe(Parser<CallStmt::Chevrons>{}),
         defaulted(parenthesized(optionalList(actualArgSpec)))))))
 
 // R1522 procedure-designator ->
 //         procedure-name | proc-component-ref | data-ref % binding-name
 TYPE_PARSER(construct<ProcedureDesignator>(Parser<ProcComponentRef>{}) ||

 // R1525 alt-return-spec -> * label
 TYPE_PARSER(construct<AltReturnSpec>(star >> label))
 
 // R1527 prefix-spec ->
 //         declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
-//         NON_RECURSIVE | PURE | RECURSIVE
+//         NON_RECURSIVE | PURE | RECURSIVE |
+// (CUDA)  ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... ) |
+//         LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
+TYPE_PARSER(first("DEVICE" >> pure(common::CUDASubprogramAttrs::Device),
+    "GLOBAL" >> pure(common::CUDASubprogramAttrs::Global),
+    "GRID_GLOBAL" >> pure(common::CUDASubprogramAttrs::Grid_Global),
+    "HOST" >> pure(common::CUDASubprogramAttrs::Host)))
 TYPE_PARSER(first(construct<PrefixSpec>(declarationTypeSpec),
     construct<PrefixSpec>(construct<PrefixSpec::Elemental>("ELEMENTAL"_tok)),
     construct<PrefixSpec>(construct<PrefixSpec::Impure>("IMPURE"_tok)),
     construct<PrefixSpec>(construct<PrefixSpec::Module>("MODULE"_tok)),
     construct<PrefixSpec>(
         construct<PrefixSpec::Non_Recursive>("NON_RECURSIVE"_tok)),
     construct<PrefixSpec>(construct<PrefixSpec::Pure>("PURE"_tok)),
-    construct<PrefixSpec>(construct<PrefixSpec::Recursive>("RECURSIVE"_tok))))
+    construct<PrefixSpec>(construct<PrefixSpec::Recursive>("RECURSIVE"_tok)),
+    extension<LanguageFeature::CUDA>(
+        construct<PrefixSpec>(construct<PrefixSpec::Attributes>("ATTRIBUTES" >>
+            parenthesized(
+                optionalList(Parser<common::CUDASubprogramAttrs>{}))))),
+    extension<LanguageFeature::CUDA>(construct<PrefixSpec>(
+        construct<PrefixSpec::Launch_Bounds>("LAUNCH_BOUNDS" >>
+            parenthesized(nonemptyList(
+                "expected launch bounds"_err_en_US, scalarIntConstantExpr))))),
+    extension<LanguageFeature::CUDA>(construct<PrefixSpec>(
+        construct<PrefixSpec::Cluster_Dims>("CLUSTER_DIMS" >>
+            parenthesized(nonemptyList("expected cluster dimensions"_err_en_US,
+                scalarIntConstantExpr)))))))
 
 // R1529 function-subprogram ->
 //         function-stmt [specification-part] [execution-part]
 //         [internal-subprogram-part] end-function-stmt
 TYPE_CONTEXT_PARSER("FUNCTION subprogram"_en_US,

flang/lib/Parser/stmt-parser.h

 
 constexpr auto progUnitEndStmtErrorRecovery{
     (many(!"END"_tok >> SkipPast<'\n'>{}) >>
         ("END"_tok >> SkipTo<'\n'>{} || consumedAllInput)) >>
     missingOptionalName};
+
+constexpr auto beginDirective{skipStuffBeforeStatement >> "!"_ch};
+constexpr auto endDirective{space >> endOfLine};
+
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_STMT_PARSER_H_

flang/lib/Parser/unparse.cpp

   }
   void Before(const AllocOpt &x) { // R928, R931
     common::visit(common::visitors{
                       [&](const AllocOpt::Mold &) { Word("MOLD="); },
                       [&](const AllocOpt::Source &) { Word("SOURCE="); },
+                      [&](const AllocOpt::Stream &) { Word("STREAM="); },
+                      [&](const AllocOpt::Pinned &) { Word("PINNED="); },
                       [](const StatOrErrmsg &) {},
                   },
         x.u);
   }
   void Unparse(const Allocation &x) { // R932

     Walk(" => ", std::get<std::optional<ProcPointerInit>>(x.t));
   }
   void Unparse(const IntrinsicStmt &x) { // R1519
     Word("INTRINSIC :: "), Walk(x.v, ", ");
   }
+  void Unparse(const CallStmt::Chevrons &x) { // CUDA
+    Walk(std::get<0>(x.t)); // grid
+    Word(","), Walk(std::get<1>(x.t)); // block
+    Walk(",", std::get<2>(x.t)); // bytes
+    Walk(",", std::get<3>(x.t)); // stream
+  }
   void Unparse(const FunctionReference &x) { // R1520
     Walk(std::get<ProcedureDesignator>(x.v.t));
     Put('('), Walk(std::get<std::list<ActualArgSpec>>(x.v.t), ", "), Put(')');
   }
   void Unparse(const CallStmt &x) { // R1521
-    if (asFortran_ && x.typedCall.get()) {
+    if (asFortran_ && x.typedCall.get() && !x.chevrons /*CUDA todo*/) {
       Put(' ');
       asFortran_->call(out_, *x.typedCall);
       Put('\n');
     } else {
-      const auto &pd{std::get<ProcedureDesignator>(x.v.t)};
-      const auto &args{std::get<std::list<ActualArgSpec>>(x.v.t)};
+      const auto &pd{std::get<ProcedureDesignator>(x.call.t)};
       Word("CALL "), Walk(pd);
+      Walk("<<<", x.chevrons, ">>>");
+      const auto &args{std::get<std::list<ActualArgSpec>>(x.call.t)};
       if (args.empty()) {
         if (std::holds_alternative<ProcComponentRef>(pd.u)) {
           Put("()"); // pgf90 crashes on CALL to tbp without parentheses
         }
       } else {

   void Post(const PrefixSpec::Impure) { Word("IMPURE"); }
   void Post(const PrefixSpec::Module) { Word("MODULE"); }
   void Post(const PrefixSpec::Non_Recursive) { Word("NON_RECURSIVE"); }
   void Post(const PrefixSpec::Pure) { Word("PURE"); }
   void Post(const PrefixSpec::Recursive) { Word("RECURSIVE"); }
+  void Unparse(const PrefixSpec::Attributes &x) {
+    Word("ATTRIBUTES("), Walk(x.v), Word(")");
+  }
+  void Unparse(const PrefixSpec::Launch_Bounds &x) {
+    Word("LAUNCH_BOUNDS("), Walk(x.v), Word(")");
+  }
+  void Unparse(const PrefixSpec::Cluster_Dims &x) {
+    Word("CLUSTER_DIMS("), Walk(x.v), Word(")");
+  }
   void Unparse(const FunctionStmt &x) { // R1530
     Walk("", std::get<std::list<PrefixSpec>>(x.t), " ", " ");
     Word("FUNCTION "), Walk(std::get<Name>(x.t)), Put("(");
     Walk(std::get<std::list<Name>>(x.t), ", "), Put(')');
     Walk(" ", std::get<std::optional<Suffix>>(x.t)), Indent();

 #include "llvm/Frontend/OpenACC/ACC.inc"
   void Unparse(const AccObjectListWithModifier &x) {
     Walk(std::get<std::optional<AccDataModifier>>(x.t), ":");
     Walk(std::get<AccObjectList>(x.t));
   }
-  void Unparse(const AccDataModifier::Modifier &x) {
-    Word(AccDataModifier::EnumToString(x));
-  }
   void Unparse(const AccBindClause &x) {
     common::visit(common::visitors{
                       [&](const Name &y) { Put('('), Walk(y), Put(')'); },
                       [&](const ScalarDefaultCharExpr &y) {
                         Put('('), Walk(y), Put(')');

                       [&](const Name &y) { Put("/"), Walk(y), Put("/"); },
                   },
         x.u);
   }
   void Unparse(const AccObjectList &x) { Walk(x.v, ","); }
-  void Unparse(const AccReductionOperator::Operator &x) {
-    Word(AccReductionOperator::EnumToString(x));
-  }
   void Unparse(const AccObjectListWithReduction &x) {
     Walk(std::get<AccReductionOperator>(x.t));
     Put(":");
     Walk(std::get<AccObjectList>(x.t));
   }

   void Unparse(const BasedPointer &x) {
     Put('('), Walk(std::get<0>(x.t)), Put(","), Walk(std::get<1>(x.t));
     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"), Put(')');
   }
   void Unparse(const BasedPointerStmt &x) { Walk("POINTER ", x.v, ","); }
+  void Unparse(const CUDAAttributesStmt &x) {
+    Word("ATTRIBUTES("), Walk(std::get<common::CUDADataAttr>(x.t));
+    Word(") "), Walk(std::get<std::list<Name>>(x.t), ", ");
+  }
   void Post(const StructureField &x) {
     if (const auto *def{std::get_if<Statement<DataComponentDefStmt>>(&x.u)}) {
       for (const auto &item :
           std::get<std::list<ComponentOrFill>>(def->statement.t)) {
         if (const auto *comp{std::get_if<ComponentDecl>(&item.u)}) {

   }
   void Unparse(const PauseStmt &x) { Word("PAUSE"), Walk(" ", x.v); }
 
 #define WALK_NESTED_ENUM(CLASS, ENUM) \
   void Unparse(const CLASS::ENUM &x) { Word(CLASS::EnumToString(x)); }
+  WALK_NESTED_ENUM(AccDataModifier, Modifier)
   WALK_NESTED_ENUM(AccessSpec, Kind) // R807
+  WALK_NESTED_ENUM(AccReductionOperator, Operator)
   WALK_NESTED_ENUM(common, TypeParamAttr) // R734
+  WALK_NESTED_ENUM(common, CUDADataAttr) // CUDA
+  WALK_NESTED_ENUM(common, CUDASubprogramAttrs) // CUDA
   WALK_NESTED_ENUM(IntentSpec, Intent) // R826
   WALK_NESTED_ENUM(ImplicitStmt, ImplicitNoneNameSpec) // R866
   WALK_NESTED_ENUM(ConnectSpec::CharExpr, Kind) // R1205
   WALK_NESTED_ENUM(IoControlSpec::CharExpr, Kind)
   WALK_NESTED_ENUM(InquireSpec::CharVar, Kind)

   WALK_NESTED_ENUM(OmpCancelType, Type) // OMP cancel-type
   WALK_NESTED_ENUM(OmpOrderClause, Type) // OMP order-type
   WALK_NESTED_ENUM(OmpOrderModifier, Kind) // OMP order-modifier
 #undef WALK_NESTED_ENUM
 
+  void Unparse(const CUFKernelDoConstruct::Directive &x) {
+    Word("!$CUF KERNEL DO");
+    Walk(" (", std::get<std::optional<ScalarIntConstantExpr>>(x.t), ")");
+    Word(" <<<");
+    const auto &grid{std::get<1>(x.t)};
+    if (grid.empty()) {
+      Word("*");
+    } else if (grid.size() == 1) {
+      Walk(grid.front());
+    } else {
+      Walk("(", grid, ",", ")");
+    }
+    Word(",");
+    const auto &block{std::get<2>(x.t)};
+    if (block.empty()) {
+      Word("*");
+    } else if (block.size() == 1) {
+      Walk(block.front());
+    } else {
+      Walk("(", block, ",", ")");
+    }
+    if (const auto &stream{std::get<3>(x.t)}) {
+      Word(",STREAM="), Walk(*stream);
+    }
+    Word(">>>\n");
+  }
+
+  void Unparse(const CUFKernelDoConstruct &x) {
+    Walk(std::get<CUFKernelDoConstruct::Directive>(x.t));
+    Walk(std::get<std::optional<DoConstruct>>(x.t));
+  }
+
   void Done() const { CHECK(indent_ == 0); }
 
 private:
   void Put(char);
   void Put(const char *);

flang/lib/Semantics/check-allocate.cpp

                 stopCheckingAllocate = true;
               }
               parserSourceExpr = &mold.v.value();
               info.gotMold = true;
             },
+            [](const parser::AllocOpt::Stream &) { /* CUDA coming */ },
+            [](const parser::AllocOpt::Pinned &) { /* CUDA coming */ },
         },
         allocOpt.u);
   }
 
   if (stopCheckingAllocate) {

flang/lib/Semantics/check-do-forall.cpp

 // actual arguments to get their source locations of the arguments for the
 // messages.
 void DoForallChecker::Leave(const parser::CallStmt &callStmt) {
   if (const auto &typedCall{callStmt.typedCall}) {
     const auto &parsedArgs{
-        std::get<std::list<parser::ActualArgSpec>>(callStmt.v.t)};
+        std::get<std::list<parser::ActualArgSpec>>(callStmt.call.t)};
     auto parsedArgIter{parsedArgs.begin()};
     const evaluate::ActualArguments &checkedArgs{typedCall->arguments()};
     for (const auto &checkedOptionalArg : checkedArgs) {
       if (parsedArgIter == parsedArgs.end()) {
         break; // No more parsed arguments, we're done.

flang/lib/Semantics/expression.cpp

 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
     std::optional<parser::StructureConstructor> *structureConstructor) {
   const parser::Call &call{funcRef.v};
-  auto restorer{GetContextualMessages().SetLocation(call.source)};
-  ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
+  auto restorer{GetContextualMessages().SetLocation(funcRef.source)};
+  ArgumentAnalyzer analyzer{*this, funcRef.source, true /* isProcedureCall */};
   for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
     analyzer.Analyze(arg, false /* not subroutine call */);
   }
   if (analyzer.fatalErrors()) {
     return std::nullopt;

           GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
               analyzer.GetActuals(), false /* not subroutine */,
               true /* might be structure constructor */)}) {
     if (auto *proc{std::get_if<ProcedureDesignator>(&callee->u)}) {
       return MakeFunctionRef(
-          call.source, std::move(*proc), std::move(callee->arguments));
+          funcRef.source, std::move(*proc), std::move(callee->arguments));
     }
     CHECK(std::holds_alternative<semantics::SymbolRef>(callee->u));
     const Symbol &symbol{*std::get<semantics::SymbolRef>(callee->u)};
     if (structureConstructor) {
       // Structure constructor misparsed as function reference?

   }
   return false;
 }
 
 void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
-  const parser::Call &call{callStmt.v};
-  auto restorer{GetContextualMessages().SetLocation(call.source)};
-  ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
+  const parser::Call &call{callStmt.call};
+  auto restorer{GetContextualMessages().SetLocation(callStmt.source)};
+  ArgumentAnalyzer analyzer{*this, callStmt.source, true /* isProcedureCall */};
   const auto &actualArgList{std::get<std::list<parser::ActualArgSpec>>(call.t)};
   for (const auto &arg : actualArgList) {
     analyzer.Analyze(arg, true /* is subroutine call */);
   }
   if (!analyzer.fatalErrors()) {
     if (std::optional<CalleeAndArguments> callee{
             GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
                 analyzer.GetActuals(), true /* subroutine */)}) {
       ProcedureDesignator *proc{std::get_if<ProcedureDesignator>(&callee->u)};
       CHECK(proc);
-      if (CheckCall(call.source, *proc, callee->arguments)) {
+      if (CheckCall(callStmt.source, *proc, callee->arguments)) {
         callStmt.typedCall.Reset(
             new ProcedureRef{std::move(*proc), std::move(callee->arguments),
                 HasAlternateReturns(callee->arguments)},
             ProcedureRef::Deleter);
         return;

   if (!name->symbol) {
     return false;
   } else if (name->symbol->Rank() == 0) {
     if (const Symbol *function{
             semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)}) {
-      auto &msg{context.Say(funcRef.v.source,
+      auto &msg{context.Say(funcRef.source,
           function->flags().test(Symbol::Flag::StmtFunction)
               ? "Recursive call to statement function '%s' is not allowed"_err_en_US
               : "Recursive call to '%s' requires a distinct RESULT in its declaration"_err_en_US,
           name->source)};
       AttachDeclaration(&msg, *function);
       name->symbol = const_cast<Symbol *>(function);
     }
     return false;
   } else {
     if (std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t).empty()) {
-      auto &msg{context.Say(funcRef.v.source,
+      auto &msg{context.Say(funcRef.source,
           "Reference to array '%s' with empty subscript list"_err_en_US,
           name->source)};
       if (name->symbol) {
         AttachDeclaration(&msg, *name->symbol);
       }

flang/lib/Semantics/mod-file.cpp

   llvm::raw_ostream &os{isInterface ? decls_ : contains_};
   if (isInterface) {
     os << (isAbstract ? "abstract " : "") << "interface\n";
   }
   PutAttrs(os, prefixAttrs, nullptr, false, ""s, " "s);
+  if (auto attrs{details.cudaSubprogramAttrs()}) {
+    if (*attrs == common::CUDASubprogramAttrs::HostDevice) {
+      os << "attributes(host,device) ";
+    } else {
+      PutLower(os << "attributes(", common::EnumToString(*attrs)) << ") ";
+    }
+    if (!details.cudaLaunchBounds().empty()) {
+      os << "launch_bounds";
+      char sep{'('};
+      for (auto x : details.cudaLaunchBounds()) {
+        os << sep << x;
+        sep = ',';
+      }
+      os << ") ";
+    }
+    if (!details.cudaClusterDims().empty()) {
+      os << "cluster_dims";
+      char sep{'('};
+      for (auto x : details.cudaClusterDims()) {
+        os << sep << x;
+        sep = ',';
+      }
+      os << ") ";
+    }
+  }
   os << (details.isFunction() ? "function " : "subroutine ");
   os << symbol.name() << '(';
   int n = 0;
   for (const auto &dummy : details.dummyArgs()) {
     if (n++ > 0) {

         break;
       }
     });
     os << ") " << symbol.name() << '\n';
   }
+  if (auto attr{details.cudaDataAttr()}) {
+    PutLower(os << "attributes(", common::EnumToString(*attr))
+        << ") " << symbol.name() << '\n';
+  }
 }
 
 void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
   if (symbol.attrs().test(Attr::INTRINSIC)) {
     os << "intrinsic::" << symbol.name() << '\n';

   parser::Parsing parsing{context_.allCookedSources()};
   parser::Options options;
   options.isModuleFile = true;
   options.features.Enable(common::LanguageFeature::BackslashEscapes);
   options.features.Enable(common::LanguageFeature::OpenMP);
+  options.features.Enable(common::LanguageFeature::CUDA);
   if (!isIntrinsic.value_or(false) && !notAModule) {
     // The search for this module file will scan non-intrinsic module
     // directories.  If a directory is in both the intrinsic and non-intrinsic
     // directory lists, the intrinsic module directory takes precedence.
     options.searchDirectories = context_.searchDirectories();

flang/lib/Semantics/resolve-names.cpp

 // Provide Post methods to collect attributes into a member variable.
 class AttrsVisitor : public virtual BaseVisitor {
 public:
   bool BeginAttrs(); // always returns true
   Attrs GetAttrs();
+  std::optional<common::CUDADataAttr> cudaDataAttr() { return cudaDataAttr_; }
   Attrs EndAttrs();
   bool SetPassNameOn(Symbol &);
   void SetBindNameOn(Symbol &);
   void Post(const parser::LanguageBindingSpec &);
   bool Pre(const parser::IntentSpec &);

   HANDLE_ATTR_CLASS(Save, SAVE)
   HANDLE_ATTR_CLASS(Target, TARGET)
   HANDLE_ATTR_CLASS(Value, VALUE)
   HANDLE_ATTR_CLASS(Volatile, VOLATILE)
 #undef HANDLE_ATTR_CLASS
+  bool Pre(const common::CUDADataAttr);
 
 protected:
   std::optional<Attrs> attrs_;
+  std::optional<common::CUDADataAttr> cudaDataAttr_;
 
   Attr AccessSpecToAttr(const parser::AccessSpec &x) {
     switch (x.v) {
     case parser::AccessSpec::Kind::Public:
       return Attr::PUBLIC;

 
   bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);
 };
 
 // Track array specifications. They can occur in AttrSpec, EntityDecl,
-// ObjectDecl, DimensionStmt, CommonBlockObject, or BasedPointerStmt.
+// ObjectDecl, DimensionStmt, CommonBlockObject, BasedPointerStmt, and
+// ComponentDecl.
 // 1. INTEGER, DIMENSION(10) :: x
 // 2. INTEGER :: x(10)
 // 3. ALLOCATABLE :: x(:)
 // 4. DIMENSION :: x(10)
 // 5. COMMON x(10)

   }
   void SetImplicitAttr(Symbol &symbol, Attr attr) const {
     symbol.attrs().set(attr);
     symbol.implicitAttrs().set(attr);
   }
+  void SetCUDADataAttr(
+      SourceName, Symbol &, std::optional<common::CUDADataAttr>);
 
 protected:
   FuncResultStack &funcResultStack() { return funcResultStack_; }
 
   // Apply the implicit type rules to this symbol.

   void Post(const parser::InterfaceBody::Subroutine &);
   bool Pre(const parser::InterfaceBody::Function &);
   void Post(const parser::InterfaceBody::Function &);
   bool Pre(const parser::Suffix &);
   bool Pre(const parser::PrefixSpec &);
+  bool Pre(const parser::PrefixSpec::Attributes &);
+  void Post(const parser::PrefixSpec::Launch_Bounds &);
+  void Post(const parser::PrefixSpec::Cluster_Dims &);
 
   bool BeginSubprogram(const parser::Name &, Symbol::Flag,
       bool hasModulePrefix = false,
       const parser::LanguageBindingSpec * = nullptr,
       const ProgramTree::EntryStmtList * = nullptr);

   void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }
   bool Pre(const parser::TargetStmt &) {
     objectDeclAttr_ = Attr::TARGET;
     return true;
   }
+  bool Pre(const parser::CUDAAttributesStmt &);
   void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
   void Post(const parser::DimensionStmt::Declaration &);
   void Post(const parser::CodimensionDecl &);
   bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
   void Post(const parser::TypeDeclarationStmt &);

   }
   bool Pre(const parser::BlockData &) {
     llvm_unreachable("This node is handled in ProgramUnit");
   }
 
-  void NoteExecutablePartCall(Symbol::Flag, const parser::Call &);
+  void NoteExecutablePartCall(
+      Symbol::Flag, const parser::Call &, bool hasCUDAChevrons);
 
   friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
 
 private:
   // Kind of procedure we are expecting to see in a ProcedureDesignator

   bool BeginScopeForNode(const ProgramTree &);
   void EndScopeForNode(const ProgramTree &);
   void FinishSpecificationParts(const ProgramTree &);
   void FinishDerivedTypeInstantiation(Scope &);
   void ResolveExecutionParts(const ProgramTree &);
+  void UseCUDABuiltinNames();
 };
 
 // ImplicitRules implementation
 
 bool ImplicitRules::isImplicitNoneType() const {

 }
 
 // AttrsVisitor implementation
 
 bool AttrsVisitor::BeginAttrs() {
-  CHECK(!attrs_);
-  attrs_ = std::make_optional<Attrs>();
+  CHECK(!attrs_ && !cudaDataAttr_);
+  attrs_ = Attrs{};
   return true;
 }
 Attrs AttrsVisitor::GetAttrs() {
   CHECK(attrs_);
   return *attrs_;
 }
 Attrs AttrsVisitor::EndAttrs() {
   Attrs result{GetAttrs()};
   attrs_.reset();
+  cudaDataAttr_.reset();
   passName_ = std::nullopt;
   bindName_.reset();
   return result;
 }
 

     return false;
   }
   attrs_->set(attrName);
   return true;
 }
+bool AttrsVisitor::Pre(const common::CUDADataAttr x) {
+  if (cudaDataAttr_.value_or(x) != x) {
+    Say(currStmtSource().value(),
+        "CUDA data attributes '%s' and '%s' may not both be specified"_err_en_US,
+        common::EnumToString(*cudaDataAttr_), common::EnumToString(x));
+  }
+  cudaDataAttr_ = x;
+  return false;
+}
 
 // DeclTypeSpecVisitor implementation
 
 const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
   return state_.declTypeSpec;

   attrs.IterateOverMembers(
       [&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); });
   return ok;
 }
 
+void ScopeHandler::SetCUDADataAttr(SourceName source, Symbol &symbol,
+    std::optional<common::CUDADataAttr> attr) {
+  if (attr) {
+    ConvertToObjectEntity(symbol);
+    if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+      if (*attr != object->cudaDataAttr().value_or(*attr)) {
+        Say(source,
+            "'%s' already has another CUDA data attribute ('%s')"_err_en_US,
+            symbol.name(),
+            common::EnumToString(*object->cudaDataAttr()).substr());
+      } else {
+        object->set_cudaDataAttr(attr);
+      }
+    } else {
+      Say(source,
+          "'%s' is not an object and may not have a CUDA data attribute"_err_en_US,
+          symbol.name());
+    }
+  }
+}
+
 // ModuleVisitor implementation
 
 bool ModuleVisitor::Pre(const parser::Only &x) {
   common::visit(common::visitors{
                     [&](const Indirection<parser::GenericSpec> &generic) {

   if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
     FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
     if (info.parsedType) { // C1543
       Say(currStmtSource().value(),
           "FUNCTION prefix cannot specify the type more than once"_err_en_US);
-      return false;
     } else {
       info.parsedType = parsedType;
       info.source = currStmtSource();
-      return false;
     }
+    return false;
   } else {
     return true;
   }
 }
 
+bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) {
+  if (auto *subp{currScope().symbol()
+              ? currScope().symbol()->detailsIf<SubprogramDetails>()
+              : nullptr}) {
+    for (auto attr : attrs.v) {
+      if (auto current{subp->cudaSubprogramAttrs()}) {
+        if (attr == *current ||
+            (*current == common::CUDASubprogramAttrs::HostDevice &&
+                (attr == common::CUDASubprogramAttrs::Host ||
+                    attr == common::CUDASubprogramAttrs::Device))) {
+          Say(currStmtSource().value(),
+              "ATTRIBUTES(%s) appears more than once"_warn_en_US,
+              common::EnumToString(attr));
+        } else if ((attr == common::CUDASubprogramAttrs::Host ||
+                       attr == common::CUDASubprogramAttrs::Device) &&
+            (*current == common::CUDASubprogramAttrs::Host ||
+                *current == common::CUDASubprogramAttrs::Device ||
+                *current == common::CUDASubprogramAttrs::HostDevice)) {
+          // HOST,DEVICE or DEVICE,HOST -> HostDevice
+          subp->set_cudaSubprogramAttrs(
+              common::CUDASubprogramAttrs::HostDevice);
+        } else {
+          Say(currStmtSource().value(),
+              "ATTRIBUTES(%s) conflicts with earlier ATTRIBUTES(%s)"_err_en_US,
+              common::EnumToString(attr), common::EnumToString(*current));
+        }
+      } else {
+        subp->set_cudaSubprogramAttrs(attr);
+      }
+    }
+  }
+  return false;
+}
+
+void SubprogramVisitor::Post(const parser::PrefixSpec::Launch_Bounds &x) {
+  std::vector<std::int64_t> bounds;
+  bool ok{true};
+  for (const auto &sicx : x.v) {
+    if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
+      bounds.push_back(*value);
+    } else {
+      ok = false;
+    }
+  }
+  if (!ok || bounds.size() != 2) {
+    Say(currStmtSource().value(),
+        "Operands of LAUNCH_BOUNDS() must be two integer constants"_err_en_US);
+  } else if (auto *subp{currScope().symbol()
+                     ? currScope().symbol()->detailsIf<SubprogramDetails>()
+                     : nullptr}) {
+    if (subp->cudaLaunchBounds().empty()) {
+      subp->set_cudaLaunchBounds(std::move(bounds));
+    } else {
+      Say(currStmtSource().value(),
+          "LAUNCH_BOUNDS() may only appear once"_err_en_US);
+    }
+  }
+}
+
+void SubprogramVisitor::Post(const parser::PrefixSpec::Cluster_Dims &x) {
+  std::vector<std::int64_t> dims;
+  bool ok{true};
+  for (const auto &sicx : x.v) {
+    if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
+      dims.push_back(*value);
+    } else {
+      ok = false;
+    }
+  }
+  if (!ok || dims.size() != 3) {
+    Say(currStmtSource().value(),
+        "Operands of CLUSTER_DIMS() must be three integer constants"_err_en_US);
+  } else if (auto *subp{currScope().symbol()
+                     ? currScope().symbol()->detailsIf<SubprogramDetails>()
+                     : nullptr}) {
+    if (subp->cudaClusterDims().empty()) {
+      subp->set_cudaClusterDims(std::move(dims));
+    } else {
+      Say(currStmtSource().value(),
+          "CLUSTER_DIMS() may only appear once"_err_en_US);
+    }
+  }
+}
+
 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
   const auto &name{std::get<parser::Name>(
       std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)};
   return BeginSubprogram(name, Symbol::Flag::Subroutine);
 }

     SayAlreadyDeclared(name, entrySymbol);
     return;
   }
   SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};
   CHECK(entryDetails.entryScope() == &inclusiveScope);
+  SetCUDADataAttr(name.source, entrySymbol, cudaDataAttr());
   entrySymbol.attrs() |= GetAttrs();
   SetBindNameOn(entrySymbol);
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
       if (Symbol * dummy{FindInScope(*dummyName)}) {

 void DeclarationVisitor::Post(const parser::EntityDecl &x) {
   const auto &name{std::get<parser::ObjectName>(x.t)};
   Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
   Symbol &symbol{DeclareUnknownEntity(name, attrs)};
   symbol.ReplaceName(name.source);
+  SetCUDADataAttr(name.source, symbol, cudaDataAttr());
   if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
     ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);
     symbol.set(
         Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors
     Initialization(name, *init, false);

       HandleAttributeStmt(Attr::VALUE, x.v);
 }
 bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {
   return HandleAttributeStmt(Attr::VOLATILE, x.v);
 }
+bool DeclarationVisitor::Pre(const parser::CUDAAttributesStmt &x) {
+  auto attr{std::get<common::CUDADataAttr>(x.t)};
+  for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
+    auto *symbol{FindInScope(name)};
+    if (symbol && symbol->has<UseDetails>()) {
+      Say(currStmtSource().value(),
+          "Cannot apply CUDA data attribute to use-associated '%s'"_err_en_US,
+          name.source);
+    } else {
+      if (!symbol) {
+        symbol = &MakeSymbol(name, ObjectEntityDetails{});
+      }
+      SetCUDADataAttr(name.source, *symbol, attr);
+    }
+  }
+  return false;
+}
 // Handle a statement that sets an attribute on a list of names.
 bool DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const std::list<parser::Name> &names) {
   for (const auto &name : names) {
     HandleAttributeStmt(attr, name);

       }
     }
   }
   if (OkToAddComponent(name)) {
     auto &symbol{DeclareObjectEntity(name, attrs)};
+    SetCUDADataAttr(name.source, symbol, cudaDataAttr());
     if (symbol.has<ObjectEntityDetails>()) {
       if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
         Initialization(name, *init, true);
       }
     }

   }
   if (!dtDetails) {
     attrs.set(Attr::EXTERNAL);
   }
   Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};
+  SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error
   symbol.ReplaceName(name.source);
   if (dtDetails) {
     dtDetails->add_component(symbol);
   }
 }

         !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) &&
         std::holds_alternative<ProcBindingDetails>(details)) {
       attrs.set(Attr::PRIVATE);
     }
     Symbol &result{MakeSymbol(name, attrs, std::move(details))};
+    SetCUDADataAttr(name, result, cudaDataAttr());
     if (result.has<TypeParamDetails>()) {
       derivedType.symbol()->get<DerivedTypeDetails>().add_paramDecl(result);
     }
     return &result;
   }

 bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {
   HandleCall(Symbol::Flag::Function, x.v);
   return false;
 }
 bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) {
-  HandleCall(Symbol::Flag::Subroutine, x.v);
+  HandleCall(Symbol::Flag::Subroutine, x.call);
+  Walk(x.chevrons);
   return false;
 }
 
 bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
   auto &scope{currScope()};

 // Variant of HandleProcedureName() for use while skimming the executable
 // part of a subprogram to catch calls to dummy procedures that are part
 // of the subprogram's interface, and to mark as procedures any symbols
 // that might otherwise have been miscategorized as objects.
 void ResolveNamesVisitor::NoteExecutablePartCall(
-    Symbol::Flag flag, const parser::Call &call) {
+    Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {
   auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
   if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
     // Subtlety: The symbol pointers in the parse tree are not set, because
     // they might end up resolving elsewhere (e.g., construct entities in
     // SELECT TYPE).

       Symbol::Flag other{flag == Symbol::Flag::Subroutine
               ? Symbol::Flag::Function
               : Symbol::Flag::Subroutine};
       if (!symbol->test(other)) {
         ConvertToProcEntity(*symbol);
-        if (symbol->has<ProcEntityDetails>()) {
+        if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
           symbol->set(flag);
           if (IsDummy(*symbol)) {
             SetImplicitAttr(*symbol, Attr::EXTERNAL);
           }
           ApplyImplicitRules(*symbol);
+          if (hasCUDAChevrons) {
+            details->set_isCUDAKernel();
+          }
         }
       }
     }
   }
 }

       common::ScopedSet(specPartState_, SpecificationPartState{})};
   Walk(accDecls);
   Walk(ompDecls);
   Walk(compilerDirectives);
   Walk(useStmts);
+  UseCUDABuiltinNames();
   ClearUseRenames();
   ClearUseOnly();
   ClearModuleUses();
   Walk(importStmts);
   Walk(implicitPart);

   Walk(decls);
   FinishSpecificationPart(decls);
   return false;
 }
 
+void ResolveNamesVisitor::UseCUDABuiltinNames() {
+  if (FindCUDADeviceContext(&currScope())) {
+    if (const Scope * CUDABuiltins{context().GetCUDABuiltinsScope()}) {
+      for (const auto &[name, symbol] : *CUDABuiltins) {
+        if (!FindInScope(name)) {
+          auto &localSymbol{MakeSymbol(name)};
+          localSymbol.set_details(UseDetails{name, *symbol});
+          localSymbol.flags() = symbol->flags();
+        }
+      }
+    }
+  }
+}
+
 // Initial processing on specification constructs, before visiting them.
 void ResolveNamesVisitor::PreSpecificationConstruct(
     const parser::SpecificationConstruct &spec) {
   common::visit(
       common::visitors{

   }
 
   template <typename A> bool Pre(const A &) { return true; }
   template <typename A> void Post(const A &) {}
   void Post(const parser::FunctionReference &fr) {
-    resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v);
+    resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v, false);
   }
   void Post(const parser::CallStmt &cs) {
-    resolver_.NoteExecutablePartCall(Symbol::Flag::Subroutine, cs.v);
+    resolver_.NoteExecutablePartCall(
+        Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());
   }
 
 private:
   ResolveNamesVisitor &resolver_;
 };

 }
 
 void ResolveNamesVisitor::Post(const parser::Program &) {
   // ensure that all temps were deallocated
   CHECK(!attrs_);
+  CHECK(!cudaDataAttr_);
   CHECK(!GetDeclTypeSpec());
 }
 
 // A singleton instance of the scope -> IMPLICIT rules mapping is
 // shared by all instances of ResolveNamesVisitor and accessed by this

flang/lib/Semantics/scope.cpp

     return &*it->second;
   } else if (IsSubmodule()) {
     const Scope *parent{symbol_->get<ModuleDetails>().parent()};
     return parent ? parent->FindSymbol(name) : nullptr;
   } else if (CanImport(name)) {
-    return parent_.FindSymbol(name);
+    return parent_->FindSymbol(name);
   } else {
     return nullptr;
   }
 }
 

   importNames_.insert(name);
 }
 
 // true if name can be imported or host-associated from parent scope.
 bool Scope::CanImport(const SourceName &name) const {
-  if (IsTopLevel() || parent_.IsTopLevel()) {
+  if (IsTopLevel() || parent_->IsTopLevel()) {
     return false;
   }
   switch (GetImportKind()) {
     SWITCH_COVERS_ALL_CASES
   case ImportKind::None:

flang/lib/Semantics/semantics.cpp

       intrinsics_.SupplyBuiltins(*builtinsScope_);
     }
   }
 }
 
+const Scope *SemanticsContext::GetCUDABuiltinsScope() {
+  if (!CUDABuiltinsScope_) {
+    CUDABuiltinsScope_ = GetBuiltinModule("__cuda_builtins");
+  }
+  return *CUDABuiltinsScope_;
+}
+
 void SemanticsContext::UsePPCFortranBuiltinsModule() {
   if (ppcBuiltinsScope_ == nullptr) {
     ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics");
   }
 }

flang/lib/Semantics/symbol.cpp

     os << " moduleInterface: " << *x.moduleInterface_;
   }
   if (x.defaultIgnoreTKR_) {
     os << " defaultIgnoreTKR";
   }
+  if (x.cudaSubprogramAttrs_) {
+    os << " cudaSubprogramAttrs: "
+       << common::EnumToString(*x.cudaSubprogramAttrs_);
+  }
+  if (!x.cudaLaunchBounds_.empty()) {
+    os << " cudaLaunchBounds:";
+    for (auto x : x.cudaLaunchBounds_) {
+      os << ' ' << x;
+    }
+  }
+  if (!x.cudaClusterDims_.empty()) {
+    os << " cudaClusterDims:";
+    for (auto x : x.cudaClusterDims_) {
+      os << ' ' << x;
+    }
+  }
   return os;
 }
 
 void EntityDetails::set_type(const DeclTypeSpec &type) {
   CHECK(!type_);

   }
   if (!x.ignoreTKR_.empty()) {
     os << ' ';
     x.ignoreTKR_.Dump(os, common::EnumToString);
   }
+  if (x.cudaDataAttr()) {
+    os << " cudaDataAttr: " << common::EnumToString(*x.cudaDataAttr());
+  }
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const AssocEntityDetails &x) {

       os << " => " << target->name();
     } else {
       os << " => NULL()";
     }
   }
+  if (x.isCUDAKernel()) {
+    os << " isCUDAKernel";
+  }
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const DerivedTypeDetails &x) {

flang/lib/Semantics/tools.cpp

     }
     return false;
   }
   bool operator()(const parser::CallStmt &stmt) {
     const auto &procedureDesignator{
-        std::get<parser::ProcedureDesignator>(stmt.v.t)};
+        std::get<parser::ProcedureDesignator>(stmt.call.t)};
     if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
       // TODO: also ensure that the procedure is, in fact, an intrinsic
       if (name->source == "move_alloc") {
-        const auto &args{std::get<std::list<parser::ActualArgSpec>>(stmt.v.t)};
+        const auto &args{
+            std::get<std::list<parser::ActualArgSpec>>(stmt.call.t)};
         if (!args.empty()) {
           const parser::ActualArg &actualArg{
               std::get<parser::ActualArg>(args.front().t)};
           if (const auto *argExpr{
                   std::get_if<common::Indirection<parser::Expr>>(

 
 bool IsPolymorphicAllocatable(const Symbol &symbol) {
   return IsAllocatable(symbol) && IsPolymorphic(symbol);
 }
 
+const Scope *FindCUDADeviceContext(const Scope *scope) {
+  return !scope ? nullptr : FindScopeContaining(*scope, [](const Scope &s) {
+    return IsCUDADeviceContext(&s);
+  });
+}
+
+std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *symbol) {
+  const auto *object{
+      symbol ? symbol->detailsIf<ObjectEntityDetails>() : nullptr};
+  return object ? object->cudaDataAttr() : std::nullopt;
+}
+
 std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
     const Scope &scope, const Symbol &symbol) {
   if (symbol.attrs().test(Attr::PRIVATE)) {
     if (FindModuleFileContaining(scope)) {
       // Don't enforce component accessibility checks in module files;

flang/module/__fortran_builtins.f90

   end type
 
   integer, parameter :: __builtin_atomic_int_kind = selected_int_kind(18)
   integer, parameter :: __builtin_atomic_logical_kind = __builtin_atomic_int_kind
 
+  procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
+
+  type :: __builtin_dim3
+    integer :: x=1, y=1, z=1
+  end type
+  type(__builtin_dim3) :: &
+    __builtin_threadIdx, __builtin_blockDim, __builtin_blockIdx, __builtin_gridDim
+  integer, parameter :: __builtin_warpsize = 32
+
   intrinsic :: __builtin_ieee_is_nan, __builtin_ieee_is_negative, &
     __builtin_ieee_is_normal
   intrinsic :: __builtin_ieee_next_after, __builtin_ieee_next_down, &
     __builtin_ieee_next_up
   intrinsic :: scale ! for ieee_scalb

flang/test/Parser/cuf-sanity-common

+! Common source for CUF parse tree and unparsing tests.
+!@cuf subroutine atcuf;
+end
+
+#ifdef _CUDA
+    subroutine cudadefd;
+end
+#endif
+
+module m
+  real, allocatable, pinned ::pa(:)
+ contains
+  attributes(device) subroutine devicesub; end
+  attributes(device) real function devicefunc(); devicefunc = 1.; end
+  attributes(global) subroutine globalsub; end
+  attributes(grid_global) subroutine gridglobalsub; end
+  attributes(host) subroutine hostsub; end
+  attributes(global) launch_bounds(1, 2) subroutine lbsub; end
+  attributes(global) cluster_dims(1, 2, 3) subroutine cdsub; end
+  attributes(device) subroutine attrs
+    attributes(device) :: devx1
+    real, device :: devx2
+  end subroutine
+  subroutine test
+    logical isPinned
+    !$cuf kernel do(1) <<<*, *, stream = 1>>>
+    do j = 1, 10
+    end do
+    !$cuf kernel do <<<1, (2, 3), stream = 1>>>
+    do j = 1, 10
+    end do
+    call globalsub<<<1, 2>>>
+    call globalsub<<<1, 2, 3>>>
+    call globalsub<<<1, 2, 3, 4>>>
+    allocate(pa(32), stream = 1, pinned = isPinned)
+  end subroutine
+end module

flang/test/Parser/cuf-sanity-tree.CUF

+! RUN: %flang_fc1 -fdebug-dump-parse-tree %s 2>&1 | FileCheck %s
+include "cuf-sanity-common"
+!CHECK: Program -> ProgramUnit -> SubroutineSubprogram
+!CHECK: | SubroutineStmt
+!CHECK: | | Name = 'atcuf'
+!CHECK: | SpecificationPart
+!CHECK: | | ImplicitPart -> 
+!CHECK: | ExecutionPart -> Block
+!CHECK: | EndSubroutineStmt -> 
+!CHECK: ProgramUnit -> SubroutineSubprogram
+!CHECK: | SubroutineStmt
+!CHECK: | | Name = 'cudadefd'
+!CHECK: | SpecificationPart
+!CHECK: | | ImplicitPart -> 
+!CHECK: | ExecutionPart -> Block
+!CHECK: | EndSubroutineStmt -> 
+!CHECK: ProgramUnit -> Module
+!CHECK: | ModuleStmt -> Name = 'm'
+!CHECK: | SpecificationPart
+!CHECK: | | ImplicitPart -> 
+!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt
+!CHECK: | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> Real
+!CHECK: | | | AttrSpec -> Allocatable
+!CHECK: | | | AttrSpec -> CUDADataAttr = Pinned
+!CHECK: | | | EntityDecl
+!CHECK: | | | | Name = 'pa'
+!CHECK: | | | | ArraySpec -> DeferredShapeSpecList -> int
+!CHECK: | ModuleSubprogramPart
+!CHECK: | | ContainsStmt
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Device
+!CHECK: | | | | Name = 'devicesub'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | | ModuleSubprogram -> FunctionSubprogram
+!CHECK: | | | FunctionStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Device
+!CHECK: | | | | PrefixSpec -> DeclarationTypeSpec -> IntrinsicTypeSpec -> Real
+!CHECK: | | | | Name = 'devicefunc'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'devicefunc=1._4'
+!CHECK: | | | | | Variable = 'devicefunc'
+!CHECK: | | | | | | Designator -> DataRef -> Name = 'devicefunc'
+!CHECK: | | | | | Expr = '1._4'
+!CHECK: | | | | | | LiteralConstant -> RealLiteralConstant
+!CHECK: | | | | | | | Real = '1.'
+!CHECK: | | | EndFunctionStmt -> 
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Global
+!CHECK: | | | | Name = 'globalsub'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Grid_Global
+!CHECK: | | | | Name = 'gridglobalsub'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Host
+!CHECK: | | | | Name = 'hostsub'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Global
+!CHECK: | | | | PrefixSpec -> Launch_Bounds -> Scalar -> Integer -> Constant -> Expr = '1_4'
+!CHECK: | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | Scalar -> Integer -> Constant -> Expr = '2_4'
+!CHECK: | | | | | LiteralConstant -> IntLiteralConstant = '2'
+!CHECK: | | | | Name = 'lbsub'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Global
+!CHECK: | | | | PrefixSpec -> Cluster_Dims -> Scalar -> Integer -> Constant -> Expr = '1_4'
+!CHECK: | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | Scalar -> Integer -> Constant -> Expr = '2_4'
+!CHECK: | | | | | LiteralConstant -> IntLiteralConstant = '2'
+!CHECK: | | | | Scalar -> Integer -> Constant -> Expr = '3_4'
+!CHECK: | | | | | LiteralConstant -> IntLiteralConstant = '3'
+!CHECK: | | | | Name = 'cdsub'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | PrefixSpec -> Attributes -> CUDASubprogramAttrs = Device
+!CHECK: | | | | Name = 'attrs'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | | DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt
+!CHECK: | | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> Real
+!CHECK: | | | | | AttrSpec -> CUDADataAttr = Device
+!CHECK: | | | | | EntityDecl
+!CHECK: | | | | | | Name = 'devx2'
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | | ModuleSubprogram -> SubroutineSubprogram
+!CHECK: | | | SubroutineStmt
+!CHECK: | | | | Name = 'test'
+!CHECK: | | | SpecificationPart
+!CHECK: | | | | ImplicitPart -> 
+!CHECK: | | | | DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt
+!CHECK: | | | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> Logical
+!CHECK: | | | | | EntityDecl
+!CHECK: | | | | | | Name = 'ispinned'
+!CHECK: | | | ExecutionPart -> Block
+!CHECK: | | | | ExecutionPartConstruct -> ExecutableConstruct -> CUFKernelDoConstruct
+!CHECK: | | | | | Directive
+!CHECK: | | | | | | Scalar -> Integer -> Constant -> Expr = '1_4'
+!CHECK: | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | | Scalar -> Integer -> Expr = '1_4'
+!CHECK: | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | DoConstruct
+!CHECK: | | | | | | NonLabelDoStmt
+!CHECK: | | | | | | | LoopControl -> LoopBounds
+!CHECK: | | | | | | | | Scalar -> Name = 'j'
+!CHECK: | | | | | | | | Scalar -> Expr = '1_4'
+!CHECK: | | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | | | | Scalar -> Expr = '10_4'
+!CHECK: | | | | | | | | | LiteralConstant -> IntLiteralConstant = '10'
+!CHECK: | | | | | | Block
+!CHECK: | | | | | | EndDoStmt -> 
+!CHECK: | | | | ExecutionPartConstruct -> ExecutableConstruct -> CUFKernelDoConstruct
+!CHECK: | | | | | Directive
+!CHECK: | | | | | | Scalar -> Integer -> Expr = '1_4'
+!CHECK: | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | | Scalar -> Integer -> Expr = '2_4'
+!CHECK: | | | | | | | LiteralConstant -> IntLiteralConstant = '2'
+!CHECK: | | | | | | Scalar -> Integer -> Expr = '3_4'
+!CHECK: | | | | | | | LiteralConstant -> IntLiteralConstant = '3'
+!CHECK: | | | | | | Scalar -> Integer -> Expr = '1_4'
+!CHECK: | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | DoConstruct
+!CHECK: | | | | | | NonLabelDoStmt
+!CHECK: | | | | | | | LoopControl -> LoopBounds
+!CHECK: | | | | | | | | Scalar -> Name = 'j'
+!CHECK: | | | | | | | | Scalar -> Expr = '1_4'
+!CHECK: | | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | | | | Scalar -> Expr = '10_4'
+!CHECK: | | | | | | | | | LiteralConstant -> IntLiteralConstant = '10'
+!CHECK: | | | | | | Block
+!CHECK: | | | | | | EndDoStmt -> 
+!CHECK: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> CallStmt = 'CALL globalsub()'
+!CHECK: | | | | | Call
+!CHECK: | | | | | | ProcedureDesignator -> Name = 'globalsub'
+!CHECK: | | | | | Chevrons
+!CHECK: | | | | | | Scalar -> Expr -> LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | | Scalar -> Expr -> LiteralConstant -> IntLiteralConstant = '2'
+!CHECK: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> CallStmt = 'CALL globalsub()'
+!CHECK: | | | | | Call
+!CHECK: | | | | | | ProcedureDesignator -> Name = 'globalsub'
+!CHECK: | | | | | Chevrons
+!CHECK: | | | | | | Scalar -> Expr -> LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | | Scalar -> Expr -> LiteralConstant -> IntLiteralConstant = '2'
+!CHECK: | | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '3'
+!CHECK: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> CallStmt = 'CALL globalsub()'
+!CHECK: | | | | | Call
+!CHECK: | | | | | | ProcedureDesignator -> Name = 'globalsub'
+!CHECK: | | | | | Chevrons
+!CHECK: | | | | | | Scalar -> Expr -> LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | | Scalar -> Expr -> LiteralConstant -> IntLiteralConstant = '2'
+!CHECK: | | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '3'
+!CHECK: | | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
+!CHECK: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
+!CHECK: | | | | | Allocation
+!CHECK: | | | | | | AllocateObject = 'pa'
+!CHECK: | | | | | | | Name = 'pa'
+!CHECK: | | | | | | AllocateShapeSpec
+!CHECK: | | | | | | | Scalar -> Integer -> Expr = '32_4'
+!CHECK: | | | | | | | | LiteralConstant -> IntLiteralConstant = '32'
+!CHECK: | | | | | AllocOpt -> Stream -> Scalar -> Integer -> Expr = '1_4'
+!CHECK: | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK: | | | | | AllocOpt -> Pinned -> Scalar -> Logical -> Variable = 'ispinned'
+!CHECK: | | | | | | Designator -> DataRef -> Name = 'ispinned'
+!CHECK: | | | EndSubroutineStmt -> 
+!CHECK: | EndModuleStmt -> 

flang/test/Parser/cuf-sanity-unparse.CUF

+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+include "cuf-sanity-common"
+!CHECK: SUBROUTINE atcuf
+!CHECK: END SUBROUTINE
+!CHECK: SUBROUTINE cudadefd
+!CHECK: END SUBROUTINE
+!CHECK: MODULE m
+!CHECK:  REAL, ALLOCATABLE, PINNED :: pa(:)
+!CHECK: CONTAINS
+!CHECK:  ATTRIBUTES(DEVICE) SUBROUTINE devicesub
+!CHECK:  END SUBROUTINE
+!CHECK:  ATTRIBUTES(DEVICE) REAL FUNCTION devicefunc()
+!CHECK:    devicefunc=1._4
+!CHECK:  END FUNCTION
+!CHECK:  ATTRIBUTES(GLOBAL) SUBROUTINE globalsub
+!CHECK:  END SUBROUTINE
+!CHECK:  ATTRIBUTES(GRID_GLOBAL) SUBROUTINE gridglobalsub
+!CHECK:  END SUBROUTINE
+!CHECK:  ATTRIBUTES(HOST) SUBROUTINE hostsub
+!CHECK:  END SUBROUTINE
+!CHECK:  ATTRIBUTES(GLOBAL) LAUNCH_BOUNDS(1_4, 2_4) SUBROUTINE lbsub
+!CHECK:  END SUBROUTINE
+!CHECK:  ATTRIBUTES(GLOBAL) CLUSTER_DIMS(1_4, 2_4, 3_4) SUBROUTINE cdsub
+!CHECK:  END SUBROUTINE
+!CHECK:  ATTRIBUTES(DEVICE) SUBROUTINE attrs
+!CHECK:   REAL, DEVICE :: devx2
+!CHECK:  END SUBROUTINE
+!CHECK:  SUBROUTINE test
+!CHECK:   LOGICAL ispinned
+!CHECK:   !$CUF KERNEL DO (1_4) <<<*,*,STREAM=1_4>>>
+!CHECK:   DO j=1_4,10_4
+!CHECK:   END DO
+!CHECK:   !$CUF KERNEL DO <<<1_4,(2_4,3_4),STREAM=1_4>>>
+!CHECK:   DO j=1_4,10_4
+!CHECK:   END DO
+!CHECK:    CALL globalsub<<<1,2>>>
+!CHECK:    CALL globalsub<<<1,2,3>>>
+!CHECK:    CALL globalsub<<<1,2,3,4>>>
+!CHECK:   ALLOCATE(pa(32_4), STREAM=1_4, PINNED=ispinned)
+!CHECK:  END SUBROUTINE
+!CHECK: END MODULE

flang/test/Semantics/cuf01.cuf

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test conflicting CUDA subprogram attributes
+module m1
+ contains
+  !WARNING: ATTRIBUTES(Host) appears more than once
+  attributes(host,host) subroutine ok1; end
+  !WARNING: ATTRIBUTES(Host) appears more than once
+  attributes(host) attributes(host) subroutine ok2; end
+  attributes(host,device) subroutine ok3; end
+  attributes(device,host) subroutine ok4; end
+  !WARNING: ATTRIBUTES(Host) appears more than once
+  attributes(host,device,host) subroutine ok5; end
+  !WARNING: ATTRIBUTES(Device) appears more than once
+  attributes(device,host,device) subroutine ok6; end
+  !ERROR: ATTRIBUTES(Global) conflicts with earlier ATTRIBUTES(Host)
+  attributes(host,global) subroutine conflict1; end
+  !ERROR: ATTRIBUTES(Host) conflicts with earlier ATTRIBUTES(Global)
+  attributes(global,host) subroutine conflict2; end
+  !ERROR: ATTRIBUTES(Grid_Global) conflicts with earlier ATTRIBUTES(Host)
+  attributes(host,grid_global) subroutine conflict3; end
+  !TODO: more with launch_bounds & cluster_dims
+end module

flang/test/Semantics/modfile55.cuf

+! RUN: %python %S/test_modfile.py %s %flang_fc1
+! Sanity check for CUDA Fortran attributes in module files
+module m
+  attributes(device) dd
+  real, managed, allocatable :: md
+  real, pinned, allocatable :: mp
+  attributes(constant) cd
+ contains
+  attributes(global) subroutine globsub(x,y,z)
+    real, value :: x
+    real, device :: y
+    real, managed :: z
+  end subroutine
+  attributes(host,device) real function foo(x)
+    foo = x + 1.
+  end function
+end
+
+!Expect: m.mod
+!module m
+!real(4)::dd
+!attributes(device) dd
+!real(4),allocatable::md
+!attributes(managed) md
+!real(4),allocatable::mp
+!attributes(pinned) mp
+!real(4)::cd
+!attributes(constant) cd
+!contains
+!attributes(global) subroutine globsub(x,y,z)
+!real(4),value::x
+!real(4)::y
+!attributes(device) y
+!real(4)::z
+!attributes(managed) z
+!end
+!attributes(host,device) function foo(x)
+!real(4)::x
+!real(4)::foo
+!end
+!end

flang/test/lib/lit.local.cfg

 
-# Excluding .cpp file from the extensions since from this level down they are used for the development 
+# Excluding .cpp file from the extensions since from this level down they are used for the development
 config.suffixes = ['.c', '.f', '.F', '.ff', '.FOR', '.for', '.f77', '.f90', '.F90',
-                   '.ff90', '.f95', '.F95', '.ff95', '.fpp', '.FPP', '.cuf'
+                   '.ff90', '.f95', '.F95', '.ff95', '.fpp', '.FPP', '.cuf',
                    '.CUF', '.f18', '.F18', '.f03', '.F03', '.f08', '.F08',
                    '.ll', '.fir', '.mlir']
 

flang/test/lit.cfg.py

 # the test runner updated.
 config.test_format = lit.formats.ShTest(not llvm_config.use_lit_shell)
 
 # suffixes: A list of file extensions to treat as test files.
 config.suffixes = ['.c', '.cpp', '.f', '.F', '.ff', '.FOR', '.for', '.f77', '.f90', '.F90',
-                   '.ff90', '.f95', '.F95', '.ff95', '.fpp', '.FPP', '.cuf'
+                   '.ff90', '.f95', '.F95', '.ff95', '.fpp', '.FPP', '.cuf',
                    '.CUF', '.f18', '.F18', '.f03', '.F03', '.f08', '.F08',
                    '.ll', '.fir', '.mlir']
 
 config.substitutions.append(('%PATH%', config.environment['PATH']))
 config.substitutions.append(('%llvmshlibdir', config.llvm_shlib_dir))