diff --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp index 39bfc47a8eb1e..e0a796972441b 100644 --- a/flang/lib/Semantics/check-cuda.cpp +++ b/flang/lib/Semantics/check-cuda.cpp @@ -277,9 +277,73 @@ template class DeviceContextChecker { }, ec.u); } + template + static const SEEK *GetIOControl(const A &stmt) { + for (const auto &spec : stmt.controls) { + if (const auto *result{std::get_if(&spec.u)}) { + return result; + } + } + return nullptr; + } + template static bool IsInternalIO(const A &stmt) { + if (stmt.iounit.has_value()) { + return std::holds_alternative(stmt.iounit->u); + } + if (auto *unit{GetIOControl(stmt)}) { + return std::holds_alternative(unit->u); + } + return false; + } + void WarnOnIoStmt(const parser::CharBlock &source) { + context_.Say( + source, "I/O statement might not be supported on device"_warn_en_US); + } + template + void WarnIfNotInternal(const A &stmt, const parser::CharBlock &source) { + if (!IsInternalIO(stmt)) { + WarnOnIoStmt(source); + } + } void Check(const parser::ActionStmt &stmt, const parser::CharBlock &source) { common::visit( common::visitors{ + [&](const common::Indirection &) {}, + [&](const common::Indirection &x) { + if (x.value().format) { // Formatted write to '*' or '6' + if (std::holds_alternative( + x.value().format->u)) { + if (x.value().iounit) { + if (std::holds_alternative( + x.value().iounit->u)) { + return; + } + } + } + } + WarnIfNotInternal(x.value(), source); + }, + [&](const common::Indirection &x) { + WarnOnIoStmt(source); + }, + [&](const common::Indirection &x) { + WarnOnIoStmt(source); + }, + [&](const common::Indirection &x) { + WarnOnIoStmt(source); + }, + [&](const common::Indirection &x) { + WarnIfNotInternal(x.value(), source); + }, + [&](const common::Indirection &x) { + WarnOnIoStmt(source); + }, + [&](const common::Indirection &x) { + WarnOnIoStmt(source); + }, + [&](const common::Indirection &x) { + WarnOnIoStmt(source); + }, [&](const auto &x) { if (auto msg{ActionStmtChecker::WhyNotOk(x)}) { context_.Say(source, std::move(*msg)); diff --git a/flang/test/Semantics/cuf09.cuf b/flang/test/Semantics/cuf09.cuf index 4bc93132044fd..d2d4d239815e4 100644 --- a/flang/test/Semantics/cuf09.cuf +++ b/flang/test/Semantics/cuf09.cuf @@ -7,6 +7,14 @@ module m do k=1,10 end do end + attributes(device) subroutine devsub2 + real, device :: x(10) + print*,'from device' + print '(f10.5)', (x(ivar), ivar = 1, 10) + write(*,*), "Hello world from device!" + !WARNING: I/O statement might not be supported on device + write(12,'(10F4.1)'), x + end end program main