[flang-commits] [flang] f2360e1 - [flang] Enforce rest of semantic constraint C919

[peter klausler via flang-commits]

Author: peter klausler
Date: 2021-10-22T11:35:58-07:00
New Revision: f2360e1156d086ac5ac58d7f29449adf9e75d716

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

LOG: [flang] Enforce rest of semantic constraint C919

A reference to an allocatable or pointer component must be applied
to a scalar base object.  (This is the second part of constraint C919;
the first part is already checked.)

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

Added: 
    

Modified: 
    flang/include/flang/Semantics/expression.h
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/deallocate01.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index cf200acd3d00..74e1b9614aeb 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -317,6 +317,8 @@ class ExpressionAnalyzer {
       const parser::SectionSubscript &);
   std::vector<Subscript> AnalyzeSectionSubscripts(
       const std::list<parser::SectionSubscript> &);
+  std::optional<Component> CreateComponent(
+      DataRef &&, const Symbol &, const semantics::Scope &);
   MaybeExpr Designate(DataRef &&);
   MaybeExpr CompleteSubscripts(ArrayRef &&);
   MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);

diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 00b34c385138..0f8eef362a83 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -235,7 +235,7 @@ MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
       for (const auto &expr : ref.subscript()) {
         subscriptRank += expr.Rank();
       }
-      if (subscriptRank > 0) {
+      if (subscriptRank > 0) { // C919a
         Say("Subscripts of component '%s' of rank-%d derived type "
             "array have rank %d but must all be scalar"_err_en_US,
             symbol.name(), baseRank, subscriptRank);
@@ -292,7 +292,7 @@ MaybeExpr ExpressionAnalyzer::TopLevelChecks(DataRef &&dataRef) {
     int componentRank{symbol.Rank()};
     if (componentRank > 0) {
       int baseRank{component->base().Rank()};
-      if (baseRank > 0) {
+      if (baseRank > 0) { // C919a
         Say("Reference to whole rank-%d component '%%%s' of "
             "rank-%d array of derived type is not allowed"_err_en_US,
             componentRank, symbol.name(), baseRank);
@@ -972,8 +972,11 @@ static NamedEntity IgnoreAnySubscripts(Designator<SomeDerived> &&designator) {
 }
 
 // Components of parent derived types are explicitly represented as such.
-static std::optional<Component> CreateComponent(
+std::optional<Component> ExpressionAnalyzer::CreateComponent(
     DataRef &&base, const Symbol &component, const semantics::Scope &scope) {
+  if (IsAllocatableOrPointer(component) && base.Rank() > 0) { // C919b
+    Say("An allocatable or pointer component reference must be applied to a scalar base"_err_en_US);
+  }
   if (&component.owner() == &scope) {
     return Component{std::move(base), component};
   }

diff  --git a/flang/test/Semantics/deallocate01.f90 b/flang/test/Semantics/deallocate01.f90
index 88c29d0814a2..b224f30df456 100644
--- a/flang/test/Semantics/deallocate01.f90
+++ b/flang/test/Semantics/deallocate01.f90
@@ -29,20 +29,21 @@
 
 Deallocate(z%p)
 
+!ERROR: An allocatable or pointer component reference must be applied to a scalar base
 Deallocate(x%p, stat=s, errmsg=e)
-Deallocate(x%p, errmsg=e)
-Deallocate(x%p, stat=s)
+Deallocate(x, errmsg=e)
+Deallocate(x, stat=s)
 
-Deallocate(y%p, stat=s, errmsg=e)
-Deallocate(y%p, errmsg=e)
-Deallocate(y%p, stat=s)
+Deallocate(y, stat=s, errmsg=e)
+Deallocate(y, errmsg=e)
+Deallocate(y, stat=s)
 
 Deallocate(z, stat=s, errmsg=e)
 Deallocate(z, errmsg=e)
 Deallocate(z, stat=s)
 
-Deallocate(z, y%p, stat=s, errmsg=e)
-Deallocate(z, y%p, errmsg=e)
-Deallocate(z, y%p, stat=s)
+Deallocate(z, y, stat=s, errmsg=e)
+Deallocate(z, y, errmsg=e)
+Deallocate(z, y, stat=s)
 
 End Program