From df4575f6b9e42fadd8890264490a8070c451b48e Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 20 Aug 2018 16:47:18 -0700 Subject: [PATCH] [flang] Add label resolution design document, pass, and tests Original-commit: flang-compiler/f18@e0d0df900c4d823b7114a4d511105c2dbd9d2e77 Reviewed-on: https://github.com/flang-compiler/f18/pull/170 Tree-same-pre-rewrite: false --- flang/lib/parser/message.cc | 16 +- flang/lib/parser/message.h | 2 + flang/lib/semantics/CMakeLists.txt | 1 + flang/lib/semantics/resolve-labels.cc | 832 ++++++++++++++++++++++++++++++++++ flang/lib/semantics/resolve-labels.h | 40 ++ flang/test/semantics/label01.F90 | 226 +++++++++ flang/test/semantics/label02.f90 | 32 ++ flang/test/semantics/label03.f90 | 51 +++ flang/test/semantics/label04.f90 | 32 ++ flang/test/semantics/label05.f90 | 51 +++ flang/test/semantics/label06.f90 | 38 ++ flang/test/semantics/label07.f90 | 30 ++ flang/test/semantics/label08.f90 | 33 ++ flang/test/semantics/label09.f90 | 21 + flang/tools/f18/f18.cc | 8 + 15 files changed, 1410 insertions(+), 3 deletions(-) create mode 100644 flang/lib/semantics/resolve-labels.cc create mode 100644 flang/lib/semantics/resolve-labels.h create mode 100644 flang/test/semantics/label01.F90 create mode 100644 flang/test/semantics/label02.f90 create mode 100644 flang/test/semantics/label03.f90 create mode 100644 flang/test/semantics/label04.f90 create mode 100644 flang/test/semantics/label05.f90 create mode 100644 flang/test/semantics/label06.f90 create mode 100644 flang/test/semantics/label07.f90 create mode 100644 flang/test/semantics/label08.f90 create mode 100644 flang/test/semantics/label09.f90 diff --git a/flang/lib/parser/message.cc b/flang/lib/parser/message.cc index 616c6d3..5f5af00 100644 --- a/flang/lib/parser/message.cc +++ b/flang/lib/parser/message.cc @@ -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; } diff --git a/flang/lib/parser/message.h b/flang/lib/parser/message.h index 6368e28..da47982 100644 --- a/flang/lib/parser/message.h +++ b/flang/lib/parser/message.h @@ -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}; }; diff --git a/flang/lib/semantics/CMakeLists.txt b/flang/lib/semantics/CMakeLists.txt index 40f5216..e38a7d2 100644 --- a/flang/lib/semantics/CMakeLists.txt +++ b/flang/lib/semantics/CMakeLists.txt @@ -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 diff --git a/flang/lib/semantics/resolve-labels.cc b/flang/lib/semantics/resolve-labels.cc new file mode 100644 index 0000000..aeb01bf --- /dev/null +++ b/flang/lib/semantics/resolve-labels.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 +#include +#include +#include + +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>; +using Scope_t = unsigned; +using LblStmt_t = std::tuple; +using ArcTrgt_t = std::map; +using ArcBase_t = std::vector>; + +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 constexpr bool IsLegalDoTerm(const parser::Statement&) { + return false; +} +// F18:R1131 (must be CONTINUE or END DO) +template<> constexpr bool IsLegalDoTerm(const parser::Statement&) { + return true; +} +template<> constexpr bool IsLegalDoTerm(const parser::Statement>&) { + return true; +} +template<> constexpr bool IsLegalDoTerm(const parser::Statement& A) { + if (std::get_if(&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>(P) || + std::get_if>(P) || + std::get_if>(P) || + std::get_if>(P) || + std::get_if>(P) || + std::get_if>(P)); +} + +/// \brief Is this a FORMAT stmt? +/// Pattern match for FORMAT statement +template constexpr bool IsFormat(const parser::Statement&) { + return false; +} +template<> constexpr bool IsFormat(const parser::Statement>&) { + return true; +} + +/// \brief Is this a legal branch target? +/// Pattern match dependent on the standard we're enforcing +template constexpr bool IsLegalBranchTarget(const parser:: + Statement&) { + return false; +} +template<> constexpr bool IsLegalBranchTarget(const parser::Statement& 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>(P) || + std::get_if>(P) || + std::get_if>(P) || + std::get_if>(P)); +} +#define Instantiate(TYPE) \ + template<> constexpr bool IsLegalBranchTarget(const parser:: \ + Statement&) { \ + 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) +Instantiate(parser::NonLabelDoStmt) +Instantiate(parser::EndDoStmt) +Instantiate(common::Indirection) +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 +constexpr unsigned ConsTrgtFlags(const parser::Statement& 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 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 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 +/// construct-name. +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 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& 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 constexpr bool Pre(const A&) { return true; } + template constexpr void Post(const A&) {} + + // Specializations of Pre() and Post() + + /// \brief Generic handling of all statements + template bool Pre(const parser::Statement& 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(&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(std::get((*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& 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 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 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 void PopNonBlockConstructName(const A& X) { + CheckName(X); SelectivePopBack(X); + } + + template 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 void PopName(const A& V) { + CheckName(V); PopScope(); SelectivePopBack(V); + } + + /// \brief Check case-construct-name and pop the scope + /// Constraint C1144 - opening and ending name must match if present, and + /// case-stmt must either match or be unnamed + void PopName(const parser::CaseConstruct& Case) { + CheckName(Case, "CASE"); PopScope(); SelectivePopBack(Case); + } + + /// \brief Check select-rank-construct-name and pop the scope + /// Constraints C1154, C1156 - opening and ending name must match if present, + /// and select-rank-case-stmt must either match or be unnamed + void PopName(const parser::SelectRankConstruct& SelRk) { + CheckName(SelRk, "RANK","RANK "); PopScope(); SelectivePopBack(SelRk); + } + + /// \brief Check select-construct-name and pop the scope + /// Constraint C1165 - opening and ending name must match if present, and + /// type-guard-stmt 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 associate-construct-name, constraint C1106 + void CheckName(const parser::AssociateConstruct& A) { ChkNm(A, "ASSOCIATE"); } + /// \brief Check critical-construct-name, constraint C1117 + void CheckName(const parser::CriticalConstruct& C) { ChkNm(C, "CRITICAL"); } + /// \brief Check do-construct-name, constraint C1131 + void CheckName(const parser::DoConstruct& Do) { ChkNm(Do, "DO"); } + /// \brief Check forall-construct-name, constraint C1035 + void CheckName(const parser::ForallConstruct& F) { ChkNm(F, "FORALL"); } + /// \brief Common code for ASSOCIATE, CRITICAL, DO, and FORALL + template 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 do-construct-name, 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 team-cosntruct-name, 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 if-construct-name + /// Constraint C1142 - opening and ending name must match if present, and + /// else-if-stmt and else-stmt 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 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 where-construct-name + /// Constraint C1033 - opening and ending name must match if present, and + /// masked-elsewhere-stmt and elsewhere-stmt 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 () 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 construct-name 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 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& Labels) { + for (const parser::Label& L : Labels) + AddBase(L); + } + + std::vector 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 Names; +}; + +template +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 +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 +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 label-do-stmt +/// Relates to 11.1.7.3, loop activation +template +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 +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 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 label-do-stmt +template +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(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 +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 +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(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 +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 +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(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 +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; +} + +} // + +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 diff --git a/flang/lib/semantics/resolve-labels.h b/flang/lib/semantics/resolve-labels.h new file mode 100644 index 0000000..6154af6 --- /dev/null +++ b/flang/lib/semantics/resolve-labels.h @@ -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: diff --git a/flang/test/semantics/label01.F90 b/flang/test/semantics/label01.F90 new file mode 100644 index 0000000..a964d0f --- /dev/null +++ b/flang/test/semantics/label01.F90 @@ -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 diff --git a/flang/test/semantics/label02.f90 b/flang/test/semantics/label02.f90 new file mode 100644 index 0000000..d6580ad --- /dev/null +++ b/flang/test/semantics/label02.f90 @@ -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 diff --git a/flang/test/semantics/label03.f90 b/flang/test/semantics/label03.f90 new file mode 100644 index 0000000..1d0d9dc --- /dev/null +++ b/flang/test/semantics/label03.f90 @@ -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 diff --git a/flang/test/semantics/label04.f90 b/flang/test/semantics/label04.f90 new file mode 100644 index 0000000..5666772 --- /dev/null +++ b/flang/test/semantics/label04.f90 @@ -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 diff --git a/flang/test/semantics/label05.f90 b/flang/test/semantics/label05.f90 new file mode 100644 index 0000000..b15e781 --- /dev/null +++ b/flang/test/semantics/label05.f90 @@ -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 diff --git a/flang/test/semantics/label06.f90 b/flang/test/semantics/label06.f90 new file mode 100644 index 0000000..dc866bc --- /dev/null +++ b/flang/test/semantics/label06.f90 @@ -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 diff --git a/flang/test/semantics/label07.f90 b/flang/test/semantics/label07.f90 new file mode 100644 index 0000000..1dd38d5 --- /dev/null +++ b/flang/test/semantics/label07.f90 @@ -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 diff --git a/flang/test/semantics/label08.f90 b/flang/test/semantics/label08.f90 new file mode 100644 index 0000000..ea02f59 --- /dev/null +++ b/flang/test/semantics/label08.f90 @@ -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 diff --git a/flang/test/semantics/label09.f90 b/flang/test/semantics/label09.f90 new file mode 100644 index 0000000..1a2221a --- /dev/null +++ b/flang/test/semantics/label09.f90 @@ -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 diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc index 2b8b086..10fb78c 100644 --- a/flang/tools/f18/f18.cc +++ b/flang/tools/f18/f18.cc @@ -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(); -- 2.7.4