}
// 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)>) {
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;
}
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 &&);
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
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
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;
}
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{
--- /dev/null
+! 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