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, std::optional, IgnoreTKRSet, std::optional *, - 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 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 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 x, std::optional y, IgnoreTKRSet ignoreTKR, std::optional *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 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