[flang][cuda] Relax compatibility rules when host,device procedure is involved

[clementval]

Relax too restrictive rule for host, device procedure.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Valentin Clement (バレンタイン クレメン) (clementval)

Changes

Relax too restrictive rule for host, device procedure.

---

Full diff: https://github.com/llvm/llvm-project/pull/134926.diff

5 Files Affected:

• (modified) flang/include/flang/Support/Fortran.h (+1-1)
• (modified) flang/lib/Evaluate/characteristics.cpp (+4-2)
• (modified) flang/lib/Semantics/check-call.cpp (+5-2)
• (modified) flang/lib/Support/Fortran.cpp (+4-1)
• (modified) flang/test/Semantics/cuf10.cuf (+11)

diff --git a/flang/include/flang/Support/Fortran.h b/flang/include/flang/Support/Fortran.h
index 6e6e37ba594be..6ce053926c1e7 100644
--- a/flang/include/flang/Support/Fortran.h
+++ b/flang/include/flang/Support/Fortran.h
@@ -96,7 +96,7 @@ std::string AsFortran(IgnoreTKRSet);
 
 bool AreCompatibleCUDADataAttrs(std::optional<CUDADataAttr>,
     std::optional<CUDADataAttr>, IgnoreTKRSet, std::optional<std::string> *,
-    bool allowUnifiedMatchingRule,
+    bool allowUnifiedMatchingRule, bool isHostDeviceProcedure,
     const LanguageFeatureControl *features = nullptr);
 
 static constexpr char blankCommonObjectName[] = "__BLNK__";
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index c5470df2622a5..63040feae43fc 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -370,7 +370,8 @@ bool DummyDataObject::IsCompatibleWith(const DummyDataObject &actual,
   if (!attrs.test(Attr::Value) &&
       !common::AreCompatibleCUDADataAttrs(cudaDataAttr, actual.cudaDataAttr,
           ignoreTKR, warning,
-          /*allowUnifiedMatchingRule=*/false)) {
+          /*allowUnifiedMatchingRule=*/false,
+          /*=isHostDeviceProcedure*/ false)) {
     if (whyNot) {
       *whyNot = "incompatible CUDA data attributes";
     }
@@ -1776,7 +1777,8 @@ bool DistinguishUtils::Distinguishable(
     return true;
   } else if (!common::AreCompatibleCUDADataAttrs(x.cudaDataAttr, y.cudaDataAttr,
                  x.ignoreTKR | y.ignoreTKR, nullptr,
-                 /*allowUnifiedMatchingRule=*/false)) {
+                 /*allowUnifiedMatchingRule=*/false,
+                 /*=isHostDeviceProcedure*/ false)) {
     return true;
   } else if (features_.IsEnabled(
                  common::LanguageFeature::DistinguishableSpecifics) &&
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index da2be08ca73ff..ef8282143451c 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1016,9 +1016,12 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
       }
     }
     std::optional<std::string> warning;
+    bool isHostDeviceProc = procedure.cudaSubprogramAttrs &&
+        *procedure.cudaSubprogramAttrs ==
+            common::CUDASubprogramAttrs::HostDevice;
     if (!common::AreCompatibleCUDADataAttrs(dummyDataAttr, actualDataAttr,
-            dummy.ignoreTKR, &warning,
-            /*allowUnifiedMatchingRule=*/true, &context.languageFeatures())) {
+            dummy.ignoreTKR, &warning, /*allowUnifiedMatchingRule=*/true,
+            isHostDeviceProc, &context.languageFeatures())) {
       auto toStr{[](std::optional<common::CUDADataAttr> x) {
         return x ? "ATTRIBUTES("s +
                 parser::ToUpperCaseLetters(common::EnumToString(*x)) + ")"s
diff --git a/flang/lib/Support/Fortran.cpp b/flang/lib/Support/Fortran.cpp
index f91c72d96fc97..8e286be1624df 100644
--- a/flang/lib/Support/Fortran.cpp
+++ b/flang/lib/Support/Fortran.cpp
@@ -104,7 +104,7 @@ std::string AsFortran(IgnoreTKRSet tkr) {
 bool AreCompatibleCUDADataAttrs(std::optional<CUDADataAttr> x,
     std::optional<CUDADataAttr> y, IgnoreTKRSet ignoreTKR,
     std::optional<std::string> *warning, bool allowUnifiedMatchingRule,
-    const LanguageFeatureControl *features) {
+    bool isHostDeviceProcedure, const LanguageFeatureControl *features) {
   bool isCudaManaged{features
           ? features->IsEnabled(common::LanguageFeature::CudaManaged)
           : false};
@@ -114,6 +114,9 @@ bool AreCompatibleCUDADataAttrs(std::optional<CUDADataAttr> x,
   if (ignoreTKR.test(common::IgnoreTKR::Device)) {
     return true;
   }
+  if (!y && isHostDeviceProcedure) {
+    return true;
+  }
   if (!x && !y) {
     return true;
   } else if (x && y && *x == *y) {
diff --git a/flang/test/Semantics/cuf10.cuf b/flang/test/Semantics/cuf10.cuf
index f85471855ec57..2cb1d0d227036 100644
--- a/flang/test/Semantics/cuf10.cuf
+++ b/flang/test/Semantics/cuf10.cuf
@@ -49,4 +49,15 @@ module m
     type (int) :: c, a, b
     c = a+b ! ok resolve to addDevice
   end subroutine overload
+
+  attributes(host,device) subroutine hostdev(a)
+    integer :: a(*)
+  end subroutine
+  
+  subroutine host()
+    integer :: a(10)
+    call hostdev(a) ! ok because hostdev is attributes(host,device)
+  end subroutine
+    
+
 end