diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index dae4050279200..e1cee89906aac 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -762,13 +762,10 @@ void CheckHelper::CheckObjectEntity( } if (auto ignoreTKR{GetIgnoreTKR(symbol)}; !ignoreTKR.empty()) { const Symbol *ownerSymbol{symbol.owner().symbol()}; - const auto *ownerSubp{ownerSymbol->detailsIf()}; - bool inInterface{ownerSubp && ownerSubp->isInterface()}; - bool inExplicitInterface{ - inInterface && !IsSeparateModuleProcedureInterface(ownerSymbol)}; - bool inModuleProc{ - !inInterface && ownerSymbol && IsModuleProcedure(*ownerSymbol)}; - if (!inExplicitInterface && !inModuleProc) { + bool inModuleProc{ownerSymbol && IsModuleProcedure(*ownerSymbol)}; + bool inExplicitExternalInterface{ + InInterface() && !IsSeparateModuleProcedureInterface(ownerSymbol)}; + if (!InInterface() && !inModuleProc) { messages_.Say( "!DIR$ IGNORE_TKR may apply only in an interface or a module procedure"_err_en_US); } @@ -779,7 +776,7 @@ void CheckHelper::CheckObjectEntity( } if (IsPassedViaDescriptor(symbol)) { if (IsAllocatableOrObjectPointer(&symbol)) { - if (inExplicitInterface) { + if (inExplicitExternalInterface) { if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) { WarnIfNotInModuleFile( "!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US); @@ -794,7 +791,7 @@ void CheckHelper::CheckObjectEntity( WarnIfNotInModuleFile( "!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US); } - } else if (inExplicitInterface) { + } else if (inExplicitExternalInterface) { if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) { WarnIfNotInModuleFile( "!DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor"_warn_en_US); diff --git a/flang/test/Semantics/ignore_tkr01.f90 b/flang/test/Semantics/ignore_tkr01.f90 index 5d1ce32cf81d0..2af4974b1c038 100644 --- a/flang/test/Semantics/ignore_tkr01.f90 +++ b/flang/test/Semantics/ignore_tkr01.f90 @@ -92,6 +92,11 @@ subroutine t14(x) real x(:) end + module subroutine t24(x) +!dir$ ignore_tkr(t) x + real x(:) + end + end interface contains @@ -158,6 +163,14 @@ subroutine bad1(x) real, intent(in) :: x end +submodule(m) subm + contains + module subroutine t24(x) +!dir$ ignore_tkr(t) x + real x(:) + end +end + program test !ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function