[flang-commits] [flang] 48a70ea - [flang] Fix semantic checks for C919
via flang-commits
flang-commits at lists.llvm.org
Mon Jun 6 23:56:10 PDT 2022
Author: Peixin-Qiao
Date: 2022-06-07T14:55:31+08:00
New Revision: 48a70ea177ad912b870cc75cd73d8459c03e8579
URL: https://github.com/llvm/llvm-project/commit/48a70ea177ad912b870cc75cd73d8459c03e8579
DIFF: https://github.com/llvm/llvm-project/commit/48a70ea177ad912b870cc75cd73d8459c03e8579.diff
LOG: [flang] Fix semantic checks for C919
The previous semantic analysis does not consider when the last part-ref
is scalar or complex part. Refactor the previous code and bring all the
checks into one place. The check starts from the designator by
extracting the dataref wrapped including the substring and complex part
and recursively check the base objects.
Co-authored-by: Peter Klausler <pklausler at nvidia.com>
Reviewed By: klausler
Differential Revision: https://reviews.llvm.org/D126595
Added:
flang/test/Semantics/expr-errors04.f90
Modified:
flang/include/flang/Evaluate/tools.h
flang/include/flang/Semantics/expression.h
flang/lib/Semantics/expression.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 2b56da846dd92..c96bc364e3433 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -260,17 +260,17 @@ template <typename A> const Symbol *ExtractBareLenParameter(const A &expr) {
}
// If an expression simply wraps a DataRef, extract and return it.
-// The Boolean argument controls the handling of Substring
+// The Boolean argument controls the handling of Substring and ComplexPart
// references: when true (not default), it extracts the base DataRef
-// of a substring, if it has one.
+// of a substring or complex part, if it has one.
template <typename A>
common::IfNoLvalue<std::optional<DataRef>, A> ExtractDataRef(
- const A &, bool intoSubstring) {
+ const A &, bool intoSubstring, bool intoComplexPart) {
return std::nullopt; // default base case
}
template <typename T>
-std::optional<DataRef> ExtractDataRef(
- const Designator<T> &d, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(const Designator<T> &d,
+ bool intoSubstring = false, bool intoComplexPart = false) {
return common::visit(
[=](const auto &x) -> std::optional<DataRef> {
if constexpr (common::HasMember<decltype(x), decltype(DataRef::u)>) {
@@ -281,29 +281,38 @@ std::optional<DataRef> ExtractDataRef(
return ExtractSubstringBase(x);
}
}
+ if constexpr (std::is_same_v<std::decay_t<decltype(x)>, ComplexPart>) {
+ if (intoComplexPart) {
+ return x.complex();
+ }
+ }
return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning
},
d.u);
}
template <typename T>
-std::optional<DataRef> ExtractDataRef(
- const Expr<T> &expr, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(const Expr<T> &expr,
+ bool intoSubstring = false, bool intoComplexPart = false) {
return common::visit(
- [=](const auto &x) { return ExtractDataRef(x, intoSubstring); }, expr.u);
+ [=](const auto &x) {
+ return ExtractDataRef(x, intoSubstring, intoComplexPart);
+ },
+ expr.u);
}
template <typename A>
-std::optional<DataRef> ExtractDataRef(
- const std::optional<A> &x, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(const std::optional<A> &x,
+ bool intoSubstring = false, bool intoComplexPart = false) {
if (x) {
- return ExtractDataRef(*x, intoSubstring);
+ return ExtractDataRef(*x, intoSubstring, intoComplexPart);
} else {
return std::nullopt;
}
}
template <typename A>
-std::optional<DataRef> ExtractDataRef(const A *p, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(
+ const A *p, bool intoSubstring = false, bool intoComplexPart = false) {
if (p) {
- return ExtractDataRef(*p, intoSubstring);
+ return ExtractDataRef(*p, intoSubstring, intoComplexPart);
} else {
return std::nullopt;
}
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 6c0d385a266bc..70e67bc237373 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -322,7 +322,7 @@ class ExpressionAnalyzer {
DataRef &&, const Symbol &, const semantics::Scope &);
MaybeExpr CompleteSubscripts(ArrayRef &&);
MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
- MaybeExpr TopLevelChecks(DataRef &&);
+ bool CheckRanks(const DataRef &); // Return false if error exists.
std::optional<Expr<SubscriptInteger>> GetSubstringBound(
const std::optional<parser::ScalarIntExpr> &);
MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index d8b7729a59d37..9f9107eaee108 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -249,20 +249,6 @@ MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
symbolRank, symbol.name(), subscripts);
}
return std::nullopt;
- } else if (Component * component{ref.base().UnwrapComponent()}) {
- int baseRank{component->base().Rank()};
- if (baseRank > 0) {
- int subscriptRank{0};
- for (const auto &expr : ref.subscript()) {
- subscriptRank += expr.Rank();
- }
- 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);
- return std::nullopt;
- }
- }
} else if (const auto *object{
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
// C928 & C1002
@@ -306,21 +292,47 @@ MaybeExpr ExpressionAnalyzer::ApplySubscripts(
std::move(dataRef.u));
}
-// Top-level checks for data references.
-MaybeExpr ExpressionAnalyzer::TopLevelChecks(DataRef &&dataRef) {
- if (Component * component{std::get_if<Component>(&dataRef.u)}) {
- const Symbol &symbol{component->GetLastSymbol()};
- int componentRank{symbol.Rank()};
- if (componentRank > 0) {
- int baseRank{component->base().Rank()};
- 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);
- }
- }
- }
- return Designate(std::move(dataRef));
+// C919a - only one part-ref of a data-ref may have rank > 0
+bool ExpressionAnalyzer::CheckRanks(const DataRef &dataRef) {
+ return common::visit(
+ common::visitors{
+ [this](const Component &component) {
+ const Symbol &symbol{component.GetLastSymbol()};
+ if (int componentRank{symbol.Rank()}; componentRank > 0) {
+ if (int baseRank{component.base().Rank()}; baseRank > 0) {
+ 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);
+ return false;
+ }
+ } else {
+ return CheckRanks(component.base());
+ }
+ return true;
+ },
+ [this](const ArrayRef &arrayRef) {
+ if (const auto *component{arrayRef.base().UnwrapComponent()}) {
+ int subscriptRank{0};
+ for (const Subscript &subscript : arrayRef.subscript()) {
+ subscriptRank += subscript.Rank();
+ }
+ if (subscriptRank > 0) {
+ if (int componentBaseRank{component->base().Rank()};
+ componentBaseRank > 0) {
+ Say("Subscripts of component '%s' of rank-%d derived type array have rank %d but must all be scalar"_err_en_US,
+ component->GetLastSymbol().name(), componentBaseRank,
+ subscriptRank);
+ return false;
+ }
+ } else {
+ return CheckRanks(component->base());
+ }
+ }
+ return true;
+ },
+ [](const SymbolRef &) { return true; },
+ [](const CoarrayRef &) { return true; },
+ },
+ dataRef.u);
}
// Parse tree correction after a substring S(j:k) was misparsed as an
@@ -369,11 +381,22 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
FixMisparsedSubstring(d);
// These checks have to be deferred to these "top level" data-refs where
// we can be sure that there are no following subscripts (yet).
- // Substrings have already been run through TopLevelChecks() and
- // won't be returned by ExtractDataRef().
if (MaybeExpr result{Analyze(d.u)}) {
if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
- return TopLevelChecks(std::move(*dataRef));
+ if (!CheckRanks(std::move(*dataRef))) {
+ return std::nullopt;
+ }
+ return Designate(std::move(*dataRef));
+ } else if (std::optional<DataRef> dataRef{
+ ExtractDataRef(std::move(result), /*intoSubstring=*/true)}) {
+ if (!CheckRanks(std::move(*dataRef))) {
+ return std::nullopt;
+ }
+ } else if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result),
+ /*intoSubstring=*/false, /*intoComplexPart=*/true)}) {
+ if (!CheckRanks(std::move(*dataRef))) {
+ return std::nullopt;
+ }
}
return result;
}
@@ -826,7 +849,7 @@ std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::GetSubstringBound(
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Substring &ss) {
if (MaybeExpr baseExpr{Analyze(std::get<parser::DataRef>(ss.t))}) {
if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*baseExpr))}) {
- if (MaybeExpr newBaseExpr{TopLevelChecks(std::move(*dataRef))}) {
+ if (MaybeExpr newBaseExpr{Designate(std::move(*dataRef))}) {
if (std::optional<DataRef> checked{
ExtractDataRef(std::move(*newBaseExpr))}) {
const parser::SubstringRange &range{
diff --git a/flang/test/Semantics/expr-errors04.f90 b/flang/test/Semantics/expr-errors04.f90
new file mode 100644
index 0000000000000..b7888a267f459
--- /dev/null
+++ b/flang/test/Semantics/expr-errors04.f90
@@ -0,0 +1,76 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Regression test for more than one part-ref with nonzero rank
+
+program m
+ type mt
+ complex :: c, c2(2)
+ integer :: x, x2(2)
+ character(10) :: s, s2(2)
+ end type
+ type mt2
+ type(mt) :: t1(2,2)
+ end type
+ type mt3
+ type(mt2) :: t2(2)
+ end type
+ type mt4
+ type(mt3) :: t3(2)
+ end type
+ type(mt4) :: t(2)
+
+ print *, t(1)%t3(1)%t2(1)%t1%x ! no error
+ print *, t(1)%t3(1)%t2(1)%t1%x2(1) ! no error
+ print *, t(1)%t3(1)%t2(1)%t1%s(1:2) ! no error
+ print *, t(1)%t3(1)%t2(1)%t1%s2(1)(1:2) ! no error
+ print *, t(1)%t3(1)%t2(1)%t1%c%RE ! no error
+ print *, t(1)%t3(1)%t2(1)%t1%c%IM ! no error
+ print *, t(1)%t3(1)%t2(1)%t1%c2(1)%RE ! no error
+ print *, t(1)%t3(1)%t2(1)%t1%c2(1)%IM ! no error
+
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%x
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3%t2%t1%x
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3(1)%t2%t1%x
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3%t2(1)%t1%x
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%x2(1)
+ !ERROR: Reference to whole rank-1 component 'x2' of rank-2 array of derived type is not allowed
+ print *, t(1)%t3%t2%t1%x2
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3(1)%t2%t1%x2(1)
+ !ERROR: Subscripts of component 'x2' of rank-2 derived type array have rank 1 but must all be scalar
+ print *, t(1)%t3(1)%t2(1)%t1%x2(1:)
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%s(1:2)
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3%t2(1)%t1%s(1:2)
+ !ERROR: Subscripts of component 't1' of rank-1 derived type array have rank 1 but must all be scalar
+ print *, t%t3%t2%t1(1,:)%s(1:2)
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%s2(1)(1:2)
+ !ERROR: Subscripts of component 's2' of rank-2 derived type array have rank 1 but must all be scalar
+ print *, t(1)%t3%t2%t1%s2(1:)(1:2)
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%c%RE
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3%t2%t1%c%RE
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3(1)%t2%t1%c%RE
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3%t2(1)%t1%c%RE
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%c%IM
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%c2(1)%RE
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3%t2%t1%c2(1)%RE
+ !ERROR: Subscripts of component 'c2' of rank-2 derived type array have rank 1 but must all be scalar
+ print *, t(1)%t3(1)%t2%t1%c2(1:)%RE
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t(1)%t3%t2(1)%t1%c2(1)%RE
+ !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+ print *, t%t3%t2%t1%c2(1)%IM
+end
More information about the flang-commits
mailing list