[flang-commits] [flang] [flang][OpenMP] Add semantic check for target construct (PR #73697)

[via flang-commits]

https://github.com/shraiysh created https://github.com/llvm/llvm-project/pull/73697

This patch adds the following semantic check for target construct

```
The result of an omp_set_default_device, omp_get_default_device, or
omp_get_num_devices routine called within a target region is
unspecified.
```

>From 797f152d91249586eafce3f78e87d2c3aa9eb959 Mon Sep 17 00:00:00 2001
From: Shraiysh Vaishay <shraiysh.vaishay at amd.com>
Date: Tue, 28 Nov 2023 13:59:57 -0600
Subject: [PATCH] [flang][OpenMP] Add semantic check for target construct

This patch adds the following semantic check for target construct

```
The result of an omp_set_default_device, omp_get_default_device, or
omp_get_num_devices routine called within a target region is
unspecified.
```
---
 flang/lib/Semantics/check-omp-structure.cpp | 15 +++++++++++++++
 flang/lib/Semantics/check-omp-structure.h   |  2 ++
 flang/test/Semantics/OpenMP/target03.f90    | 17 +++++++++++++++++
 3 files changed, 34 insertions(+)
 create mode 100644 flang/test/Semantics/OpenMP/target03.f90

diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 53bdf57ff8efa5a..9d4c3d12870b84e 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -10,6 +10,7 @@
 #include "definable.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/tools.h"
+#include "llvm/ADT/StringSet.h"
 
 namespace Fortran::semantics {
 
@@ -2653,6 +2654,20 @@ void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::Call &c) {
+  const parser::Name *name =
+      std::get_if<parser::Name>(&std::get<parser::ProcedureDesignator>(c.t).u);
+  llvm::StringSet rtlfns{"omp_set_default_device", "omp_get_default_device",
+      "omp_get_num_devices"};
+  if (context_.ShouldWarn(common::UsageWarning::Portability) &&
+      GetContext().directive == llvm::omp::OMPD_target && name &&
+      rtlfns.contains(name->ToString())) {
+    context_.Say("The result of an %s routine called within a TARGET region is "
+                 "unspecified."_port_en_US,
+        parser::ToUpperCaseLetters(name->ToString()));
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_linear);
 
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 90e5c9f19127750..2c351c91ab85121 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -116,6 +116,8 @@ class OmpStructureChecker
   void Enter(const parser::OmpAtomicCapture &);
   void Leave(const parser::OmpAtomic &);
 
+  void Enter(const parser::Call &c);
+
 #define GEN_FLANG_CLAUSE_CHECK_ENTER
 #include "llvm/Frontend/OpenMP/OMP.inc"
 
diff --git a/flang/test/Semantics/OpenMP/target03.f90 b/flang/test/Semantics/OpenMP/target03.f90
new file mode 100644
index 000000000000000..d101dae610b3c72
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/target03.f90
@@ -0,0 +1,17 @@
+! RUN: %flang_fc1 -fopenmp -fdebug-dump-parse-tree -pedantic %s 2>&1 | FileCheck %s
+
+program main
+  use omp_lib
+  integer :: x, y
+contains
+  subroutine foo()
+  !$omp target
+    !CHECK: portability: The result of an OMP_GET_DEFAULT_DEVICE routine called within a TARGET region is unspecified.
+    x = omp_get_default_device()
+    !CHECK: portability: The result of an OMP_GET_NUM_DEVICES routine called within a TARGET region is unspecified.
+    y = omp_get_num_devices()
+    !CHECK: portability: The result of an OMP_SET_DEFAULT_DEVICE routine called within a TARGET region is unspecified.
+    call omp_set_default_device(x)
+  !$omp end target
+  end subroutine
+end program