maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Process names in ASSIGN and assigned GOTO 

Allow ASSIGNed integer variables as formats

Address review comment

Original-commit: flang-compiler/f18@361a151508
Reviewed-on: https://github.com/flang-compiler/f18/pull/1099
This commit is contained in:
peter klausler 2020-04-03 12:05:03 -07:00
parent 3638543f55
commit 455ed8de4f
18 changed files with 242 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2573,9 +2573,10 @@ struct CloseStmt {
};
// R1215 format -> default-char-expr | label | *
// deprecated(ASSIGN): | scalar-int-name
struct Format {
UNION_CLASS_BOILERPLATE(Format);
std::variant<DefaultCharExpr, Label, Star> u;
std::variant<Expr, Label, Star> u;
};
// R1214 id-variable -> scalar-int-variable

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

@ -240,8 +240,9 @@ TYPE_CONTEXT_PARSER("PRINT statement"_en_US,
"PRINT" >> format, defaulted("," >> nonemptyList(outputItem))))
// R1215 format -> default-char-expr | label | *
// deprecated(ASSIGN): | scalar-int-name
TYPE_PARSER(construct<Format>(label / !"_."_ch) ||
construct<Format>(defaultCharExpr / !"="_tok) || construct<Format>(star))
construct<Format>(expr / !"="_tok) || construct<Format>(star))
// R1216 input-item -> variable | io-implied-do
TYPE_PARSER(construct<InputItem>(variable) ||

34
flang/lib/Semantics/check-io.cpp
View File

@ -195,7 +195,29 @@ void IoChecker::Enter(const parser::Format &spec) {
common::visitors{
[&](const parser::Label &) { flags_.set(Flag::LabelFmt); },
[&](const parser::Star &) { flags_.set(Flag::StarFmt); },
[&](const parser::DefaultCharExpr &format) {
[&](const parser::Expr &format) {
const SomeExpr *expr{GetExpr(format)};
if (!expr) {
return;
}
auto type{expr->GetType()};
if (!type ||
(type->category() != TypeCategory::Integer &&
type->category() != TypeCategory::Character) ||
type->kind() !=
context_.defaultKinds().GetDefaultKind(type->category())) {
context_.Say(format.source,
"Format expression must be default character or integer"_err_en_US);
return;
}
if (type->category() == TypeCategory::Integer) {
flags_.set(Flag::AssignFmt);
if (expr->Rank() != 0 || !IsVariable(*expr)) {
context_.Say(format.source,
"Assigned format label must be a scalar variable"_err_en_US);
}
return;
}
flags_.set(Flag::CharFmt);
const std::optional<std::string> constantFormat{
GetConstExpr<std::string>(format)};
@ -203,11 +225,10 @@ void IoChecker::Enter(const parser::Format &spec) {
return;
}
// validate constant format -- 12.6.2.2
bool isFolded{constantFormat->size() !=
format.thing.value().source.size() - 2};
bool isFolded{constantFormat->size() != format.source.size() - 2};
parser::CharBlock reporterCharBlock{isFolded
? parser::CharBlock{format.thing.value().source}
: parser::CharBlock{format.thing.value().source.begin() + 1,
? parser::CharBlock{format.source}
: parser::CharBlock{format.source.begin() + 1,
static_cast<std::size_t>(0)}};
FormatErrorReporter reporter{context_, reporterCharBlock};
auto reporterWrapper{
@ -723,7 +744,8 @@ void IoChecker::LeaveReadWrite() const {
CheckForProhibitedSpecifier(
IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220
CheckForRequiredSpecifier(IoSpecKind::Advance,
flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt),
flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) ||
flags_.test(Flag::AssignFmt),
"an explicit format"); // C1221
CheckForProhibitedSpecifier(IoSpecKind::Advance,
flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221

6
flang/lib/Semantics/check-io.h
View File

@ -81,9 +81,9 @@ public:
private:
// Presence flag values.
ENUM_CLASS(Flag, IoControlList, InternalUnit, NumberUnit, StarUnit, CharFmt,
LabelFmt, StarFmt, FmtOrNml, KnownAccess, AccessDirect, AccessStream,
AdvanceYes, AsynchronousYes, KnownStatus, StatusNew, StatusReplace,
StatusScratch, DataList)
LabelFmt, StarFmt, AssignFmt, FmtOrNml, KnownAccess, AccessDirect,
AccessStream, AdvanceYes, AsynchronousYes, KnownStatus, StatusNew,
StatusReplace, StatusScratch, DataList)
template <typename R, typename T> std::optional<R> GetConstExpr(const T &x) {
using DefaultCharConstantType =

74
flang/lib/Semantics/resolve-labels.cpp
View File

@ -154,16 +154,11 @@ static unsigned SayLabel(parser::Label label) {
struct UnitAnalysis {
UnitAnalysis() { scopeModel.push_back(0); }
UnitAnalysis(UnitAnalysis &&that)
: doStmtSources{std::move(that.doStmtSources)},
formatStmtSources{std::move(that.formatStmtSources)},
otherStmtSources{std::move(that.otherStmtSources)},
targetStmts{std::move(that.targetStmts)}, scopeModel{std::move(
that.scopeModel)} {}
SourceStmtList doStmtSources;
SourceStmtList formatStmtSources;
SourceStmtList otherStmtSources;
SourceStmtList assignStmtSources;
TargetStmtMap targetStmts;
std::vector<ProxyForScope> scopeModel;
};
@ -465,7 +460,7 @@ public:
AddLabelReference(std::get<3>(arithmeticIfStmt.t));
}
void Post(const parser::AssignStmt &assignStmt) {
AddLabelReference(std::get<parser::Label>(assignStmt.t));
AddLabelReferenceFromAssignStmt(std::get<parser::Label>(assignStmt.t));
}
void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
AddLabelReference(std::get<std::list<parser::Label>>(assignedGotoStmt.t));
@ -726,7 +721,7 @@ private:
if (label < 1 || label > 99999) {
context_.Say(currentPosition_,
parser::MessageFormattedText{
"label '%u' is out of range"_err_en_US, SayLabel(label)});
"Label '%u' is out of range"_err_en_US, SayLabel(label)});
}
}
@ -742,7 +737,7 @@ private:
if (!pair.second) {
context_.Say(currentPosition_,
parser::MessageFormattedText{
"label '%u' is not distinct"_err_en_US, SayLabel(label)});
"Label '%u' is not distinct"_err_en_US, SayLabel(label)});
}
}
@ -758,6 +753,12 @@ private:
label, currentScope_, currentPosition_);
}
void AddLabelReferenceFromAssignStmt(parser::Label label) {
CheckLabelInRange(label);
programUnits_.back().assignStmtSources.emplace_back(
label, currentScope_, currentPosition_);
}
void AddLabelReference(parser::Label label) {
CheckLabelInRange(label);
programUnits_.back().otherStmtSources.emplace_back(
@ -879,12 +880,12 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
// C1133
context.Say(position,
parser::MessageFormattedText{
"label '%u' cannot be found"_err_en_US, SayLabel(label)});
"Label '%u' cannot be found"_err_en_US, SayLabel(label)});
} else if (doTarget.parserCharBlock.begin() < position.begin()) {
// R1119
context.Say(position,
parser::MessageFormattedText{
"label '%u' doesn't lexically follow DO stmt"_err_en_US,
"Label '%u' doesn't lexically follow DO stmt"_err_en_US,
SayLabel(label)});
} else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
@ -905,7 +906,7 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
} else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
context.Say(position,
parser::MessageFormattedText{
"label '%u' is not in DO loop scope"_err_en_US, SayLabel(label)});
"Label '%u' is not in DO loop scope"_err_en_US, SayLabel(label)});
} else if (!doTarget.labeledStmtClassificationSet.test(
TargetStatementEnum::Do)) {
context.Say(doTarget.parserCharBlock,
@ -932,11 +933,11 @@ void CheckScopeConstraints(const SourceStmtList &stmts,
if (!HasScope(target.proxyForScope)) {
context.Say(position,
parser::MessageFormattedText{
"label '%u' was not found"_err_en_US, SayLabel(label)});
"Label '%u' was not found"_err_en_US, SayLabel(label)});
} else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
context.Say(position,
parser::MessageFormattedText{
"label '%u' is not in scope"_en_US, SayLabel(label)});
"Label '%u' is not in scope"_en_US, SayLabel(label)});
}
}
}
@ -950,23 +951,24 @@ void CheckBranchTargetConstraints(const SourceStmtList &stmts,
if (!branchTarget.labeledStmtClassificationSet.test(
TargetStatementEnum::Branch) &&
!branchTarget.labeledStmtClassificationSet.test(
TargetStatementEnum::CompatibleBranch)) {
TargetStatementEnum::CompatibleBranch)) { // error
context
.Say(branchTarget.parserCharBlock,
parser::MessageFormattedText{
"'%u' not a branch target"_err_en_US, SayLabel(label)})
"Label '%u' is not a branch target"_err_en_US,
SayLabel(label)})
.Attach(stmt.parserCharBlock,
parser::MessageFormattedText{
"control flow use of '%u'"_en_US, SayLabel(label)});
"Control flow use of '%u'"_en_US, SayLabel(label)});
} else if (!branchTarget.labeledStmtClassificationSet.test(
TargetStatementEnum::Branch)) {
TargetStatementEnum::Branch)) { // warning
context
.Say(branchTarget.parserCharBlock,
parser::MessageFormattedText{
"'%u' not a branch target"_en_US, SayLabel(label)})
"Label '%u' is not a branch target"_en_US, SayLabel(label)})
.Attach(stmt.parserCharBlock,
parser::MessageFormattedText{
"control flow use of '%u'"_en_US, SayLabel(label)});
"Control flow use of '%u'"_en_US, SayLabel(label)});
}
}
}
@ -1006,6 +1008,36 @@ void CheckDataTransferConstraints(const SourceStmtList &dataTransfers,
CheckDataXferTargetConstraints(dataTransfers, labels, context);
}
void CheckAssignTargetConstraints(const SourceStmtList &stmts,
const TargetStmtMap &labels, SemanticsContext &context) {
for (const auto &stmt : stmts) {
const auto &label{stmt.parserLabel};
auto target{GetLabel(labels, label)};
if (HasScope(target.proxyForScope) &&
!target.labeledStmtClassificationSet.test(
TargetStatementEnum::Branch) &&
!target.labeledStmtClassificationSet.test(
TargetStatementEnum::Format)) {
context
.Say(target.parserCharBlock,
target.labeledStmtClassificationSet.test(
TargetStatementEnum::CompatibleBranch)
? "Label '%u' is not a branch target or FORMAT"_en_US
: "Label '%u' is not a branch target or FORMAT"_err_en_US,
SayLabel(label))
.Attach(stmt.parserCharBlock, "ASSIGN statement use of '%u'"_en_US,
SayLabel(label));
}
}
}
void CheckAssignConstraints(const SourceStmtList &assigns,
const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
SemanticsContext &context) {
CheckScopeConstraints(assigns, labels, scopes, context);
CheckAssignTargetConstraints(assigns, labels, context);
}
bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
auto &context{parseTreeAnalysis.ErrorHandler()};
for (const auto &programUnit : parseTreeAnalysis.ProgramUnits()) {
@ -1017,6 +1049,8 @@ bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
CheckBranchConstraints(branches, labels, scopes, context);
const auto &dataTransfers{programUnit.formatStmtSources};
CheckDataTransferConstraints(dataTransfers, labels, scopes, context);
const auto &assigns{programUnit.assignStmtSources};
CheckAssignConstraints(assigns, labels, scopes, context);
}
return !context.AnyFatalError();
}

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

@ -1387,6 +1387,8 @@ public:
bool Pre(const parser::StmtFunctionStmt &);
bool Pre(const parser::DefinedOpName &);
bool Pre(const parser::ProgramUnit &);
void Post(const parser::AssignStmt &);
void Post(const parser::AssignedGotoStmt &);
// These nodes should never be reached: they are handled in ProgramUnit
bool Pre(const parser::MainProgram &) { DIE("unreachable"); }
@ -6056,6 +6058,17 @@ bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) {
return false;
}
void ResolveNamesVisitor::Post(const parser::AssignStmt &x) {
if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
ConvertToObjectEntity(DEREF(name->symbol));
}
}
void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) {
if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
ConvertToObjectEntity(DEREF(name->symbol));
}
}
bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
auto root{ProgramTree::Build(x)};
SetScope(context().globalScope());

2
flang/lib/Semantics/rewrite-parse-tree.cpp
View File

@ -132,7 +132,7 @@ void RewriteMutator::Post(parser::IoUnit &x) {
template <typename READ_OR_WRITE>
void FixMisparsedUntaggedNamelistName(READ_OR_WRITE &x) {
if (x.iounit && x.format &&
std::holds_alternative<parser::DefaultCharExpr>(x.format->u)) {
std::holds_alternative<parser::Expr>(x.format->u)) {
if (const parser::Name * name{parser::Unwrap<parser::Name>(x.format)}) {
if (name->symbol && name->symbol->GetUltimate().has<NamelistDetails>()) {
x.controls.emplace_front(parser::IoControlSpec{std::move(*name)});

34
flang/lib/Semantics/semantics.cpp
View File

@ -113,25 +113,49 @@ private:
SemanticsContext &context_;
};
class EntryChecker : public virtual BaseChecker {
class MiscChecker : public virtual BaseChecker {
public:
explicit EntryChecker(SemanticsContext &context) : context_{context} {}
explicit MiscChecker(SemanticsContext &context) : context_{context} {}
void Leave(const parser::EntryStmt &) {
if (!context_.constructStack().empty()) { // C1571
context_.Say("ENTRY may not appear in an executable construct"_err_en_US);
}
}
void Leave(const parser::AssignStmt &stmt) {
CheckAssignGotoName(std::get<parser::Name>(stmt.t));
}
void Leave(const parser::AssignedGotoStmt &stmt) {
CheckAssignGotoName(std::get<parser::Name>(stmt.t));
}
private:
void CheckAssignGotoName(const parser::Name &name) {
if (context_.HasError(name.symbol)) {
return;
}
const Symbol &symbol{DEREF(name.symbol)};
auto type{evaluate::DynamicType::From(symbol)};
if (!IsVariableName(symbol) || symbol.Rank() != 0 || !type ||
type->category() != TypeCategory::Integer ||
type->kind() !=
context_.defaultKinds().GetDefaultKind(TypeCategory::Integer)) {
context_
.Say(name.source,
"'%s' must be a default integer scalar variable"_err_en_US,
name.source)
.Attach(symbol.name(), "Declaration of '%s'"_en_US, symbol.name());
}
}
SemanticsContext &context_;
};
using StatementSemanticsPass1 = ExprChecker;
using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
ArithmeticIfStmtChecker, AssignmentChecker, CaseChecker, CoarrayChecker,
DataChecker, DeallocateChecker, DoForallChecker, EntryChecker,
IfStmtChecker, IoChecker, NamelistChecker, NullifyChecker,
OmpStructureChecker, PurityChecker, ReturnStmtChecker, StopChecker>;
DataChecker, DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
MiscChecker, NamelistChecker, NullifyChecker, OmpStructureChecker,
PurityChecker, ReturnStmtChecker, StopChecker>;
static bool PerformStatementSemantics(
SemanticsContext &context, parser::Program &program) {

47
flang/test/Semantics/assign06.f90 Normal file
View File

@ -0,0 +1,47 @@
! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
! Test ASSIGN statement, assigned GOTO, and assigned format labels
! (see subclause 8.2.4 in Fortran 90 (*not* 2018!)
program main
call test(0)
contains
subroutine test(n)
integer, intent(in) :: n
integer :: lab
integer(kind=1) :: badlab1
real :: badlab2
integer :: badlab3(1)
assign 1 to lab ! ok
assign 1 to implicitlab1 ! ok
!ERROR: 'badlab1' must be a default integer scalar variable
assign 1 to badlab1
!ERROR: 'badlab2' must be a default integer scalar variable
assign 1 to badlab2
!ERROR: 'badlab3' must be a default integer scalar variable
assign 1 to badlab3
!ERROR: 'test' must be a default integer scalar variable
assign 1 to test
if (n==1) goto lab ! ok
if (n==1) goto implicitlab2 ! ok
!ERROR: 'badlab1' must be a default integer scalar variable
if (n==1) goto badlab1
!ERROR: 'badlab2' must be a default integer scalar variable
if (n==1) goto badlab2
!ERROR: 'badlab3' must be a default integer scalar variable
if (n==1) goto badlab3
if (n==1) goto lab(1) ! ok
if (n==1) goto lab,(1) ! ok
if (n==1) goto lab(1,1) ! ok
assign 3 to lab ! ok
write(*,fmt=lab) ! ok
write(*,fmt=implicitlab3) ! ok
!ERROR: Format expression must be default character or integer
write(*,fmt=badlab1)
!ERROR: Format expression must be default character or integer
write(*,fmt=badlab2)
!ERROR: Format expression must be default character or integer
write(*,fmt=badlab2)
1 continue
3 format('yes')
end subroutine test
end program

35
flang/test/Semantics/assign07.f90 Normal file
View File

@ -0,0 +1,35 @@
! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
! Test ASSIGN statement, assigned GOTO, and assigned format labels
! (see subclause 8.2.4 in Fortran 90 (*not* 2018!)
program main
call test(0)
2 format('no')
contains
subroutine test(n)
!ERROR: Label '4' is not a branch target or FORMAT
4 integer, intent(in) :: n
integer :: lab
assign 1 to lab ! ok
assign 1 to implicitlab1 ! ok
!ERROR: Label '666' was not found
assign 666 to lab
!ERROR: Label '2' was not found
assign 2 to lab
assign 4 to lab
if (n==1) goto lab ! ok
if (n==1) goto implicitlab2 ! ok
if (n==1) goto lab(1) ! ok
if (n==1) goto lab,(1) ! ok
if (n==1) goto lab(1,1) ! ok
!ERROR: Label '666' was not found
if (n==1) goto lab(1,666)
!ERROR: Label '2' was not found
if (n==1) goto lab(1,2)
assign 3 to lab
write(*,fmt=lab) ! ok
write(*,fmt=implicitlab3) ! ok
1 continue
3 format('yes')
end subroutine test
end program

6
flang/test/Semantics/if_arith03.f90
View File

@ -1,19 +1,19 @@
! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
!ERROR: label '600' was not found
!ERROR: Label '600' was not found
if ( A ) 100, 200, 600
100 CONTINUE
200 CONTINUE
300 CONTINUE
!ERROR: label '601' was not found
!ERROR: Label '601' was not found
if ( A ) 101, 601, 301
101 CONTINUE
201 CONTINUE
301 CONTINUE
!ERROR: label '602' was not found
!ERROR: Label '602' was not found
if ( A ) 602, 202, 302
102 CONTINUE
202 CONTINUE

10
flang/test/Semantics/label02.f90
View File

@ -2,11 +2,11 @@
! negative test -- invalid labels, out of range
! EXEC: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
! CHECK: label '0' is out of range
! CHECK: label '100000' is out of range
! CHECK: label '123456' is out of range
! CHECK: label '123456' was not found
! CHECK: label '1000' is not distinct
! CHECK: Label '0' is out of range
! CHECK: Label '100000' is out of range
! CHECK: Label '123456' is out of range
! CHECK: Label '123456' was not found
! CHECK: Label '1000' is not distinct
subroutine sub00(a,b,n,m)
real a(n)

6
flang/test/Semantics/label03.f90
View File

@ -4,9 +4,9 @@
! EXEC: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
! CHECK: DO loop doesn't properly nest
! CHECK: DO loop conflicts
! CHECK: label '30' cannot be found
! CHECK: label '40' cannot be found
! CHECK: label '50' doesn't lexically follow DO stmt
! CHECK: Label '30' cannot be found
! CHECK: Label '40' cannot be found
! CHECK: Label '50' doesn't lexically follow DO stmt
subroutine sub00(a,b,n,m)
real a(n,m)

8
flang/test/Semantics/label05.f90
View File

@ -2,10 +2,10 @@
! negative test -- invalid labels, out of range
! EXEC: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
! CHECK: label '50' was not found
! CHECK: label '55' is not in scope
! CHECK: '70' not a branch target
! CHECK: control flow use of '70'
! CHECK: Label '50' was not found
! CHECK: Label '55' is not in scope
! CHECK: Label '70' is not a branch target
! CHECK: Control flow use of '70'
subroutine sub00(a,b,n,m)
real a(n,m)

12
flang/test/Semantics/label06.f90
View File

@ -2,12 +2,12 @@
! negative test -- invalid labels, out of range
! EXEC: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
! CHECK: label '10' is not in scope
! CHECK: label '20' was not found
! CHECK: '30' not a branch target
! CHECK: control flow use of '30'
! CHECK: label '40' is not in scope
! CHECK: label '50' is not in scope
! CHECK: Label '10' is not in scope
! CHECK: Label '20' was not found
! CHECK: Label '30' is not a branch target
! CHECK: Control flow use of '30'
! CHECK: Label '40' is not in scope
! CHECK: Label '50' is not in scope
subroutine sub00(n)
GOTO (10,20,30) n

10
flang/test/Semantics/label07.f90
View File

@ -2,11 +2,11 @@
! negative test -- invalid labels, out of range
! EXEC: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
! CHECK: '30' not a branch target
! CHECK: control flow use of '30'
! CHECK: label '10' is not in scope
! CHECK: label '20' was not found
! CHECK: label '60' was not found
! CHECK: Label '30' is not a branch target
! CHECK: Control flow use of '30'
! CHECK: Label '10' is not in scope
! CHECK: Label '20' was not found
! CHECK: Label '60' was not found
subroutine sub00(n,m)
30 format (i6,f6.2)

2
flang/test/Semantics/label09.f90
View File

@ -1,6 +1,6 @@
! RUN: %S/test_any.sh %s %flang %t
! EXEC: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
! CHECK: label '60' was not found
! CHECK: Label '60' was not found
subroutine s(a)
real a(10)

2
flang/test/Semantics/label14.f90
View File

@ -4,7 +4,7 @@
! Block Construct
! EXEC: ${F18} %s 2>&1 | ${FileCheck} %s
! CHECK: label '20' is not in scope
! CHECK: Label '20' is not in scope
subroutine s1
block