@@ -56,28 +56,44 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
5656 " %VAL argument must be a scalar numeric or logical expression" _err_en_US);
5757 }
5858 if (const auto *expr{arg.UnwrapExpr ()}) {
59- if (const Symbol * base{GetFirstSymbol (*expr)};
60- base && IsFunctionResult (*base)) {
61- context.NoteDefinedSymbol (*base);
59+ if (const Symbol *base{GetFirstSymbol (*expr)}) {
60+ const Symbol &symbol{GetAssociationRoot (*base)};
61+ if (IsFunctionResult (symbol)) {
62+ context.NoteDefinedSymbol (symbol);
63+ }
6264 }
6365 if (IsBOZLiteral (*expr)) {
64- messages.Say (" BOZ argument requires an explicit interface" _err_en_US);
66+ messages.Say (" BOZ argument %s requires an explicit interface" _err_en_US,
67+ expr->AsFortran ());
6568 } else if (evaluate::IsNullPointerOrAllocatable (expr)) {
6669 messages.Say (
67- " Null pointer argument requires an explicit interface" _err_en_US);
70+ " Null pointer argument '%s' requires an explicit interface" _err_en_US,
71+ expr->AsFortran ());
6872 } else if (auto named{evaluate::ExtractNamedEntity (*expr)}) {
69- const Symbol &symbol{ named->GetLastSymbol ()};
70- if (IsAssumedRank (symbol )) {
73+ const Symbol &resolved{ ResolveAssociations ( named->GetLastSymbol () )};
74+ if (IsAssumedRank (resolved )) {
7175 messages.Say (
72- " Assumed rank argument requires an explicit interface" _err_en_US);
76+ " Assumed rank argument '%s' requires an explicit interface" _err_en_US,
77+ expr->AsFortran ());
7378 }
79+ const Symbol &symbol{GetAssociationRoot (resolved)};
7480 if (symbol.attrs ().test (Attr::ASYNCHRONOUS)) {
7581 messages.Say (
76- " ASYNCHRONOUS argument requires an explicit interface" _err_en_US);
82+ " ASYNCHRONOUS argument '%s' requires an explicit interface" _err_en_US,
83+ expr->AsFortran ());
7784 }
7885 if (symbol.attrs ().test (Attr::VOLATILE)) {
7986 messages.Say (
80- " VOLATILE argument requires an explicit interface" _err_en_US);
87+ " VOLATILE argument '%s' requires an explicit interface" _err_en_US,
88+ expr->AsFortran ());
89+ }
90+ if (const auto *object{symbol.detailsIf <ObjectEntityDetails>()}) {
91+ if (object->cudaDataAttr ()) {
92+ messages.Warn (/* inModuleFile=*/ false , context.languageFeatures (),
93+ common::UsageWarning::CUDAUsage,
94+ " Actual argument '%s' with CUDA data attributes should be passed via an explicit interface" _warn_en_US,
95+ expr->AsFortran ());
96+ }
8197 }
8298 } else if (auto argChars{characteristics::DummyArgument::FromActual (
8399 " actual argument" , *expr, context.foldingContext (),
@@ -2387,44 +2403,51 @@ bool CheckArguments(const characteristics::Procedure &proc,
23872403 evaluate::FoldingContext foldingContext{context.foldingContext ()};
23882404 parser::ContextualMessages &messages{foldingContext.messages ()};
23892405 bool allowArgumentConversions{true };
2406+ parser::Messages implicitBuffer;
23902407 if (!explicitInterface || treatingExternalAsImplicit) {
2391- parser::Messages buffer;
23922408 {
2393- auto restorer{messages.SetMessages (buffer )};
2409+ auto restorer{messages.SetMessages (implicitBuffer )};
23942410 for (auto &actual : actuals) {
23952411 if (actual) {
23962412 CheckImplicitInterfaceArg (*actual, messages, context);
23972413 }
23982414 }
23992415 }
2400- if (!buffer. empty ()) {
2416+ if (implicitBuffer. AnyFatalError ()) {
24012417 if (auto *msgs{messages.messages ()}) {
2402- msgs->Annex (std::move (buffer ));
2418+ msgs->Annex (std::move (implicitBuffer ));
24032419 }
24042420 return false ; // don't pile on
24052421 }
24062422 allowArgumentConversions = false ;
24072423 }
24082424 if (explicitInterface) {
2409- auto buffer {CheckExplicitInterface (proc, actuals, context, &scope,
2425+ auto explicitBuffer {CheckExplicitInterface (proc, actuals, context, &scope,
24102426 intrinsic, allowArgumentConversions,
24112427 /* extentErrors=*/ true , ignoreImplicitVsExplicit)};
2412- if (!buffer .empty ()) {
2428+ if (!explicitBuffer .empty ()) {
24132429 if (treatingExternalAsImplicit) {
2414- if (auto *msg{foldingContext.Warn (
2430+ // Combine all messages into one warning
2431+ if (auto *warning{messages.Warn (/* inModuleFile=*/ false ,
2432+ context.languageFeatures (),
24152433 common::UsageWarning::KnownBadImplicitInterface,
24162434 " If the procedure's interface were explicit, this reference would be in error" _warn_en_US)}) {
2417- buffer.AttachTo (*msg, parser::Severity::Because);
2418- } else {
2419- buffer.clear ();
2435+ explicitBuffer.AttachTo (*warning, parser::Severity::Because);
24202436 }
2437+ } else if (auto *msgs{messages.messages ()}) {
2438+ msgs->Annex (std::move (explicitBuffer));
24212439 }
2422- if (auto *msgs{messages.messages ()}) {
2423- msgs->Annex (std::move (buffer));
2424- }
2440+ // These messages override any in implicitBuffer.
24252441 return false ;
24262442 }
24272443 }
2428- return true ;
2444+ if (!implicitBuffer.empty ()) {
2445+ if (auto *msgs{messages.messages ()}) {
2446+ msgs->Annex (std::move (implicitBuffer));
2447+ }
2448+ return false ;
2449+ } else {
2450+ return true ; // no messages
2451+ }
24292452}
24302453} // namespace Fortran::semantics
0 commit comments