[flang-commits] [flang] 9ac5b1f - [flang][openmp] Semantic check for OpenMPExecutableAllocate

[Ethan Luis McDonough via flang-commits]

Author: Ethan Luis McDonough
Date: 2023-09-08T13:03:04-05:00
New Revision: 9ac5b1f1b205980fc924103da0984b87ed96a77b

URL: https://github.com/llvm/llvm-project/commit/9ac5b1f1b205980fc924103da0984b87ed96a77b
DIFF: https://github.com/llvm/llvm-project/commit/9ac5b1f1b205980fc924103da0984b87ed96a77b.diff

LOG: [flang][openmp] Semantic check for OpenMPExecutableAllocate

Executable allocate directives require that list items show up in the corresponding allocate statement.  This patch is dependent on revision D150428 and applies the semantic check introduced there to allocate directives associated with allocate statements.

Reviewed By: kiranchandramohan

Differential Revision: https://reviews.llvm.org/D150483

Added: 
    flang/test/Semantics/OpenMP/allocate09.f90

Modified: 
    flang/lib/Semantics/resolve-directives.cpp
    flang/test/Semantics/OpenMP/allocate-directive.f90
    flang/test/Semantics/OpenMP/allocate01.f90
    flang/test/Semantics/OpenMP/allocate02.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index f72334e1506da0e..38e195d20a34367 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1761,6 +1761,21 @@ void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) {
         "ALLOCATE directives that appear in a TARGET region "
         "must specify an allocator clause"_err_en_US);
   }
+
+  const auto &allocateStmt =
+      std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement;
+  if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
+    CheckAllNamesInAllocateStmt(
+        std::get<parser::Verbatim>(x.t).source, *list, allocateStmt);
+  }
+  if (const auto &subDirs{
+          std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
+              x.t)}) {
+    for (const auto &dalloc : *subDirs) {
+      CheckAllNamesInAllocateStmt(std::get<parser::Verbatim>(dalloc.t).source,
+          std::get<parser::OmpObjectList>(dalloc.t), allocateStmt);
+    }
+  }
   PopContext();
 }
 

diff  --git a/flang/test/Semantics/OpenMP/allocate-directive.f90 b/flang/test/Semantics/OpenMP/allocate-directive.f90
index 5204e4aceae7685..254e5b617a7a90c 100644
--- a/flang/test/Semantics/OpenMP/allocate-directive.f90
+++ b/flang/test/Semantics/OpenMP/allocate-directive.f90
@@ -5,21 +5,21 @@
 ! 2.11.3 declarative allocate
 ! 2.11.3 executable allocate
 
-real, dimension (:,:), allocatable :: darray
-integer :: a, b, x, y, m, n, t, z
+integer :: x, y
+integer, allocatable :: a, b, m, n, t, z
 !$omp allocate(x, y)
 !$omp allocate(x, y) allocator(omp_default_mem_alloc)
 
 !$omp allocate(a, b)
-    allocate ( darray(a, b) )
+    allocate ( a, b )
 
 !$omp allocate(a, b) allocator(omp_default_mem_alloc)
-    allocate ( darray(a, b) )
+    allocate ( a, b )
 
 !$omp allocate(t) allocator(omp_const_mem_alloc)
 !$omp allocate(z) allocator(omp_default_mem_alloc)
 !$omp allocate(m) allocator(omp_default_mem_alloc)
 !$omp allocate(n)
-    allocate ( darray(z, t) )
+    allocate ( t, z, m, n )
 
 end

diff  --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90
index 92a7c23ff276515..4b290a5c2c749ba 100644
--- a/flang/test/Semantics/OpenMP/allocate01.f90
+++ b/flang/test/Semantics/OpenMP/allocate01.f90
@@ -6,19 +6,20 @@
 
 subroutine allocate()
 use omp_lib
-  integer :: x
+  integer, allocatable :: x(:)
+  integer :: y
   contains
     subroutine sema()
     integer :: a, b
     real, dimension (:,:), allocatable :: darray
 
     !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
-    !$omp allocate(x)
+    !$omp allocate(y)
         print *, a
 
     !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
     !$omp allocate(x) allocator(omp_default_mem_alloc)
-      allocate ( darray(a, b) )
+      allocate ( x(a), darray(a, b) )
     end subroutine sema
 
 end subroutine allocate

diff  --git a/flang/test/Semantics/OpenMP/allocate02.f90 b/flang/test/Semantics/OpenMP/allocate02.f90
index a5c4f3f6c1896ec..d7da9ef575271ea 100644
--- a/flang/test/Semantics/OpenMP/allocate02.f90
+++ b/flang/test/Semantics/OpenMP/allocate02.f90
@@ -14,11 +14,11 @@ subroutine allocate()
   !ERROR: At most one ALLOCATOR clause can appear on the ALLOCATE directive
   !$omp allocate(x, y) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc)
 
-  !$omp allocate(x) allocator(omp_default_mem_alloc)
+  !$omp allocate(darray) allocator(omp_default_mem_alloc)
       allocate ( darray(a, b) )
 
   !ERROR: At most one ALLOCATOR clause can appear on the ALLOCATE directive
-  !$omp allocate(x) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc)
+  !$omp allocate(darray) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc)
       allocate ( darray(a, b) )
 
 end subroutine allocate

diff  --git a/flang/test/Semantics/OpenMP/allocate09.f90 b/flang/test/Semantics/OpenMP/allocate09.f90
new file mode 100644
index 000000000000000..26d6ff98c4a3f14
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/allocate09.f90
@@ -0,0 +1,33 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive
+! List items specified in an allocate directive that is associated
+! with an allocate statement must be variables that are allocated
+! by the allocate statement.
+
+subroutine allocate()
+use omp_lib
+  integer, dimension(:), allocatable :: a, b, c, d, e, f, &
+                                        g, h, i, j, k, l
+
+  !$omp allocate(a) allocator(omp_default_mem_alloc)
+    allocate(a(1), b(2))
+
+  !$omp allocate(c, d) allocator(omp_default_mem_alloc)
+    allocate(c(3), d(4))
+
+  !$omp allocate(e) allocator(omp_default_mem_alloc)
+  !$omp allocate(f, g) allocator(omp_default_mem_alloc)
+  !$omp allocate
+    allocate(e(5), f(6), g(7))
+
+  !ERROR: Object 'i' in ALLOCATE directive not found in corresponding ALLOCATE statement
+  !$omp allocate(h, i) allocator(omp_default_mem_alloc)
+    allocate(h(8))
+
+  !ERROR: Object 'j' in ALLOCATE directive not found in corresponding ALLOCATE statement
+  !$omp allocate(j, k) allocator(omp_default_mem_alloc)
+  !$omp allocate(l) allocator(omp_default_mem_alloc)
+    allocate(k(9), l(10))
+
+end subroutine allocate