[flang-commits] [flang] [flang][cuda] Emit error when a device actual argument is used in host intrinsic (PR #174025)
via flang-commits
flang-commits at lists.llvm.org
Tue Dec 30 13:51:10 PST 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Valentin Clement (バレンタイン クレメン) (clementval)
<details>
<summary>Changes</summary>
This can lead to segfault if a device variable is used in a host intrinsic. Emit an error in semantic.
Reland #<!-- -->172914 with the addition of `__builtin_c_devloc `, `loc` and `present` as skipped intrinsic
---
Full diff: https://github.com/llvm/llvm-project/pull/174025.diff
5 Files Affected:
- (modified) flang/lib/Semantics/check-call.cpp (+36)
- (modified) flang/lib/Semantics/resolve-names.cpp (+12)
- (modified) flang/test/Lower/CUDA/cuda-data-transfer.cuf (+11-1)
- (modified) flang/test/Lower/CUDA/cuda-devptr.cuf (+6)
- (modified) flang/test/Semantics/cuf23.cuf (+18)
``````````diff
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 5f276d9b9f4f8..46cc35fcb0d57 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -18,6 +18,7 @@
#include "flang/Parser/message.h"
#include "flang/Semantics/scope.h"
#include "flang/Semantics/tools.h"
+#include "llvm/ADT/StringSet.h"
#include <map>
#include <string>
@@ -340,6 +341,15 @@ static bool DefersSameTypeParameters(
return true;
}
+// List of intrinsics that are skipped when checking for device actual
+// arguments.
+static const llvm::StringSet<> cudaSkippedIntrinsics = {"__builtin_c_devloc",
+ "__builtin_c_f_pointer", "__builtin_c_loc", "loc", "present"};
+// List of intrinsics that can have a device actual argument if it is an
+// allocatable or pointer.
+static const llvm::StringSet<> cudaAllowedIntrinsics = {"allocated",
+ "associated", "kind", "lbound", "shape", "size", "ubound"};
+
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
characteristics::TypeAndShape &actualType, bool isElemental,
@@ -1140,6 +1150,32 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummyName, toStr(dummyDataAttr), toStr(actualDataAttr));
}
}
+ // Emit an error message if an actual argument passed to a host intrinsic is
+ // on the device.
+ if (intrinsic && !FindCUDADeviceContext(scope) &&
+ !FindOpenACCConstructContaining(scope)) {
+ if (!cudaSkippedIntrinsics.contains(intrinsic->name)) {
+ std::optional<common::CUDADataAttr> actualDataAttr;
+ if (const auto *actualObject{actualLastSymbol
+ ? actualLastSymbol->detailsIf<ObjectEntityDetails>()
+ : nullptr}) {
+ actualDataAttr = actualObject->cudaDataAttr();
+ }
+ if (actualDataAttr && *actualDataAttr == common::CUDADataAttr::Device) {
+ // Allocatable or pointer with device attribute have their descriptor in
+ // managed memory. It is allowed to pass them to some inquiry
+ // intrinsics.
+ if (!actualLastSymbol || !IsAllocatableOrPointer(*actualLastSymbol) ||
+ (IsAllocatableOrPointer(*actualLastSymbol) &&
+ !cudaAllowedIntrinsics.contains(intrinsic->name))) {
+ messages.Say(
+ "Actual argument %s associated with host intrinsic %s is on the device"_err_en_US,
+ actualLastSymbol ? actualLastSymbol->name() : "",
+ intrinsic->name);
+ }
+ }
+ }
+ }
// Warning for breaking F'2023 change with character allocatables
if (intrinsic && dummy.intent != common::Intent::In) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5cc887791048d..6b59eb94c1c9b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1081,6 +1081,8 @@ class DeclarationVisitor : public ArraySpecVisitor,
bool Pre(const parser::SaveStmt &);
bool Pre(const parser::BasedPointer &);
void Post(const parser::BasedPointer &);
+ bool Pre(const parser::CUFKernelDoConstruct &);
+ void Post(const parser::CUFKernelDoConstruct &);
void PointerInitialization(
const parser::Name &, const parser::InitialDataTarget &);
@@ -9278,6 +9280,16 @@ void DeclarationVisitor::LegacyDataInitialization(const parser::Name &name,
}
}
+bool DeclarationVisitor::Pre(const parser::CUFKernelDoConstruct &x) {
+ // Treat CUDA kernel do construct as OpenACC construct.
+ PushScope(Scope::Kind::OpenACCConstruct, nullptr);
+ return true;
+}
+
+void DeclarationVisitor::Post(const parser::CUFKernelDoConstruct &x) {
+ PopScope();
+}
+
void ResolveNamesVisitor::HandleCall(
Symbol::Flag procFlag, const parser::Call &call) {
common::visit(
diff --git a/flang/test/Lower/CUDA/cuda-data-transfer.cuf b/flang/test/Lower/CUDA/cuda-data-transfer.cuf
index 015947430b07c..e0c23a1d5df8f 100644
--- a/flang/test/Lower/CUDA/cuda-data-transfer.cuf
+++ b/flang/test/Lower/CUDA/cuda-data-transfer.cuf
@@ -22,6 +22,15 @@ module mod1
end function
end interface
+ interface
+ function somefunction(d, n)
+ integer :: n
+ real(8), device :: d(n,n)
+ real(8) :: somefunction(n)
+ end function
+ end interface
+
+
contains
function dev1(a)
integer, device :: a(:)
@@ -447,9 +456,10 @@ end subroutine
! CHECK: cuf.data_transfer
subroutine sub23(n)
+ use mod1
integer :: n
real(8), device :: d(n,n), x(n)
- x = sum(d,dim=2) ! Was triggering Unsupported CUDA data transfer
+ x = somefunction(d,2) ! Was triggering Unsupported CUDA data transfer
end subroutine
! CHECK-LABEL: func.func @_QPsub23
diff --git a/flang/test/Lower/CUDA/cuda-devptr.cuf b/flang/test/Lower/CUDA/cuda-devptr.cuf
index 2d6af2a9693a4..b1126c6fd58af 100644
--- a/flang/test/Lower/CUDA/cuda-devptr.cuf
+++ b/flang/test/Lower/CUDA/cuda-devptr.cuf
@@ -81,3 +81,9 @@ end subroutine
! CHECK-LABEL: func.func @_QPassign_nested_c_devptr
! CHECK-NOT: fir.call @_FortranAAssign
+
+subroutine host_c_devloc(a)
+ use __fortran_builtins, only: c_devloc => __builtin_c_devloc
+ complex, allocatable, device :: a(:)
+ print*, c_devloc(a(1))
+end subroutine
diff --git a/flang/test/Semantics/cuf23.cuf b/flang/test/Semantics/cuf23.cuf
index 8c03c18d9b0db..759a1c4e588b9 100644
--- a/flang/test/Semantics/cuf23.cuf
+++ b/flang/test/Semantics/cuf23.cuf
@@ -53,3 +53,21 @@ attributes(global) subroutine global_with_block()
print*, a ! ok
end block
end subroutine
+
+subroutine intrinsic_error(n)
+ integer :: n
+ real(8), device :: d(n,n), x(n)
+!ERROR: Actual argument d associated with host intrinsic sum is on the device
+ x = sum(d,dim=2)
+end subroutine
+
+subroutine intrinsic_error_skipped(ws)
+ integer(8), device, optional :: ws(*)
+ integer(8) :: p
+ if (.not. present(ws)) then
+ print*, 'not present'
+ else
+ p = loc(ws(1))
+ end if
+
+end subroutine
``````````
</details>
https://github.com/llvm/llvm-project/pull/174025
More information about the flang-commits
mailing list