[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

Author: EthanLuisMcDonough

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();
 }
 

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

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

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

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