diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -317,6 +317,8 @@ const parser::SectionSubscript &); std::vector AnalyzeSectionSubscripts( const std::list &); + std::optional CreateComponent( + DataRef &&, const Symbol &, const semantics::Scope &); MaybeExpr Designate(DataRef &&); MaybeExpr CompleteSubscripts(ArrayRef &&); MaybeExpr ApplySubscripts(DataRef &&, std::vector &&); diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -235,7 +235,7 @@ 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 @@ 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 @@ } // Components of parent derived types are explicitly represented as such. -static std::optional CreateComponent( +std::optional 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 --- 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