From 889c81eae79f7ecca49ca0381f13785a33b85c84 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Tue, 14 Jan 2020 12:06:52 -0800 Subject: [PATCH] [flang] Move checks for valid array-spec to check-declarations.cc At the time we finish processing an array-spec in `resolve-names.cc`, we don't know if the entity is going to be declared ALLOCATABLE later so we can't check for validity there. In the new test in `resolve58.f90` (based on issue flang-compiler/f18#930) we were reporting an error on `b` and not on `a` when it should be the reverse. The fix is to move array-spec checking to `check-declarations.cc`, after name resolution is complete. Fixes flang-compiler/f18#930. Original-commit: flang-compiler/f18@c596d2fef7628236676c1939659f4eb956e4df35 Reviewed-on: https://github.com/flang-compiler/f18/pull/933 --- flang/lib/semantics/check-declarations.cc | 80 +++++++++++++++++++++ flang/lib/semantics/resolve-names.cc | 112 +++--------------------------- flang/test/semantics/resolve58.f90 | 7 ++ flang/test/semantics/resolve61.f90 | 2 +- 4 files changed, 97 insertions(+), 104 deletions(-) diff --git a/flang/lib/semantics/check-declarations.cc b/flang/lib/semantics/check-declarations.cc index 74048b7..385811d 100644 --- a/flang/lib/semantics/check-declarations.cc +++ b/flang/lib/semantics/check-declarations.cc @@ -55,6 +55,7 @@ private: const Symbol &proc, const Symbol *interface, const WithPassArg &); void CheckProcBinding(const Symbol &, const ProcBindingDetails &); void CheckObjectEntity(const Symbol &, const ObjectEntityDetails &); + void CheckArraySpec(const Symbol &, const ArraySpec &); void CheckProcEntity(const Symbol &, const ProcEntityDetails &); void CheckDerivedType(const Symbol &, const DerivedTypeDetails &); void CheckGeneric(const Symbol &, const GenericDetails &); @@ -285,6 +286,7 @@ void CheckHelper::CheckValue( void CheckHelper::CheckObjectEntity( const Symbol &symbol, const ObjectEntityDetails &details) { + CheckArraySpec(symbol, details.shape()); Check(details.shape()); Check(details.coshape()); if (!details.coshape().empty()) { @@ -345,6 +347,84 @@ void CheckHelper::CheckObjectEntity( } } +// The six different kinds of array-specs: +// array-spec -> explicit-shape-list | deferred-shape-list +// | assumed-shape-list | implied-shape-list +// | assumed-size | assumed-rank +// explicit-shape -> [ lb : ] ub +// deferred-shape -> : +// assumed-shape -> [ lb ] : +// implied-shape -> [ lb : ] * +// assumed-size -> [ explicit-shape-list , ] [ lb : ] * +// assumed-rank -> .. +// Note: +// - deferred-shape is also an assumed-shape +// - A single "*" or "lb:*" might be assumed-size or implied-shape-list +void CheckHelper::CheckArraySpec( + const Symbol &symbol, const ArraySpec &arraySpec) { + if (arraySpec.Rank() == 0) { + return; + } + bool isExplicit{arraySpec.IsExplicitShape()}; + bool isDeferred{arraySpec.IsDeferredShape()}; + bool isImplied{arraySpec.IsImpliedShape()}; + bool isAssumedShape{arraySpec.IsAssumedShape()}; + bool isAssumedSize{arraySpec.IsAssumedSize()}; + bool isAssumedRank{arraySpec.IsAssumedRank()}; + std::optional msg; + if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit && !isAssumedSize) { + msg = "Cray pointee '%s' must have must have explicit shape or" + " assumed size"_err_en_US; + } else if (IsAllocatableOrPointer(symbol) && !isDeferred && !isAssumedRank) { + if (symbol.owner().IsDerivedType()) { // C745 + if (IsAllocatable(symbol)) { + msg = "Allocatable array component '%s' must have" + " deferred shape"_err_en_US; + } else { + msg = "Array pointer component '%s' must have deferred shape"_err_en_US; + } + } else { + if (IsAllocatable(symbol)) { // C832 + msg = "Allocatable array '%s' must have deferred shape or" + " assumed rank"_err_en_US; + } else { + msg = "Array pointer '%s' must have deferred shape or" + " assumed rank"_err_en_US; + } + } + } else if (symbol.IsDummy()) { + if (isImplied && !isAssumedSize) { // C836 + msg = "Dummy array argument '%s' may not have implied shape"_err_en_US; + } + } else if (isAssumedShape && !isDeferred) { + msg = "Assumed-shape array '%s' must be a dummy argument"_err_en_US; + } else if (isAssumedSize && !isImplied) { // C833 + msg = "Assumed-size array '%s' must be a dummy argument"_err_en_US; + } else if (isAssumedRank) { // C837 + msg = "Assumed-rank array '%s' must be a dummy argument"_err_en_US; + } else if (isImplied) { + if (!IsNamedConstant(symbol)) { // C836 + msg = "Implied-shape array '%s' must be a named constant"_err_en_US; + } + } else if (IsNamedConstant(symbol)) { + if (!isExplicit && !isImplied) { + msg = "Named constant '%s' array must have explicit or" + " implied shape"_err_en_US; + } + } else if (!IsAllocatableOrPointer(symbol) && !isExplicit) { + if (symbol.owner().IsDerivedType()) { // C749 + msg = "Component array '%s' without ALLOCATABLE or POINTER attribute must" + " have explicit shape"_err_en_US; + } else { // C816 + msg = "Array '%s' without ALLOCATABLE or POINTER attribute must have" + " explicit shape"_err_en_US; + } + } + if (msg) { + context_.Say(std::move(*msg), symbol.name()); + } +} + void CheckHelper::CheckProcEntity( const Symbol &symbol, const ProcEntityDetails &details) { if (details.isDummy()) { diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 412b836..a1bf22e 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -888,7 +888,6 @@ private: void Initialization(const parser::Name &, const parser::Initialization &, bool inComponentDecl); bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol); - bool CheckArraySpec(const parser::Name &, const Symbol &, const ArraySpec &); // Declare an object or procedure entity. // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails @@ -3170,10 +3169,8 @@ Symbol &DeclarationVisitor::DeclareObjectEntity( Say(name, "The dimensions of '%s' have already been declared"_err_en_US); context().SetError(symbol); - } else if (CheckArraySpec(name, symbol, arraySpec())) { - details->set_shape(arraySpec()); } else { - context().SetError(symbol); + details->set_shape(arraySpec()); } } if (!coarraySpec().empty()) { @@ -3193,96 +3190,6 @@ Symbol &DeclarationVisitor::DeclareObjectEntity( return symbol; } -// The six different kinds of array-specs: -// array-spec -> explicit-shape-list | deferred-shape-list -// | assumed-shape-list | implied-shape-list -// | assumed-size | assumed-rank -// explicit-shape -> [ lb : ] ub -// deferred-shape -> : -// assumed-shape -> [ lb ] : -// implied-shape -> [ lb : ] * -// assumed-size -> [ explicit-shape-list , ] [ lb : ] * -// assumed-rank -> .. -// Note: -// - deferred-shape is also an assumed-shape -// - A single "*" or "lb:*" might be assumed-size or implied-shape-list -bool DeclarationVisitor::CheckArraySpec(const parser::Name &name, - const Symbol &symbol, const ArraySpec &arraySpec) { - if (arraySpec.Rank() == 0) { - return true; - } - bool isExplicit{arraySpec.IsExplicitShape()}; - bool isDeferred{arraySpec.IsDeferredShape()}; - bool isImplied{arraySpec.IsImpliedShape()}; - bool isAssumedShape{arraySpec.IsAssumedShape()}; - bool isAssumedSize{arraySpec.IsAssumedSize()}; - bool isAssumedRank{arraySpec.IsAssumedRank()}; - if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit && !isAssumedSize) { - Say(name, - "Cray pointee '%s' must have must have explicit shape or assumed size"_err_en_US); - return false; - } - if (IsAllocatableOrPointer(symbol) && !isDeferred && !isAssumedRank) { - if (symbol.owner().IsDerivedType()) { // C745 - if (IsAllocatable(symbol)) { - Say(name, - "Allocatable array component '%s' must have deferred shape"_err_en_US); - } else { - Say(name, - "Array pointer component '%s' must have deferred shape"_err_en_US); - } - } else { - if (IsAllocatable(symbol)) { // C832 - Say(name, - "Allocatable array '%s' must have deferred shape or assumed rank"_err_en_US); - } else { - Say(name, - "Array pointer '%s' must have deferred shape or assumed rank"_err_en_US); - } - } - return false; - } - if (symbol.IsDummy()) { - if (isImplied && !isAssumedSize) { // C836 - Say(name, - "Dummy array argument '%s' may not have implied shape"_err_en_US); - return false; - } - } else if (isAssumedShape && !isDeferred) { - Say(name, "Assumed-shape array '%s' must be a dummy argument"_err_en_US); - return false; - } else if (isAssumedSize && !isImplied) { // C833 - Say(name, "Assumed-size array '%s' must be a dummy argument"_err_en_US); - return false; - } else if (isAssumedRank) { // C837 - Say(name, "Assumed-rank array '%s' must be a dummy argument"_err_en_US); - return false; - } else if (isImplied) { - if (!IsNamedConstant(symbol)) { // C836 - Say(name, "Implied-shape array '%s' must be a named constant"_err_en_US); - return false; - } - } else if (IsNamedConstant(symbol)) { - if (!isExplicit && !isImplied) { - Say(name, - "Named constant '%s' array must have explicit or implied shape"_err_en_US); - return false; - } - } else if (!IsAllocatableOrPointer(symbol) && !isExplicit) { - if (symbol.owner().IsDerivedType()) { // C749 - Say(name, - "Component array '%s' without ALLOCATABLE or POINTER attribute must" - " have explicit shape"_err_en_US); - } else { // C816 - Say(name, - "Array '%s' without ALLOCATABLE or POINTER attribute must have" - " explicit shape"_err_en_US); - } - return false; - } - return true; -} - void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) { SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v)); } @@ -3911,15 +3818,14 @@ bool DeclarationVisitor::Pre(const parser::BasedPointerStmt &x) { BeginArraySpec(); Walk(std::get>(bp.t)); const auto &spec{arraySpec()}; - if (spec.empty()) { - // No array spec - CheckArraySpec( - pointeeName, pointee, pointee.get().shape()); - } else if (pointee.Rank() > 0) { - SayWithDecl(pointeeName, pointee, - "Array spec was already declared for '%s'"_err_en_US); - } else if (CheckArraySpec(pointeeName, pointee, spec)) { - pointee.get().set_shape(spec); + if (!spec.empty()) { + auto &details{pointee.get()}; + if (details.shape().empty()) { + details.set_shape(spec); + } else { + SayWithDecl(pointeeName, pointee, + "Array spec was already declared for '%s'"_err_en_US); + } } ClearArraySpec(); currScope().add_crayPointer(pointeeName.source, *pointer); diff --git a/flang/test/semantics/resolve58.f90 b/flang/test/semantics/resolve58.f90 index c0271e5..00232dc 100644 --- a/flang/test/semantics/resolve58.f90 +++ b/flang/test/semantics/resolve58.f90 @@ -48,3 +48,10 @@ function f() !ERROR: Array 'f' without ALLOCATABLE or POINTER attribute must have explicit shape real, dimension(:) :: f ! C832 end + +subroutine s5() + !ERROR: Allocatable array 'a' must have deferred shape or assumed rank + integer :: a(10), b(:) + allocatable :: a + allocatable :: b +end subroutine diff --git a/flang/test/semantics/resolve61.f90 b/flang/test/semantics/resolve61.f90 index 0a416d0..727b264 100644 --- a/flang/test/semantics/resolve61.f90 +++ b/flang/test/semantics/resolve61.f90 @@ -44,8 +44,8 @@ program p7 contains subroutine s(x, y) real :: x(*) ! assumed size - real :: y(:) ! assumed shape !ERROR: Cray pointee 'y' must have must have explicit shape or assumed size + real :: y(:) ! assumed shape pointer(w, y) end end -- 2.7.4