From 15c023b9c1c85bc615184cfd2652ff70fb426764 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Tue, 30 Sep 2025 12:25:16 -0700 Subject: [PATCH] [flang][CUDA] Downgrade error to warning The compiler currently emit an error about the lack of an explicit procedure interface when an external procedure that is called via an implicit interface is known to have an dummy argument with a CUDA data attribute, even when the corresponding actual argument does have a CUDA data attribute. This behavior is inconsistent with what happens when such a call is to an external in another source file and its definition is not visible -- the compiler silently accepts an actual argument with a CUDA data attribute across the implicit interface. Harmonize this situation so that an actual argument with a CUDA data attribute in a reference to a procedure with an implicit interface elicits a usage warning encouraging the use of explicit interfaces. Only when the procedure's definition is visible, and incompatible, will an error message appear. --- .../include/flang/Evaluate/characteristics.h | 9 ++- flang/lib/Evaluate/characteristics.cpp | 14 ++-- flang/lib/Semantics/check-call.cpp | 71 ++++++++++++------- flang/lib/Semantics/expression.cpp | 2 +- .../test/Semantics/boz-literal-constants.f90 | 2 +- flang/test/Semantics/call13.f90 | 2 +- flang/test/Semantics/cuf24.cuf | 40 +++++++++++ flang/test/Semantics/null01.f90 | 4 +- 8 files changed, 106 insertions(+), 38 deletions(-) create mode 100644 flang/test/Semantics/cuf24.cuf diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h index b6a9ebefec9df..4cf82e7c14d70 100644 --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -251,7 +251,8 @@ struct DummyDataObject { std::optional *warning = nullptr) const; static std::optional Characterize( const semantics::Symbol &, FoldingContext &); - bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; + bool CanBePassedViaImplicitInterface( + std::string *whyNot = nullptr, bool checkCUDA = true) const; bool IsPassedByDescriptor(bool isBindC) const; llvm::raw_ostream &Dump(llvm::raw_ostream &) const; @@ -307,7 +308,8 @@ struct DummyArgument { void SetOptional(bool = true); common::Intent GetIntent() const; void SetIntent(common::Intent); - bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; + bool CanBePassedViaImplicitInterface( + std::string *whyNot = nullptr, bool checkCUDA = true) const; bool IsTypelessIntrinsicDummy() const; bool IsCompatibleWith(const DummyArgument &, std::string *whyNot = nullptr, std::optional *warning = nullptr) const; @@ -402,7 +404,8 @@ struct Procedure { return !attrs.test(Attr::ImplicitInterface); } std::optional FindPassIndex(std::optional) const; - bool CanBeCalledViaImplicitInterface(std::string *whyNot = nullptr) const; + bool CanBeCalledViaImplicitInterface( + std::string *whyNot = nullptr, bool checkCUDA = true) const; bool CanOverride(const Procedure &, std::optional passIndex) const; bool IsCompatibleWith(const Procedure &, bool ignoreImplicitVsExplicit, std::string *whyNot = nullptr, const SpecificIntrinsic * = nullptr, diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 37c62c93a87df..542f1223e658d 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -458,7 +458,7 @@ std::optional DummyDataObject::Characterize( } bool DummyDataObject::CanBePassedViaImplicitInterface( - std::string *whyNot) const { + std::string *whyNot, bool checkCUDA) const { if ((attrs & Attrs{Attr::Allocatable, Attr::Asynchronous, Attr::Optional, Attr::Pointer, Attr::Target, Attr::Value, Attr::Volatile}) @@ -482,7 +482,7 @@ bool DummyDataObject::CanBePassedViaImplicitInterface( *whyNot = "a dummy argument is polymorphic"; } return false; // 15.4.2.2(3)(f) - } else if (cudaDataAttr) { + } else if (checkCUDA && cudaDataAttr) { if (whyNot) { *whyNot = "a dummy argument has a CUDA data attribute"; } @@ -1012,9 +1012,10 @@ common::Intent DummyArgument::GetIntent() const { u); } -bool DummyArgument::CanBePassedViaImplicitInterface(std::string *whyNot) const { +bool DummyArgument::CanBePassedViaImplicitInterface( + std::string *whyNot, bool checkCUDA) const { if (const auto *object{std::get_if(&u)}) { - return object->CanBePassedViaImplicitInterface(whyNot); + return object->CanBePassedViaImplicitInterface(whyNot, checkCUDA); } else if (const auto *proc{std::get_if(&u)}) { return proc->CanBePassedViaImplicitInterface(whyNot); } else { @@ -1501,7 +1502,8 @@ std::optional Procedure::FromActuals(const ProcedureDesignator &proc, return callee; } -bool Procedure::CanBeCalledViaImplicitInterface(std::string *whyNot) const { +bool Procedure::CanBeCalledViaImplicitInterface( + std::string *whyNot, bool checkCUDA) const { if (attrs.test(Attr::Elemental)) { if (whyNot) { *whyNot = "the procedure is elemental"; @@ -1524,7 +1526,7 @@ bool Procedure::CanBeCalledViaImplicitInterface(std::string *whyNot) const { return false; } else { for (const DummyArgument &arg : dummyArguments) { - if (!arg.CanBePassedViaImplicitInterface(whyNot)) { + if (!arg.CanBePassedViaImplicitInterface(whyNot, checkCUDA)) { return false; } } diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 4939d8d64a999..81c53aaf9e339 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -56,28 +56,44 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg, "%VAL argument must be a scalar numeric or logical expression"_err_en_US); } if (const auto *expr{arg.UnwrapExpr()}) { - if (const Symbol * base{GetFirstSymbol(*expr)}; - base && IsFunctionResult(*base)) { - context.NoteDefinedSymbol(*base); + if (const Symbol *base{GetFirstSymbol(*expr)}) { + const Symbol &symbol{GetAssociationRoot(*base)}; + if (IsFunctionResult(symbol)) { + context.NoteDefinedSymbol(symbol); + } } if (IsBOZLiteral(*expr)) { - messages.Say("BOZ argument requires an explicit interface"_err_en_US); + messages.Say("BOZ argument %s requires an explicit interface"_err_en_US, + expr->AsFortran()); } else if (evaluate::IsNullPointerOrAllocatable(expr)) { messages.Say( - "Null pointer argument requires an explicit interface"_err_en_US); + "Null pointer argument '%s' requires an explicit interface"_err_en_US, + expr->AsFortran()); } else if (auto named{evaluate::ExtractNamedEntity(*expr)}) { - const Symbol &symbol{named->GetLastSymbol()}; - if (IsAssumedRank(symbol)) { + const Symbol &resolved{ResolveAssociations(named->GetLastSymbol())}; + if (IsAssumedRank(resolved)) { messages.Say( - "Assumed rank argument requires an explicit interface"_err_en_US); + "Assumed rank argument '%s' requires an explicit interface"_err_en_US, + expr->AsFortran()); } + const Symbol &symbol{GetAssociationRoot(resolved)}; if (symbol.attrs().test(Attr::ASYNCHRONOUS)) { messages.Say( - "ASYNCHRONOUS argument requires an explicit interface"_err_en_US); + "ASYNCHRONOUS argument '%s' requires an explicit interface"_err_en_US, + expr->AsFortran()); } if (symbol.attrs().test(Attr::VOLATILE)) { messages.Say( - "VOLATILE argument requires an explicit interface"_err_en_US); + "VOLATILE argument '%s' requires an explicit interface"_err_en_US, + expr->AsFortran()); + } + if (const auto *object{symbol.detailsIf()}) { + if (object->cudaDataAttr()) { + messages.Warn(/*inModuleFile=*/false, context.languageFeatures(), + common::UsageWarning::CUDAUsage, + "Actual argument '%s' with CUDA data attributes should be passed via an explicit interface"_warn_en_US, + expr->AsFortran()); + } } } else if (auto argChars{characteristics::DummyArgument::FromActual( "actual argument", *expr, context.foldingContext(), @@ -2387,44 +2403,51 @@ bool CheckArguments(const characteristics::Procedure &proc, evaluate::FoldingContext foldingContext{context.foldingContext()}; parser::ContextualMessages &messages{foldingContext.messages()}; bool allowArgumentConversions{true}; + parser::Messages implicitBuffer; if (!explicitInterface || treatingExternalAsImplicit) { - parser::Messages buffer; { - auto restorer{messages.SetMessages(buffer)}; + auto restorer{messages.SetMessages(implicitBuffer)}; for (auto &actual : actuals) { if (actual) { CheckImplicitInterfaceArg(*actual, messages, context); } } } - if (!buffer.empty()) { + if (implicitBuffer.AnyFatalError()) { if (auto *msgs{messages.messages()}) { - msgs->Annex(std::move(buffer)); + msgs->Annex(std::move(implicitBuffer)); } return false; // don't pile on } allowArgumentConversions = false; } if (explicitInterface) { - auto buffer{CheckExplicitInterface(proc, actuals, context, &scope, + auto explicitBuffer{CheckExplicitInterface(proc, actuals, context, &scope, intrinsic, allowArgumentConversions, /*extentErrors=*/true, ignoreImplicitVsExplicit)}; - if (!buffer.empty()) { + if (!explicitBuffer.empty()) { if (treatingExternalAsImplicit) { - if (auto *msg{foldingContext.Warn( + // Combine all messages into one warning + if (auto *warning{messages.Warn(/*inModuleFile=*/false, + context.languageFeatures(), common::UsageWarning::KnownBadImplicitInterface, "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) { - buffer.AttachTo(*msg, parser::Severity::Because); - } else { - buffer.clear(); + explicitBuffer.AttachTo(*warning, parser::Severity::Because); } + } else if (auto *msgs{messages.messages()}) { + msgs->Annex(std::move(explicitBuffer)); } - if (auto *msgs{messages.messages()}) { - msgs->Annex(std::move(buffer)); - } + // These messages override any in implicitBuffer. return false; } } - return true; + if (!implicitBuffer.empty()) { + if (auto *msgs{messages.messages()}) { + msgs->Annex(std::move(implicitBuffer)); + } + return false; + } else { + return true; // no messages + } } } // namespace Fortran::semantics diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 836500145e4a2..fc268886c5feb 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -3628,7 +3628,7 @@ std::optional ExpressionAnalyzer::CheckCall( if (chars) { std::string whyNot; if (treatExternalAsImplicit && - !chars->CanBeCalledViaImplicitInterface(&whyNot)) { + !chars->CanBeCalledViaImplicitInterface(&whyNot, /*checkCUDA=*/false)) { if (auto *msg{Say(callSite, "References to the procedure '%s' require an explicit interface"_err_en_US, DEREF(procSymbol).name())}; diff --git a/flang/test/Semantics/boz-literal-constants.f90 b/flang/test/Semantics/boz-literal-constants.f90 index 4d957d13f3f67..67e9ce78537b7 100644 --- a/flang/test/Semantics/boz-literal-constants.f90 +++ b/flang/test/Semantics/boz-literal-constants.f90 @@ -120,7 +120,7 @@ subroutine explicit(n, x, c) !ERROR: Actual argument 'z'55'' associated with dummy argument 'c=' is not a variable or typed expression call explicit(z'deadbeef', o'666', b'01010101') - !ERROR: BOZ argument requires an explicit interface + !ERROR: BOZ argument z'12345' requires an explicit interface call implictSub(Z'12345') !ERROR: Output item must not be a BOZ literal constant diff --git a/flang/test/Semantics/call13.f90 b/flang/test/Semantics/call13.f90 index 3f7fb2efc8f63..90e19180f9c56 100644 --- a/flang/test/Semantics/call13.f90 +++ b/flang/test/Semantics/call13.f90 @@ -20,7 +20,7 @@ subroutine s(assumedRank, coarray, class, classStar, typeStar) real :: array(implicit01()) ! 15.4.2.2(2) !ERROR: Keyword 'keyword=' may not appear in a reference to a procedure with an implicit interface call implicit10(1, 2, keyword=3) ! 15.4.2.2(1) - !ERROR: Assumed rank argument requires an explicit interface + !ERROR: Assumed rank argument 'assumedrank' requires an explicit interface call implicit11(assumedRank) ! 15.4.2.2(3)(c) call implicit12(coarray) ! ok call implicit12a(coarray[1]) ! ok diff --git a/flang/test/Semantics/cuf24.cuf b/flang/test/Semantics/cuf24.cuf new file mode 100644 index 0000000000000..67c9d5d72ebbd --- /dev/null +++ b/flang/test/Semantics/cuf24.cuf @@ -0,0 +1,40 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenacc + +subroutine implicitDeviceInSameFile(v) + real, device :: v(10) +end + +subroutine implicitNonDeviceInSameFile(v) + real :: v(10) +end + +program p + real, device :: dev(10) + real :: host(10) + interface + subroutine explicitDevice(v) + real, device :: v(10) + end + subroutine explicitNonDevice(v) + real :: v(10) + end + end interface + !WARNING: Actual argument 'dev' with CUDA data attributes should be passed via an explicit interface [-Wcuda-usage] + call implicit1(dev) + call implicit2(host) + !WARNING: Actual argument 'dev' with CUDA data attributes should be passed via an explicit interface [-Wcuda-usage] + call implicitDeviceInSameFile(dev) + !WARNING: If the procedure's interface were explicit, this reference would be in error [-Wknown-bad-implicit-interface] + !BECAUSE: dummy argument 'v=' has ATTRIBUTES(DEVICE) but its associated actual argument has no CUDA data attribute + call implicitDeviceInSameFile(host) + !WARNING: If the procedure's interface were explicit, this reference would be in error [-Wknown-bad-implicit-interface] + !BECAUSE: dummy argument 'v=' has no CUDA data attribute but its associated actual argument has ATTRIBUTES(DEVICE) + call implicitNonDeviceInSameFile(dev) + call implicitNonDeviceInSameFile(host) + call explicitDevice(dev) + !ERROR: dummy argument 'v=' has ATTRIBUTES(DEVICE) but its associated actual argument has no CUDA data attribute + call explicitDevice(host) + !ERROR: dummy argument 'v=' has no CUDA data attribute but its associated actual argument has ATTRIBUTES(DEVICE) + call explicitNonDevice(dev) + call explicitNonDevice(host) +end diff --git a/flang/test/Semantics/null01.f90 b/flang/test/Semantics/null01.f90 index 64c9881297308..ccf617996c30b 100644 --- a/flang/test/Semantics/null01.f90 +++ b/flang/test/Semantics/null01.f90 @@ -116,9 +116,9 @@ function f3() call optionalAllocatable(null(mold=ip0)) call optionalAllocatable(null(mold=ia0)) ! fine call optionalAllocatable(null()) ! fine - !ERROR: Null pointer argument requires an explicit interface + !ERROR: Null pointer argument 'NULL()' requires an explicit interface call implicit(null()) - !ERROR: Null pointer argument requires an explicit interface + !ERROR: Null pointer argument 'null(mold=ip0)' requires an explicit interface call implicit(null(mold=ip0)) !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument print *, sin(null(rp0))