diff --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp index 9b48432e049b9..8d95a3ab580ef 100644 --- a/flang/lib/Semantics/check-cuda.cpp +++ b/flang/lib/Semantics/check-cuda.cpp @@ -774,4 +774,24 @@ void CUDAChecker::Enter(const parser::AssignmentStmt &x) { } } +void CUDAChecker::Enter(const parser::PrintStmt &x) { + CHECK(context_.location()); + const Scope &scope{context_.FindScope(*context_.location())}; + if (IsCUDADeviceContext(&scope) || deviceConstructDepth_ > 0) { + return; + } + + auto &outputItemList{std::get>(x.t)}; + for (const auto &item : outputItemList) { + if (const auto *x{std::get_if(&item.u)}) { + if (const auto *expr{GetExpr(context_, *x)}) { + if (Fortran::evaluate::HasCUDADeviceAttrs(*expr)) { + context_.Say(parser::FindSourceLocation(*x), + "device data not allowed in I/O statements"_err_en_US); + } + } + } + } +} + } // namespace Fortran::semantics diff --git a/flang/lib/Semantics/check-cuda.h b/flang/lib/Semantics/check-cuda.h index 10000253ffe5a..ef5e57ab41b81 100644 --- a/flang/lib/Semantics/check-cuda.h +++ b/flang/lib/Semantics/check-cuda.h @@ -49,6 +49,7 @@ class CUDAChecker : public virtual BaseChecker { void Leave(const parser::OpenACCLoopConstruct &); void Enter(const parser::DoConstruct &); void Leave(const parser::DoConstruct &); + void Enter(const parser::PrintStmt &); private: SemanticsContext &context_; diff --git a/flang/test/Semantics/cuf23.cuf b/flang/test/Semantics/cuf23.cuf new file mode 100644 index 0000000000000..386ad50a70acb --- /dev/null +++ b/flang/test/Semantics/cuf23.cuf @@ -0,0 +1,34 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenacc + +program test + real, device :: a(10) + a = 1.0 +!ERROR: device data not allowed in I/O statements + print *, a(1) +!ERROR: device data not allowed in I/O statements + print *, a +end + +subroutine host() + integer :: i + real, device :: a(10) + !$acc parallel loop + do i = 1, 10 + print*, a(i) ! ok + end do + + !$cuf kernel do + do i = 1, 10 + print*, a(i) ! ok + end do +end subroutine + +attributes(global) subroutine global1() + real, device :: a(10) + print*, a ! ok +end subroutine + +attributes(device) subroutine device1() + real, device :: a(10) + print*, a ! ok +end subroutine