[flang][cuda] Allow list-directed PRINT and WRITE stmt in device code (#87415)

The specification allow list-directed PRINT and WRITE statements to
appear in device code. This patch relax the semantic check to allow
them.

3.6.11.
List-directed PRINT and WRITE statements to the default unit may be used
when compiling for compute capability 2.0 and higher; all other uses of
PRINT and WRITE are disallowed.

Author: clementval

flang/lib/Semantics/check-cuda.cpp

@@ -277,9 +277,73 @@ template <bool IsCUFKernelDo> class DeviceContextChecker {
         },
         ec.u);
   }
+  template <typename SEEK, typename A>
+  static const SEEK *GetIOControl(const A &stmt) {
+    for (const auto &spec : stmt.controls) {
+      if (const auto *result{std::get_if<SEEK>(&spec.u)}) {
+        return result;
+      }
+    }
+    return nullptr;
+  }
+  template <typename A> static bool IsInternalIO(const A &stmt) {
+    if (stmt.iounit.has_value()) {
+      return std::holds_alternative<Fortran::parser::Variable>(stmt.iounit->u);
+    }
+    if (auto *unit{GetIOControl<Fortran::parser::IoUnit>(stmt)}) {
+      return std::holds_alternative<Fortran::parser::Variable>(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 <typename A>
+  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<parser::PrintStmt> &) {},
+            [&](const common::Indirection<parser::WriteStmt> &x) {
+              if (x.value().format) { // Formatted write to '*' or '6'
+                if (std::holds_alternative<Fortran::parser::Star>(
+                        x.value().format->u)) {
+                  if (x.value().iounit) {
+                    if (std::holds_alternative<Fortran::parser::Star>(
+                            x.value().iounit->u)) {
+                      return;
+                    }
+                  }
+                }
+              }
+              WarnIfNotInternal(x.value(), source);
+            },
+            [&](const common::Indirection<parser::CloseStmt> &x) {
+              WarnOnIoStmt(source);
+            },
+            [&](const common::Indirection<parser::EndfileStmt> &x) {
+              WarnOnIoStmt(source);
+            },
+            [&](const common::Indirection<parser::OpenStmt> &x) {
+              WarnOnIoStmt(source);
+            },
+            [&](const common::Indirection<parser::ReadStmt> &x) {
+              WarnIfNotInternal(x.value(), source);
+            },
+            [&](const common::Indirection<parser::InquireStmt> &x) {
+              WarnOnIoStmt(source);
+            },
+            [&](const common::Indirection<parser::RewindStmt> &x) {
+              WarnOnIoStmt(source);
+            },
+            [&](const common::Indirection<parser::BackspaceStmt> &x) {
+              WarnOnIoStmt(source);
+            },
             [&](const auto &x) {
               if (auto msg{ActionStmtChecker<IsCUFKernelDo>::WhyNotOk(x)}) {
                 context_.Say(source, std::move(*msg));

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