[flang][CUDA] Allow constant to match device actual in specific procedure (llvm#178658)

When scanning the specific procedures of a generic interface for a match
for a set of actual arguments, accept a constant actual argument as a
match for a dummy argument with the DEVICE attribute.

Author: klausler

flang/lib/Semantics/check-call.cpp

@@ -1107,8 +1107,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
         actualDataAttr = common::CUDADataAttr::Device;
       }
       // For device procedures, treat actual arguments with VALUE attribute as
-      // device data
-      if (!actualDataAttr && actualLastSymbol && IsValue(*actualLastSymbol) &&
+      // device data; also constant actual arguments.
+      if (!actualDataAttr &&
+          (!actualLastSymbol || IsValue(*actualLastSymbol)) &&
           (*procedure.cudaSubprogramAttrs ==
               common::CUDASubprogramAttrs::Device)) {
         actualDataAttr = common::CUDADataAttr::Device;

flang/lib/Semantics/expression.cpp

@@ -3011,7 +3011,6 @@ auto ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
           }
           crtMatchingDistance = ComputeCudaMatchingDistance(
               context_.languageFeatures(), *procedure, localActuals);
-        } else {
         }
       }
     }
@@ -3113,14 +3112,12 @@ void ExpressionAnalyzer::EmitGenericResolutionError(const Symbol &symbol,
               ? "No specific subroutine of generic '%s' matches the actual arguments"_err_en_US
               : "No specific function of generic '%s' matches the actual arguments"_err_en_US,
           symbol.name())}) {
-    parser::ContextualMessages &messages{GetContextualMessages()};
-    semantics::Scope &scope{context_.FindScope(messages.at())};
     for (const Symbol &specific : tried) {
       if (auto procChars{characteristics::Procedure::Characterize(
               specific, GetFoldingContext())}) {
         if (procChars->HasExplicitInterface()) {
           auto reasons{semantics::CheckExplicitInterface(*procChars, arguments,
-              context_, &scope, /*intrinsic=*/nullptr,
+              context_, /*scope=*/nullptr, /*intrinsic=*/nullptr,
               /*allocActualArgumentConversions=*/false,
               /*extentErrors=*/false,
               /*ignoreImplicitVsExplicit=*/false)};

flang/test/Semantics/bug2131.cuf

@@ -0,0 +1,26 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1 -x cuda
+module m
+  interface randomNumber
+     module procedure rngScalar, rngArray
+  end interface
+  integer :: host_n = 3
+ contains
+  attributes(device) function rngScalar() result(res)
+    real :: res
+    res = 123.
+  end
+  attributes(device) function rngArray(n) result(res)
+    integer, intent(in) :: n
+    real :: res(n)
+    res = 123.
+  end
+  attributes(device) function randomPointInUnitSphere() result(res)
+    real :: res(3)
+    integer :: n
+    res = randomNumber(3) ! ok, constant
+    n = 3
+    res = randomNumber(n) ! ok, local
+    !ERROR: No specific function of generic 'randomnumber' matches the actual arguments
+    res = randomNumber(host_n)
+  end
+end