From 4887ae80cd9f4e2193ce2550873dbbf08bac3223 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Tue, 6 Aug 2019 13:48:13 -0700 Subject: [PATCH] [flang] Perform more checks on array-specs There are many constraints on what kind of array-specs can appear in what contexts. Add `CheckArraySpec()` to perform most of them. When the check fails, don't set the shape of the symbol being declared and instead set the Error flag so we can avoid cascading errors. Fixes flang-compiler/f18#609. Original-commit: flang-compiler/f18@f159d97f1f1e02b4d66e410b0f5a587f3c8fc51a Reviewed-on: https://github.com/flang-compiler/f18/pull/630 Tree-same-pre-rewrite: false --- flang/lib/parser/grammar.h | 2 + flang/lib/semantics/resolve-names.cc | 119 +++++++++++++++++++++++++++++------ flang/test/evaluate/CMakeLists.txt | 6 +- flang/test/semantics/CMakeLists.txt | 1 + flang/test/semantics/resolve42.f90 | 2 +- flang/test/semantics/resolve58.f90 | 64 +++++++++++++++++++ 6 files changed, 172 insertions(+), 22 deletions(-) create mode 100644 flang/test/semantics/resolve58.f90 diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h index 6d55d15..53d4dfe 100644 --- a/flang/lib/parser/grammar.h +++ b/flang/lib/parser/grammar.h @@ -1086,6 +1086,8 @@ TYPE_PARSER(construct( // implied-shape-or-assumed-size-spec | assumed-rank-spec // N.B. Parenthesized here rather than around references to avoid // a need for forced look-ahead. +// Shape specs that could be deferred-shape-spec or assumed-shape-spec +// (e.g. '(:,:)') are parsed as the former. TYPE_PARSER( construct(parenthesized(nonemptyList(explicitShapeSpec))) || construct(parenthesized(deferredShapeSpecList)) || diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index eb08a19..bb6de3d 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -159,17 +159,21 @@ public: template MaybeExpr EvaluateConvertedExpr( const Symbol &symbol, const T &expr, parser::CharBlock source) { - if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) { - if (auto converted{ - evaluate::ConvertToType(symbol, std::move(*maybeExpr))}) { - return FoldExpr(std::move(*converted)); - } else { - Say(source, - "Initialization expression could not be converted to declared type of symbol '%s'"_err_en_US, - symbol.name()); - } + if (context().HasError(symbol)) { + return std::nullopt; } - return std::nullopt; + auto maybeExpr{AnalyzeExpr(*context_, expr)}; + if (!maybeExpr) { + return std::nullopt; + } + auto converted{evaluate::ConvertToType(symbol, std::move(*maybeExpr))}; + if (!converted) { + Say(source, + "Initialization expression could not be converted to declared type of '%s'"_err_en_US, + symbol.name()); + return std::nullopt; + } + return FoldExpr(std::move(*converted)); } template MaybeIntExpr EvaluateIntExpr(const T &expr) { @@ -852,6 +856,7 @@ 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 @@ -2839,10 +2844,11 @@ Symbol &DeclarationVisitor::DeclareObjectEntity( Say(name, "The dimensions of '%s' have already been declared"_err_en_US); context().SetError(symbol); - } else { + } else if (CheckArraySpec(name, symbol, arraySpec())) { details->set_shape(arraySpec()); + } else { + context().SetError(symbol); } - ClearArraySpec(); } if (!coarraySpec().empty()) { if (details->IsCoarray()) { @@ -2852,7 +2858,6 @@ Symbol &DeclarationVisitor::DeclareObjectEntity( } else { details->set_coshape(coarraySpec()); } - ClearCoarraySpec(); } SetBindNameOn(symbol); } @@ -2862,6 +2867,89 @@ 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) { + CHECK(arraySpec.Rank() > 0); + 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 (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 (!symbol.attrs().test(Attr::PARAMETER)) { // C836 + Say(name, "Implied-shape array '%s' must be a named constant"_err_en_US); + return false; + } + } else if (symbol.attrs().test(Attr::PARAMETER)) { + 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)); } @@ -3514,11 +3602,6 @@ void DeclarationVisitor::Post(const parser::CommonBlockObject &x) { return; // error was reported } commonBlockInfo_.curr->get().add_object(symbol); - if (!IsAllocatableOrPointer(symbol) && !details->shape().IsExplicitShape()) { - Say(name, - "The shape of common block object '%s' must be explicit"_err_en_US); - return; - } auto pair{commonBlockInfo_.names.insert(name.source)}; if (!pair.second) { const SourceName &prev{*pair.first}; diff --git a/flang/test/evaluate/CMakeLists.txt b/flang/test/evaluate/CMakeLists.txt index 8e7667a..d7fb367 100644 --- a/flang/test/evaluate/CMakeLists.txt +++ b/flang/test/evaluate/CMakeLists.txt @@ -41,8 +41,8 @@ add_executable(expression-test target_link_libraries(expression-test FortranEvaluateTesting - FortranSemantics FortranEvaluate + FortranSemantics FortranParser ) @@ -61,8 +61,8 @@ add_executable(intrinsics-test target_link_libraries(intrinsics-test FortranEvaluateTesting - FortranSemantics FortranEvaluate + FortranSemantics FortranParser FortranRuntime ) @@ -118,8 +118,8 @@ add_executable(folding-test target_link_libraries(folding-test FortranEvaluateTesting - FortranSemantics FortranEvaluate + FortranSemantics ) set(FOLDING_TESTS diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 9bc173e..a2207e4 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -94,6 +94,7 @@ set(ERROR_TESTS resolve55.f90 resolve56.f90 resolve57.f90 + resolve58.f90 stop01.f90 structconst01.f90 structconst02.f90 diff --git a/flang/test/semantics/resolve42.f90 b/flang/test/semantics/resolve42.f90 index b44e2a5..7065ea7 100644 --- a/flang/test/semantics/resolve42.f90 +++ b/flang/test/semantics/resolve42.f90 @@ -13,7 +13,7 @@ ! limitations under the License. subroutine s1 - !ERROR: The shape of common block object 'z' must be explicit + !ERROR: Array 'z' without ALLOCATABLE or POINTER attribute must have explicit shape common x, y(4), z(:) end diff --git a/flang/test/semantics/resolve58.f90 b/flang/test/semantics/resolve58.f90 new file mode 100644 index 0000000..2626b53 --- /dev/null +++ b/flang/test/semantics/resolve58.f90 @@ -0,0 +1,64 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +subroutine s1(x, y) + !ERROR: Array pointer 'x' must have deferred shape or assumed rank + real, pointer :: x(1:) ! C832 + !ERROR: Allocatable array 'y' must have deferred shape or assumed rank + real, dimension(1:,1:), allocatable :: y ! C832 +end + +subroutine s2(a, b, c) + real :: a(:,1:) + real :: b(10,*) + real :: c(..) + !ERROR: Array pointer 'd' must have deferred shape or assumed rank + real, pointer :: d(:,1:) ! C832 + !ERROR: Allocatable array 'e' must have deferred shape or assumed rank + real, allocatable :: e(10,*) ! C832 + !ERROR: Assumed-rank array 'f' must be a dummy argument + real, pointer :: f(..) ! C837 + !ERROR: Assumed-shape array 'g' must be a dummy argument + real :: g(:,1:) + !ERROR: Assumed-size array 'h' must be a dummy argument + real :: h(10,*) ! C833 + !ERROR: Assumed-rank array 'i' must be a dummy argument + real :: i(..) ! C837 +end + +subroutine s3(a, b) + real :: a(*) + !ERROR: Dummy array argument 'b' may not have implied shape + real :: b(*,*) ! C836 + !ERROR: Implied-shape array 'c' must be a named constant + real :: c(*) ! C836 + !ERROR: Named constant 'd' array must have explicit or implied shape + integer, parameter :: d(:) = [1, 2, 3] +end + +subroutine s4() + type :: t + integer, allocatable :: a(:) + !ERROR: Component array 'b' without ALLOCATABLE or POINTER attribute must have explicit shape + integer :: b(:) ! C749 + real, dimension(1:10) :: c + !ERROR: Array pointer component 'd' must have deferred shape + real, pointer, dimension(1:10) :: d ! C745 + end type +end + +function f() + !ERROR: Array 'f' without ALLOCATABLE or POINTER attribute must have explicit shape + real, dimension(:) :: f ! C832 +end -- 2.7.4