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

[via flang-commits]

Author: Valentin Clement (バレンタイン クレメン)
Date: 2024-04-08T09:59:12-07:00
New Revision: 896b5e55711121b3de4630fe1412b50d96061c1c

URL: https://github.com/llvm/llvm-project/commit/896b5e55711121b3de4630fe1412b50d96061c1c
DIFF: https://github.com/llvm/llvm-project/commit/896b5e55711121b3de4630fe1412b50d96061c1c.diff

LOG: [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.

Added: 
    

Modified: 
    flang/lib/Semantics/check-cuda.cpp
    flang/test/Semantics/cuf09.cuf

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp
index 39bfc47a8eb1ee..e0a796972441ba 100644
--- a/flang/lib/Semantics/check-cuda.cpp
+++ b/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));

diff  --git a/flang/test/Semantics/cuf09.cuf b/flang/test/Semantics/cuf09.cuf
index 4bc93132044fdd..d2d4d239815e4b 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