intel/llvm
1
0
Fork 0
mirror of https://github.com/intel/llvm.git synced 2026-01-16 13:35:38 +08:00
Code Issues Packages Projects Releases Wiki Activity

[flang] Fix parsing and semantics for array element substring%KIND/%LEN

Browse Source 
A type-param-inquiry of %KIND or %LEN applies to a designator, and
so must also be allowed for a substring.  F18 presently (mis)parses
instances of a type-param-inquiry as structure component references
and then fixes them in expression semantics when types are known and
we can distinguish them.  But when the base of a type-param-inquiry is
a substring of an array element, as in "charArray(i)(j:k)%len",
parsing fails.

Adjust the grammar to parse these cases, and extend expression semantics
to process the new production.

Differential Revision: https://reviews.llvm.org/D130375
This commit is contained in:
Peter Klausler
2022-07-22 10:52:30 -07:00
parent 0d89963df3
commit e03664d40c
9 changed files with 150 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
flang/include/flang/Parser/dump-parse-tree.h
View File

@@ -664,6 +664,7 @@ public:
NODE(parser, SubroutineSubprogram)
NODE(parser, SubscriptTriplet)
NODE(parser, Substring)
NODE(parser, SubstringInquiry)
NODE(parser, SubstringRange)
NODE(parser, Suffix)
NODE(parser, SyncAllStmt)

12
flang/include/flang/Parser/parse-tree.h
View File

@@ -179,6 +179,7 @@ struct EquivalenceStmt; // R870
struct CommonStmt; // R873
struct Substring; // R908
struct CharLiteralConstantSubstring;
struct SubstringInquiry;
struct DataRef; // R911
struct StructureComponent; // R913
struct CoindexedNamedObject; // R914
@@ -1734,7 +1735,7 @@ struct Expr {
StructureConstructor, common::Indirection<FunctionReference>, Parentheses,
UnaryPlus, Negate, NOT, PercentLoc, DefinedUnary, Power, Multiply, Divide,
Add, Subtract, Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV,
DefinedBinary, ComplexConstructor>
DefinedBinary, ComplexConstructor, common::Indirection<SubstringInquiry>>
u;
};
@@ -1778,6 +1779,15 @@ struct CharLiteralConstantSubstring {
std::tuple<CharLiteralConstant, SubstringRange> t;
};
// substring%KIND/LEN type parameter inquiry for cases that could not be
// parsed as part-refs and fixed up afterwards. N.B. we only have to
// handle inquiries into designator-based substrings, not those based on
// char-literal-constants.
struct SubstringInquiry {
CharBlock source;
WRAPPER_CLASS_BOILERPLATE(SubstringInquiry, Substring);
};
// R901 designator -> object-name | array-element | array-section |
// coindexed-named-object | complex-part-designator |
// structure-component | substring

2
flang/include/flang/Semantics/expression.h
View File

@@ -269,6 +269,7 @@ private:
MaybeExpr Analyze(const parser::ArrayElement &);
MaybeExpr Analyze(const parser::CoindexedNamedObject &);
MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
MaybeExpr Analyze(const parser::SubstringInquiry &);
MaybeExpr Analyze(const parser::ArrayConstructor &);
MaybeExpr Analyze(const parser::FunctionReference &,
std::optional<parser::StructureConstructor> * = nullptr);
@@ -326,6 +327,7 @@ private:
std::optional<Expr<SubscriptInteger>> GetSubstringBound(
const std::optional<parser::ScalarIntExpr> &);
MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
MaybeExpr FixMisparsedSubstring(const parser::Designator &);
struct CalleeAndArguments {
// A non-component function reference may constitute a misparsed

3
flang/lib/Parser/Fortran-parsers.cpp
View File

@@ -1075,6 +1075,9 @@ TYPE_PARSER(
TYPE_PARSER(construct<CharLiteralConstantSubstring>(
charLiteralConstant, parenthesized(Parser<SubstringRange>{})))
TYPE_PARSER(sourced(construct<SubstringInquiry>(Parser<Substring>{}) /
("%LEN"_tok || "%KIND"_tok)))
// R910 substring-range -> [scalar-int-expr] : [scalar-int-expr]
TYPE_PARSER(construct<SubstringRange>(
maybe(scalarIntExpr), ":" >> maybe(scalarIntExpr)))

8
flang/lib/Parser/expr-parsers.cpp
View File

@@ -66,13 +66,15 @@ TYPE_PARSER(construct<AcImpliedDoControl>(
// literal-constant | designator | array-constructor |
// structure-constructor | function-reference | type-param-inquiry |
// type-param-name | ( expr )
// N.B. type-param-inquiry is parsed as a structure component
// type-param-inquiry is parsed as a structure component, except for
// substring%KIND/LEN
constexpr auto primary{instrumented("primary"_en_US,
first(construct<Expr>(indirect(Parser<CharLiteralConstantSubstring>{})),
construct<Expr>(literalConstant),
construct<Expr>(construct<Expr::Parentheses>(parenthesized(expr))),
construct<Expr>(indirect(functionReference) / !"("_tok),
construct<Expr>(designator / !"("_tok),
construct<Expr>(indirect(functionReference) / !"("_tok / !"%"_tok),
construct<Expr>(designator / !"("_tok / !"%"_tok),
construct<Expr>(indirect(Parser<SubstringInquiry>{})), // %LEN or %KIND
construct<Expr>(Parser<StructureConstructor>{}),
construct<Expr>(Parser<ArrayConstructor>{}),
// PGI/XLF extension: COMPLEX constructor (x,y)

4
flang/lib/Parser/unparse.cpp
View File

@@ -758,6 +758,10 @@ public:
Walk(std::get<CharLiteralConstant>(x.t));
Put('('), Walk(std::get<SubstringRange>(x.t)), Put(')');
}
void Unparse(const SubstringInquiry &x) {
Walk(x.v);
Put(x.source.end()[-1] == 'n' ? "%LEN" : "%KIND");
}
void Unparse(const SubstringRange &x) { // R910
Walk(x.t, ":");
}

102
flang/lib/Semantics/expression.cpp
View File

@@ -336,37 +336,28 @@ bool ExpressionAnalyzer::CheckRanks(const DataRef &dataRef) {
}
// Parse tree correction after a substring S(j:k) was misparsed as an
// array section. N.B. Fortran substrings have to have a range, not a
// array section. Fortran substrings must have a range, not a
// single index.
static void FixMisparsedSubstring(const parser::Designator &d) {
auto &mutate{const_cast<parser::Designator &>(d)};
if (auto *dataRef{std::get_if<parser::DataRef>(&mutate.u)}) {
if (auto *ae{std::get_if<common::Indirection<parser::ArrayElement>>(
&dataRef->u)}) {
parser::ArrayElement &arrElement{ae->value()};
if (!arrElement.subscripts.empty()) {
auto iter{arrElement.subscripts.begin()};
if (auto *triplet{std::get_if<parser::SubscriptTriplet>(&iter->u)}) {
if (!std::get<2>(triplet->t) /* no stride */ &&
++iter == arrElement.subscripts.end() /* one subscript */) {
if (Symbol *
symbol{common::visit(
common::visitors{
[](parser::Name &n) { return n.symbol; },
[](common::Indirection<parser::StructureComponent>
&sc) { return sc.value().component.symbol; },
[](auto &) -> Symbol * { return nullptr; },
},
arrElement.base.u)}) {
const Symbol &ultimate{symbol->GetUltimate()};
if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
if (!ultimate.IsObjectArray() &&
type->category() == semantics::DeclTypeSpec::Character) {
// The ambiguous S(j:k) was parsed as an array section
// reference, but it's now clear that it's a substring.
// Fix the parse tree in situ.
mutate.u = arrElement.ConvertToSubstring();
}
static std::optional<parser::Substring> FixMisparsedSubstringDataRef(
parser::DataRef &dataRef) {
if (auto *ae{
std::get_if<common::Indirection<parser::ArrayElement>>(&dataRef.u)}) {
// ...%a(j:k) and "a" is a character scalar
parser::ArrayElement &arrElement{ae->value()};
if (arrElement.subscripts.size() == 1) {
if (auto *triplet{std::get_if<parser::SubscriptTriplet>(
&arrElement.subscripts.front().u)}) {
if (!std::get<2 /*stride*/>(triplet->t).has_value()) {
if (const Symbol *
symbol{parser::GetLastName(arrElement.base).symbol}) {
const Symbol &ultimate{symbol->GetUltimate()};
if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
if (!ultimate.IsObjectArray() &&
type->category() == semantics::DeclTypeSpec::Character) {
// The ambiguous S(j:k) was parsed as an array section
// reference, but it's now clear that it's a substring.
// Fix the parse tree in situ.
return arrElement.ConvertToSubstring();
}
}
}
@@ -374,11 +365,45 @@ static void FixMisparsedSubstring(const parser::Designator &d) {
}
}
}
return std::nullopt;
}
// When a designator is a misparsed type-param-inquiry of a misparsed
// substring -- it looks like a structure component reference of an array
// slice -- fix the substring and then convert to an intrinsic function
// call to KIND() or LEN(). And when the designator is a misparsed
// substring, convert it into a substring reference in place.
MaybeExpr ExpressionAnalyzer::FixMisparsedSubstring(
const parser::Designator &d) {
auto &mutate{const_cast<parser::Designator &>(d)};
if (auto *dataRef{std::get_if<parser::DataRef>(&mutate.u)}) {
if (auto *sc{std::get_if<common::Indirection<parser::StructureComponent>>(
&dataRef->u)}) {
parser::StructureComponent &structComponent{sc->value()};
parser::CharBlock which{structComponent.component.source};
if (which == "kind" || which == "len") {
if (auto substring{
FixMisparsedSubstringDataRef(structComponent.base)}) {
// ...%a(j:k)%kind or %len and "a" is a character scalar
mutate.u = std::move(*substring);
if (MaybeExpr substringExpr{Analyze(d)}) {
return MakeFunctionRef(which,
ActualArguments{ActualArgument{std::move(*substringExpr)}});
}
}
}
} else if (auto substring{FixMisparsedSubstringDataRef(*dataRef)}) {
mutate.u = std::move(*substring);
}
}
return std::nullopt;
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
auto restorer{GetContextualMessages().SetLocation(d.source)};
FixMisparsedSubstring(d);
if (auto substringInquiry{FixMisparsedSubstring(d)}) {
return std::move(substringInquiry);
}
// These checks have to be deferred to these "top level" data-refs where
// we can be sure that there are no following subscripts (yet).
if (MaybeExpr result{Analyze(d.u)}) {
@@ -918,6 +943,21 @@ MaybeExpr ExpressionAnalyzer::Analyze(
return std::nullopt;
}
// substring%KIND/LEN
MaybeExpr ExpressionAnalyzer::Analyze(const parser::SubstringInquiry &x) {
if (MaybeExpr substring{Analyze(x.v)}) {
CHECK(x.source.size() >= 8);
int nameLen{x.source.end()[-1] == 'n' ? 3 /*LEN*/ : 4 /*KIND*/};
parser::CharBlock name{
x.source.end() - nameLen, static_cast<std::size_t>(nameLen)};
CHECK(name == "len" || name == "kind");
return MakeFunctionRef(
name, ActualArguments{ActualArgument{std::move(*substring)}});
} else {
return std::nullopt;
}
}
// Subscripted array references
std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::AsSubscript(
MaybeExpr &&expr) {

6
flang/lib/Semantics/resolve-names.cpp
View File

@@ -1456,6 +1456,7 @@ public:
void Post(const parser::AllocateObject &);
bool Pre(const parser::PointerAssignmentStmt &);
void Post(const parser::Designator &);
void Post(const parser::SubstringInquiry &);
template <typename A, typename B>
void Post(const parser::LoopBounds<A, B> &x) {
ResolveName(*parser::Unwrap<parser::Name>(x.name));
@@ -6458,6 +6459,7 @@ const parser::Name *DeclarationVisitor::ResolveDesignator(
common::visitors{
[&](const parser::DataRef &x) { return ResolveDataRef(x); },
[&](const parser::Substring &x) {
Walk(std::get<parser::SubstringRange>(x.t).t);
return ResolveDataRef(std::get<parser::DataRef>(x.t));
},
},
@@ -7312,6 +7314,10 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
void ResolveNamesVisitor::Post(const parser::Designator &x) {
ResolveDesignator(x);
}
void ResolveNamesVisitor::Post(const parser::SubstringInquiry &x) {
Walk(std::get<parser::SubstringRange>(x.v.t).t);
ResolveDataRef(std::get<parser::DataRef>(x.v.t));
}
void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {
ResolveStructureComponent(x.v.thing);

47
flang/test/Evaluate/rewrite02.f90 Normal file
View File

@@ -0,0 +1,47 @@
! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
! Tests handling of easily-misparsed substrings and substring
! type parameter inquiries.
subroutine foo(j)
integer, intent(in) :: j
character*4 sc, ac(1)
type t
character*4 sc, ac(1)
end type
type(t) st, at(1)
!CHECK: PRINT *, sc(1_8:int(j,kind=8))
print *, sc(1:j)
!CHECK: PRINT *, ac(1_8)(1_8:int(j,kind=8))
print *, ac(1)(1:j)
!CHECK: PRINT *, st%sc(1_8:int(j,kind=8))
print *, st%sc(1:j)
!CHECK: PRINT *, st%ac(1_8)(1_8:int(j,kind=8))
print *, st%ac(1)(1:j)
!CHECK: PRINT *, at(1_8)%sc(1_8:int(j,kind=8))
print *, at(1)%sc(1:j)
!CHECK: PRINT *, at(1_8)%ac(1_8)(1_8:int(j,kind=8))
print *, at(1)%ac(1)(1:j)
!CHECK: PRINT *, 1_4
print *, sc(1:j)%kind
!CHECK: PRINT *, 1_4
print *, ac(1)(1:j)%kind
!CHECK: PRINT *, 1_4
print *, st%sc(1:j)%kind
!CHECK: PRINT *, 1_4
print *, st%ac(1)(1:j)%kind
!CHECK: PRINT *, 1_4
print *, at(1)%sc(1:j)%kind
!CHECK: PRINT *, 1_4
print *, at(1)%ac(1)(1:j)%kind
!CHECK: PRINT *, int(max(0_8,int(j,kind=8)-1_8+1_8),kind=4)
print *, sc(1:j)%len
!CHECK: PRINT *, int(max(0_8,int(j,kind=8)-1_8+1_8),kind=4)
print *, ac(1)(1:j)%len
!CHECK: PRINT *, int(max(0_8,int(j,kind=8)-1_8+1_8),kind=4)
print *, st%sc(1:j)%len
!CHECK: PRINT *, int(max(0_8,int(j,kind=8)-1_8+1_8),kind=4)
print *, st%ac(1)(1:j)%len
!CHECK: PRINT *, int(max(0_8,int(j,kind=8)-1_8+1_8),kind=4)
print *, at(1)%sc(1:j)%len
!CHECK: PRINT *, int(max(0_8,int(j,kind=8)-1_8+1_8),kind=4)
print *, at(1)%ac(1)(1:j)%len
end