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

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/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.

>From 41d2f2e66b073c9bc3702de00c7fad97edbe6e98 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 10 Jul 2024 12:52:58 -0700
Subject: [PATCH] [flang] Accept IGNORE_TKR in separate module procedure
 interface

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.
---
 flang/lib/Semantics/check-declarations.cpp | 15 ++++++---------
 flang/test/Semantics/ignore_tkr01.f90      | 13 +++++++++++++
 2 files changed, 19 insertions(+), 9 deletions(-)

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<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