[flang-commits] [flang] d6f314c - [flang] Accept IGNORE_TKR in separate module procedure interface (#98374)

[via flang-commits]

Author: Peter Klausler
Date: 2024-07-11T13:30:16-07:00
New Revision: d6f314ce870266a051a659d09938d8ceb34e36f1

URL: https://github.com/llvm/llvm-project/commit/d6f314ce870266a051a659d09938d8ceb34e36f1
DIFF: https://github.com/llvm/llvm-project/commit/d6f314ce870266a051a659d09938d8ceb34e36f1.diff

LOG: [flang] Accept IGNORE_TKR in separate module procedure interface (#98374)

We emit an incorrect error message when !DIR$ IGNORE_TKR appears in a
separate module procedure's interface declaration.

Fixes https://github.com/llvm/llvm-project/issues/98210.

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Semantics/ignore_tkr01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 2b9a05be3829b..eb898bad53a4f 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<SubprogramDetails>()};
-      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