[flang-commits] [flang] bebbe64 - [flang] Fix creation of deferred shape arrays by POINTER statement

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-01-20T13:08:11-08:00
New Revision: bebbe64075abf9d9887a8e1ee39c1ecefe970954

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

LOG: [flang] Fix creation of deferred shape arrays by POINTER statement

It's possible to  declare deferred shape array using the POINTER
statement, for example:

  POINTER :: var(:)

When analyzing POINTER declarations, we were not capturing the array
specification information, if present.  I fixed this by changing the
"Post" function for "parser::PointerDecl" to check to see if the
declaration contained a "DeferredShapeSpecList".  In such cases, I
analyzed the shape and used to information to declare an "ObjectEntity"
that contains the shape information rather than an "UnknownEntity".

I also added a couple of small tests that fail to compile without these
changes.

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names-utils.cpp
    flang/lib/Semantics/resolve-names-utils.h
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/allocate12.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 83bff78f426a..61cfba046022 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -219,6 +219,7 @@ class ArraySpecAnalyzer {
 public:
   ArraySpecAnalyzer(SemanticsContext &context) : context_{context} {}
   ArraySpec Analyze(const parser::ArraySpec &);
+  ArraySpec AnalyzeDeferredShapeSpecList(const parser::DeferredShapeSpecList &);
   ArraySpec Analyze(const parser::ComponentArraySpec &);
   ArraySpec Analyze(const parser::CoarraySpec &);
 
@@ -252,6 +253,11 @@ ArraySpec AnalyzeArraySpec(
     SemanticsContext &context, const parser::ComponentArraySpec &arraySpec) {
   return ArraySpecAnalyzer{context}.Analyze(arraySpec);
 }
+ArraySpec AnalyzeDeferredShapeSpecList(SemanticsContext &context,
+    const parser::DeferredShapeSpecList &deferredShapeSpecs) {
+  return ArraySpecAnalyzer{context}.AnalyzeDeferredShapeSpecList(
+      deferredShapeSpecs);
+}
 ArraySpec AnalyzeCoarraySpec(
     SemanticsContext &context, const parser::CoarraySpec &coarraySpec) {
   return ArraySpecAnalyzer{context}.Analyze(coarraySpec);
@@ -275,6 +281,12 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
   CHECK(!arraySpec_.empty());
   return arraySpec_;
 }
+ArraySpec ArraySpecAnalyzer::AnalyzeDeferredShapeSpecList(
+    const parser::DeferredShapeSpecList &x) {
+  Analyze(x);
+  CHECK(!arraySpec_.empty());
+  return arraySpec_;
+}
 ArraySpec ArraySpecAnalyzer::Analyze(const parser::CoarraySpec &x) {
   std::visit(
       common::visitors{

diff  --git a/flang/lib/Semantics/resolve-names-utils.h b/flang/lib/Semantics/resolve-names-utils.h
index 89011ff3b956..ce1673e681b4 100644
--- a/flang/lib/Semantics/resolve-names-utils.h
+++ b/flang/lib/Semantics/resolve-names-utils.h
@@ -100,6 +100,8 @@ class GenericSpecInfo {
 ArraySpec AnalyzeArraySpec(SemanticsContext &, const parser::ArraySpec &);
 ArraySpec AnalyzeArraySpec(
     SemanticsContext &, const parser::ComponentArraySpec &);
+ArraySpec AnalyzeDeferredShapeSpecList(
+    SemanticsContext &, const parser::DeferredShapeSpecList &);
 ArraySpec AnalyzeCoarraySpec(
     SemanticsContext &context, const parser::CoarraySpec &);
 

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3bc9a85cbf41..d76abbf68a08 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -429,6 +429,7 @@ class ArraySpecVisitor : public virtual BaseVisitor {
 
 protected:
   const ArraySpec &arraySpec();
+  void set_arraySpec(const ArraySpec arraySpec) { arraySpec_ = arraySpec; }
   const ArraySpec &coarraySpec();
   void BeginArraySpec();
   void EndArraySpec();
@@ -3250,8 +3251,18 @@ void DeclarationVisitor::Post(const parser::EntityDecl &x) {
 
 void DeclarationVisitor::Post(const parser::PointerDecl &x) {
   const auto &name{std::get<parser::Name>(x.t)};
-  Symbol &symbol{DeclareUnknownEntity(name, Attrs{Attr::POINTER})};
-  symbol.ReplaceName(name.source);
+  if (const auto &deferredShapeSpecs{
+          std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) {
+    CHECK(arraySpec().empty());
+    BeginArraySpec();
+    set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs));
+    Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})};
+    symbol.ReplaceName(name.source);
+    EndArraySpec();
+  } else {
+    Symbol &symbol{DeclareUnknownEntity(name, Attrs{Attr::POINTER})};
+    symbol.ReplaceName(name.source);
+  }
 }
 
 bool DeclarationVisitor::Pre(const parser::BindEntity &x) {

diff  --git a/flang/test/Semantics/allocate12.f90 b/flang/test/Semantics/allocate12.f90
index 95a88a8cb254..91cb979d040e 100644
--- a/flang/test/Semantics/allocate12.f90
+++ b/flang/test/Semantics/allocate12.f90
@@ -1,7 +1,7 @@
 ! RUN: %S/test_errors.sh %s %t %f18
 ! Check for semantic errors in ALLOCATE statements
 
-subroutine C941_C942b_C950(xsrc, x1, a2, b2, cx1, ca2, cb1, cb2, c1)
+subroutine C941_C942b_C950(xsrc, x1, a2, b2, cx1, ca2, cb1, cb2, c1, c2)
 ! C941: An allocate-coarray-spec shall appear if and only if the allocate-object
 ! is a coarray.
   type type0
@@ -40,6 +40,8 @@ subroutine C941_C942b_C950(xsrc, x1, a2, b2, cx1, ca2, cb1, cb2, c1)
   type(B) :: cb1[5:*], cb2(*)[2, -1:*]
 
   type(C) :: c1
+  pointer :: c2(:, :)
+  pointer :: varLocal(:)
 
   class(*), allocatable :: var(:), cvar(:)[:]
 
@@ -48,6 +50,8 @@ subroutine C941_C942b_C950(xsrc, x1, a2, b2, cx1, ca2, cb1, cb2, c1)
   allocate(a1, a2(10), ca1[2, -1:*], ca2(10)[*])
   allocate(b1%x, b2(1)%x, cb1%x, cb2(1)%x, SOURCE=xsrc)
   allocate(c1%x(-1:10, 1:5), c1%cx(-1:10, 1:5)[-1:5, 1:2, 2:*])
+  allocate(c2(9, 27))
+  allocate(varLocal(64))
   allocate(A:: var(5), cvar(10)[*])