[flang][cuda] Fix crash in semantic

[clementval]

Fix for #88451

Do not perform semantic check about data transfer on assignment statement in device context.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Valentin Clement (バレンタイン クレメン) (clementval)

Changes

Fix for #88451

Do not perform semantic check about data transfer on assignment statement in device context.

---

Full diff: https://github.com/llvm/llvm-project/pull/88577.diff

2 Files Affected:

• (modified) flang/lib/Semantics/check-cuda.cpp (+6-1)
• (modified) flang/test/Semantics/cuf11.cuf (+12)

diff --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp
index e0a796972441ba..49679c1a9304f3 100644
--- a/flang/lib/Semantics/check-cuda.cpp
+++ b/flang/lib/Semantics/check-cuda.cpp
@@ -480,10 +480,15 @@ void CUDAChecker::Enter(const parser::CUFKernelDoConstruct &x) {
 }
 
 void CUDAChecker::Enter(const parser::AssignmentStmt &x) {
+  auto lhsLoc{std::get<parser::Variable>(x.t).GetSource()};
+  const auto &scope{context_.FindScope(lhsLoc)};
+  const Scope &progUnit{GetProgramUnitContaining(scope)};
+  if (IsCUDADeviceContext(&progUnit))
+    return; // Data transfer with assignment is only perform on host.
+
   const evaluate::Assignment *assign{semantics::GetAssignment(x)};
   int nbLhs{evaluate::GetNbOfCUDASymbols(assign->lhs)};
   int nbRhs{evaluate::GetNbOfCUDASymbols(assign->rhs)};
-  auto lhsLoc{std::get<parser::Variable>(x.t).GetSource()};
 
   // device to host transfer with more than one device object on the rhs is not
   // legal.
diff --git a/flang/test/Semantics/cuf11.cuf b/flang/test/Semantics/cuf11.cuf
index 96108e2b245560..b915c7246ed947 100644
--- a/flang/test/Semantics/cuf11.cuf
+++ b/flang/test/Semantics/cuf11.cuf
@@ -1,5 +1,17 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 
+module mod1
+contains
+  attributes(global) subroutine sub1(adev)
+    real :: adev(10)
+    integer :: tid
+    tid = threadIdx%x
+! Use to crash the compiler. Make sure we have the proper semantic error.
+!ERROR: Actual argument for 'i=' has bad type 'REAL(4)'
+    adev(tid + 1) = scale(real(tid), 2.0) 
+  end subroutine sub1
+end module
+
 subroutine sub1()
   real, device :: adev(10), bdev(10)
   real :: ahost(10)