[flang-commits] [flang] [flang][OpenMP] Add semantic check for declare target (PR #71425)

[via flang-commits]

https://github.com/shraiysh updated https://github.com/llvm/llvm-project/pull/71425

>From 72bf7eaf87e39b2b68f6b5252642469da15e6db7 Mon Sep 17 00:00:00 2001
From: Shraiysh Vaishay <shraiysh.vaishay at amd.com>
Date: Sun, 5 Nov 2023 14:27:04 -0600
Subject: [PATCH] [flang][OpenMP] Add semantic check for declare target

This patch adds a semantic check for the following:

```
If a list item is a procedure name, it must not be a generic name,
procedure pointer, entry name, or statement function name.
```
---
 flang/lib/Semantics/check-omp-structure.cpp   | 31 ++++++++++++
 flang/lib/Semantics/check-omp-structure.h     |  1 +
 .../Semantics/OpenMP/declare-target07.f90     | 49 +++++++++++++++++++
 3 files changed, 81 insertions(+)
 create mode 100644 flang/test/Semantics/OpenMP/declare-target07.f90

diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 512a44ba77da16f..d7a0681d1c3d476 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1173,6 +1173,37 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) {
+  SymbolSourceMap symbols;
+  GetSymbolsInObjectList(x.v, symbols);
+  for (auto &[symbol, source] : symbols) {
+    const GenericDetails *genericDetails = symbol->detailsIf<GenericDetails>();
+    if (genericDetails) {
+      context_.Say(source,
+          "The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US,
+          symbol->name());
+      genericDetails->specific();
+    }
+    if (IsProcedurePointer(*symbol)) {
+      context_.Say(source,
+          "The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US,
+          symbol->name());
+    }
+    const SubprogramDetails *entryDetails =
+        symbol->detailsIf<SubprogramDetails>();
+    if (entryDetails && entryDetails->entryScope()) {
+      context_.Say(source,
+          "The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US,
+          symbol->name());
+    }
+    if (IsStmtFunction(*symbol)) {
+      context_.Say(source,
+          "The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US,
+          symbol->name());
+    }
+  }
+}
+
 void OmpStructureChecker::CheckSymbolNames(
     const parser::CharBlock &source, const parser::OmpObjectList &objList) {
   for (const auto &ompObject : objList.v) {
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 0adfa7b5d83874d..d35602cca75d549 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -79,6 +79,7 @@ class OmpStructureChecker
   void Leave(const parser::OpenMPDeclarativeAllocate &);
   void Enter(const parser::OpenMPDeclareTargetConstruct &);
   void Leave(const parser::OpenMPDeclareTargetConstruct &);
+  void Enter(const parser::OmpDeclareTargetWithList &);
   void Enter(const parser::OpenMPExecutableAllocate &);
   void Leave(const parser::OpenMPExecutableAllocate &);
   void Enter(const parser::OpenMPAllocatorsConstruct &);
diff --git a/flang/test/Semantics/OpenMP/declare-target07.f90 b/flang/test/Semantics/OpenMP/declare-target07.f90
new file mode 100644
index 000000000000000..22b4a4bd081d755
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-target07.f90
@@ -0,0 +1,49 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
+
+module my_module
+  interface foo
+    subroutine foo_int(a)
+    integer :: a
+    end subroutine
+    subroutine foo_real(a)
+    real :: a
+    end subroutine
+  end interface
+contains
+  subroutine bar(N)
+    integer :: N
+    entry entry1(N)
+  end subroutine
+  subroutine foobar(N)
+    integer::N
+    !ERROR: The procedure 'entry1' in DECLARE TARGET construct cannot be an entry name.
+    !$omp declare target(bar, entry1)
+    call bar(N)
+  end subroutine
+end module
+
+module other_mod
+  abstract interface
+    integer function foo(a)
+      integer, intent(in) :: a
+    end function
+  end interface
+  procedure(foo), pointer :: procptr
+  !ERROR: The procedure 'procptr' in DECLARE TARGET construct cannot be a procedure pointer.
+  !$omp declare target(procptr)
+end module
+
+subroutine baz(x)
+    real, intent(inout) :: x
+    real :: res 
+    stmtfunc(x) = 4.0 * (x**3)
+    !ERROR: The procedure 'stmtfunc' in DECLARE TARGET construct cannot be a statement function.
+    !$omp declare target (stmtfunc)
+    res = stmtfunc(x)
+end subroutine
+
+program main
+  use my_module
+  !ERROR: The procedure 'foo' in DECLARE TARGET construct cannot be a generic name.
+  !$omp declare target(foo)
+end