[flang-commits] [flang] 9245f35 - [flang] Validate SIZE(x, DIM=n) dimension for assumed-size array x
peter klausler via flang-commits
flang-commits at lists.llvm.org
Fri Sep 17 10:36:49 PDT 2021
Author: peter klausler
Date: 2021-09-17T10:14:18-07:00
New Revision: 9245f35580ca0cce147ec9cebfa431fa5b7feac4
URL: https://github.com/llvm/llvm-project/commit/9245f35580ca0cce147ec9cebfa431fa5b7feac4
DIFF: https://github.com/llvm/llvm-project/commit/9245f35580ca0cce147ec9cebfa431fa5b7feac4.diff
LOG: [flang] Validate SIZE(x,DIM=n) dimension for assumed-size array x
Catch invalid attempts to extract the unknowable extent of the last
dimension of an assumed-size array dummy argument, and clean up
problems with assumed-rank arguments in similar circumstances
exposed by testing the fix.
Differential Revision: https://reviews.llvm.org/D109918
Added:
Modified:
flang/include/flang/Evaluate/tools.h
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/formatting.cpp
flang/lib/Evaluate/shape.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Evaluate/variable.cpp
flang/lib/Semantics/check-select-rank.cpp
flang/test/Semantics/select-rank.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 50a9e265a6069..5ebf3cd3b1fd7 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -298,6 +298,9 @@ std::optional<DataRef> ExtractDataRef(const A *p, bool intoSubstring = false) {
return std::nullopt;
}
}
+std::optional<DataRef> ExtractDataRef(
+ const ActualArgument &, bool intoSubstring = false);
+
std::optional<DataRef> ExtractSubstringBase(const Substring &);
// Predicate: is an expression is an array element reference?
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index d969dc914b037..5c23bc3ad853b 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -179,10 +179,6 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) {
const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
return details && details->IsAssumedSize();
}
-inline bool IsAssumedRankArray(const Symbol &symbol) {
- const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
- return details && details->IsAssumedRank();
-}
bool IsAssumedLengthCharacter(const Symbol &);
bool IsExternal(const Symbol &);
bool IsModuleProcedure(const Symbol &);
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 3fdf252407e92..c69ce32da1882 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -612,7 +612,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
if (auto named{ExtractNamedEntity(*array)}) {
const Symbol &symbol{named->GetLastSymbol()};
- if (semantics::IsAssumedRankArray(symbol)) {
+ if (IsAssumedRank(symbol)) {
// DescriptorInquiry can only be placed in expression of kind
// DescriptorInquiry::Result::kind.
return ConvertToType<T>(Expr<
@@ -667,7 +667,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (auto dim{GetInt64Arg(args[1])}) {
int rank{GetRank(*shape)};
if (*dim >= 1 && *dim <= rank) {
- if (auto &extent{shape->at(*dim - 1)}) {
+ const Symbol *symbol{UnwrapWholeSymbolDataRef(args[0])};
+ if (symbol && IsAssumedSizeArray(*symbol) && *dim == rank) {
+ context.messages().Say(
+ "size(array,dim=%jd) of last dimension is not available for rank-%d assumed-size array dummy argument"_err_en_US,
+ *dim, rank);
+ return MakeInvalidIntrinsic<T>(std::move(funcRef));
+ } else if (auto &extent{shape->at(*dim - 1)}) {
return Fold(context, ConvertToType<T>(std::move(*extent)));
}
} else {
@@ -705,7 +711,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else if (name == "ubound") {
return UBOUND(context, std::move(funcRef));
}
- // TODO: count(w/ dim), dot_product, findloc, ibits, image_status, ishftc,
+ // TODO: dot_product, findloc, ibits, image_status, ishftc,
// matmul, maxloc, minloc, sign, transfer
return Expr<T>{std::move(funcRef)};
}
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 5b5ae258d8b0b..2569c85e345d0 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -739,7 +739,7 @@ llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const {
if (field_ == Field::Len) {
return o << "%len";
} else {
- if (dimension_ >= 0) {
+ if (field_ != Field::Rank && dimension_ >= 0) {
o << ",dim=" << (dimension_ + 1);
}
return o << ')';
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 8919038d7ec90..0d2bb504a84ad 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -260,7 +260,15 @@ auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result {
}
} else if (const auto *assoc{
symbol.detailsIf<semantics::AssocEntityDetails>()}) {
- return (*this)(assoc->expr());
+ if (assoc->rank()) { // SELECT RANK case
+ const Symbol &resolved{ResolveAssociations(symbol)};
+ if (IsDescriptor(resolved) && dimension_ < *assoc->rank()) {
+ return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
+ DescriptorInquiry::Field::LowerBound, dimension_}};
+ }
+ } else {
+ return (*this)(assoc->expr());
+ }
}
return Default();
}
@@ -338,7 +346,20 @@ static MaybeExtentExpr GetNonNegativeExtent(
MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
CHECK(dimension >= 0);
- const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
+ const Symbol &last{base.GetLastSymbol()};
+ const Symbol &symbol{ResolveAssociations(last)};
+ if (const auto *assoc{last.detailsIf<semantics::AssocEntityDetails>()}) {
+ if (assoc->rank()) { // SELECT RANK case
+ if (semantics::IsDescriptor(symbol) && dimension < *assoc->rank()) {
+ return ExtentExpr{DescriptorInquiry{
+ NamedEntity{base}, DescriptorInquiry::Field::Extent, dimension}};
+ }
+ } else if (auto shape{GetShape(assoc->expr())}) {
+ if (dimension < static_cast<int>(shape->size())) {
+ return std::move(shape->at(dimension));
+ }
+ }
+ }
if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
if (IsImpliedShape(symbol) && details->init()) {
if (auto shape{GetShape(symbol)}) {
@@ -369,13 +390,6 @@ MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
}
}
}
- } else if (const auto *assoc{
- symbol.detailsIf<semantics::AssocEntityDetails>()}) {
- if (auto shape{GetShape(assoc->expr())}) {
- if (dimension < static_cast<int>(shape->size())) {
- return std::move(shape->at(dimension));
- }
- }
}
return std::nullopt;
}
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index fde6089b21963..dd66259789ff4 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -50,6 +50,15 @@ Expr<SomeType> Parenthesize(Expr<SomeType> &&expr) {
std::move(expr.u));
}
+std::optional<DataRef> ExtractDataRef(
+ const ActualArgument &arg, bool intoSubstring) {
+ if (const Expr<SomeType> *expr{arg.UnwrapExpr()}) {
+ return ExtractDataRef(*expr, intoSubstring);
+ } else {
+ return std::nullopt;
+ }
+}
+
std::optional<DataRef> ExtractSubstringBase(const Substring &substring) {
return std::visit(
common::visitors{
@@ -665,6 +674,11 @@ std::optional<Expr<SomeType>> ConvertToType(
}
bool IsAssumedRank(const Symbol &original) {
+ if (const auto *assoc{original.detailsIf<semantics::AssocEntityDetails>()}) {
+ if (assoc->rank()) {
+ return false; // in SELECT RANK case
+ }
+ }
const Symbol &symbol{semantics::ResolveAssociations(original)};
if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
return details->IsAssumedRank();
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 6b5f4caeb884b..6a9fced879e08 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -245,7 +245,7 @@ DescriptorInquiry::DescriptorInquiry(
: base_{base}, field_{field}, dimension_{dim} {
const Symbol &last{base_.GetLastSymbol()};
CHECK(IsDescriptor(last));
- CHECK((field == Field::Len && dim == 0) ||
+ CHECK(((field == Field::Len || field == Field::Rank) && dim == 0) ||
(field != Field::Len && dim >= 0 && dim < last.Rank()));
}
diff --git a/flang/lib/Semantics/check-select-rank.cpp b/flang/lib/Semantics/check-select-rank.cpp
index 3487fb564df04..595c17fa7211a 100644
--- a/flang/lib/Semantics/check-select-rank.cpp
+++ b/flang/lib/Semantics/check-select-rank.cpp
@@ -32,7 +32,7 @@ void SelectRankConstructChecker::Leave(
const Symbol *saveSelSymbol{nullptr};
if (const auto selExpr{GetExprFromSelector(selectRankStmtSel)}) {
if (const Symbol * sel{evaluate::UnwrapWholeSymbolDataRef(*selExpr)}) {
- if (!IsAssumedRankArray(*sel)) { // C1150
+ if (!evaluate::IsAssumedRank(*sel)) { // C1150
context_.Say(parser::FindSourceLocation(selectRankStmtSel),
"Selector '%s' is not an assumed-rank array variable"_err_en_US,
sel->name().ToString());
diff --git a/flang/test/Semantics/select-rank.f90 b/flang/test/Semantics/select-rank.f90
index d0cd93195501f..3e21e48605215 100644
--- a/flang/test/Semantics/select-rank.f90
+++ b/flang/test/Semantics/select-rank.f90
@@ -145,11 +145,13 @@ subroutine CALL_ME8(x)
Rank(2)
print *, "Now it's rank 2 "
RANK (*)
- print *, "Going for a other rank"
+ print *, "Going for another rank"
+ !ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
!ERROR: Not more than one of the selectors of SELECT RANK statement may be '*'
RANK (*)
print *, "This is Wrong"
+ !ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
END SELECT
end subroutine
More information about the flang-commits
mailing list