forked from OSchip/llvm-project
[flang] Add label resolution design document, pass, and tests
Original-commit: flang-compiler/f18@e0d0df900c Reviewed-on: https://github.com/flang-compiler/f18/pull/170 Tree-same-pre-rewrite: false
This commit is contained in:
Eric Schweitz
GitHub
parent
ed048fb3f8
commit
df4575f6b9
|
|
@ -35,6 +35,19 @@ std::ostream &operator<<(std::ostream &o, const MessageFixedText &t) {
|
|||
|
||||
MessageFormattedText::MessageFormattedText(MessageFixedText text, ...)
|
||||
: isFatal_{text.isFatal()} {
|
||||
va_list ap;
|
||||
va_start(ap, text);
|
||||
SetMessageFormattedText(text, ap);
|
||||
va_end(ap);
|
||||
}
|
||||
|
||||
MessageFormattedText::MessageFormattedText(MessageFixedText text, va_list ap)
|
||||
: isFatal_{text.isFatal()} {
|
||||
SetMessageFormattedText(text, ap);
|
||||
}
|
||||
|
||||
void MessageFormattedText::SetMessageFormattedText(MessageFixedText text,
|
||||
va_list ap) {
|
||||
const char *p{text.text().begin()};
|
||||
std::string asString;
|
||||
if (*text.text().end() != '\0') {
|
||||
|
|
@ -43,10 +56,7 @@ MessageFormattedText::MessageFormattedText(MessageFixedText text, ...)
|
|||
p = asString.data();
|
||||
}
|
||||
char buffer[256];
|
||||
va_list ap;
|
||||
va_start(ap, text);
|
||||
vsnprintf(buffer, sizeof buffer, p, ap);
|
||||
va_end(ap);
|
||||
string_ = buffer;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -68,6 +68,7 @@ constexpr MessageFixedText operator""_err_en_US(
|
|||
class MessageFormattedText {
|
||||
public:
|
||||
MessageFormattedText(MessageFixedText, ...);
|
||||
MessageFormattedText(MessageFixedText, va_list);
|
||||
MessageFormattedText(const MessageFormattedText &) = default;
|
||||
MessageFormattedText(MessageFormattedText &&) = default;
|
||||
MessageFormattedText &operator=(const MessageFormattedText &) = default;
|
||||
|
|
@ -77,6 +78,7 @@ public:
|
|||
std::string MoveString() { return std::move(string_); }
|
||||
|
||||
private:
|
||||
void SetMessageFormattedText(MessageFixedText, va_list);
|
||||
std::string string_;
|
||||
bool isFatal_{false};
|
||||
};
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@ add_library(FortranSemantics
|
|||
expression.cc
|
||||
mod-file.cc
|
||||
resolve-names.cc
|
||||
resolve-labels.cc
|
||||
rewrite-parse-tree.cc
|
||||
scope.cc
|
||||
symbol.cc
|
||||
|
|
|
|||
|
|
@ -0,0 +1,832 @@
|
|||
/* -*- mode: c++; c-basic-offset: 2 -*- */
|
||||
// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
|
||||
#include "resolve-labels.h"
|
||||
#include "../parser/message.h"
|
||||
#include "../parser/parse-tree-visitor.h"
|
||||
#include <cstdarg>
|
||||
#include <iostream>
|
||||
#include <cctype>
|
||||
#include <cassert>
|
||||
|
||||
namespace {
|
||||
|
||||
using namespace Fortran;
|
||||
using namespace parser::literals;
|
||||
using ParseTree_t = parser::Program;
|
||||
using CookedSource_t = parser::CookedSource;
|
||||
using Index_t = parser::CharBlock;
|
||||
using IndexList = std::vector<std::pair<Index_t, Index_t>>;
|
||||
using Scope_t = unsigned;
|
||||
using LblStmt_t = std::tuple<Scope_t, Index_t, unsigned>;
|
||||
using ArcTrgt_t = std::map<parser::Label, LblStmt_t>;
|
||||
using ArcBase_t = std::vector<std::tuple<parser::Label, Scope_t, Index_t>>;
|
||||
|
||||
const bool StrictF18 = false; // FIXME - make a command-line option
|
||||
|
||||
const unsigned DO_TERM_FLAG = 1u;
|
||||
const unsigned BRANCH_TARGET_FLAG = 2u;
|
||||
const unsigned FORMAT_STMT_FLAG = 4u;
|
||||
|
||||
// convenient package for error reporting
|
||||
struct ErrorHandler {
|
||||
public:
|
||||
explicit ErrorHandler(const parser::CookedSource& CookedSource)
|
||||
: cookedSource{CookedSource}, messages{parser::Messages()} {}
|
||||
~ErrorHandler() = default;
|
||||
ErrorHandler(ErrorHandler&&) = default;
|
||||
ErrorHandler() = delete;
|
||||
ErrorHandler(const ErrorHandler&) = delete;
|
||||
ErrorHandler& operator=(const ErrorHandler&) = delete;
|
||||
|
||||
parser::Message& Report(const parser::CharBlock& CB,
|
||||
const parser::MessageFixedText& Fixed, ...) {
|
||||
va_list ap;
|
||||
va_start(ap, Fixed);
|
||||
parser::MessageFormattedText Msg{Fixed, ap};
|
||||
va_end(ap);
|
||||
return messages.Put({CB, Msg});
|
||||
}
|
||||
|
||||
const parser::CookedSource& cookedSource;
|
||||
parser::Messages messages;
|
||||
};
|
||||
|
||||
/// \brief Is this a legal DO terminator?
|
||||
/// Pattern match dependent on the standard we're enforcing
|
||||
template<typename A> constexpr bool IsLegalDoTerm(const parser::Statement<A>&) {
|
||||
return false;
|
||||
}
|
||||
// F18:R1131 (must be CONTINUE or END DO)
|
||||
template<> constexpr bool IsLegalDoTerm(const parser::Statement<parser::
|
||||
EndDoStmt>&) {
|
||||
return true;
|
||||
}
|
||||
template<> constexpr bool IsLegalDoTerm(const parser::Statement<common::
|
||||
Indirection<parser::EndDoStmt>>&) {
|
||||
return true;
|
||||
}
|
||||
template<> constexpr bool IsLegalDoTerm(const parser::Statement<parser::
|
||||
ActionStmt>& A) {
|
||||
if (std::get_if<parser::ContinueStmt>(&A.statement.u)) {
|
||||
// See F08:C816
|
||||
return true;
|
||||
}
|
||||
if (StrictF18)
|
||||
return false;
|
||||
// Applies in F08 and earlier
|
||||
const auto* P{&A.statement.u};
|
||||
return !(std::get_if<common::Indirection<parser::ArithmeticIfStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::CycleStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::ExitStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::StopStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::GotoStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::ReturnStmt>>(P));
|
||||
}
|
||||
|
||||
/// \brief Is this a FORMAT stmt?
|
||||
/// Pattern match for FORMAT statement
|
||||
template<typename A> constexpr bool IsFormat(const parser::Statement<A>&) {
|
||||
return false;
|
||||
}
|
||||
template<> constexpr bool IsFormat(const parser::Statement<common::
|
||||
Indirection<parser::FormatStmt>>&) {
|
||||
return true;
|
||||
}
|
||||
|
||||
/// \brief Is this a legal branch target?
|
||||
/// Pattern match dependent on the standard we're enforcing
|
||||
template<typename A> constexpr bool IsLegalBranchTarget(const parser::
|
||||
Statement<A>&) {
|
||||
return false;
|
||||
}
|
||||
template<> constexpr bool IsLegalBranchTarget(const parser::Statement<parser::
|
||||
ActionStmt>& A) {
|
||||
if (!StrictF18)
|
||||
return true;
|
||||
// XXX: do we care to flag these as errors? If we want strict F18, these
|
||||
// statements should not even be present
|
||||
const auto* P{&A.statement.u};
|
||||
return !(std::get_if<common::Indirection<parser::ArithmeticIfStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::AssignStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::AssignedGotoStmt>>(P) ||
|
||||
std::get_if<common::Indirection<parser::PauseStmt>>(P));
|
||||
}
|
||||
#define Instantiate(TYPE) \
|
||||
template<> constexpr bool IsLegalBranchTarget(const parser:: \
|
||||
Statement<TYPE>&) { \
|
||||
return true; \
|
||||
}
|
||||
Instantiate(parser::AssociateStmt)
|
||||
Instantiate(parser::EndAssociateStmt)
|
||||
Instantiate(parser::IfThenStmt)
|
||||
Instantiate(parser::EndIfStmt)
|
||||
Instantiate(parser::SelectCaseStmt)
|
||||
Instantiate(parser::EndSelectStmt)
|
||||
Instantiate(parser::SelectRankStmt)
|
||||
Instantiate(parser::SelectTypeStmt)
|
||||
Instantiate(common::Indirection<parser::LabelDoStmt>)
|
||||
Instantiate(parser::NonLabelDoStmt)
|
||||
Instantiate(parser::EndDoStmt)
|
||||
Instantiate(common::Indirection<parser::EndDoStmt>)
|
||||
Instantiate(parser::BlockStmt)
|
||||
Instantiate(parser::EndBlockStmt)
|
||||
Instantiate(parser::CriticalStmt)
|
||||
Instantiate(parser::EndCriticalStmt)
|
||||
Instantiate(parser::ForallConstructStmt)
|
||||
Instantiate(parser::ForallStmt)
|
||||
Instantiate(parser::WhereConstructStmt)
|
||||
Instantiate(parser::EndFunctionStmt)
|
||||
Instantiate(parser::EndMpSubprogramStmt)
|
||||
Instantiate(parser::EndProgramStmt)
|
||||
Instantiate(parser::EndSubroutineStmt)
|
||||
#undef Instantiate
|
||||
|
||||
template<typename A>
|
||||
constexpr unsigned ConsTrgtFlags(const parser::Statement<A>& S) {
|
||||
unsigned Flags{0u};
|
||||
if (IsLegalDoTerm(S))
|
||||
Flags |= DO_TERM_FLAG;
|
||||
if (IsLegalBranchTarget(S))
|
||||
Flags |= BRANCH_TARGET_FLAG;
|
||||
if (IsFormat(S))
|
||||
Flags |= FORMAT_STMT_FLAG;
|
||||
return Flags;
|
||||
}
|
||||
|
||||
/// \brief \p opt1 and \p opt2 must be either present and identical or absent
|
||||
/// \param opt1 an optional construct-name (opening statement)
|
||||
/// \param opt2 an optional construct-name (ending statement)
|
||||
template<typename A> inline bool BothEqOrNone(const A& opt1, const A& opt2) {
|
||||
return (opt1.has_value() == opt2.has_value())
|
||||
? (opt1.has_value()
|
||||
? (opt1.value().ToString() == opt2.value().ToString()) : true)
|
||||
: false;
|
||||
}
|
||||
|
||||
/// \brief \p opt1 must either be absent or identical to \p opt2
|
||||
/// \param opt1 an optional construct-name for an optional constraint
|
||||
/// \param opt2 an optional construct-name (opening statement)
|
||||
template<typename A> inline bool PresentAndEq(const A& opt1, const A& opt2) {
|
||||
return (!opt1.has_value()) ||
|
||||
(opt2.has_value() &&
|
||||
(opt1.value().ToString() == opt2.value().ToString()));
|
||||
}
|
||||
|
||||
/// \brief Iterates over parse tree, creates the analysis result
|
||||
/// As a side-effect checks the constraints for the usages of
|
||||
/// <i>construct-name</i>.
|
||||
struct ParseTreeAnalyzer {
|
||||
public:
|
||||
struct UnitAnalysis {
|
||||
public:
|
||||
ArcBase_t DoArcBases; ///< bases of label-do-stmts
|
||||
ArcBase_t FmtArcBases; ///< bases of all other stmts with labels
|
||||
ArcBase_t ArcBases; ///< bases of all other stmts with labels
|
||||
ArcTrgt_t ArcTrgts; ///< unique map of labels to stmt info
|
||||
std::vector<Scope_t> Scopes; ///< scope stack model
|
||||
|
||||
explicit UnitAnalysis() { Scopes.push_back(0); }
|
||||
UnitAnalysis(UnitAnalysis&&) = default;
|
||||
~UnitAnalysis() = default;
|
||||
UnitAnalysis(const UnitAnalysis&) = delete;
|
||||
UnitAnalysis& operator=(const UnitAnalysis&) = delete;
|
||||
|
||||
const ArcBase_t& GetLabelDos() const { return DoArcBases; }
|
||||
const ArcBase_t& GetDataXfers() const { return FmtArcBases; }
|
||||
const ArcBase_t& GetBranches() const { return ArcBases; }
|
||||
const ArcTrgt_t& GetLabels() const { return ArcTrgts; }
|
||||
const std::vector<Scope_t>& GetScopes() const { return Scopes; }
|
||||
};
|
||||
|
||||
explicit ParseTreeAnalyzer(const parser::CookedSource& Src) : EH{Src} {}
|
||||
~ParseTreeAnalyzer() = default;
|
||||
ParseTreeAnalyzer(ParseTreeAnalyzer&&) = default;
|
||||
ParseTreeAnalyzer() = delete;
|
||||
ParseTreeAnalyzer(const ParseTreeAnalyzer&) = delete;
|
||||
ParseTreeAnalyzer& operator=(const ParseTreeAnalyzer&) = delete;
|
||||
|
||||
// Default Pre() and Post()
|
||||
template<typename A> constexpr bool Pre(const A&) { return true; }
|
||||
template<typename A> constexpr void Post(const A&) {}
|
||||
|
||||
// Specializations of Pre() and Post()
|
||||
|
||||
/// \brief Generic handling of all statements
|
||||
template<typename A> bool Pre(const parser::Statement<A>& Stmt) {
|
||||
Index = Stmt.source;
|
||||
if (Stmt.label.has_value())
|
||||
AddTrgt(Stmt.label.value(), ConsTrgtFlags(Stmt));
|
||||
return true;
|
||||
}
|
||||
|
||||
// Inclusive scopes (see 11.1.1)
|
||||
bool Pre(const parser::ProgramUnit&) { return PushNewScope(); }
|
||||
bool Pre(const parser::AssociateConstruct& A) { return PushName(A); }
|
||||
bool Pre(const parser::BlockConstruct& Blk) { return PushName(Blk); }
|
||||
bool Pre(const parser::ChangeTeamConstruct& Ctm) { return PushName(Ctm); }
|
||||
bool Pre(const parser::CriticalConstruct& Crit) { return PushName(Crit); }
|
||||
bool Pre(const parser::DoConstruct& Do) { return PushName(Do); }
|
||||
bool Pre(const parser::IfConstruct& If) { return PushName(If); }
|
||||
bool Pre(const parser::IfConstruct::ElseIfBlock&) { return SwScope(); }
|
||||
bool Pre(const parser::IfConstruct::ElseBlock&) { return SwScope(); }
|
||||
bool Pre(const parser::CaseConstruct& Case) { return PushName(Case); }
|
||||
bool Pre(const parser::CaseConstruct::Case&) { return SwScope(); }
|
||||
bool Pre(const parser::SelectRankConstruct& SRk) { return PushName(SRk); }
|
||||
bool Pre(const parser::SelectRankConstruct::RankCase&) { return SwScope(); }
|
||||
bool Pre(const parser::SelectTypeConstruct& STy) { return PushName(STy); }
|
||||
bool Pre(const parser::SelectTypeConstruct::TypeCase&) { return SwScope(); }
|
||||
bool Pre(const parser::WhereConstruct& W) { return PushNonBlockName(W); }
|
||||
bool Pre(const parser::ForallConstruct& F) { return PushNonBlockName(F); }
|
||||
|
||||
void Post(const parser::ProgramUnit&) { PopScope(); }
|
||||
void Post(const parser::AssociateConstruct& A) { PopName(A); }
|
||||
void Post(const parser::BlockConstruct& Blk) { PopName(Blk); }
|
||||
void Post(const parser::ChangeTeamConstruct& Ctm) { PopName(Ctm); }
|
||||
void Post(const parser::CriticalConstruct& Crit) { PopName(Crit); }
|
||||
void Post(const parser::DoConstruct& Do) { PopName(Do); }
|
||||
void Post(const parser::IfConstruct& If) { PopName(If); }
|
||||
void Post(const parser::CaseConstruct& Case) { PopName(Case); }
|
||||
void Post(const parser::SelectRankConstruct& SelRk) { PopName(SelRk); }
|
||||
void Post(const parser::SelectTypeConstruct& SelTy) { PopName(SelTy); }
|
||||
|
||||
// Named constructs without block scope
|
||||
void Post(const parser::WhereConstruct& W) { PopNonBlockConstructName(W); }
|
||||
void Post(const parser::ForallConstruct& F) { PopNonBlockConstructName(F); }
|
||||
|
||||
// Statements with label references
|
||||
void Post(const parser::LabelDoStmt& Do) { AddDoBase(std::get<1>(Do.t)); }
|
||||
void Post(const parser::GotoStmt& Goto) { AddBase(Goto.v); }
|
||||
void Post(const parser::ComputedGotoStmt& C) { AddBase(std::get<0>(C.t)); }
|
||||
void Post(const parser::ArithmeticIfStmt& AIf) {
|
||||
AddBase(std::get<1>(AIf.t));
|
||||
AddBase(std::get<2>(AIf.t));
|
||||
AddBase(std::get<3>(AIf.t));
|
||||
}
|
||||
void Post(const parser::AssignStmt& Assn) { AddBase(std::get<0>(Assn.t)); }
|
||||
void Post(const parser::AssignedGotoStmt& A) { AddBase(std::get<1>(A.t)); }
|
||||
void Post(const parser::AltReturnSpec& ARS) { AddBase(ARS.v); }
|
||||
|
||||
void Post(const parser::ErrLabel& Err) { AddBase(Err.v); }
|
||||
void Post(const parser::EndLabel& End) { AddBase(End.v); }
|
||||
void Post(const parser::EorLabel& Eor) { AddBase(Eor.v); }
|
||||
void Post(const parser::Format& Fmt) {
|
||||
// BUG: the label is saved as an IntLiteralConstant rather than a Label
|
||||
#if 0
|
||||
if (const auto* P{std::get_if<parser::Label>(&Fmt.u)})
|
||||
AddFmtBase(*P);
|
||||
#else
|
||||
// FIXME: this is wrong, but extracts the label's value
|
||||
if (const auto* P{std::get_if<0>(&Fmt.u)}) {
|
||||
parser::Label L{std::get<0>(std::get<parser::IntLiteralConstant>(std::get<parser::LiteralConstant>((*P->thing).u).u).t)};
|
||||
AddFmtBase(L);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
void Post(const parser::CycleStmt& Cycle) {
|
||||
if (Cycle.v.has_value())
|
||||
CheckLabelContext("CYCLE", Cycle.v.value().ToString());
|
||||
}
|
||||
void Post(const parser::ExitStmt& Exit) {
|
||||
if (Exit.v.has_value())
|
||||
CheckLabelContext("EXIT", Exit.v.value().ToString());
|
||||
}
|
||||
|
||||
// Getters for the results
|
||||
const std::vector<UnitAnalysis>& GetProgramUnits() const { return PUnits; }
|
||||
ErrorHandler& GetEH() { return EH; }
|
||||
bool HasNoErrors() const { return NoErrors; }
|
||||
|
||||
private:
|
||||
bool PushScope() {
|
||||
PUnits.back().Scopes.push_back(CurrScope);
|
||||
CurrScope = PUnits.back().Scopes.size() - 1;
|
||||
return true;
|
||||
}
|
||||
bool PushNewScope() {
|
||||
PUnits.emplace_back(UnitAnalysis{});
|
||||
return PushScope();
|
||||
}
|
||||
void PopScope() { CurrScope = PUnits.back().Scopes[CurrScope]; }
|
||||
bool SwScope() { PopScope(); return PushScope(); }
|
||||
|
||||
template<typename A> bool PushName(const A& X) {
|
||||
const auto& OptName{std::get<0>(std::get<0>(X.t).statement.t)};
|
||||
if (OptName.has_value())
|
||||
Names.push_back(OptName.value().ToString());
|
||||
return PushScope();
|
||||
}
|
||||
bool PushName(const parser::BlockConstruct& Blk) {
|
||||
const auto& OptName{std::get<0>(Blk.t).statement.v};
|
||||
if (OptName.has_value())
|
||||
Names.push_back(OptName.value().ToString());
|
||||
return PushScope();
|
||||
}
|
||||
template<typename A> bool PushNonBlockName(const A& X) {
|
||||
const auto& OptName{std::get<0>(std::get<0>(X.t).statement.t)};
|
||||
if (OptName.has_value())
|
||||
Names.push_back(OptName.value().ToString());
|
||||
return true;
|
||||
}
|
||||
|
||||
template<typename A> void PopNonBlockConstructName(const A& X) {
|
||||
CheckName(X); SelectivePopBack(X);
|
||||
}
|
||||
|
||||
template<typename A> void SelectivePopBack(const A& X) {
|
||||
const auto& OptName{std::get<0>(std::get<0>(X.t).statement.t)};
|
||||
if (OptName.has_value())
|
||||
Names.pop_back();
|
||||
}
|
||||
void SelectivePopBack(const parser::BlockConstruct& Blk) {
|
||||
const auto& OptName{std::get<0>(Blk.t).statement.v};
|
||||
if (OptName.has_value())
|
||||
Names.pop_back();
|
||||
}
|
||||
|
||||
/// \brief Check constraints and pop scope
|
||||
template<typename A> void PopName(const A& V) {
|
||||
CheckName(V); PopScope(); SelectivePopBack(V);
|
||||
}
|
||||
|
||||
/// \brief Check <i>case-construct-name</i> and pop the scope
|
||||
/// Constraint C1144 - opening and ending name must match if present, and
|
||||
/// <i>case-stmt</i> must either match or be unnamed
|
||||
void PopName(const parser::CaseConstruct& Case) {
|
||||
CheckName(Case, "CASE"); PopScope(); SelectivePopBack(Case);
|
||||
}
|
||||
|
||||
/// \brief Check <i>select-rank-construct-name</i> and pop the scope
|
||||
/// Constraints C1154, C1156 - opening and ending name must match if present,
|
||||
/// and <i>select-rank-case-stmt</i> must either match or be unnamed
|
||||
void PopName(const parser::SelectRankConstruct& SelRk) {
|
||||
CheckName(SelRk, "RANK","RANK "); PopScope(); SelectivePopBack(SelRk);
|
||||
}
|
||||
|
||||
/// \brief Check <i>select-construct-name</i> and pop the scope
|
||||
/// Constraint C1165 - opening and ending name must match if present, and
|
||||
/// <i>type-guard-stmt</i> must either match or be unnamed
|
||||
void PopName(const parser::SelectTypeConstruct& SelTy) {
|
||||
CheckName(SelTy, "TYPE", "TYPE "); PopScope(); SelectivePopBack(SelTy);
|
||||
}
|
||||
|
||||
// -----------------------------------------------
|
||||
// CheckName - check constraints on construct-name
|
||||
// Case 1: construct name must be absent or specified & identical on END
|
||||
|
||||
/// \brief Check <i>associate-construct-name</i>, constraint C1106
|
||||
void CheckName(const parser::AssociateConstruct& A) { ChkNm(A, "ASSOCIATE"); }
|
||||
/// \brief Check <i>critical-construct-name</i>, constraint C1117
|
||||
void CheckName(const parser::CriticalConstruct& C) { ChkNm(C, "CRITICAL"); }
|
||||
/// \brief Check <i>do-construct-name</i>, constraint C1131
|
||||
void CheckName(const parser::DoConstruct& Do) { ChkNm(Do, "DO"); }
|
||||
/// \brief Check <i>forall-construct-name</i>, constraint C1035
|
||||
void CheckName(const parser::ForallConstruct& F) { ChkNm(F, "FORALL"); }
|
||||
/// \brief Common code for ASSOCIATE, CRITICAL, DO, and FORALL
|
||||
template<typename A> void ChkNm(const A& V, const char *const Con) {
|
||||
if (!BothEqOrNone(std::get<0>(std::get<0>(V.t).statement.t),
|
||||
std::get<2>(V.t).statement.v)) {
|
||||
EH.Report(Index, "%s construct name mismatch"_err_en_US, Con);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
|
||||
/// \brief Check <i>do-construct-name</i>, constraint C1109
|
||||
void CheckName(const parser::BlockConstruct& B) {
|
||||
if (!BothEqOrNone(std::get<0>(B.t).statement.v,
|
||||
std::get<3>(B.t).statement.v)) {
|
||||
EH.Report(Index, "BLOCK construct name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
/// \brief Check <i>team-cosntruct-name</i>, constraint C1112
|
||||
void CheckName(const parser::ChangeTeamConstruct& C) {
|
||||
if (!BothEqOrNone(std::get<0>(std::get<0>(C.t).statement.t),
|
||||
std::get<1>(std::get<2>(C.t).statement.t))) {
|
||||
EH.Report(Index, "CHANGE TEAM construct name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
|
||||
// -----------------------------------------------
|
||||
// Case 2: same as case 1, but subblock statement construct-names are
|
||||
// optional but if they are specified their values must be identical
|
||||
|
||||
/// \brief Check <i>if-construct-name</i>
|
||||
/// Constraint C1142 - opening and ending name must match if present, and
|
||||
/// <i>else-if-stmt</i> and <i>else-stmt</i> must either match or be unnamed
|
||||
void CheckName(const parser::IfConstruct& If) {
|
||||
const auto& Name{std::get<0>(std::get<0>(If.t).statement.t)};
|
||||
if (!BothEqOrNone(Name, std::get<4>(If.t).statement.v)) {
|
||||
EH.Report(Index, "IF construct name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
for (const auto& ElseIfBlock : std::get<2>(If.t)) {
|
||||
const auto& E{std::get<0>(ElseIfBlock.t).statement.t};
|
||||
if (!PresentAndEq(std::get<1>(E), Name)) {
|
||||
EH.Report(Index, "ELSE IF statement name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
if (std::get<3>(If.t).has_value()) {
|
||||
const auto& E{std::get<3>(If.t).value().t};
|
||||
if (!PresentAndEq(std::get<0>(E).statement.v, Name)) {
|
||||
EH.Report(Index, "ELSE statement name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
}
|
||||
/// \brief Common code for SELECT CASE, SELECT RANK, and SELECT TYPE
|
||||
template<typename A> void CheckName(const A& Case, const char *const Sel1,
|
||||
const char *const Sel2 = "") {
|
||||
const auto& Name{std::get<0>(std::get<0>(Case.t).statement.t)};
|
||||
if (!BothEqOrNone(Name, std::get<2>(Case.t).statement.v)) {
|
||||
EH.Report(Index, "SELECT %s construct name mismatch"_err_en_US, Sel1);
|
||||
NoErrors = false;
|
||||
}
|
||||
for (const auto& CS : std::get<1>(Case.t))
|
||||
if (!PresentAndEq(std::get<1>(std::get<0>(CS.t).statement.t), Name)) {
|
||||
EH.Report(Index, "%sCASE statement name mismatch"_err_en_US, Sel2);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
|
||||
/// \brief Check <i>where-construct-name</i>
|
||||
/// Constraint C1033 - opening and ending name must match if present, and
|
||||
/// <i>masked-elsewhere-stmt</i> and <i>elsewhere-stmt</i> either match
|
||||
/// or be unnamed
|
||||
void CheckName(const parser::WhereConstruct& Where) {
|
||||
const auto& Name{std::get<0>(std::get<0>(Where.t).statement.t)};
|
||||
if (!BothEqOrNone(Name, std::get<4>(Where.t).statement.v)) {
|
||||
EH.Report(Index, "WHERE construct name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
for (const auto& W : std::get<2>(Where.t))
|
||||
if (!PresentAndEq(std::get<1>(std::get<0>(W.t).statement.t), Name)) {
|
||||
EH.Report(Index,
|
||||
"ELSEWHERE (<mask>) statement name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
if (std::get<3>(Where.t).has_value()) {
|
||||
const auto& E{std::get<3>(Where.t).value().t};
|
||||
if (!PresentAndEq(std::get<0>(E).statement.v, Name)) {
|
||||
EH.Report(Index, "ELSEWHERE statement name mismatch"_err_en_US);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/// \brief Check constraint <i>construct-name</i> in scope (C1134 and C1166)
|
||||
/// \param SStr a string to specify the statement, \c CYCLE or \c EXIT
|
||||
/// \param Label the name used by the \c CYCLE or \c EXIT
|
||||
template<typename A> void CheckLabelContext(const char* const SStr,
|
||||
const A& Name) {
|
||||
auto E{Names.crend()};
|
||||
for (auto I{Names.crbegin()}; I != E; ++I) {
|
||||
if (*I == Name)
|
||||
return;
|
||||
}
|
||||
EH.Report(Index, "%s construct-name '%s' is not in scope"_err_en_US,
|
||||
SStr, Name.c_str());
|
||||
NoErrors = false;
|
||||
}
|
||||
|
||||
/// \brief Check label range
|
||||
/// Constraint per section 6.2.5, paragraph 2
|
||||
void LabelInRange(parser::Label Label) {
|
||||
if ((Label < 1) || (Label > 99999)) {
|
||||
// this is an error: labels must have a value 1 to 99999, inclusive
|
||||
EH.Report(Index, "label '%lu' is out of range"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
|
||||
/// \brief Add a labeled statement (label must be distinct)
|
||||
/// Constraint per section 6.2.5., paragraph 2
|
||||
void AddTrgt(parser::Label Label, unsigned Flags) {
|
||||
LabelInRange(Label);
|
||||
const auto Pair{PUnits.back().ArcTrgts.insert({Label,
|
||||
{CurrScope, Index, Flags}})};
|
||||
if (!Pair.second) {
|
||||
// this is an error: labels must be pairwise distinct
|
||||
EH.Report(Index, "label '%lu' is not distinct"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
}
|
||||
// Don't enforce a limit to the cardinality of labels
|
||||
}
|
||||
|
||||
/// \brief Reference to a labeled statement from a DO statement
|
||||
void AddDoBase(parser::Label Label) {
|
||||
LabelInRange(Label);
|
||||
PUnits.back().DoArcBases.push_back({Label, CurrScope, Index});
|
||||
}
|
||||
|
||||
/// \brief Reference to a labeled FORMAT statement
|
||||
void AddFmtBase(parser::Label Label) {
|
||||
LabelInRange(Label);
|
||||
PUnits.back().FmtArcBases.push_back({Label, CurrScope, Index});
|
||||
}
|
||||
|
||||
/// \brief Reference to a labeled statement as a (possible) branch
|
||||
void AddBase(parser::Label Label) {
|
||||
LabelInRange(Label);
|
||||
PUnits.back().ArcBases.push_back({Label, CurrScope, Index});
|
||||
}
|
||||
|
||||
/// \brief References to labeled statements as (possible) branches
|
||||
void AddBase(const std::list<parser::Label>& Labels) {
|
||||
for (const parser::Label& L : Labels)
|
||||
AddBase(L);
|
||||
}
|
||||
|
||||
std::vector<UnitAnalysis> PUnits; ///< results for each program unit
|
||||
ErrorHandler EH; ///< error handler, collects messages
|
||||
Index_t Index{nullptr}; ///< current location in parse tree
|
||||
Scope_t CurrScope{0}; ///< current scope in the model
|
||||
bool NoErrors{true}; ///< no semantic errors found?
|
||||
std::vector<std::string> Names;
|
||||
};
|
||||
|
||||
template<typename A, typename B>
|
||||
bool InInclusiveScope(const A& Scopes, B Tl, const B& Hd) {
|
||||
assert(Hd > 0);
|
||||
assert(Tl > 0);
|
||||
while (Tl && (Tl != Hd))
|
||||
Tl = Scopes[Tl];
|
||||
return Tl == Hd;
|
||||
}
|
||||
|
||||
ParseTreeAnalyzer LabelAnalysis(const ParseTree_t& ParseTree,
|
||||
const CookedSource_t& Source) {
|
||||
ParseTreeAnalyzer Analysis{Source};
|
||||
Walk(ParseTree, Analysis);
|
||||
return Analysis;
|
||||
}
|
||||
|
||||
template<typename A, typename B>
|
||||
inline bool InBody(const A& CP, const B& Pair) {
|
||||
assert(Pair.first.begin() < Pair.second.begin());
|
||||
return (CP.begin() >= Pair.first.begin()) &&
|
||||
(CP.begin() < Pair.second.end());
|
||||
}
|
||||
|
||||
template<typename A, typename B>
|
||||
LblStmt_t GetLabel(const A& Labels, const B& Label) {
|
||||
const auto Iter{Labels.find(Label)};
|
||||
if (Iter == Labels.cend())
|
||||
return {0, 0, 0};
|
||||
return Iter->second;
|
||||
}
|
||||
|
||||
/// \brief Check branches into a <i>label-do-stmt</i>
|
||||
/// Relates to 11.1.7.3, loop activation
|
||||
template<typename A, typename B, typename C, typename D>
|
||||
inline bool CheckBranchesIntoDoBody(const A& Branches, const B& Labels,
|
||||
const C& Scopes, const D& LoopBodies,
|
||||
ErrorHandler& EH) {
|
||||
auto NoErrors{true};
|
||||
for (const auto Branch : Branches) {
|
||||
const auto& Label{std::get<0>(Branch)};
|
||||
auto Trgt{GetLabel(Labels, Label)};
|
||||
if (!std::get<0>(Trgt))
|
||||
continue;
|
||||
const auto& FmIdx{std::get<2>(Branch)};
|
||||
const auto& ToIdx{std::get<1>(Trgt)};
|
||||
for (const auto Body : LoopBodies) {
|
||||
if (!InBody(FmIdx, Body) && InBody(ToIdx, Body)) {
|
||||
// this is an error: branch into labeled DO body
|
||||
if (StrictF18) {
|
||||
EH.Report(FmIdx, "branch into '%s' from another scope"_err_en_US,
|
||||
Body.first.ToString().c_str());
|
||||
NoErrors = false;
|
||||
} else {
|
||||
EH.Report(FmIdx, "branch into '%s' from another scope"_en_US,
|
||||
Body.first.ToString().c_str());
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return NoErrors;
|
||||
}
|
||||
|
||||
/// \brief Check that DO loops properly nest
|
||||
template<typename A>
|
||||
inline bool CheckDoNesting(const A& LoopBodies, ErrorHandler& EH) {
|
||||
auto NoErrors{true};
|
||||
auto E{LoopBodies.cend()};
|
||||
for (auto I1{LoopBodies.cbegin()}; I1 != E; ++I1) {
|
||||
const auto& L1{*I1};
|
||||
for (auto I2{I1 + 1}; I2 != E; ++I2) {
|
||||
const auto& L2{*I2};
|
||||
assert(L1.first.begin() != L2.first.begin());
|
||||
if ((L2.first.begin() < L1.second.end()) &&
|
||||
(L1.second.begin() < L2.second.begin())) {
|
||||
// this is an error: DOs do not properly nest
|
||||
EH.Report(L2.second, "'%s' doesn't properly nest"_err_en_US,
|
||||
L1.first.ToString().c_str());
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
}
|
||||
return NoErrors;
|
||||
}
|
||||
|
||||
/// \brief Advance \p Pos past any label and whitespace
|
||||
/// Want the statement without its label for error messages, range checking
|
||||
template<typename A> inline A SkipLabel(const A& Pos) {
|
||||
const long Max{Pos.end() - Pos.begin()};
|
||||
if (Max && (Pos[0] >= '0') && (Pos[0] <= '9')) {
|
||||
long i{1l};
|
||||
for (;(i < Max) && std::isdigit(Pos[i]); ++i);
|
||||
for (;(i < Max) && std::isspace(Pos[i]); ++i);
|
||||
return Index_t{Pos.begin() + i, Pos.end()};
|
||||
}
|
||||
return Pos;
|
||||
}
|
||||
|
||||
/// \brief Check constraints on <i>label-do-stmt</i>
|
||||
template<typename A, typename B, typename C>
|
||||
inline bool CheckLabelDoConstraints(const A& Dos, const A& Branches,
|
||||
const B& Labels, const C& Scopes,
|
||||
ErrorHandler& EH) {
|
||||
auto NoErrors{true};
|
||||
IndexList LoopBodies;
|
||||
for (const auto Stmt : Dos) {
|
||||
const auto& Label{std::get<0>(Stmt)};
|
||||
const auto& Scope{std::get<1>(Stmt)};
|
||||
const auto& Index{std::get<2>(Stmt)};
|
||||
auto Trgt{GetLabel(Labels, Label)};
|
||||
if (!std::get<0>(Trgt)) {
|
||||
// C1133: this is an error: label not found
|
||||
EH.Report(Index, "label '%lu' cannot be found"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
continue;
|
||||
}
|
||||
if (std::get<1>(Trgt).begin() < Index.begin()) {
|
||||
// R1119: this is an error: label does not follow DO
|
||||
EH.Report(Index, "label '%lu' doesn't lexically follow DO stmt"_err_en_US,
|
||||
Label);
|
||||
NoErrors = false;
|
||||
continue;
|
||||
}
|
||||
if (!InInclusiveScope(Scopes, Scope, std::get<0>(Trgt))) {
|
||||
// C1133: this is an error: label is not in scope
|
||||
if (StrictF18) {
|
||||
EH.Report(Index, "label '%lu' is not in scope"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
} else {
|
||||
EH.Report(Index, "label '%lu' is not in scope"_en_US, Label);
|
||||
}
|
||||
continue;
|
||||
}
|
||||
if (!(std::get<2>(Trgt) & DO_TERM_FLAG)) {
|
||||
EH.Report(std::get<Index_t>(Trgt),
|
||||
"'%lu' invalid DO terminal statement"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
}
|
||||
// save the loop body marks
|
||||
LoopBodies.push_back({SkipLabel(Index), std::get<1>(Trgt)});
|
||||
}
|
||||
|
||||
if (NoErrors) {
|
||||
NoErrors =
|
||||
// check that nothing jumps into the block
|
||||
CheckBranchesIntoDoBody(Branches, Labels, Scopes, LoopBodies, EH) &
|
||||
// check that do loops properly nest
|
||||
CheckDoNesting(LoopBodies, EH);
|
||||
}
|
||||
return NoErrors;
|
||||
}
|
||||
|
||||
/// \brief General constraint, control transfers within inclusive scope
|
||||
/// See, for example, section 6.2.5.
|
||||
template<typename A, typename B, typename C>
|
||||
bool CheckScopeConstraints(const A& Stmts, const B& Labels,
|
||||
const C& Scopes, ErrorHandler& EH) {
|
||||
auto NoErrors{true};
|
||||
for (const auto Stmt : Stmts) {
|
||||
const auto& Label{std::get<0>(Stmt)};
|
||||
const auto& Scope{std::get<1>(Stmt)};
|
||||
const auto& Index{std::get<2>(Stmt)};
|
||||
auto Trgt{GetLabel(Labels, Label)};
|
||||
if (!std::get<0>(Trgt)) {
|
||||
// this is an error: label not found
|
||||
EH.Report(Index, "label '%lu' was not found"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
continue;
|
||||
}
|
||||
if (!InInclusiveScope(Scopes, Scope, std::get<0>(Trgt))) {
|
||||
// this is an error: label not in scope
|
||||
if (StrictF18) {
|
||||
EH.Report(Index, "label '%lu' is not in scope"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
} else {
|
||||
EH.Report(Index, "label '%lu' is not in scope"_en_US, Label);
|
||||
}
|
||||
}
|
||||
}
|
||||
return NoErrors;
|
||||
}
|
||||
|
||||
template<typename A, typename B>
|
||||
inline bool CheckBranchTargetConstraints(const A& Stmts, const B& Labels,
|
||||
ErrorHandler& EH) {
|
||||
auto NoErrors{true};
|
||||
for (const auto Stmt : Stmts) {
|
||||
const auto& Label{std::get<0>(Stmt)};
|
||||
auto Trgt{GetLabel(Labels, Label)};
|
||||
if (!std::get<0>(Trgt))
|
||||
continue;
|
||||
if (!(std::get<2>(Trgt) & BRANCH_TARGET_FLAG)) {
|
||||
// this is an error: label statement is not a branch target
|
||||
EH.Report(std::get<Index_t>(Trgt), "'%lu' not a branch target"_err_en_US,
|
||||
Label);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
return NoErrors;
|
||||
}
|
||||
|
||||
/// \brief Validate the constraints on branches
|
||||
/// \param Analysis the analysis result
|
||||
template<typename A, typename B, typename C>
|
||||
inline bool CheckBranchConstraints(const A& Branches, const B& Labels,
|
||||
const C& Scopes, ErrorHandler& EH) {
|
||||
return CheckScopeConstraints(Branches, Labels, Scopes, EH) &
|
||||
CheckBranchTargetConstraints(Branches, Labels, EH);
|
||||
}
|
||||
|
||||
template<typename A, typename B>
|
||||
inline bool CheckDataXferTargetConstraints(const A& Stmts, const B& Labels,
|
||||
ErrorHandler& EH) {
|
||||
auto NoErrors{true};
|
||||
for (const auto Stmt : Stmts) {
|
||||
const auto& Label{std::get<0>(Stmt)};
|
||||
auto Trgt{GetLabel(Labels, Label)};
|
||||
if (!std::get<0>(Trgt))
|
||||
continue;
|
||||
if (!(std::get<2>(Trgt) & FORMAT_STMT_FLAG)) {
|
||||
// this is an error: label not a FORMAT
|
||||
EH.Report(std::get<Index_t>(Trgt), "'%lu' not a FORMAT"_err_en_US, Label);
|
||||
NoErrors = false;
|
||||
}
|
||||
}
|
||||
return NoErrors;
|
||||
}
|
||||
|
||||
/// \brief Validate that data transfers reference FORMATs in scope
|
||||
/// \param Analysis the analysis result
|
||||
/// These label uses are disjoint from branching (control flow)
|
||||
template<typename A, typename B, typename C>
|
||||
inline bool CheckDataTransferConstraints(const A& DataXfers, const B& Labels,
|
||||
const C& Scopes, ErrorHandler& EH) {
|
||||
return CheckScopeConstraints(DataXfers, Labels, Scopes, EH) &
|
||||
CheckDataXferTargetConstraints(DataXfers, Labels, EH);
|
||||
}
|
||||
|
||||
/// \brief Validate label related constraints on the parse tree
|
||||
/// \param Analysis the analysis results as run of the parse tree
|
||||
/// \param EH the error handler
|
||||
/// \return true iff all the semantics checks passed
|
||||
bool CheckConstraints(ParseTreeAnalyzer&& Analysis) {
|
||||
auto result{Analysis.HasNoErrors()};
|
||||
auto& EH{Analysis.GetEH()};
|
||||
for (const auto& A : Analysis.GetProgramUnits()) {
|
||||
const auto& Dos{A.GetLabelDos()};
|
||||
const auto& Branches{A.GetBranches()};
|
||||
const auto& DataXfers{A.GetDataXfers()};
|
||||
const auto& Labels{A.GetLabels()};
|
||||
const auto& Scopes{A.GetScopes()};
|
||||
result &= CheckLabelDoConstraints(Dos, Branches, Labels, Scopes, EH) &
|
||||
CheckBranchConstraints(Branches, Labels, Scopes, EH) &
|
||||
CheckDataTransferConstraints(DataXfers, Labels, Scopes, EH);
|
||||
}
|
||||
if (!EH.messages.empty())
|
||||
EH.messages.Emit(std::cerr, EH.cookedSource);
|
||||
return result;
|
||||
}
|
||||
|
||||
} // <anonymous>
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
||||
/// \brief Check the semantics of LABELs in the program
|
||||
/// \return true iff the program's use of LABELs is semantically correct
|
||||
bool ValidateLabels(const parser::Program& ParseTree,
|
||||
const parser::CookedSource& Source) {
|
||||
return CheckConstraints(LabelAnalysis(ParseTree, Source));
|
||||
}
|
||||
|
||||
} // Fortran::semantics
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
|
||||
#ifndef FORTRAN_SEMANTICS_RESOLVE_LABELS_H_
|
||||
#define FORTRAN_SEMANTICS_RESOLVE_LABELS_H_
|
||||
|
||||
namespace Fortran {
|
||||
namespace parser {
|
||||
struct Program;
|
||||
class CookedSource;
|
||||
} // parser
|
||||
|
||||
namespace semantics {
|
||||
|
||||
/// \brief Validate the labels in the program
|
||||
/// \param ParseTree the parse tree
|
||||
/// \param Source the cooked source
|
||||
/// \return true, iff the program's labels pass semantics checks
|
||||
bool ValidateLabels(const parser::Program &ParseTree,
|
||||
const parser::CookedSource &Source);
|
||||
} // semantics
|
||||
} // Fortran
|
||||
|
||||
#endif // FORTRAN_SEMANTICS_RESOLVE_LABELS_H_
|
||||
|
||||
// Local Variables:
|
||||
// mode: C++
|
||||
// c-basic-offset: 2
|
||||
// End:
|
||||
|
|
@ -0,0 +1,226 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK-NOT:
|
||||
|
||||
! these are the conformance tests
|
||||
! define STRICT_F18 to eliminate tests of features not in F18
|
||||
! define ARCHAIC_FORTRAN to add test of feature found in Fortran before F95
|
||||
|
||||
subroutine sub00(a,b,n,m)
|
||||
real a(n)
|
||||
real :: b(m)
|
||||
1 print *, n, m
|
||||
1234 print *, a(n), b(1)
|
||||
99999 print *, a(1), b(m)
|
||||
end subroutine sub00
|
||||
|
||||
subroutine do_loop01(a,n)
|
||||
real, dimension(n) :: a
|
||||
do 10 i = 1, n
|
||||
print *, i, a(i)
|
||||
10 continue
|
||||
end subroutine do_loop01
|
||||
|
||||
subroutine do_loop02(a,n)
|
||||
real, dimension(n,n) :: a
|
||||
do 10 j = 1, n
|
||||
do 10 i = 1, n
|
||||
print *, i, j, a(i, j)
|
||||
10 continue
|
||||
end subroutine do_loop02
|
||||
|
||||
#ifndef STRICT_F18
|
||||
subroutine do_loop03(a,n)
|
||||
real, dimension(n) :: a
|
||||
do 10 i = 1, n
|
||||
10 print *, i, a(i) ! extension (not f18)
|
||||
end subroutine do_loop03
|
||||
|
||||
subroutine do_loop04(a,n)
|
||||
real :: a(n,n)
|
||||
do 10 j = 1, n
|
||||
do 10 i = 1, n
|
||||
10 print *, i, j, a(i, j) ! extension (not f18)
|
||||
end subroutine do_loop04
|
||||
|
||||
subroutine do_loop05(a,n)
|
||||
real a(n,n,n)
|
||||
do 10 k = 1, n
|
||||
do 10 j = 1, n
|
||||
do 10 i = 1, n
|
||||
10 print *, a(i, j, k) ! extension (not f18)
|
||||
end subroutine do_loop05
|
||||
#endif
|
||||
|
||||
subroutine do_loop06(a,n)
|
||||
real, dimension(n) :: a
|
||||
loopname: do i = 1, n
|
||||
print *, i, a(i)
|
||||
if (i .gt. 50) then
|
||||
678 exit
|
||||
end if
|
||||
end do loopname
|
||||
end subroutine do_loop06
|
||||
|
||||
subroutine do_loop07(a,n)
|
||||
real, dimension(n,n) :: a
|
||||
loopone: do j = 1, n
|
||||
looptwo: do i = 1, n
|
||||
print *, i, j, a(i, j)
|
||||
end do looptwo
|
||||
end do loopone
|
||||
end subroutine do_loop07
|
||||
|
||||
subroutine do_loop08(a,b,n,m,nn)
|
||||
real, dimension(n,n) :: a
|
||||
real b(m,nn)
|
||||
loopone: do j = 1, n
|
||||
condone: if (m .lt. n) then
|
||||
looptwo: do i = 1, m
|
||||
condtwo: if (n .lt. nn) then
|
||||
b(m-i,j) = s(m-i,j)
|
||||
if (i .eq. j) then
|
||||
goto 111
|
||||
end if
|
||||
else
|
||||
cycle loopone
|
||||
end if condtwo
|
||||
end do looptwo
|
||||
else if (n .lt. m) then
|
||||
loopthree: do i = 1, n
|
||||
condthree: if (n .lt. nn) then
|
||||
a(i,j) = b(i,j)
|
||||
if (i .eq. j) then
|
||||
return
|
||||
end if
|
||||
else
|
||||
exit loopthree
|
||||
end if condthree
|
||||
end do loopthree
|
||||
end if condone
|
||||
end do loopone
|
||||
111 print *, "done"
|
||||
end subroutine do_loop08
|
||||
|
||||
#ifndef STRICT_F18
|
||||
! extended ranges supported by PGI, gfortran gives warnings
|
||||
subroutine do_loop09(a,n,j)
|
||||
real a(n)
|
||||
goto 400
|
||||
200 print *, "found the index", j
|
||||
print *, "value at", j, "is", a(j)
|
||||
goto 300
|
||||
400 do 100 i = 1, n
|
||||
if (i .eq. j) then
|
||||
goto 200 ! extension: extended GOTO ranges
|
||||
300 continue
|
||||
else
|
||||
print *, a(i)
|
||||
end if
|
||||
100 end do
|
||||
500 continue
|
||||
end subroutine do_loop09
|
||||
#endif
|
||||
|
||||
subroutine goto10(a,b,n)
|
||||
goto 10
|
||||
10 print *,"x"
|
||||
4 labelit: if (a(n-1) .ne. b(n-2)) then
|
||||
goto 567
|
||||
end if labelit
|
||||
567 end subroutine goto10
|
||||
|
||||
subroutine computed_goto11(i,j,k)
|
||||
goto (100,110,120) i
|
||||
100 print *, j
|
||||
goto 200
|
||||
110 print *, k
|
||||
goto 200
|
||||
120 print *, -1
|
||||
200 end subroutine computed_goto11
|
||||
|
||||
#ifndef STRICT_F18
|
||||
subroutine arith_if12(i)
|
||||
if (i) 300,310,320
|
||||
300 continue
|
||||
print *,"<"
|
||||
goto 340
|
||||
310 print *,"=="
|
||||
340 goto 330
|
||||
320 print *,">"
|
||||
330 goto 350
|
||||
350 continue
|
||||
end subroutine arith_if12
|
||||
#endif
|
||||
|
||||
#if 0
|
||||
subroutine alt_return_spec13(i,*,*,*)
|
||||
9 continue
|
||||
8 labelme: if (i .lt. 42) then
|
||||
7 return 1
|
||||
6 else if (i .lt. 94) then
|
||||
5 return 2
|
||||
4 else if (i .lt. 645) then
|
||||
3 return 3
|
||||
2 end if labelme
|
||||
1 end subroutine alt_return_spec13
|
||||
|
||||
subroutine alt_return_spec14(i)
|
||||
call alt_return_spec13(i,*6000,*6130,*6457)
|
||||
print *, "Hi!"
|
||||
6000 continue
|
||||
6100 print *,"123"
|
||||
6130 continue
|
||||
6400 print *,"abc"
|
||||
6457 continue
|
||||
6650 print *,"!@#"
|
||||
end subroutine alt_return_spec14
|
||||
#endif
|
||||
|
||||
subroutine specifiers15(a,b,x)
|
||||
integer x
|
||||
OPEN (10, file="myfile.dat", err=100)
|
||||
READ (10,20,end=200,size=x,advance='no',eor=300) a
|
||||
goto 99
|
||||
99 CLOSE (10)
|
||||
goto 40
|
||||
100 print *,"error opening"
|
||||
101 return
|
||||
200 print *,"end of file"
|
||||
202 return
|
||||
300 print *, "end of record"
|
||||
303 return
|
||||
20 FORMAT (1x,F5.1)
|
||||
30 FORMAT (2x,F6.2)
|
||||
40 OPEN (11, file="myfile2.dat", err=100)
|
||||
goto 50
|
||||
50 WRITE (11,30,err=100) b
|
||||
CLOSE (11)
|
||||
end subroutine specifiers15
|
||||
|
||||
#if !defined(STRICT_F18) && defined(ARCHAIC_FORTRAN)
|
||||
! assigned goto was deleted in F95. PGI supports, gfortran gives warnings
|
||||
subroutine assigned_goto16
|
||||
assign 10 to i
|
||||
goto i (10, 20, 30)
|
||||
10 continue
|
||||
assign 20 to i
|
||||
20 continue
|
||||
assign 30 to i
|
||||
30 pause
|
||||
print *, "archaic feature!"
|
||||
end subroutine assigned_goto16
|
||||
#endif
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! negative test -- invalid labels, out of range
|
||||
|
||||
! RUN: f18 < %s | 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
|
||||
|
||||
subroutine sub00(a,b,n,m)
|
||||
real a(n)
|
||||
real :: b(m)
|
||||
0 print *, "error"
|
||||
100000 print *, n
|
||||
goto 123456
|
||||
1000 print *, m
|
||||
1000 print *, m+1
|
||||
end subroutine sub00
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! negative test -- invalid labels, out of range
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK: 'do 10 i = 1, m' doesn't properly nest
|
||||
! 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)
|
||||
real b(n,m)
|
||||
do 10 i = 1, m
|
||||
do 20 j = 1, n
|
||||
a(i,j) = b(i,j) + 2.0
|
||||
10 continue
|
||||
20 continue
|
||||
end subroutine sub00
|
||||
|
||||
subroutine sub01(a,b,n,m)
|
||||
real a(n,m)
|
||||
real b(n,m)
|
||||
do 30 i = 1, m
|
||||
do 40 j = 1, n
|
||||
a(i,j) = b(i,j) + 10.0
|
||||
35 continue
|
||||
45 continue
|
||||
end subroutine sub01
|
||||
|
||||
subroutine sub02(a,b,n,m)
|
||||
real a(n,m)
|
||||
real b(n,m)
|
||||
50 continue
|
||||
do 50 i = 1, m
|
||||
do 60 j = 1, n
|
||||
a(i,j) = b(i,j) + 20.0
|
||||
60 continue
|
||||
end subroutine sub02
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! negative test -- invalid labels, out of range
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK: branch into 'do 10 i = 1, m' from another scope
|
||||
! CHECK: branch into 'do 20 j = 1, n' from another scope
|
||||
|
||||
subroutine sub00(a,b,n,m)
|
||||
real a(n,m)
|
||||
real b(n,m)
|
||||
if (n .ne. m) then
|
||||
goto 50
|
||||
end if
|
||||
do 10 i = 1, m
|
||||
do 20 j = 1, n
|
||||
50 a(i,j) = b(i,j) + 2.0
|
||||
20 continue
|
||||
10 continue
|
||||
end subroutine sub00
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! negative test -- invalid labels, out of range
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK: label '50' was not found
|
||||
! CHECK: label '55' is not in scope
|
||||
! CHECK: label '70' is not an action stmt
|
||||
|
||||
subroutine sub00(a,b,n,m)
|
||||
real a(n,m)
|
||||
real b(n,m)
|
||||
if (n .ne. m) then
|
||||
goto 50
|
||||
end if
|
||||
6 n = m
|
||||
end subroutine sub00
|
||||
|
||||
subroutine sub01(a,b,n,m)
|
||||
real a(n,m)
|
||||
real b(n,m)
|
||||
if (n .ne. m) then
|
||||
goto 55
|
||||
else
|
||||
55 continue
|
||||
end if
|
||||
60 n = m
|
||||
end subroutine sub01
|
||||
|
||||
subroutine sub02(a,b,n,m)
|
||||
real a(n,m)
|
||||
real b(n,m)
|
||||
if (n .ne. m) then
|
||||
goto 70
|
||||
else
|
||||
return
|
||||
end if
|
||||
70 FORMAT (1x,i6)
|
||||
end subroutine sub02
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! negative test -- invalid labels, out of range
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK: label '10' is not in scope
|
||||
! CHECK: label '20' was not found
|
||||
! CHECK: label '40' is not in scope
|
||||
! CHECK: label '50' is not in scope (FIXME is that correct?)
|
||||
|
||||
subroutine sub00(n)
|
||||
GOTO (10,20,30) n
|
||||
if (n .eq. 1) then
|
||||
10 print *, "xyz"
|
||||
end if
|
||||
30 FORMAT (1x,i6)
|
||||
end subroutine sub00
|
||||
|
||||
subroutine sub01(n)
|
||||
real n
|
||||
GOTO (40,50,60) n
|
||||
if (n .eq. 1) then
|
||||
40 print *, "xyz"
|
||||
50 end if
|
||||
60 continue
|
||||
end subroutine sub01
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! negative test -- invalid labels, out of range
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK: label '10' is not in scope
|
||||
! CHECK: label '20' was not found
|
||||
! CHECK: label '30' is not an action stmt
|
||||
! CHECK: label '60' was not found
|
||||
|
||||
subroutine sub00(n,m)
|
||||
30 format (i6,f6.2)
|
||||
if (n .eq. m) then
|
||||
10 print *,"equal"
|
||||
end if
|
||||
call sub01(n,*10,*20,*30)
|
||||
write (*,60) n, m
|
||||
end subroutine sub00
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! negative test -- invalid labels, out of range
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK: IF construct name mismatch
|
||||
! CHECK: DO construct name mismatch
|
||||
! CHECK: CYCLE construct name mismatch
|
||||
|
||||
subroutine sub00(a,b,n,m)
|
||||
real a(n,m)
|
||||
real b(n,m)
|
||||
labelone: do i = 1, m
|
||||
labeltwo: do j = 1, n
|
||||
50 a(i,j) = b(i,j) + 2.0
|
||||
if (n .eq. m) then
|
||||
cycle label3
|
||||
end if label3
|
||||
60 end do labeltwo
|
||||
end do label1
|
||||
end subroutine sub00
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! RUN: f18 < %s | FileCheck %s
|
||||
! CHECK:
|
||||
|
||||
subroutine s(a)
|
||||
real a(10)
|
||||
write(*,60) "Hi there"
|
||||
end subroutine s
|
||||
|
|
@ -24,6 +24,7 @@
|
|||
#include "../../lib/parser/unparse.h"
|
||||
#include "../../lib/semantics/dump-parse-tree.h"
|
||||
#include "../../lib/semantics/mod-file.h"
|
||||
#include "../../lib/semantics/resolve-labels.h"
|
||||
#include "../../lib/semantics/resolve-names.h"
|
||||
#include "../../lib/semantics/scope.h"
|
||||
#include "../../lib/semantics/unparse-with-symbols.h"
|
||||
|
|
@ -215,6 +216,13 @@ std::string CompileFortran(
|
|||
}
|
||||
Fortran::semantics::ResolveNames(Fortran::semantics::Scope::globalScope,
|
||||
parseTree, parsing.cooked(), directories);
|
||||
const auto& Cook = parsing.cooked();
|
||||
bool Pass = Fortran::semantics::ValidateLabels(parseTree, Cook);
|
||||
if (!Pass) {
|
||||
std::cerr << "Semantic error(s), aborting\n";
|
||||
exitStatus = EXIT_FAILURE;
|
||||
return {};
|
||||
}
|
||||
Fortran::semantics::ModFileWriter writer;
|
||||
writer.set_directory(driver.moduleDirectory);
|
||||
writer.WriteAll();
|
||||
|
|
|
|||
Loading…
Reference in New Issue