[flang] Semantics for !DIR$ IGNORE_TKR

[klausler]

Summary

Implement semantics for the IGNORE_TKR directive as it is interpreted
by the PGI / NVFORTRAN compiler.

flang/docs/Directives.md

 <!--===- docs/Directives.md 
   
    Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
    See https://llvm.org/LICENSE.txt for license information.
    SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   
 -->
 
 # Compiler directives supported by Flang
 
 A list of non-standard directives supported by Flang
 
 * `!dir$ fixed` and `!dir$ free` select Fortran source forms.  Their effect
   persists to the end of the current source file.
-* `!dir$ ignore_tkr (tkr) var-list` omits checks on type, kind, and/or rank.
+* `!dir$ ignore_tkr [[(TKRDMAC)] dummy-arg-name]...` in an interface definition
+  disables some semantic checks at call sites for the actual arguments that
+  correspond to some named dummy arguments (or all of them, by default).
+  The directive allow actual arguments that would otherwise be diagnosed
+  as incompatible in type (T), kind (K), rank (R), CUDA device (D), or
+  managed (M) status.  The letter (A) is a shorthand for all of these,
+  and is the default when no letters appear.  The letter (C) is a legacy
+  no-op.  For example, if one wanted to call a "set all bytes to zero"
+  utility that could be applied to arrays of any type or rank:
+```
+  interface
+    subroutine clear(arr,bytes)
+!dir$ ignore_tkr arr
+      integer(1), intent(out) :: arr(bytes)
+    end
+  end interface
+```

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

 //===-- include/flang/Common/Fortran-features.h -----------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_COMMON_FORTRAN_FEATURES_H_
 #define FORTRAN_COMMON_FORTRAN_FEATURES_H_
 
 #include "flang/Common/Fortran.h"
 #include "flang/Common/enum-set.h"
 #include "flang/Common/idioms.h"
+#include <vector>
 
 namespace Fortran::common {
 
 ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     FixedFormContinuationWithColumn1Ampersand, LogicalAbbreviations,
     XOROperator, PunctuationInNames, OptionalFreeFormSpace, BOZExtensions,
     EmptyStatement, AlternativeNE, ExecutionPartNamelist, DECStructures,
     DoubleComplex, Byte, StarKind, ExponentMatchingKindParam, QuadPrecision,

flang/include/flang/Common/Fortran.h

 //===-- include/flang/Common/Fortran.h --------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_COMMON_FORTRAN_H_
 #define FORTRAN_COMMON_FORTRAN_H_
 
 // Fortran language concepts that are used in many phases are defined
 // once here to avoid redundancy and needless translation.
 
+#include "enum-set.h"
 #include "idioms.h"
 #include <cinttypes>
-#include <vector>
+#include <string>
 
 namespace Fortran::common {
 
 // Fortran has five kinds of intrinsic data types, plus the derived types.
 ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived)
 
 constexpr bool IsNumericTypeCategory(TypeCategory category) {
   return category == TypeCategory::Integer || category == TypeCategory::Real ||

 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};
 
 // 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
+ENUM_CLASS(IgnoreTKR,
+    Type, // T - don't check type category
+    Kind, // K - don't check kind
+    Rank, // R - don't check ranks
+    Device, // D - don't check host/device residence
+    Managed, // M - don't check managed storage
+    Contiguous) // C - legacy; disabled NVFORTRAN's convention that leading
+                // dimension of assumed-shape was contiguous
+using IgnoreTKRSet = EnumSet<IgnoreTKR, 8>;
+// IGNORE_TKR(A) = IGNORE_TKR(TKRDM)
+static constexpr IgnoreTKRSet ignoreTKRAll{IgnoreTKR::Type, IgnoreTKR::Kind,
+    IgnoreTKR::Rank, IgnoreTKR::Device, IgnoreTKR::Managed};
+std::string AsFortran(IgnoreTKRSet);
+
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_FORTRAN_H_

flang/include/flang/Common/enum-class.h

 //===-- include/flang/Common/enum-class.h -----------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 // The macro
 //   ENUM_CLASS(className, enum1, enum2, ..., enumN)
 // defines
 //   enum class className { enum1, enum2, ... , enumN };
 // as well as the introspective utilities
 //   static constexpr std::size_t className_enumSize{N};
-//   static inline const std::string &EnumToString(className);
+//   static inline const std::string_view EnumToString(className);
 
 #ifndef FORTRAN_COMMON_ENUM_CLASS_H_
 #define FORTRAN_COMMON_ENUM_CLASS_H_
 
 #include <array>
 #include <string>
 
 namespace Fortran::common {

flang/include/flang/Evaluate/characteristics.h

struct DummyDataObject {
   static std::optional<DummyDataObject> Characterize(
       const semantics::Symbol &, FoldingContext &);
   bool CanBePassedViaImplicitInterface() const;
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
   TypeAndShape type;
   std::vector<Expr<SubscriptInteger>> coshape;
   common::Intent intent{common::Intent::Default};
   Attrs attrs;
+  common::IgnoreTKRSet ignoreTKR;
 };
 
 // 15.3.2.3
 struct DummyProcedure {
   ENUM_CLASS(Attr, Pointer, Optional)
   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
   explicit DummyProcedure(Procedure &&);

flang/include/flang/Evaluate/tools.h

 const Symbol &GetUsedModule(const UseDetails &);
 const Symbol *FindFunctionResult(const Symbol &);
 
 // Type compatibility predicate: are x and y effectively the same type?
 // Uses DynamicType::IsTkCompatible(), which handles the case of distinct
 // but identical derived types.
 bool AreTkCompatibleTypes(const DeclTypeSpec *x, const DeclTypeSpec *y);
 
+common::IgnoreTKRSet GetIgnoreTKR(const Symbol &);
+
 } // namespace Fortran::semantics
 
 #endif // FORTRAN_EVALUATE_TOOLS_H_

flang/include/flang/Evaluate/type.h

 #include <type_traits>
 #include <variant>
 
 namespace Fortran::semantics {
 class DeclTypeSpec;
 class DerivedTypeSpec;
 class ParamValue;
 class Symbol;
+// IsDescriptor() is true when an object requires the use of a descriptor
+// in memory when "at rest".  IsPassedViaDescriptor() is sometimes false
+// when IsDescriptor() is true, including the cases of CHARACTER dummy
+// arguments and explicit & assumed-size dummy arrays.
 bool IsDescriptor(const Symbol &);
+bool IsPassedViaDescriptor(const Symbol &);
 } // namespace Fortran::semantics
 
 namespace Fortran::evaluate {
 
 using common::TypeCategory;
 class TargetCharacteristics;
 
 // Specific intrinsic types are represented by specializations of
#endif
   bool HasDeferredTypeParameter() const;
 
   // 7.3.2.3 & 15.5.2.4 type compatibility.
   // x.IsTkCompatibleWith(y) is true if "x => y" or passing actual y to
   // dummy argument x would be valid.  Be advised, this is not a reflexive
   // relation.  Kind type parameters must match, but CHARACTER lengths
   // need not do so.
   bool IsTkCompatibleWith(const DynamicType &) const;
+  bool IsTkCompatibleWith(const DynamicType &, common::IgnoreTKRSet) const;
 
   // A stronger compatibility check that does not allow distinct known
   // values for CHARACTER lengths for e.g. MOVE_ALLOC().
   bool IsTkLenCompatibleWith(const DynamicType &) const;
 
   // EXTENDS_TYPE_OF (16.9.76); ignores type parameter values
   std::optional<bool> ExtendsTypeOf(const DynamicType &) const;
   // SAME_TYPE_AS (16.9.165); ignores type parameter values

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

 template <typename V> void Walk(const format::FormatItem &, V &);
 template <typename M> void Walk(format::FormatItem &, M &);
 template <typename V> void Walk(const format::FormatSpecification &, V &);
 template <typename M> void Walk(format::FormatSpecification &, M &);
 template <typename V> void Walk(const format::IntrinsicTypeDataEditDesc &, V &);
 template <typename M> void Walk(format::IntrinsicTypeDataEditDesc &, M &);
 
 // Traversal of needed STL template classes (optional, list, tuple, variant)
-template <typename T, typename V>
-void Walk(const std::optional<T> &x, V &visitor) {
-  if (x) {
-    Walk(*x, visitor);
-  }
-}
-template <typename T, typename M> void Walk(std::optional<T> &x, M &mutator) {
-  if (x) {
-    Walk(*x, mutator);
-  }
-}
 // For most lists, just traverse the elements; but when a list constitutes
 // a Block (i.e., std::list<ExecutionPartConstruct>), also invoke the
 // visitor/mutator on the list itself.
 template <typename T, typename V> void Walk(const std::list<T> &x, V &visitor) {
   for (const auto &elem : x) {
     Walk(elem, visitor);
   }
 }

 template <typename M> void Walk(Block &x, M &mutator) {
   if (mutator.Pre(x)) {
     for (auto &elem : x) {
       Walk(elem, mutator);
     }
     mutator.Post(x);
   }
 }
+template <typename T, typename V>
+void Walk(const std::optional<T> &x, V &visitor) {
+  if (x) {
+    Walk(*x, visitor);
+  }
+}
+template <typename T, typename M> void Walk(std::optional<T> &x, M &mutator) {
+  if (x) {
+    Walk(*x, mutator);
+  }
+}
 template <std::size_t I = 0, typename Func, typename T>
 void ForEachInTuple(const T &tuple, Func func) {
   func(std::get<I>(tuple));
   if constexpr (I + 1 < std::tuple_size_v<T>) {
     ForEachInTuple<I + 1>(tuple, func);
   }
 }
 template <typename V, typename... A>

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

 //         function-name ( [dummy-arg-name-list] ) = scalar-expr
 struct StmtFunctionStmt {
   TUPLE_CLASS_BOILERPLATE(StmtFunctionStmt);
   std::tuple<Name, std::list<Name>, Scalar<Expr>> t;
   Statement<ActionStmt> ConvertToAssignment();
 };
 
 // Compiler directives
-// !DIR$ IGNORE_TKR [ [(tkr...)] name ]...
+// !DIR$ IGNORE_TKR [ [(tkrdmac...)] name ]...
 // !DIR$ LOOP COUNT (n1[, n2]...)
 // !DIR$ name...
 struct CompilerDirective {
   UNION_CLASS_BOILERPLATE(CompilerDirective);
   struct IgnoreTKR {
     TUPLE_CLASS_BOILERPLATE(IgnoreTKR);
-    std::tuple<std::list<const char *>, Name> t;
+    std::tuple<std::optional<std::list<const char *>>, Name> t;
   };
   struct LoopCount {
     WRAPPER_CLASS_BOILERPLATE(LoopCount, std::list<std::uint64_t>);
   };
   struct NameValue {
     TUPLE_CLASS_BOILERPLATE(NameValue);
     std::tuple<Name, std::optional<std::uint64_t>> t;
   };

flang/include/flang/Semantics/symbol.h

public:
   void set_stmtFunction(SomeExpr &&expr) { stmtFunction_ = std::move(expr); }
   Symbol *moduleInterface() { return moduleInterface_; }
   const Symbol *moduleInterface() const { return moduleInterface_; }
   void set_moduleInterface(Symbol &);
   void ReplaceResult(Symbol &result) {
     CHECK(result_ != nullptr);
     result_ = &result;
   }
+  bool defaultIgnoreTKR() const { return defaultIgnoreTKR_; }
+  void set_defaultIgnoreTKR(bool yes) { defaultIgnoreTKR_ = yes; }
 
 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
   Symbol *result_{nullptr};
   Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope
   MaybeExpr stmtFunction_;
   // 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};
 
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const SubprogramDetails &);
 };
 
 // For SubprogramNameDetails, the kind indicates whether it is the name
 // of a module subprogram or an internal subprogram or ENTRY.
 ENUM_CLASS(SubprogramKind, Module, Internal)
public:
   ArraySpec &coshape() { return coshape_; }
   const ArraySpec &coshape() const { return coshape_; }
   void set_shape(const ArraySpec &);
   void set_coshape(const ArraySpec &);
   const Symbol *commonBlock() const { return commonBlock_; }
   void set_commonBlock(const Symbol &commonBlock) {
     commonBlock_ = &commonBlock;
   }
+  common::IgnoreTKRSet ignoreTKR() const { return ignoreTKR_; }
+  void set_ignoreTKR(common::IgnoreTKRSet set) { ignoreTKR_ = set; }
   bool IsArray() const { return !shape_.empty(); }
   bool IsCoarray() const { return !coshape_.empty(); }
   bool CanBeAssumedShape() const {
     return isDummy() && shape_.CanBeAssumedShape();
   }
   bool CanBeDeferredShape() const { return shape_.CanBeDeferredShape(); }
   bool IsAssumedSize() const { return isDummy() && shape_.CanBeAssumedSize(); }
   bool IsAssumedRank() const { return isDummy() && shape_.IsAssumedRank(); }
 
 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
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const ObjectEntityDetails &);
 };
 
 // Mixin for details with passed-object dummy argument.
 // If a procedure pointer component or type-bound procedure does not have
 // the NOPASS attribute on its symbol, then PASS is assumed; the name

flang/lib/Common/Fortran.cpp

case DefinedIo::ReadUnformatted:
     return "read(unformatted)";
   case DefinedIo::WriteFormatted:
     return "write(formatted)";
   case DefinedIo::WriteUnformatted:
     return "write(unformatted)";
   }
 }
 
+std::string AsFortran(IgnoreTKRSet tkr) {
+  std::string result;
+  if (tkr.test(IgnoreTKR::Type)) {
+    result += 'T';
+  }
+  if (tkr.test(IgnoreTKR::Kind)) {
+    result += 'K';
+  }
+  if (tkr.test(IgnoreTKR::Rank)) {
+    result += 'R';
+  }
+  if (tkr.test(IgnoreTKR::Device)) {
+    result += 'D';
+  }
+  if (tkr.test(IgnoreTKR::Managed)) {
+    result += 'M';
+  }
+  if (tkr.test(IgnoreTKR::Contiguous)) {
+    result += 'C';
+  }
+  return result;
+}
+
 } // namespace Fortran::common

flang/lib/Evaluate/characteristics.cpp

if (intent != actual.intent) {
     return false;
   }
   if (coshape != actual.coshape) {
     if (whyNot) {
       *whyNot = "incompatible dummy data object coshapes";
     }
     return false;
   }
+  if (ignoreTKR != actual.ignoreTKR) {
+    if (whyNot) {
+      *whyNot = "incompatible !DIR$ IGNORE_TKR directives";
+    }
+  }
   return true;
 }
 
 static common::Intent GetIntent(const semantics::Attrs &attrs) {
   if (attrs.test(semantics::Attr::INTENT_IN)) {
     return common::Intent::In;
   } else if (attrs.test(semantics::Attr::INTENT_OUT)) {
     return common::Intent::Out;
   } else if (attrs.test(semantics::Attr::INTENT_INOUT)) {
     return common::Intent::InOut;
   } else {
     return common::Intent::Default;
   }
 }
 
 std::optional<DummyDataObject> DummyDataObject::Characterize(
     const semantics::Symbol &symbol, FoldingContext &context) {
-  if (symbol.has<semantics::ObjectEntityDetails>() ||
-      symbol.has<semantics::EntityDetails>()) {
+  if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
+      object || symbol.has<semantics::EntityDetails>()) {
     if (auto type{TypeAndShape::Characterize(symbol, context)}) {
       std::optional<DummyDataObject> result{std::move(*type)};
       using semantics::Attr;
       CopyAttrs<DummyDataObject, DummyDataObject::Attr>(symbol, *result,
           {
               {Attr::OPTIONAL, DummyDataObject::Attr::Optional},
               {Attr::ALLOCATABLE, DummyDataObject::Attr::Allocatable},
               {Attr::ASYNCHRONOUS, DummyDataObject::Attr::Asynchronous},
               {Attr::CONTIGUOUS, DummyDataObject::Attr::Contiguous},
               {Attr::VALUE, DummyDataObject::Attr::Value},
               {Attr::VOLATILE, DummyDataObject::Attr::Volatile},
               {Attr::POINTER, DummyDataObject::Attr::Pointer},
               {Attr::TARGET, DummyDataObject::Attr::Target},
           });
       result->intent = GetIntent(symbol.attrs());
+      result->ignoreTKR = GetIgnoreTKR(symbol);
       return result;
     }
   }
   return std::nullopt;
 }
 
 bool DummyDataObject::CanBePassedViaImplicitInterface() const {
   if ((attrs &
int FindLastToDistinguishByName(
       const DummyArguments &, const DummyArguments &) const;
   int CountCompatibleWith(const DummyArgument &, const DummyArguments &) const;
   int CountNotDistinguishableFrom(
       const DummyArgument &, const DummyArguments &) const;
   bool Distinguishable(const DummyArgument &, const DummyArgument &) const;
   bool Distinguishable(const DummyDataObject &, const DummyDataObject &) const;
   bool Distinguishable(const DummyProcedure &, const DummyProcedure &) const;
   bool Distinguishable(const FunctionResult &, const FunctionResult &) const;
-  bool Distinguishable(const TypeAndShape &, const TypeAndShape &) const;
+  bool Distinguishable(
+      const TypeAndShape &, const TypeAndShape &, common::IgnoreTKRSet) const;
   bool IsTkrCompatible(const DummyArgument &, const DummyArgument &) const;
-  bool IsTkrCompatible(const TypeAndShape &, const TypeAndShape &) const;
+  bool IsTkCompatible(const DummyDataObject &, const DummyDataObject &) const;
   const DummyArgument *GetAtEffectivePosition(
       const DummyArguments &, int) const;
   const DummyArgument *GetPassArg(const Procedure &) const;
 
   const common::LanguageFeatureControl &features_;
 };
 
 // Simpler distinguishability rules for operators and assignment
return common::visit(
           [&](const AlternateReturn &) { return false; },
       },
       x.u);
 }
 
 bool DistinguishUtils::Distinguishable(
     const DummyDataObject &x, const DummyDataObject &y) const {
   using Attr = DummyDataObject::Attr;
-  if (Distinguishable(x.type, y.type)) {
+  if (Distinguishable(x.type, y.type, x.ignoreTKR | y.ignoreTKR)) {
     return true;
   } else if (x.attrs.test(Attr::Allocatable) && y.attrs.test(Attr::Pointer) &&
       y.intent != common::Intent::In) {
     return true;
   } else if (y.attrs.test(Attr::Allocatable) && x.attrs.test(Attr::Pointer) &&
       x.intent != common::Intent::In) {
     return true;
   } else if (features_.IsEnabled(

 bool DistinguishUtils::Distinguishable(
     const FunctionResult &x, const FunctionResult &y) const {
   if (x.u.index() != y.u.index()) {
     return true; // one is data object, one is procedure
   }
   return common::visit(
       common::visitors{
           [&](const TypeAndShape &z) {
-            return Distinguishable(z, std::get<TypeAndShape>(y.u));
+            return Distinguishable(
+                z, std::get<TypeAndShape>(y.u), common::IgnoreTKRSet{});
           },
           [&](const CopyableIndirection<Procedure> &z) {
             return Distinguishable(z.value(),
                 std::get<CopyableIndirection<Procedure>>(y.u).value());
           },
       },
       x.u);
 }
 
-bool DistinguishUtils::Distinguishable(
-    const TypeAndShape &x, const TypeAndShape &y) const {
-  return !IsTkrCompatible(x, y) && !IsTkrCompatible(y, x);
+bool DistinguishUtils::Distinguishable(const TypeAndShape &x,
+    const TypeAndShape &y, common::IgnoreTKRSet ignoreTKR) const {
+  if (!x.type().IsTkCompatibleWith(y.type(), ignoreTKR) &&
+      !y.type().IsTkCompatibleWith(x.type(), ignoreTKR)) {
+    return true;
+  }
+  if (ignoreTKR.test(common::IgnoreTKR::Rank)) {
+  } else if (x.attrs().test(TypeAndShape::Attr::AssumedRank) ||
+      y.attrs().test(TypeAndShape::Attr::AssumedRank)) {
+  } else if (x.Rank() != y.Rank()) {
+    return true;
+  }
+  return false;
 }
 
 // Compatibility based on type, kind, and rank
+
 bool DistinguishUtils::IsTkrCompatible(
     const DummyArgument &x, const DummyArgument &y) const {
   const auto *obj1{std::get_if<DummyDataObject>(&x.u)};
   const auto *obj2{std::get_if<DummyDataObject>(&y.u)};
-  return obj1 && obj2 && IsTkrCompatible(obj1->type, obj2->type);
+  return obj1 && obj2 && IsTkCompatible(*obj1, *obj2) &&
+      (obj1->type.Rank() == obj2->type.Rank() ||
+          obj1->type.attrs().test(TypeAndShape::Attr::AssumedRank) ||
+          obj2->type.attrs().test(TypeAndShape::Attr::AssumedRank) ||
+          obj1->ignoreTKR.test(common::IgnoreTKR::Rank) ||
+          obj2->ignoreTKR.test(common::IgnoreTKR::Rank));
 }
-bool DistinguishUtils::IsTkrCompatible(
-    const TypeAndShape &x, const TypeAndShape &y) const {
-  return x.type().IsTkCompatibleWith(y.type()) &&
-      (x.attrs().test(TypeAndShape::Attr::AssumedRank) ||
-          y.attrs().test(TypeAndShape::Attr::AssumedRank) ||
-          x.Rank() == y.Rank());
+
+bool DistinguishUtils::IsTkCompatible(
+    const DummyDataObject &x, const DummyDataObject &y) const {
+  return x.type.type().IsTkCompatibleWith(
+      y.type.type(), x.ignoreTKR | y.ignoreTKR);
 }
 
 // Return the argument at the given index, ignoring the passed arg
 const DummyArgument *DistinguishUtils::GetAtEffectivePosition(
     const DummyArguments &args, int index) const {
   for (const DummyArgument &arg : args) {
     if (!arg.pass) {
       if (index == 0) {

flang/lib/Evaluate/tools.cpp

if (auto xDt{evaluate::DynamicType::From(*x)}) {
       if (auto yDt{evaluate::DynamicType::From(*y)}) {
         return xDt->IsTkCompatibleWith(*yDt);
       }
     }
   }
   return false;
 }
 
+common::IgnoreTKRSet GetIgnoreTKR(const Symbol &symbol) {
+  common::IgnoreTKRSet result;
+  if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+    result = object->ignoreTKR();
+    if (const Symbol * ownerSymbol{symbol.owner().symbol()}) {
+      if (const auto *ownerSubp{ownerSymbol->detailsIf<SubprogramDetails>()}) {
+        if (ownerSubp->defaultIgnoreTKR()) {
+          result |= common::ignoreTKRAll;
+        }
+      }
+    }
+  }
+  return result;
+}
+
 } // namespace Fortran::semantics

flang/lib/Evaluate/type.cpp

return common::visit(
             return d.isFunction() && IsDescriptor(d.result());
           },
           [](const UseDetails &d) { return IsDescriptor(d.symbol()); },
           [](const HostAssocDetails &d) { return IsDescriptor(d.symbol()); },
           [](const auto &) { return false; },
       },
       symbol.details());
 }
+
+bool IsPassedViaDescriptor(const Symbol &symbol) {
+  if (!IsDescriptor(symbol)) {
+    return false;
+  }
+  if (const auto *object{
+          symbol.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
+    if (object->isDummy()) {
+      if (object->type() &&
+          object->type()->category() == DeclTypeSpec::Character) {
+        return false;
+      }
+      if (object->IsAssumedSize()) {
+        return false;
+      }
+      bool isExplicitShape{true};
+      for (const ShapeSpec &shapeSpec : object->shape()) {
+        if (!shapeSpec.lbound().GetExplicit() ||
+            !shapeSpec.ubound().GetExplicit()) {
+          isExplicitShape = false;
+          break;
+        }
+      }
+      if (isExplicitShape) {
+        return false; // explicit shape but non-constant bounds
+      }
+    }
+  }
+  return true;
+}
 } // namespace Fortran::semantics
 
 namespace Fortran::evaluate {
 
 DynamicType::DynamicType(int k, const semantics::ParamValue &pv)
     : category_{TypeCategory::Character}, kind_{k} {
   CHECK(IsValidKindOfIntrinsicType(category_, kind_));
   if (auto n{ToInt64(pv.GetExplicit())}) {
static bool AreCompatibleTypes(const DynamicType &x, const DynamicType &y,
   }
 }
 
 // See 7.3.2.3 (5) & 15.5.2.4
 bool DynamicType::IsTkCompatibleWith(const DynamicType &that) const {
   return AreCompatibleTypes(*this, that, false, true);
 }
 
+bool DynamicType::IsTkCompatibleWith(
+    const DynamicType &that, common::IgnoreTKRSet ignoreTKR) const {
+  if (ignoreTKR.test(common::IgnoreTKR::Type) &&
+      (category() == TypeCategory::Derived ||
+          that.category() == TypeCategory::Derived ||
+          category() != that.category())) {
+    return true;
+  } else if (ignoreTKR.test(common::IgnoreTKR::Kind) &&
+      category() == that.category()) {
+    return true;
+  } else {
+    return AreCompatibleTypes(*this, that, false, true);
+  }
+}
+
 bool DynamicType::IsTkLenCompatibleWith(const DynamicType &that) const {
   return AreCompatibleTypes(*this, that, false, false);
 }
 
 // 16.9.165
 std::optional<bool> DynamicType::SameTypeAs(const DynamicType &that) const {
   bool x{AreCompatibleTypes(*this, that, true, true)};
   bool y{AreCompatibleTypes(that, *this, true, true)};

flang/lib/Parser/Fortran-parsers.cpp

construct<DeallocateStmt>(
         defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))
 
 // R942 dealloc-opt -> STAT = stat-variable | ERRMSG = errmsg-variable
 // R1165 sync-stat -> STAT = stat-variable | ERRMSG = errmsg-variable
 TYPE_PARSER(construct<StatOrErrmsg>("STAT =" >> statVariable) ||
     construct<StatOrErrmsg>("ERRMSG =" >> msgVariable))
 
 // Directives, extensions, and deprecated statements
-// !DIR$ IGNORE_TKR [ [(tkr...)] name ]...
+// !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>(
-                             defaulted(parenthesized(some("tkr"_ch))), name))};
+                             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>(

flang/lib/Parser/unparse.cpp

common::visit(
             [&](const std::list<CompilerDirective::NameValue> &names) {
               Walk("!DIR$ ", names, " ");
             },
         },
         x.u);
     Put('\n');
   }
   void Unparse(const CompilerDirective::IgnoreTKR &x) {
-    const auto &list{std::get<std::list<const char *>>(x.t)};
-    if (!list.empty()) {
+    if (const auto &maybeList{
+            std::get<std::optional<std::list<const char *>>>(x.t)}) {
       Put("(");
-      for (const char *tkr : list) {
+      for (const char *tkr : *maybeList) {
         Put(*tkr);
       }
       Put(") ");
     }
     Walk(std::get<Name>(x.t));
   }
   void Unparse(const CompilerDirective::NameValue &x) {
     Walk(std::get<Name>(x.t));

flang/lib/Semantics/check-call.cpp

bool dummyIsAllocatable{
       dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable)};
   bool dummyIsPointer{
       dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
   bool dummyIsAllocatableOrPointer{dummyIsAllocatable || dummyIsPointer};
   allowActualArgumentConversions &= !dummyIsAllocatableOrPointer;
   if (allowActualArgumentConversions) {
     ConvertIntegerActual(actual, dummy.type, actualType, messages);
   }
-  bool typesCompatible{dummy.type.type().IsTkCompatibleWith(actualType.type())};
+  bool typesCompatible{
+      (dummy.ignoreTKR.test(common::IgnoreTKR::Type) &&
+          (dummy.type.type().category() == TypeCategory::Derived ||
+              actualType.type().category() == TypeCategory::Derived ||
+              dummy.type.type().category() != actualType.type().category())) ||
+      (dummy.ignoreTKR.test(common::IgnoreTKR::Kind) &&
+          dummy.type.type().category() == actualType.type().category()) ||
+      dummy.type.type().IsTkCompatibleWith(actualType.type())};
   if (!typesCompatible && dummy.type.Rank() == 0 &&
       allowActualArgumentConversions) {
     // Extension: pass Hollerith literal to scalar as if it had been BOZ
     if (auto converted{
             evaluate::HollerithToBOZ(context, actual, dummy.type.type())}) {
       messages.Say(
           "passing Hollerith or character literal as if it were BOZ"_port_en_US);
       actual = *converted;
       actualType.type() = dummy.type.type();
       typesCompatible = true;
     }
   }
   if (typesCompatible) {
     if (isElemental) {
     } else if (dummy.type.attrs().test(
                    characteristics::TypeAndShape::Attr::AssumedRank)) {
+    } else if (dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
     } else if (dummy.type.Rank() > 0 && !dummyIsAllocatableOrPointer &&
         !dummy.type.attrs().test(
             characteristics::TypeAndShape::Attr::AssumedShape) &&
         !dummy.type.attrs().test(
             characteristics::TypeAndShape::Attr::DeferredShape) &&
         (actualType.Rank() > 0 || IsArrayElement(actual))) {
       // Sequence association (15.5.2.11) applies -- rank need not match
       // if the actual argument is an array or array element designator,
if (dummy.type.attrs().test(
     }
     bool actualIsArrayElement{IsArrayElement(actual)};
     bool actualIsCKindCharacter{
         actualType.type().category() == TypeCategory::Character &&
         actualType.type().kind() == 1};
     if (!actualIsCKindCharacter) {
       if (!actualIsArrayElement &&
           !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize) &&
-          !dummyIsAssumedRank) {
+          !dummyIsAssumedRank &&
+          !dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
         messages.Say(
             "Whole scalar actual argument may not be associated with a %s array"_err_en_US,
             dummyName);
       }
       if (actualIsPolymorphic) {
         messages.Say(
             "Polymorphic scalar may not be associated with a %s array"_err_en_US,
             dummyName);

flang/lib/Semantics/check-declarations.cpp

if (InPure() && !IsStmtFunction(DEREF(innermostSymbol_)) &&
                 "An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine"_err_en_US);
           }
         }
       } else if (!IsIntentInOut(symbol)) { // C1586
         messages_.Say(
             "non-POINTER dummy argument of pure subroutine must have INTENT() or VALUE attribute"_err_en_US);
       }
     }
+    if (auto ignoreTKR{GetIgnoreTKR(symbol)}; !ignoreTKR.empty()) {
+      if (IsAllocatableOrPointer(symbol)) {
+        messages_.Say(
+            "!DIR$ IGNORE_TKR may not apply to an allocatable or pointer"_err_en_US);
+      } else if (ignoreTKR.test(common::IgnoreTKR::Contiguous) &&
+          !IsAssumedShape(symbol)) {
+        messages_.Say(
+            "!DIR$ IGNORE_TKR(C) may apply only to an assumed-shape array"_err_en_US);
+      } else if (ignoreTKR.test(common::IgnoreTKR::Rank) &&
+          IsPassedViaDescriptor(symbol)) {
+        messages_.Say(
+            "!DIR$ IGNORE_TKR(R) may not apply to a dummy argument passed via descriptor"_err_en_US);
+      } else if (const Symbol * ownerSymbol{symbol.owner().symbol()}) {
+        if (const auto *ownerSubp{ownerSymbol->detailsIf<SubprogramDetails>()};
+            ownerSubp && !ownerSubp->isInterface() &&
+            !FindModuleContaining(symbol.owner())) {
+          messages_.Say(
+              "!DIR$ IGNORE_TKR may apply only in an interface or a module procedure"_err_en_US);
+        } else if (ownerSymbol->attrs().test(Attr::ELEMENTAL) &&
+            details.ignoreTKR().test(common::IgnoreTKR::Rank)) {
+          messages_.Say(
+              "!DIR$ IGNORE_TKR(R) may not apply in an ELEMENTAL procedure"_err_en_US);
+        }
+      }
+    }
   } else if (symbol.attrs().test(Attr::INTENT_IN) ||
       symbol.attrs().test(Attr::INTENT_OUT) ||
       symbol.attrs().test(Attr::INTENT_INOUT)) {
-    messages_.Say("INTENT attributes may apply only to a dummy "
-                  "argument"_err_en_US); // C843
+    messages_.Say(
+        "INTENT attributes may apply only to a dummy argument"_err_en_US); // C843
   } else if (IsOptional(symbol)) {
-    messages_.Say("OPTIONAL attribute may apply only to a dummy "
-                  "argument"_err_en_US); // C849
+    messages_.Say(
+        "OPTIONAL attribute may apply only to a dummy argument"_err_en_US); // C849
+  } else if (!details.ignoreTKR().empty()) {
+    messages_.Say(
+        "!DIR$ IGNORE_TKR directive may apply only to a dummy data argument"_err_en_US);
   }
   if (InElemental()) {
     if (details.isDummy()) { // C15100
       if (details.shape().Rank() > 0) {
         messages_.Say(
             "A dummy argument of an ELEMENTAL procedure must be scalar"_err_en_US);
       }
       if (IsAllocatable(symbol)) {
if (auto whyNot{
             WhyNotDefinable(symbol.name(), symbol.owner(), {}, symbol)}) {
       if (auto *msg{messages_.Say(
               "'%s' may not be a local variable in a pure subprogram"_err_en_US,
               symbol.name())}) {
         msg->Attach(std::move(*whyNot));
       }
     }
   }
+  if (symbol.attrs().test(Attr::EXTERNAL)) {
+    SayWithDeclaration(symbol,
+        "'%s' is a data object and may not be EXTERNAL"_err_en_US,
+        symbol.name());
+  }
 }
 
 void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
   if (IsPointer(symbol) && !context_.HasError(symbol) &&
       !scopeIsUninstantiatedPDT_) {
     if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
       if (object->init()) { // C764, C765; C808
         if (auto designator{evaluate::AsGenericExpr(symbol)}) {

flang/lib/Semantics/mod-file.cpp

PutAttrs(os, bindAttrs, details.bindName(), details.isExplicitBindName(),
       " "s, ""s);
   if (details.isFunction()) {
     const Symbol &result{details.result()};
     if (result.name() != symbol.name()) {
       os << " result(" << result.name() << ')';
     }
   }
   os << '\n';
-
   // walk symbols, collect ones needed for interface
   const Scope &scope{
       details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
   SubprogramSymbolCollector collector{symbol, scope};
   collector.Collect();
   std::string typeBindingsBuf;
   llvm::raw_string_ostream typeBindings{typeBindingsBuf};
   ModFileWriter writer{context_};
void ModFileWriter::PutObjectEntity(
   }
   PutEntity(
       os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
       symbol.attrs());
   PutShape(os, details.shape(), '(', ')');
   PutShape(os, details.coshape(), '[', ']');
   PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit());
   os << '\n';
+  if (auto tkr{GetIgnoreTKR(symbol)}; !tkr.empty()) {
+    os << "!dir$ ignore_tkr(";
+    tkr.IterateOverMembers([&](common::IgnoreTKR tkr) {
+      switch (tkr) {
+        SWITCH_COVERS_ALL_CASES
+      case common::IgnoreTKR::Type:
+        os << 't';
+        break;
+      case common::IgnoreTKR::Kind:
+        os << 'k';
+        break;
+      case common::IgnoreTKR::Rank:
+        os << 'r';
+        break;
+      case common::IgnoreTKR::Device:
+        os << 'd';
+        break;
+      case common::IgnoreTKR::Managed:
+        os << 'm';
+        break;
+      case common::IgnoreTKR::Contiguous:
+        os << 'c';
+        break;
+      }
+    });
+    os << ") " << symbol.name() << '\n';
+  }
 }
 
 void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
   if (symbol.attrs().test(Attr::INTRINSIC)) {
     os << "intrinsic::" << symbol.name() << '\n';
     if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
       os << "private::" << symbol.name() << '\n';
     }

flang/lib/Semantics/resolve-names.cpp

public:
   bool Pre(const parser::CallStmt &);
   bool Pre(const parser::ImportStmt &);
   void Post(const parser::TypeGuardStmt &);
   bool Pre(const parser::StmtFunctionStmt &);
   bool Pre(const parser::DefinedOpName &);
   bool Pre(const parser::ProgramUnit &);
   void Post(const parser::AssignStmt &);
   void Post(const parser::AssignedGotoStmt &);
+  void Post(const parser::CompilerDirective &);
 
   // These nodes should never be reached: they are handled in ProgramUnit
   bool Pre(const parser::MainProgram &) {
     llvm_unreachable("This node is handled in ProgramUnit");
   }
   bool Pre(const parser::FunctionSubprogram &) {
     llvm_unreachable("This node is handled in ProgramUnit");
   }

 }
 void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) {
   if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
     CheckEntryDummyUse(name->source, name->symbol);
     ConvertToObjectEntity(DEREF(name->symbol));
   }
 }
 
+void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {
+  if (const auto *tkr{
+          std::get_if<std::list<parser::CompilerDirective::IgnoreTKR>>(&x.u)}) {
+    if (currScope().IsTopLevel() ||
+        GetProgramUnitContaining(currScope()).kind() !=
+            Scope::Kind::Subprogram) {
+      Say(x.source,
+          "!DIR$ IGNORE_TKR directive must appear in a subroutine or function"_err_en_US);
+      return;
+    }
+    if (!inSpecificationPart_) {
+      Say(x.source,
+          "!DIR$ IGNORE_TKR directive must appear in the specification part"_err_en_US);
+      return;
+    }
+    if (tkr->empty()) {
+      Symbol *symbol{currScope().symbol()};
+      if (SubprogramDetails *
+          subp{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}) {
+        subp->set_defaultIgnoreTKR(true);
+      }
+    } else {
+      for (const parser::CompilerDirective::IgnoreTKR &item : *tkr) {
+        common::IgnoreTKRSet set;
+        if (const auto &maybeList{
+                std::get<std::optional<std::list<const char *>>>(item.t)}) {
+          for (const char *p : *maybeList) {
+            if (p) {
+              switch (*p) {
+              case 't':
+                set.set(common::IgnoreTKR::Type);
+                break;
+              case 'k':
+                set.set(common::IgnoreTKR::Kind);
+                break;
+              case 'r':
+                set.set(common::IgnoreTKR::Rank);
+                break;
+              case 'd':
+                set.set(common::IgnoreTKR::Device);
+                break;
+              case 'm':
+                set.set(common::IgnoreTKR::Managed);
+                break;
+              case 'c':
+                set.set(common::IgnoreTKR::Contiguous);
+                break;
+              case 'a':
+                set = common::ignoreTKRAll;
+                break;
+              default:
+                Say(x.source,
+                    "'%c' is not a valid letter for !DIR$ IGNORE_TKR directive"_err_en_US,
+                    *p);
+                set = common::ignoreTKRAll;
+                break;
+              }
+            }
+          }
+          if (set.empty()) {
+            Say(x.source,
+                "!DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters"_err_en_US);
+          }
+        } else { // no (list)
+          set = common::ignoreTKRAll;
+          ;
+        }
+        const auto &name{std::get<parser::Name>(item.t)};
+        Symbol *symbol{FindSymbol(name)};
+        if (!symbol) {
+          symbol = &MakeSymbol(name, Attrs{}, ObjectEntityDetails{});
+        }
+        if (symbol->owner() != currScope()) {
+          SayWithDecl(
+              name, *symbol, "'%s' must be local to this subprogram"_err_en_US);
+        } else {
+          ConvertToObjectEntity(*symbol);
+          if (auto *object{symbol->detailsIf<ObjectEntityDetails>()}) {
+            object->set_ignoreTKR(set);
+          } else {
+            SayWithDecl(name, *symbol, "'%s' must be an object"_err_en_US);
+          }
+        }
+      }
+    }
+  } else {
+    Say(x.source, "Compiler directive was ignored"_warn_en_US);
+  }
+}
+
 bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
   if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>(
           x.u)) {
     // TODO: global directives
     return true;
   }
   auto root{ProgramTree::Build(x)};
   SetScope(topScope_);

flang/lib/Semantics/symbol.cpp

llvm::raw_ostream &operator<<(
   }
   os << (sep == '(' ? "()" : ")");
   if (x.stmtFunction_) {
     os << " -> " << x.stmtFunction_->AsFortran();
   }
   if (x.moduleInterface_) {
     os << " moduleInterface: " << *x.moduleInterface_;
   }
+  if (x.defaultIgnoreTKR_) {
+    os << " defaultIgnoreTKR";
+  }
   return os;
 }
 
 void EntityDetails::set_type(const DeclTypeSpec &type) {
   CHECK(!type_);
   type_ = &type;
 }
 
llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const ObjectEntityDetails &x) {
   os << *static_cast<const EntityDetails *>(&x);
   DumpList(os, "shape", x.shape());
   DumpList(os, "coshape", x.coshape());
   DumpExpr(os, "init", x.init_);
   if (x.unanalyzedPDTComponentInit()) {
     os << " (has unanalyzedPDTComponentInit)";
   }
+  if (!x.ignoreTKR_.empty()) {
+    os << ' ';
+    x.ignoreTKR_.Dump(os, common::EnumToString);
+  }
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const AssocEntityDetails &x) {
   os << *static_cast<const EntityDetails *>(&x);
   if (auto assocRank{x.rank()}) {
     os << " rank: " << *assocRank;

flang/test/Semantics/ignore_tkr01.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! !DIR$ IGNORE_TKR tests
+
+!ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
+!dir$ ignore_tkr
+
+module m
+
+!ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
+!dir$ ignore_tkr
+
+  interface
+    subroutine t1(x)
+!dir$ ignore_tkr
+      real, intent(in) :: x
+    end
+
+    subroutine t2(x)
+!dir$ ignore_tkr(t) x
+      real, intent(in) :: x
+    end
+
+    subroutine t3(x)
+!dir$ ignore_tkr(k) x
+      real, intent(in) :: x
+    end
+
+    subroutine t4(a)
+!dir$ ignore_tkr(r) a
+      real, intent(in) :: a(2)
+    end
+
+    subroutine t5(m)
+!dir$ ignore_tkr(r) m
+      real, intent(in) :: m(2,2)
+    end
+
+    subroutine t6(x)
+!dir$ ignore_tkr(a) x
+      real, intent(in) :: x
+    end
+
+    subroutine t7(x)
+!ERROR: !DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters
+!dir$ ignore_tkr() x
+      real, intent(in) :: x
+    end
+
+    subroutine t8(x)
+!dir$ ignore_tkr x
+      real, intent(in) :: x
+    end
+
+    subroutine t9(x)
+!dir$ ignore_tkr x
+!ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
+      real, intent(in), allocatable :: x
+    end
+
+    subroutine t10(x)
+!dir$ ignore_tkr x
+!ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
+      real, intent(in), pointer :: x
+    end
+
+    subroutine t11
+!dir$ ignore_tkr x
+!ERROR: !DIR$ IGNORE_TKR directive may apply only to a dummy data argument
+      real :: x
+    end
+
+    subroutine t12(p,q,r)
+!dir$ ignore_tkr p, q
+!ERROR: 'p' is a data object and may not be EXTERNAL
+      real, external :: p
+!ERROR: 'q' is already declared as an object
+      procedure(real) :: q
+      procedure(), pointer :: r
+!ERROR: 'r' must be an object
+!dir$ ignore_tkr r
+    end
+
+    elemental subroutine t13(x)
+!dir$ ignore_tkr(r) x
+!ERROR: !DIR$ IGNORE_TKR(R) may not apply in an ELEMENTAL procedure
+      real, intent(in) :: x
+    end
+
+  end interface
+
+ contains
+  subroutine t14(x)
+    real x
+    x = x + 1.
+!ERROR: !DIR$ IGNORE_TKR directive must appear in the specification part
+!dir$ ignore_tkr x
+  end
+
+  subroutine t15(x)
+!ERROR: 'q' is not a valid letter for !DIR$ IGNORE_TKR directive
+!dir$ ignore_tkr(q) x
+    real x
+    x = x + 1.
+  end
+
+  subroutine t16(x)
+    real x
+   contains
+    subroutine inner
+!ERROR: 'x' must be local to this subprogram
+!dir$ ignore_tkr x
+    end
+  end
+
+  subroutine t17(x)
+    real x
+    block
+!ERROR: 'x' must be local to this subprogram
+!dir$ ignore_tkr x
+    end block
+  end
+
+  subroutine t18(x)
+!dir$ ignore_tkr(c) x
+!ERROR: !DIR$ IGNORE_TKR(C) may apply only to an assumed-shape array
+    real x(1)
+  end
+
+  subroutine t19(x)
+!dir$ ignore_tkr(r) x
+!ERROR: !DIR$ IGNORE_TKR(R) may not apply to a dummy argument passed via descriptor
+    real x(..)
+  end
+
+end
+
+subroutine bad1(x)
+!dir$ ignore_tkr x
+!ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
+  real, intent(in) :: x
+end
+
+program test
+
+!ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
+!dir$ ignore_tkr
+
+  use m
+  real x
+  real a(2)
+  real m(2,2)
+  double precision dx
+
+  call t1(1)
+  call t1(dx)
+  call t1('a')
+  call t1((1.,2.))
+  call t1(.true.)
+
+  call t2(1)
+  !ERROR: Actual argument type 'REAL(8)' is not compatible with dummy argument type 'REAL(4)'
+  call t2(dx)
+  call t2('a')
+  call t2((1.,2.))
+  call t2(.true.)
+
+  !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'REAL(4)'
+  call t3(1)
+  call t3(dx)
+  !ERROR: passing Hollerith or character literal as if it were BOZ
+  call t3('a')
+  !ERROR: Actual argument type 'COMPLEX(4)' is not compatible with dummy argument type 'REAL(4)'
+  call t3((1.,2.))
+  !ERROR: Actual argument type 'LOGICAL(4)' is not compatible with dummy argument type 'REAL(4)'
+  call t3(.true.)
+
+  call t4(x)
+  call t4(m)
+  call t5(x)
+  call t5(a)
+
+  call t6(1)
+  call t6(dx)
+  call t6('a')
+  call t6((1.,2.))
+  call t6(.true.)
+  call t6(a)
+
+  call t8(1)
+  call t8(dx)
+  call t8('a')
+  call t8((1.,2.))
+  call t8(.true.)
+  call t8(a)
+
+ contains
+  subroutine inner(x)
+!dir$ ignore_tkr x
+!ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
+    real, intent(in) :: x
+  end
+end