From 6370087abc4aad351dae765b59cb08a750859b74 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier@nvidia.com>
Date: Fri, 3 May 2019 01:31:48 -0700
Subject: [PATCH] [flang] Address comments

Original-commit: flang-compiler/f18@2a6473ce6af3d409fda024915c719ee88db40a78
---
 flang/lib/semantics/check-allocate.cc | 49 ++++++++++++++++-------------------
 flang/test/semantics/allocate11.f90   |  9 ++++---
 2 files changed, 28 insertions(+), 30 deletions(-)

diff --git a/flang/lib/semantics/check-allocate.cc b/flang/lib/semantics/check-allocate.cc
index a10a602..232617b 100644
--- a/flang/lib/semantics/check-allocate.cc
+++ b/flang/lib/semantics/check-allocate.cc
@@ -48,24 +48,11 @@ public:
       allocateShapeSpecRank_{ShapeSpecRank(alloc)},
       rank_{name_.symbol ? name_.symbol->Rank() : 0},
       allocateCoarraySpecRank_{CoarraySpecRank(alloc)},
-      corank_{name_.symbol ? name_.symbol->Corank() : 0} {
-    GatherAllocationBasicInfo();
-  }
+      corank_{name_.symbol ? name_.symbol->Corank() : 0} {}
 
   bool RunChecks(SemanticsContext &context);
 
 private:
-  AllocateCheckerInfo &allocateInfo_;
-  const parser::AllocateObject &allocateObject_;
-  const parser::Name &name_;
-  const DeclTypeSpec *type_;
-  const int allocateShapeSpecRank_;
-  const int rank_;
-  const int allocateCoarraySpecRank_;
-  const int corank_;
-  bool hasDeferredTypeParameter_{false};
-  bool isUnlimitedPolymorphic_{false};
-  bool isAbstract_{false};
   bool hasAllocateShapeSpecList() const { return allocateShapeSpecRank_ != 0; }
   bool hasAllocateCoarraySpec() const { return allocateCoarraySpecRank_ != 0; }
   bool RunCoarrayRelatedChecks(SemanticsContext &) const;
@@ -88,21 +75,30 @@ private:
   }
 
   void GatherAllocationBasicInfo() {
-    if (type_) {
-      if (type_->category() == DeclTypeSpec::Category::Character) {
-        hasDeferredTypeParameter_ =
-            type_->characterTypeSpec().length().isDeferred();
-      } else if (const DerivedTypeSpec * derivedTypeSpec{type_->AsDerived()}) {
-        for (const auto &pair : derivedTypeSpec->parameters()) {
-          hasDeferredTypeParameter_ |= pair.second.isDeferred();
-        }
-        isAbstract_ =
-            derivedTypeSpec->typeSymbol().attrs().test(Attr::ABSTRACT);
+    if (type_->category() == DeclTypeSpec::Category::Character) {
+      hasDeferredTypeParameter_ =
+          type_->characterTypeSpec().length().isDeferred();
+    } else if (const DerivedTypeSpec * derivedTypeSpec{type_->AsDerived()}) {
+      for (const auto &pair : derivedTypeSpec->parameters()) {
+        hasDeferredTypeParameter_ |= pair.second.isDeferred();
       }
-      isUnlimitedPolymorphic_ =
-          type_->category() == DeclTypeSpec::Category::ClassStar;
+      isAbstract_ = derivedTypeSpec->typeSymbol().attrs().test(Attr::ABSTRACT);
     }
+    isUnlimitedPolymorphic_ =
+        type_->category() == DeclTypeSpec::Category::ClassStar;
   }
+
+  AllocateCheckerInfo &allocateInfo_;
+  const parser::AllocateObject &allocateObject_;
+  const parser::Name &name_;
+  const DeclTypeSpec *type_;
+  const int allocateShapeSpecRank_;
+  const int rank_;
+  const int allocateCoarraySpecRank_;
+  const int corank_;
+  bool hasDeferredTypeParameter_{false};
+  bool isUnlimitedPolymorphic_{false};
+  bool isAbstract_{false};
 };
 
 static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
@@ -408,6 +404,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
   if (type_ == nullptr) {
     return false;
   }
+  GatherAllocationBasicInfo();
   if (!IsVariableName(*name_.symbol)) {  // C932 pre-requisite
     context.Say(name_.source,
         "Name in ALLOCATE statement must be a variable name"_err_en_US);
diff --git a/flang/test/semantics/allocate11.f90 b/flang/test/semantics/allocate11.f90
index 19bf99e..6237059 100644
--- a/flang/test/semantics/allocate11.f90
+++ b/flang/test/semantics/allocate11.f90
@@ -16,7 +16,7 @@
 
 ! TODO: Function Pointer in allocate and derived types!
 
-! Rules I should know when working wit coarrays and derived type:
+! Rules I should know when working with coarrays and derived type:
 
 ! C736: If EXTENDS appears and the type being defined has a coarray ultimate
 ! component, its parent type shall have a coarray ultimate component.
@@ -67,12 +67,13 @@ subroutine C937(var)
 
   class(*), allocatable :: var
   ! unlimited polymorphic is the ONLY way to get an allocatable/pointer 'var' that can be
-  ! allocated with a type-spec T that has coarray ultimate component.
-  ! Rational:
+  ! allocated with a type-spec T that has coarray ultimate component without
+  ! violating other rules than C937.
+  ! Rationale:
   !   C934 => var must be type compatible with T.
   !        => var type is T, a type P extended by T, or unlimited polymorphic
   !   C825 => var cannot be of type T.
-  !   C736 => all parent type P of T must have a coarray unlimited component
+  !   C736 => all parent types P of T must have a coarray ultimate component
   !        => var cannot be of type P (C825)
   !        => if var can be defined, it can only be unlimited polymorphic
 
-- 
2.7.4