[flang][cuda] Relax compatibility rules when host,device procedure is involved (llvm#134926)

Relax too restrictive rule for host, device procedure.

Author: clementval

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__";

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

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

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

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