[flang][CUDA] Downgrade error to warning

flang/include/flang/Evaluate/characteristics.h

@@ -251,7 +251,8 @@ struct DummyDataObject {
       std::optional<std::string> *warning = nullptr) const;
   static std::optional<DummyDataObject> 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<std::string> *warning = nullptr) const;
@@ -402,7 +404,8 @@ struct Procedure {
     return !attrs.test(Attr::ImplicitInterface);
   }
   std::optional<int> FindPassIndex(std::optional<parser::CharBlock>) const;
-  bool CanBeCalledViaImplicitInterface(std::string *whyNot = nullptr) const;
+  bool CanBeCalledViaImplicitInterface(
+      std::string *whyNot = nullptr, bool checkCUDA = true) const;
   bool CanOverride(const Procedure &, std::optional<int> passIndex) const;
   bool IsCompatibleWith(const Procedure &, bool ignoreImplicitVsExplicit,
       std::string *whyNot = nullptr, const SpecificIntrinsic * = nullptr,

flang/lib/Evaluate/characteristics.cpp

@@ -458,7 +458,7 @@ std::optional<DummyDataObject> 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<DummyDataObject>(&u)}) {
-    return object->CanBePassedViaImplicitInterface(whyNot);
+    return object->CanBePassedViaImplicitInterface(whyNot, checkCUDA);
   } else if (const auto *proc{std::get_if<DummyProcedure>(&u)}) {
     return proc->CanBePassedViaImplicitInterface(whyNot);
   } else {
@@ -1501,7 +1502,8 @@ std::optional<Procedure> 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;
       }
     }

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<ObjectEntityDetails>()}) {
+        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

flang/lib/Semantics/expression.cpp

@@ -3628,7 +3628,7 @@ std::optional<characteristics::Procedure> 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())};

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

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

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

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