template<typename T>
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<typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
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
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()) {
} else {
details->set_coshape(coarraySpec());
}
- ClearCoarraySpec();
}
SetBindNameOn(symbol);
}
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));
}
return; // error was reported
}
commonBlockInfo_.curr->get<CommonBlockDetails>().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};
--- /dev/null
+! 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
projects / platform / upstream / llvm.git / commitdiff