Skip to content

Commit

Permalink
Changes responding to comments on my previous pull request. Specifica…
Browse files Browse the repository at this point in the history 
…lly --

parse-tree.cc
 - Cleaned up the use of "const" in several declarations.
check-do-stmt.cc
 - Replaced uses of parser::Messages with SemanticsContext.
 - Removed unused "==" operator from the DoStmtContext class.
 - Reduced the size of the GetBounds function by calling GetLoopControl().
 - Changed the warning message for REAL DO controls to not mention standard
   extensions.
check-do-stmt.h
 - Restored the forward reference to Fortran::parser::DoConstruct and removed
   the include of parse-tree.h
dosemantics*.f90
 - Removed extraneous references to the "RUN" command.
test_errors.sh
 - Simplified and generalized the extraction of the OPTIONS specification.
  • Loading branch information
@psteinfeld
psteinfeld committed Jun 10, 2019
1 parent f484660 commit 04a0712
Show file tree
Hide file tree
Showing 7 changed files with 45 additions and 56 deletions.
10 changes: 5 additions & 5 deletions lib/parser/parse-tree.cc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,25 +81,25 @@ Expr::Expr(FunctionReference &&x)
: u{common::Indirection<FunctionReference>::Make(std::move(x))} {}

const std::optional<LoopControl> &DoConstruct::GetLoopControl() const {
NonLabelDoStmt const &doStmt{
const NonLabelDoStmt &doStmt{
std::get<Statement<NonLabelDoStmt>>(t).statement};
std::optional<LoopControl> const &control{
const std::optional<LoopControl> &control{
std::get<std::optional<LoopControl>>(doStmt.t)};
return control;
}

bool DoConstruct::IsDoNormal() const {
std::optional<LoopControl> const &control{GetLoopControl()};
const std::optional<LoopControl> &control{GetLoopControl()};
return control && std::holds_alternative<LoopControl::Bounds>(control->u);
}

bool DoConstruct::IsDoWhile() const {
std::optional<LoopControl> const &control{GetLoopControl()};
const std::optional<LoopControl> &control{GetLoopControl()};
return control && std::holds_alternative<ScalarLogicalExpr>(control->u);
}

bool DoConstruct::IsDoConcurrent() const {
std::optional<LoopControl> const &control{GetLoopControl()};
const std::optional<LoopControl> &control{GetLoopControl()};
return control && std::holds_alternative<LoopControl::Concurrent>(control->u);
}

Expand Down
78 changes: 34 additions & 44 deletions lib/semantics/check-do-stmt.cc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ static bool isProcedure(const Symbol::Flags &flags) {
// 11.1.7.5 - enforce semantics constraints on a DO CONCURRENT loop body
class DoConcurrentEnforcement {
public:
DoConcurrentEnforcement(parser::Messages &messages) : messages_{messages} {}
DoConcurrentEnforcement(SemanticsContext &context) : context_{context} {}
std::set<parser::Label> labels() { return labels_; }
std::set<parser::CharBlock> names() { return names_; }
template<typename T> bool Pre(const T &) { return true; }
Expand Down Expand Up @@ -107,13 +107,13 @@ class DoConcurrentEnforcement {

// C1136
void Post(const parser::ReturnStmt &) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"RETURN not allowed in DO CONCURRENT"_err_en_US);
}

// C1137
void NoImageControl() {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"image control statement not allowed in DO CONCURRENT"_err_en_US);
}

Expand All @@ -133,27 +133,27 @@ class DoConcurrentEnforcement {

void Post(const parser::AllocateStmt &) {
if (anyObjectIsCoarray()) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"ALLOCATE coarray not allowed in DO CONCURRENT"_err_en_US);
}
}

void Post(const parser::DeallocateStmt &) {
if (anyObjectIsCoarray()) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"DEALLOCATE coarray not allowed in DO CONCURRENT"_err_en_US);
}
// C1140: deallocation of polymorphic objects
if (anyObjectIsPolymorphic()) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"DEALLOCATE polymorphic object(s) not allowed"
" in DO CONCURRENT"_err_en_US);
}
}

template<typename T> void Post(const parser::Statement<T> &) {
if (EndTDeallocatesCoarray()) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"implicit deallocation of coarray not allowed"
" in DO CONCURRENT"_err_en_US);
}
Expand All @@ -165,25 +165,25 @@ class DoConcurrentEnforcement {
// C1137: call move_alloc with coarray arguments
if (name->source == "move_alloc") {
if (anyObjectIsCoarray()) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"call to MOVE_ALLOC intrinsic in DO CONCURRENT with coarray"
" argument(s) not allowed"_err_en_US);
}
}
// C1139: call to impure procedure
if (name->symbol && !isPure(name->symbol->attrs())) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"call to impure subroutine in DO CONCURRENT not allowed"_err_en_US);
}
if (name->symbol && fromScope(*name->symbol, "ieee_exceptions"s)) {
if (name->source == "ieee_get_flag") {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"IEEE_GET_FLAG not allowed in DO CONCURRENT"_err_en_US);
} else if (name->source == "ieee_set_halting_mode") {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"IEEE_SET_HALTING_MODE not allowed in DO CONCURRENT"_err_en_US);
} else if (name->source == "ieee_get_halting_mode") {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"IEEE_GET_HALTING_MODE not allowed in DO CONCURRENT"_err_en_US);
}
}
Expand All @@ -192,7 +192,7 @@ class DoConcurrentEnforcement {
auto &component{std::get<parser::ProcComponentRef>(procedureDesignator.u)
.v.thing.component};
if (component.symbol && !isPure(component.symbol->attrs())) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"call to impure subroutine in DO CONCURRENT not allowed"_err_en_US);
}
}
Expand All @@ -204,7 +204,7 @@ class DoConcurrentEnforcement {
std::get_if<parser::IoControlSpec::CharExpr>(&ioControlSpec.u)}) {
if (std::get<parser::IoControlSpec::CharExpr::Kind>(charExpr->t) ==
parser::IoControlSpec::CharExpr::Kind::Advance) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"ADVANCE specifier not allowed in DO CONCURRENT"_err_en_US);
}
}
Expand All @@ -231,15 +231,15 @@ class DoConcurrentEnforcement {
std::set<parser::CharBlock> names_;
std::set<parser::Label> labels_;
parser::CharBlock currentStatementSourcePosition_;
parser::Messages &messages_;
};
SemanticsContext &context_;
}; // class DoConcurrentEnforcement

class DoConcurrentLabelEnforce {
public:
DoConcurrentLabelEnforce(parser::Messages &messages,
DoConcurrentLabelEnforce(SemanticsContext &context,
std::set<parser::Label> &&labels, std::set<parser::CharBlock> &&names,
parser::CharBlock doConcurrentSourcePosition)
: messages_{messages}, labels_{labels}, names_{names},
: context_{context}, labels_{labels}, names_{names},
doConcurrentSourcePosition_{doConcurrentSourcePosition} {}
template<typename T> bool Pre(const T &) { return true; }
template<typename T> bool Pre(const parser::Statement<T> &statement) {
Expand Down Expand Up @@ -290,34 +290,34 @@ class DoConcurrentLabelEnforce {
void checkName(const std::optional<parser::Name> &nm) {
if (!nm.has_value()) {
if (do_depth_ == 0) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"exit from DO CONCURRENT construct (%s)"_err_en_US,
doConcurrentSourcePosition_);
}
// nesting of named constructs is assumed to have been previously checked
// by the name/label resolution pass
} else if (names_.find(nm.value().source) == names_.end()) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"exit from DO CONCURRENT construct (%s) to construct with name '%s'"_err_en_US,
doConcurrentSourcePosition_, nm.value().source);
}
}

void checkLabelUse(const parser::Label &labelUsed) {
if (labels_.find(labelUsed) == labels_.end()) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"control flow escapes from DO CONCURRENT"_err_en_US);
}
}

private:
parser::Messages &messages_;
SemanticsContext &context_;
std::set<parser::Label> labels_;
std::set<parser::CharBlock> names_;
int do_depth_{0};
parser::CharBlock currentStatementSourcePosition_{nullptr};
parser::CharBlock doConcurrentSourcePosition_{nullptr};
};
}; // class DoConcurrentLabelEnforce

using CS = std::vector<const Symbol *>;

Expand Down Expand Up @@ -375,10 +375,7 @@ static CS GatherReferencesFromExpression(const parser::Expr &expression) {
// Find a DO statement and enforce semantics checks on its body
class DoStmtContext {
public:
DoStmtContext(SemanticsContext &context)
: context_{context}, messages_{context.messages()} {}

bool operator==(const DoStmtContext &x) const { return this == &x; }
DoStmtContext(SemanticsContext &context) : context_{context} {}

void Check(const parser::DoConstruct &doConstruct) {
if (doConstruct.IsDoConcurrent()) {
Expand All @@ -396,11 +393,7 @@ class DoStmtContext {
using Bounds = parser::LoopControl::Bounds;

const Bounds &GetBounds(const parser::DoConstruct &doConstruct) {
auto &doStmt{
std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)};
auto &optionalLoopControl{
std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
auto &loopControl{optionalLoopControl.value()};
auto &loopControl{doConstruct.GetLoopControl().value()};
return std::get<Bounds>(loopControl.u);
}

Expand All @@ -409,11 +402,9 @@ class DoStmtContext {
// No messages for the default case
} else if (isReal && context_.warnOnNonstandardUsage() &&
(!context_.warningsAreErrors())) {
messages_.Say(sourceLocation,
"DO controls not of type INTEGER are a non-standard "
"extension"_en_US);
context_.Say(sourceLocation, "DO controls should be INTEGER"_en_US);
} else {
messages_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);
context_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);
}
}

Expand Down Expand Up @@ -455,11 +446,11 @@ class DoStmtContext {
std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
currentStatementSourcePosition_ = doStmt.source;

DoConcurrentEnforcement doConcurrentEnforcement{messages_};
DoConcurrentEnforcement doConcurrentEnforcement{context_};
parser::Walk(
std::get<parser::Block>(doConstruct.t), doConcurrentEnforcement);

DoConcurrentLabelEnforce doConcurrentLabelEnforce{messages_,
DoConcurrentLabelEnforce doConcurrentLabelEnforce{context_,
doConcurrentEnforcement.labels(), doConcurrentEnforcement.names(),
currentStatementSourcePosition_};
parser::Walk(
Expand All @@ -482,7 +473,7 @@ class DoStmtContext {
if (std::holds_alternative<parser::LocalitySpec::DefaultNone>(ls.u)) {
++count;
if (count > 1) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"only one DEFAULT(NONE) may appear"_err_en_US);
return;
}
Expand All @@ -494,7 +485,7 @@ class DoStmtContext {
// C1124
for (auto *symbol : symbols) {
if (!InnermostEnclosingScope(*symbol)) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"variable in locality-spec must be in innermost"
" scoping unit"_err_en_US);
return;
Expand All @@ -507,7 +498,7 @@ class DoStmtContext {
CS references{GatherReferencesFromExpression(mask.thing.thing.value())};
for (auto *r : references) {
if (isProcedure(r->flags()) && !isPure(r->attrs())) {
messages_.Say(currentStatementSourcePosition_,
context_.Say(currentStatementSourcePosition_,
"concurrent-header mask expression cannot reference an impure"
" procedure"_err_en_US);
return;
Expand All @@ -519,7 +510,7 @@ class DoStmtContext {
for (auto *a : containerA) {
for (auto *b : containerB) {
if (a == b) {
messages_.Say(currentStatementSourcePosition_, errorMessage);
context_.Say(currentStatementSourcePosition_, errorMessage);
return;
}
}
Expand Down Expand Up @@ -596,9 +587,8 @@ class DoStmtContext {
}

SemanticsContext &context_;
parser::Messages &messages_;
parser::CharBlock currentStatementSourcePosition_;
};
}; // class DoStmtContext

// DO loops must be canonicalized prior to calling
void DoStmtChecker::Leave(const parser::DoConstruct &x) {
Expand Down
5 changes: 4 additions & 1 deletion lib/semantics/check-do-stmt.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,10 @@
#define FORTRAN_SEMANTICS_CHECK_DO_STMT_H_

#include "semantics.h"
#include "../parser/parse-tree.h"

namespace Fortran::parser {
struct DoConstruct;
}

namespace Fortran::semantics {

Expand Down
2 changes: 0 additions & 2 deletions test/semantics/dosemantics02.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,6 @@

! C1121 -- any procedure referenced in a concurrent header must be pure

! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s

SUBROUTINE do_concurrent_c1121(i,n)
IMPLICIT NONE
INTEGER :: i, n, flag
Expand Down
1 change: 0 additions & 1 deletion test/semantics/dosemantics03.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@
! to produce error messages when using REAL and DOUBLE PRECISION DO
! loop controls.

! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
!OPTIONS: -Mstandard -Werror

PROGRAM do_issue_458
Expand Down
2 changes: 0 additions & 2 deletions test/semantics/dosemantics04.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,8 +24,6 @@
! to produce error messages when using REAL and DOUBLE PRECISION DO
! loop controls.

! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s

PROGRAM do_issue_458
IMPLICIT NONE
INTEGER :: ivar
Expand Down
3 changes: 2 additions & 1 deletion test/semantics/test_errors.sh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,8 @@ diffs=$temp/diffs
options=$temp/options

# See if there are additional options
awk '/^ *!OPTIONS: / {gsub (/^! OPTIONS: /, " " ); print}' $src > $options
sed -n 's/^ *! *OPTIONS: *//p' $src > $options
cat $options

cmd="$CMD `cat $options` $src"
( cd $temp; $cmd ) > $log 2>&1
Expand Down

0 comments on commit 04a0712

Please sign in to comment.