[flang-commits] [PATCH] D150806: [flang] Respect !DIR$ IGNORE_TKR in generic matching

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: DanielCChen.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

Generic matching needs to relax argument compatibility checks when
dummy arguments have !DIR$ IGNORE_TKR directives.


https://reviews.llvm.org/D150806

Files:
  flang/lib/Evaluate/characteristics.cpp
  flang/lib/Semantics/expression.cpp
  flang/lib/Semantics/symbol.cpp
  flang/test/Semantics/ignore_tkr02.f90


Index: flang/test/Semantics/ignore_tkr02.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/ignore_tkr02.f90
@@ -0,0 +1,38 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+program main
+  interface generic
+    subroutine sub1(j, k)
+      integer(1) j
+      integer k
+      !dir$ ignore_tkr(kr) k
+    end
+    subroutine sub2(j, k)
+      integer(2) j
+      integer k
+      !dir$ ignore_tkr(kr) k
+    end
+    subroutine sub4(j, k)
+      integer(4) j
+      integer k
+      !dir$ ignore_tkr(kr) k
+    end
+  end interface
+!CHECK: CALL sub1(1_1,int(1_1,kind=4))
+  call generic(1_1,1_1)
+!CHECK: CALL sub1(1_1,int(1_2,kind=4))
+  call generic(1_1,1_2)
+!CHECK: CALL sub1(1_1,[INTEGER(1)::1_1])
+  call generic(1_1,[1_1])
+!CHECK: CALL sub2(1_2,int(1_1,kind=4))
+  call generic(1_2,1_1)
+!CHECK: CALL sub2(1_2,int(1_2,kind=4))
+  call generic(1_2,1_2)
+!CHECK: CALL sub2(1_2,[INTEGER(1)::1_1])
+  call generic(1_2,[1_1])
+!CHECK: CALL sub4(1_4,int(1_1,kind=4))
+  call generic(1_4,1_1)
+!CHECK: CALL sub4(1_4,int(1_2,kind=4))
+  call generic(1_4,1_2)
+!CHECK: CALL sub4(1_4,[INTEGER(1)::1_1])
+  call generic(1_4,[1_1])
+end
Index: flang/lib/Semantics/symbol.cpp
===================================================================
--- flang/lib/Semantics/symbol.cpp
+++ flang/lib/Semantics/symbol.cpp
@@ -411,8 +411,7 @@
     os << " (has unanalyzedPDTComponentInit)";
   }
   if (!x.ignoreTKR_.empty()) {
-    os << ' ';
-    x.ignoreTKR_.Dump(os, common::EnumToString);
+    x.ignoreTKR_.Dump(os << ' ', common::EnumToString);
   }
   return os;
 }
Index: flang/lib/Semantics/expression.cpp
===================================================================
--- flang/lib/Semantics/expression.cpp
+++ flang/lib/Semantics/expression.cpp
@@ -2307,10 +2307,11 @@
               return true;
             } else if (!isElemental && actual.Rank() != x.type.Rank() &&
                 !x.type.attrs().test(
-                    characteristics::TypeAndShape::Attr::AssumedRank)) {
+                    characteristics::TypeAndShape::Attr::AssumedRank) &&
+                !x.ignoreTKR.test(common::IgnoreTKR::Rank)) {
               return false;
             } else if (auto actualType{actual.GetType()}) {
-              return x.type.type().IsTkCompatibleWith(*actualType);
+              return x.type.type().IsTkCompatibleWith(*actualType, x.ignoreTKR);
             }
             return false;
           },
Index: flang/lib/Evaluate/characteristics.cpp
===================================================================
--- flang/lib/Evaluate/characteristics.cpp
+++ flang/lib/Evaluate/characteristics.cpp
@@ -400,6 +400,9 @@
       sep = ',';
     }
   }
+  if (!ignoreTKR.empty()) {
+    ignoreTKR.Dump(o << ' ', common::EnumToString);
+  }
   return o;
 }
 


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D150806.523121.patch
Type: text/x-patch
Size: 2849 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230517/c9bd27ca/attachment-0001.bin>