[flang] [openmp] Correct OpenMP Allocate Directive parse tree structure to associate directives with allocate statements correctly.

[I_Perry]

Summary

This patch implements a parse tree rewrite such that openmp allocate directives which should be associated with fortran allocate statements are done so.

[I_Perry]

Added test to stop unambiguous start of executable allocate from being ignored.

[kiranchandramohan]

Can this be in the Canonicalize OpenMP file?
flang/lib/Semantics/canonicalize-omp.cpp

[I_Perry]

Addressed comment to move changes to canonicalize-omp.cpp

[I_Perry]

Removed included <iterator> in rewrite-parse-tree.cpp

flang/lib/Parser/unparse.cpp

void Unparse(const OmpAtomicWrite &x) {
     Put("\n");
     EndOpenMP();
     Walk(std::get<Statement<AssignmentStmt>>(x.t));
     BeginOpenMP();
     Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
     EndOpenMP();
   }
   void Unparse(const OpenMPExecutableAllocate &x) {
+    auto &optionalList{
+        std::get<std::optional<std::list<OpenMPDeclarativeAllocate>>>(x.t)};
+    if (optionalList.has_value()) {
+      for (auto &declarativeAllocate : optionalList.value()) {
+        Walk(declarativeAllocate);
+      }
+    }
     BeginOpenMP();
     Word("!$OMP ALLOCATE");
     Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")");
     Walk(std::get<OmpClauseList>(x.t));
     Put("\n");
     EndOpenMP();
     Walk(std::get<Statement<AllocateStmt>>(x.t));
   }

flang/lib/Semantics/rewrite-parse-tree.cpp

 #include "flang/Common/indirection.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/semantics.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
+#include <iterator>
 #include <list>
 
 namespace Fortran::semantics {
 
 using namespace parser::literals;
 
 /// Convert misidentified statement functions to array element assignments.
 /// Convert misidentified format expressions to namelist group names.
public:
 
   // Default action for a parse tree node is to visit children.
   template <typename T> bool Pre(T &) { return true; }
   template <typename T> void Post(T &) {}
 
   void Post(parser::Name &);
   void Post(parser::SpecificationPart &);
   bool Pre(parser::ExecutionPart &);
+  void Post(parser::ExecutionPart &);
   void Post(parser::IoUnit &);
   void Post(parser::ReadStmt &);
   void Post(parser::WriteStmt &);
+  void Post(parser::ExecutionPartConstruct &);
 
   // Name resolution yet implemented:
   // TODO: Can some/all of these now be enabled?
   bool Pre(parser::EquivalenceStmt &) { return false; }
   bool Pre(parser::Keyword &) { return false; }
   bool Pre(parser::EntryStmt &) { return false; }
   bool Pre(parser::CompilerDirective &) { return false; }
 
public:
   bool Pre(parser::EndTypeStmt &) { return false; }
 
 private:
   using stmtFuncType =
       parser::Statement<common::Indirection<parser::StmtFunctionStmt>>;
   bool errorOnUnresolvedName_{true};
   parser::Messages &messages_;
   std::list<stmtFuncType> stmtFuncsToConvert_;
+  using execPartType = common::Reference<parser::ExecutionPartConstruct>;
+  using execPartPair = std::pair<execPartType, int>;
+  std::list<execPartPair> executableOmpAllocateCandidates;
+  std::list<int> movedExecutableOmpAllocateCandidates;
+  int executionPartIndex{0};
 };
 
 // Check that name has been resolved to a symbol
 void RewriteMutator::Post(parser::Name &name) {
   if (!name.symbol && errorOnUnresolvedName_) {
     messages_.Say(name.source, "Internal: no symbol found for '%s'"_err_en_US,
         name.source);
   }
bool RewriteMutator::Pre(parser::ExecutionPart &x) {
   for (stmtFuncType &sf : stmtFuncsToConvert_) {
     auto stmt{sf.statement.value().ConvertToAssignment()};
     stmt.source = sf.source;
     x.v.insert(origFirst,
         parser::ExecutionPartConstruct{
             parser::ExecutableConstruct{std::move(stmt)}});
   }
   stmtFuncsToConvert_.clear();
+  executionPartIndex = 0;
   return true;
 }
 
+void RewriteMutator::Post(parser::ExecutionPart &x) {
+  auto it{x.v.begin()};
+  int previousExecutableCandidate{0};
+  for (auto &executableCandidate : movedExecutableOmpAllocateCandidates) {
+    std::advance(it, executableCandidate - previousExecutableCandidate);
+    x.v.erase(it++);
+    previousExecutableCandidate = executableCandidate + 1;
+  }
+  movedExecutableOmpAllocateCandidates.clear();
+}
+
+void RewriteMutator::Post(parser::ExecutionPartConstruct &x) {
+  auto *declarativeAllocate{
+      parser::Unwrap<parser::OpenMPDeclarativeAllocate>(x)};
+  auto *executableAllocate{parser::Unwrap<parser::OpenMPExecutableAllocate>(x)};
+  if (declarativeAllocate) {
+    executableOmpAllocateCandidates.push_back(
+        execPartPair{x, executionPartIndex});
+
+  } else if (executableAllocate &&
+      std::get<std::optional<parser::OmpObjectList>>(executableAllocate->t)
+          .has_value() &&
+      executableOmpAllocateCandidates.size() > 0) {
+    auto &declarativeList{
+        std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
+            executableAllocate->t)};
+    // OpenMPExecutable allocate's list of child declaratives is an optional so
+    // this list needs to be set here
+    declarativeList = std::list<parser::OpenMPDeclarativeAllocate>();
+    for (auto &executableCandidate : executableOmpAllocateCandidates) {
+      auto *declarativeCandidate{
+          parser::Unwrap<parser::OpenMPDeclarativeAllocate>(
+              *(std::get<0>(executableCandidate)))};
+      declarativeList.value().push_back(std::move(*declarativeCandidate));
+      movedExecutableOmpAllocateCandidates.push_back(
+          std::get<1>(executableCandidate));
+    }
+    executableOmpAllocateCandidates.clear();
+  } else {
+    executableOmpAllocateCandidates.clear();
+  }
+  ++executionPartIndex;
+}
+
 // Convert a syntactically ambiguous io-unit internal-file-variable to a
 // file-unit-number.
 void RewriteMutator::Post(parser::IoUnit &x) {
   if (auto *var{std::get_if<parser::Variable>(&x.u)}) {
     const parser::Name &last{parser::GetLastName(*var)};
     DeclTypeSpec *type{last.symbol ? last.symbol->GetType() : nullptr};
     if (!type || type->category() != DeclTypeSpec::Character) {
       // If the Variable is not known to be character (any kind), transform