"name": "test",
"image": "ubuntu",
"commands": [
- "apt-get update && apt-get install -y clang-8 cmake ninja-build lld-8 llvm-dev libc++-8-dev libc++abi-8-dev libz-dev",
+ "apt-get update && apt-get install -y clang-8 cmake ninja-build lld-8 llvm-8-dev libc++-8-dev libc++abi-8-dev libz-dev",
"mkdir build && cd build",
- 'env CC=clang-8 CXX=clang++-8 CXXFLAGS="-UNDEBUG -stdlib=libc++" LDFLAGS="-fuse-ld=lld" cmake -GNinja -DCMAKE_BUILD_TYPE=Release ..',
+ 'env CC=clang-8 CXX=clang++-8 CXXFLAGS="-UNDEBUG" LDFLAGS="-fuse-ld=lld" cmake -GNinja -DCMAKE_BUILD_TYPE=Release ..',
"ninja -j8",
"ctest --output-on-failure -j24",
],
# https://stackoverflow.com/questions/41924375/llvm-how-to-specify-all-link-libraries-as-input-to-llvm-map-components-to-libna
# https://stackoverflow.com/questions/33948633/how-do-i-link-when-building-with-llvm-libraries
-include_directories(${LLVM_INCLUDE_DIRS})
+# Add LLVM include files as if they were SYSTEM because there are complex unused
+# parameter issues that may or may not appear depending on the environments and
+# compilers (ifdefs are involved). This allows warnings from LLVM headers to be
+# ignored while keeping -Wunused-parameter a fatal error inside f18 code base.
+# This may have to be fine-tuned if flang headers are consider part of this
+# LLVM_INCLUDE_DIRS when merging in the monorepo (Warning from flang headers
+# should not be suppressed).
+include_directories(SYSTEM ${LLVM_INCLUDE_DIRS})
add_definitions(${LLVM_DEFINITIONS})
# LLVM_LIT_EXTERNAL store in cache so it could be used by AddLLVM.cmake
--- /dev/null
+//===-- include/flang/lower/PFTBuilder.h ------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_PFT_BUILDER_H_
+#define FORTRAN_LOWER_PFT_BUILDER_H_
+
+#include "flang/common/template.h"
+#include "flang/parser/parse-tree.h"
+#include "llvm/Support/raw_ostream.h"
+#include <memory>
+
+/// Build a light-weight tree over the parse-tree to help with lowering to FIR.
+/// It is named Pre-FIR Tree (PFT) to underline it has no other usage than
+/// helping lowering to FIR.
+/// The PFT will capture pointers back into the parse tree, so the parse tree
+/// data structure may <em>not</em> be changed between the construction of the
+/// PFT and all of its uses.
+///
+/// The PFT captures a structured view of the program. The program is a list of
+/// units. Function like units will contain lists of evaluations. Evaluations
+/// are either statements or constructs, where a construct contains a list of
+/// evaluations. The resulting PFT structure can then be used to create FIR.
+
+namespace Fortran::lower {
+namespace pft {
+
+struct Evaluation;
+struct Program;
+struct ModuleLikeUnit;
+struct FunctionLikeUnit;
+
+// TODO: A collection of Evaluations can obviously be any of the container
+// types; leaving this as a std::list _for now_ because we reserve the right to
+// insert PFT nodes in any order in O(1) time.
+using EvaluationCollection = std::list<Evaluation>;
+
+struct ParentType {
+ template <typename A>
+ ParentType(A &parent) : p{&parent} {}
+ const std::variant<Program *, ModuleLikeUnit *, FunctionLikeUnit *,
+ Evaluation *>
+ p;
+};
+
+/// Flags to describe the impact of parse-trees nodes on the program
+/// control flow. These annotations to parse-tree nodes are later used to
+/// build the control flow graph when lowering to FIR.
+enum class CFGAnnotation {
+ None, // Node does not impact control flow.
+ Goto, // Node acts like a goto on the control flow.
+ CondGoto, // Node acts like a conditional goto on the control flow.
+ IndGoto, // Node acts like an indirect goto on the control flow.
+ IoSwitch, // Node is an IO statement with ERR, END, or EOR specifier.
+ Switch, // Node acts like a switch on the control flow.
+ Iterative, // Node creates iterations in the control flow.
+ FirStructuredOp, // Node is a structured loop.
+ Return, // Node triggers a return from the current procedure.
+ Terminate // Node terminates the program.
+};
+
+/// Compiler-generated jump
+///
+/// This is used to convert implicit control-flow edges to explicit form in the
+/// decorated PFT
+struct CGJump {
+ CGJump(Evaluation &to) : target{to} {}
+ Evaluation ⌖
+};
+
+/// Classify the parse-tree nodes from ExecutablePartConstruct
+
+using ActionStmts = std::tuple<
+ parser::AllocateStmt, parser::AssignmentStmt, parser::BackspaceStmt,
+ parser::CallStmt, parser::CloseStmt, parser::ContinueStmt,
+ parser::CycleStmt, parser::DeallocateStmt, parser::EndfileStmt,
+ parser::EventPostStmt, parser::EventWaitStmt, parser::ExitStmt,
+ parser::FailImageStmt, parser::FlushStmt, parser::FormTeamStmt,
+ parser::GotoStmt, parser::IfStmt, parser::InquireStmt, parser::LockStmt,
+ parser::NullifyStmt, parser::OpenStmt, parser::PointerAssignmentStmt,
+ parser::PrintStmt, parser::ReadStmt, parser::ReturnStmt, parser::RewindStmt,
+ parser::StopStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
+ parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt,
+ parser::WaitStmt, parser::WhereStmt, parser::WriteStmt,
+ parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt,
+ parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>;
+
+using OtherStmts = std::tuple<parser::FormatStmt, parser::EntryStmt,
+ parser::DataStmt, parser::NamelistStmt>;
+
+using Constructs =
+ std::tuple<parser::AssociateConstruct, parser::BlockConstruct,
+ parser::CaseConstruct, parser::ChangeTeamConstruct,
+ parser::CriticalConstruct, parser::DoConstruct,
+ parser::IfConstruct, parser::SelectRankConstruct,
+ parser::SelectTypeConstruct, parser::WhereConstruct,
+ parser::ForallConstruct, parser::CompilerDirective,
+ parser::OpenMPConstruct, parser::OmpEndLoopDirective>;
+
+using ConstructStmts = std::tuple<
+ parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt,
+ parser::EndBlockStmt, parser::SelectCaseStmt, parser::CaseStmt,
+ parser::EndSelectStmt, parser::ChangeTeamStmt, parser::EndChangeTeamStmt,
+ parser::CriticalStmt, parser::EndCriticalStmt, parser::NonLabelDoStmt,
+ parser::EndDoStmt, parser::IfThenStmt, parser::ElseIfStmt, parser::ElseStmt,
+ parser::EndIfStmt, parser::SelectRankStmt, parser::SelectRankCaseStmt,
+ parser::SelectTypeStmt, parser::TypeGuardStmt, parser::WhereConstructStmt,
+ parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt,
+ parser::ForallConstructStmt, parser::EndForallStmt>;
+
+template <typename A>
+constexpr static bool isActionStmt{common::HasMember<A, ActionStmts>};
+
+template <typename A>
+constexpr static bool isConstruct{common::HasMember<A, Constructs>};
+
+template <typename A>
+constexpr static bool isConstructStmt{common::HasMember<A, ConstructStmts>};
+
+template <typename A>
+constexpr static bool isOtherStmt{common::HasMember<A, OtherStmts>};
+
+template <typename A>
+constexpr static bool isGenerated{std::is_same_v<A, CGJump>};
+
+template <typename A>
+constexpr static bool isFunctionLike{common::HasMember<
+ A, std::tuple<parser::MainProgram, parser::FunctionSubprogram,
+ parser::SubroutineSubprogram,
+ parser::SeparateModuleSubprogram>>};
+
+/// Function-like units can contains lists of evaluations. These can be
+/// (simple) statements or constructs, where a construct contains its own
+/// evaluations.
+struct Evaluation {
+ using EvalTuple = common::CombineTuples<ActionStmts, OtherStmts, Constructs,
+ ConstructStmts>;
+
+ /// Hide non-nullable pointers to the parse-tree node.
+ template <typename A>
+ using MakeRefType = const A *const;
+ using EvalVariant =
+ common::CombineVariants<common::MapTemplate<MakeRefType, EvalTuple>,
+ std::variant<CGJump>>;
+ template <typename A>
+ constexpr auto visit(A visitor) const {
+ return std::visit(common::visitors{
+ [&](const auto *p) { return visitor(*p); },
+ [&](auto &r) { return visitor(r); },
+ },
+ u);
+ }
+ template <typename A>
+ constexpr const A *getIf() const {
+ if constexpr (!std::is_same_v<A, CGJump>) {
+ if (auto *ptr{std::get_if<MakeRefType<A>>(&u)}) {
+ return *ptr;
+ }
+ } else {
+ return std::get_if<CGJump>(&u);
+ }
+ return nullptr;
+ }
+ template <typename A>
+ constexpr bool isA() const {
+ if constexpr (!std::is_same_v<A, CGJump>) {
+ return std::holds_alternative<MakeRefType<A>>(u);
+ }
+ return std::holds_alternative<CGJump>(u);
+ }
+
+ Evaluation() = delete;
+ Evaluation(const Evaluation &) = delete;
+ Evaluation(Evaluation &&) = default;
+
+ /// General ctor
+ template <typename A>
+ Evaluation(const A &a, const ParentType &p, const parser::CharBlock &pos,
+ const std::optional<parser::Label> &lab)
+ : u{&a}, parent{p}, pos{pos}, lab{lab} {}
+
+ /// Compiler-generated jump
+ Evaluation(const CGJump &jump, const ParentType &p)
+ : u{jump}, parent{p}, cfg{CFGAnnotation::Goto} {}
+
+ /// Construct ctor
+ template <typename A>
+ Evaluation(const A &a, const ParentType &parent) : u{&a}, parent{parent} {
+ static_assert(pft::isConstruct<A>, "must be a construct");
+ }
+
+ constexpr bool isActionOrGenerated() const {
+ return visit(common::visitors{
+ [](auto &r) {
+ using T = std::decay_t<decltype(r)>;
+ return isActionStmt<T> || isGenerated<T>;
+ },
+ });
+ }
+
+ constexpr bool isStmt() const {
+ return visit(common::visitors{
+ [](auto &r) {
+ using T = std::decay_t<decltype(r)>;
+ static constexpr bool isStmt{isActionStmt<T> || isOtherStmt<T> ||
+ isConstructStmt<T>};
+ static_assert(!(isStmt && pft::isConstruct<T>),
+ "statement classification is inconsistent");
+ return isStmt;
+ },
+ });
+ }
+ constexpr bool isConstruct() const { return !isStmt(); }
+
+ /// Set the type of originating control flow type for this evaluation.
+ void setCFG(CFGAnnotation a, Evaluation *cstr) {
+ cfg = a;
+ setBranches(cstr);
+ }
+
+ /// Is this evaluation a control-flow origin? (The PFT must be annotated)
+ bool isControlOrigin() const { return cfg != CFGAnnotation::None; }
+
+ /// Is this evaluation a control-flow target? (The PFT must be annotated)
+ bool isControlTarget() const { return isTarget; }
+
+ /// Set the containsBranches flag iff this evaluation (a construct) contains
+ /// control flow
+ void setBranches() { containsBranches = true; }
+
+ EvaluationCollection *getConstructEvals() {
+ auto *evals{subs.get()};
+ if (isStmt() && !evals) {
+ return nullptr;
+ }
+ if (isConstruct() && evals) {
+ return evals;
+ }
+ llvm_unreachable("evaluation subs is inconsistent");
+ return nullptr;
+ }
+
+ /// Set that the construct `cstr` (if not a nullptr) has branches.
+ static void setBranches(Evaluation *cstr) {
+ if (cstr)
+ cstr->setBranches();
+ }
+
+ EvalVariant u;
+ ParentType parent;
+ parser::CharBlock pos;
+ std::optional<parser::Label> lab;
+ std::unique_ptr<EvaluationCollection> subs; // construct sub-statements
+ CFGAnnotation cfg{CFGAnnotation::None};
+ bool isTarget{false}; // this evaluation is a control target
+ bool containsBranches{false}; // construct contains branches
+};
+
+/// A program is a list of program units.
+/// These units can be function like, module like, or block data
+struct ProgramUnit {
+ template <typename A>
+ ProgramUnit(const A &ptr, const ParentType &parent)
+ : p{&ptr}, parent{parent} {}
+ ProgramUnit(ProgramUnit &&) = default;
+ ProgramUnit(const ProgramUnit &) = delete;
+
+ const std::variant<
+ const parser::MainProgram *, const parser::FunctionSubprogram *,
+ const parser::SubroutineSubprogram *, const parser::Module *,
+ const parser::Submodule *, const parser::SeparateModuleSubprogram *,
+ const parser::BlockData *>
+ p;
+ ParentType parent;
+};
+
+/// Function-like units have similar structure. They all can contain executable
+/// statements as well as other function-like units (internal procedures and
+/// function statements).
+struct FunctionLikeUnit : public ProgramUnit {
+ // wrapper statements for function-like syntactic structures
+ using FunctionStatement =
+ std::variant<const parser::Statement<parser::ProgramStmt> *,
+ const parser::Statement<parser::EndProgramStmt> *,
+ const parser::Statement<parser::FunctionStmt> *,
+ const parser::Statement<parser::EndFunctionStmt> *,
+ const parser::Statement<parser::SubroutineStmt> *,
+ const parser::Statement<parser::EndSubroutineStmt> *,
+ const parser::Statement<parser::MpSubprogramStmt> *,
+ const parser::Statement<parser::EndMpSubprogramStmt> *>;
+
+ FunctionLikeUnit(const parser::MainProgram &f, const ParentType &parent);
+ FunctionLikeUnit(const parser::FunctionSubprogram &f,
+ const ParentType &parent);
+ FunctionLikeUnit(const parser::SubroutineSubprogram &f,
+ const ParentType &parent);
+ FunctionLikeUnit(const parser::SeparateModuleSubprogram &f,
+ const ParentType &parent);
+ FunctionLikeUnit(FunctionLikeUnit &&) = default;
+ FunctionLikeUnit(const FunctionLikeUnit &) = delete;
+
+ bool isMainProgram() {
+ return std::holds_alternative<
+ const parser::Statement<parser::EndProgramStmt> *>(endStmt);
+ }
+ const parser::FunctionStmt *getFunction() {
+ return getA<parser::FunctionStmt>();
+ }
+ const parser::SubroutineStmt *getSubroutine() {
+ return getA<parser::SubroutineStmt>();
+ }
+ const parser::MpSubprogramStmt *getMPSubp() {
+ return getA<parser::MpSubprogramStmt>();
+ }
+
+ /// Anonymous programs do not have a begin statement
+ std::optional<FunctionStatement> beginStmt;
+ FunctionStatement endStmt;
+ EvaluationCollection evals; // statements
+ std::list<FunctionLikeUnit> funcs; // internal procedures
+
+private:
+ template <typename A>
+ const A *getA() {
+ if (beginStmt) {
+ if (auto p =
+ std::get_if<const parser::Statement<A> *>(&beginStmt.value()))
+ return &(*p)->statement;
+ }
+ return nullptr;
+ }
+};
+
+/// Module-like units have similar structure. They all can contain a list of
+/// function-like units.
+struct ModuleLikeUnit : public ProgramUnit {
+ // wrapper statements for module-like syntactic structures
+ using ModuleStatement =
+ std::variant<const parser::Statement<parser::ModuleStmt> *,
+ const parser::Statement<parser::EndModuleStmt> *,
+ const parser::Statement<parser::SubmoduleStmt> *,
+ const parser::Statement<parser::EndSubmoduleStmt> *>;
+
+ ModuleLikeUnit(const parser::Module &m, const ParentType &parent);
+ ModuleLikeUnit(const parser::Submodule &m, const ParentType &parent);
+ ~ModuleLikeUnit() = default;
+ ModuleLikeUnit(ModuleLikeUnit &&) = default;
+ ModuleLikeUnit(const ModuleLikeUnit &) = delete;
+
+ ModuleStatement beginStmt;
+ ModuleStatement endStmt;
+ std::list<FunctionLikeUnit> funcs;
+};
+
+struct BlockDataUnit : public ProgramUnit {
+ BlockDataUnit(const parser::BlockData &bd, const ParentType &parent);
+ BlockDataUnit(BlockDataUnit &&) = default;
+ BlockDataUnit(const BlockDataUnit &) = delete;
+};
+
+/// A Program is the top-level PFT
+struct Program {
+ using Units = std::variant<FunctionLikeUnit, ModuleLikeUnit, BlockDataUnit>;
+
+ Program() = default;
+ Program(Program &&) = default;
+ Program(const Program &) = delete;
+
+ std::list<Units> &getUnits() { return units; }
+
+private:
+ std::list<Units> units;
+};
+
+} // namespace pft
+
+/// Create an PFT from the parse tree
+std::unique_ptr<pft::Program> createPFT(const parser::Program &root);
+
+/// Decorate the PFT with control flow annotations
+///
+/// The PFT must be decorated with control-flow annotations to prepare it for
+/// use in generating a CFG-like structure.
+void annotateControl(pft::Program &);
+
+void dumpPFT(llvm::raw_ostream &o, pft::Program &);
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_PFT_BUILDER_H_
std::ostream &out, const AnalyzedObjectsAsFortran *asFortran = nullptr)
: out_(out), asFortran_{asFortran} {}
- constexpr const char *GetNodeName(const char *) { return "char *"; }
+ static constexpr const char *GetNodeName(const char *) { return "char *"; }
#define NODE_NAME(T, N) \
- constexpr const char *GetNodeName(const T &) { return N; }
+ static constexpr const char *GetNodeName(const T &) { return N; }
#define NODE_ENUM(T, E) \
- std::string GetNodeName(const T::E &x) { \
+ static std::string GetNodeName(const T::E &x) { \
return #E " = "s + T::EnumToString(x); \
}
#define NODE(T1, T2) NODE_NAME(T1::T2, #T2)
add_subdirectory(common)
add_subdirectory(evaluate)
add_subdirectory(decimal)
+add_subdirectory(lower)
add_subdirectory(parser)
add_subdirectory(semantics)
--- /dev/null
+add_library(FortranLower
+ PFTBuilder.cpp
+)
+
+target_link_libraries(FortranLower
+ LLVMSupport
+)
+
+install (TARGETS FortranLower
+ ARCHIVE DESTINATION lib
+ LIBRARY DESTINATION lib
+ RUNTIME DESTINATION bin
+)
--- /dev/null
+//===-- lib/lower/PFTBuilder.cc -------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/lower/PFTBuilder.h"
+#include "flang/parser/dump-parse-tree.h"
+#include "flang/parser/parse-tree-visitor.h"
+#include "llvm/ADT/DenseMap.h"
+#include <algorithm>
+#include <cassert>
+#include <utility>
+
+namespace Fortran::lower {
+namespace {
+
+/// Helpers to unveil parser node inside parser::Statement<>,
+/// parser::UnlabeledStatement, and common::Indirection<>
+template <typename A>
+struct RemoveIndirectionHelper {
+ using Type = A;
+ static constexpr const Type &unwrap(const A &a) { return a; }
+};
+template <typename A>
+struct RemoveIndirectionHelper<common::Indirection<A>> {
+ using Type = A;
+ static constexpr const Type &unwrap(const common::Indirection<A> &a) {
+ return a.value();
+ }
+};
+
+template <typename A>
+const auto &removeIndirection(const A &a) {
+ return RemoveIndirectionHelper<A>::unwrap(a);
+}
+
+template <typename A>
+struct UnwrapStmt {
+ static constexpr bool isStmt{false};
+};
+template <typename A>
+struct UnwrapStmt<parser::Statement<A>> {
+ static constexpr bool isStmt{true};
+ using Type = typename RemoveIndirectionHelper<A>::Type;
+ constexpr UnwrapStmt(const parser::Statement<A> &a)
+ : unwrapped{removeIndirection(a.statement)}, pos{a.source}, lab{a.label} {
+ }
+ const Type &unwrapped;
+ parser::CharBlock pos;
+ std::optional<parser::Label> lab;
+};
+template <typename A>
+struct UnwrapStmt<parser::UnlabeledStatement<A>> {
+ static constexpr bool isStmt{true};
+ using Type = typename RemoveIndirectionHelper<A>::Type;
+ constexpr UnwrapStmt(const parser::UnlabeledStatement<A> &a)
+ : unwrapped{removeIndirection(a.statement)}, pos{a.source} {}
+ const Type &unwrapped;
+ parser::CharBlock pos;
+ std::optional<parser::Label> lab;
+};
+
+/// The instantiation of a parse tree visitor (Pre and Post) is extremely
+/// expensive in terms of compile and link time, so one goal here is to limit
+/// the bridge to one such instantiation.
+class PFTBuilder {
+public:
+ PFTBuilder() : pgm{new pft::Program}, parents{*pgm.get()} {}
+
+ /// Get the result
+ std::unique_ptr<pft::Program> result() { return std::move(pgm); }
+
+ template <typename A>
+ constexpr bool Pre(const A &a) {
+ bool visit{true};
+ if constexpr (pft::isFunctionLike<A>) {
+ return enterFunc(a);
+ } else if constexpr (pft::isConstruct<A>) {
+ return enterConstruct(a);
+ } else if constexpr (UnwrapStmt<A>::isStmt) {
+ using T = typename UnwrapStmt<A>::Type;
+ // Node "a" being visited has one of the following types:
+ // Statement<T>, Statement<Indirection<T>, UnlabeledStatement<T>,
+ // or UnlabeledStatement<Indirection<T>>
+ auto stmt{UnwrapStmt<A>(a)};
+ if constexpr (pft::isConstructStmt<T> || pft::isOtherStmt<T>) {
+ addEval(pft::Evaluation{stmt.unwrapped, parents.back(), stmt.pos,
+ stmt.lab});
+ visit = false;
+ } else if constexpr (std::is_same_v<T, parser::ActionStmt>) {
+ addEval(makeEvalAction(stmt.unwrapped, stmt.pos, stmt.lab));
+ visit = false;
+ }
+ }
+ return visit;
+ }
+
+ template <typename A>
+ constexpr void Post(const A &) {
+ if constexpr (pft::isFunctionLike<A>) {
+ exitFunc();
+ } else if constexpr (pft::isConstruct<A>) {
+ exitConstruct();
+ }
+ }
+
+ // Module like
+ bool Pre(const parser::Module &node) { return enterModule(node); }
+ bool Pre(const parser::Submodule &node) { return enterModule(node); }
+
+ void Post(const parser::Module &) { exitModule(); }
+ void Post(const parser::Submodule &) { exitModule(); }
+
+ // Block data
+ bool Pre(const parser::BlockData &node) {
+ addUnit(pft::BlockDataUnit{node, parents.back()});
+ return false;
+ }
+
+ // Get rid of production wrapper
+ bool Pre(const parser::UnlabeledStatement<parser::ForallAssignmentStmt>
+ &statement) {
+ addEval(std::visit(
+ [&](const auto &x) {
+ return pft::Evaluation{x, parents.back(), statement.source, {}};
+ },
+ statement.statement.u));
+ return false;
+ }
+ bool Pre(const parser::Statement<parser::ForallAssignmentStmt> &statement) {
+ addEval(std::visit(
+ [&](const auto &x) {
+ return pft::Evaluation{x, parents.back(), statement.source,
+ statement.label};
+ },
+ statement.statement.u));
+ return false;
+ }
+ bool Pre(const parser::WhereBodyConstruct &whereBody) {
+ return std::visit(
+ common::visitors{
+ [&](const parser::Statement<parser::AssignmentStmt> &stmt) {
+ // Not caught as other AssignmentStmt because it is not
+ // wrapped in a parser::ActionStmt.
+ addEval(pft::Evaluation{stmt.statement, parents.back(),
+ stmt.source, stmt.label});
+ return false;
+ },
+ [&](const auto &) { return true; },
+ },
+ whereBody.u);
+ }
+
+private:
+ // ActionStmt has a couple of non-conforming cases, which get handled
+ // explicitly here. The other cases use an Indirection, which we discard in
+ // the PFT.
+ pft::Evaluation makeEvalAction(const parser::ActionStmt &statement,
+ parser::CharBlock pos,
+ std::optional<parser::Label> lab) {
+ return std::visit(
+ common::visitors{
+ [&](const auto &x) {
+ return pft::Evaluation{removeIndirection(x), parents.back(), pos,
+ lab};
+ },
+ },
+ statement.u);
+ }
+
+ // When we enter a function-like structure, we want to build a new unit and
+ // set the builder's cursors to point to it.
+ template <typename A>
+ bool enterFunc(const A &func) {
+ auto &unit = addFunc(pft::FunctionLikeUnit{func, parents.back()});
+ funclist = &unit.funcs;
+ pushEval(&unit.evals);
+ parents.emplace_back(unit);
+ return true;
+ }
+ /// Make funclist to point to current parent function list if it exists.
+ void setFunctListToParentFuncs() {
+ if (!parents.empty()) {
+ std::visit(common::visitors{
+ [&](pft::FunctionLikeUnit *p) { funclist = &p->funcs; },
+ [&](pft::ModuleLikeUnit *p) { funclist = &p->funcs; },
+ [&](auto *) { funclist = nullptr; },
+ },
+ parents.back().p);
+ }
+ }
+
+ void exitFunc() {
+ popEval();
+ parents.pop_back();
+ setFunctListToParentFuncs();
+ }
+
+ // When we enter a construct structure, we want to build a new construct and
+ // set the builder's evaluation cursor to point to it.
+ template <typename A>
+ bool enterConstruct(const A &construct) {
+ auto &con = addEval(pft::Evaluation{construct, parents.back()});
+ con.subs.reset(new pft::EvaluationCollection);
+ pushEval(con.subs.get());
+ parents.emplace_back(con);
+ return true;
+ }
+
+ void exitConstruct() {
+ popEval();
+ parents.pop_back();
+ }
+
+ // When we enter a module structure, we want to build a new module and
+ // set the builder's function cursor to point to it.
+ template <typename A>
+ bool enterModule(const A &func) {
+ auto &unit = addUnit(pft::ModuleLikeUnit{func, parents.back()});
+ funclist = &unit.funcs;
+ parents.emplace_back(unit);
+ return true;
+ }
+
+ void exitModule() {
+ parents.pop_back();
+ setFunctListToParentFuncs();
+ }
+
+ template <typename A>
+ A &addUnit(A &&unit) {
+ pgm->getUnits().emplace_back(std::move(unit));
+ return std::get<A>(pgm->getUnits().back());
+ }
+
+ template <typename A>
+ A &addFunc(A &&func) {
+ if (funclist) {
+ funclist->emplace_back(std::move(func));
+ return funclist->back();
+ }
+ return addUnit(std::move(func));
+ }
+
+ /// move the Evaluation to the end of the current list
+ pft::Evaluation &addEval(pft::Evaluation &&eval) {
+ assert(funclist && "not in a function");
+ assert(evallist.size() > 0);
+ evallist.back()->emplace_back(std::move(eval));
+ return evallist.back()->back();
+ }
+
+ /// push a new list on the stack of Evaluation lists
+ void pushEval(pft::EvaluationCollection *eval) {
+ assert(funclist && "not in a function");
+ assert(eval && eval->empty() && "evaluation list isn't correct");
+ evallist.emplace_back(eval);
+ }
+
+ /// pop the current list and return to the last Evaluation list
+ void popEval() {
+ assert(funclist && "not in a function");
+ evallist.pop_back();
+ }
+
+ std::unique_ptr<pft::Program> pgm;
+ /// funclist points to FunctionLikeUnit::funcs list (resp.
+ /// ModuleLikeUnit::funcs) when building a FunctionLikeUnit (resp.
+ /// ModuleLikeUnit) to store internal procedures (resp. module procedures).
+ /// Otherwise (e.g. when building the top level Program), it is null.
+ std::list<pft::FunctionLikeUnit> *funclist{nullptr};
+ /// evallist is a stack of pointer to FunctionLikeUnit::evals (or
+ /// Evaluation::subs) that are being build.
+ std::vector<pft::EvaluationCollection *> evallist;
+ std::vector<pft::ParentType> parents;
+};
+
+template <typename Label, typename A>
+constexpr bool hasLabel(const A &stmt) {
+ auto isLabel{
+ [](const auto &v) { return std::holds_alternative<Label>(v.u); }};
+ if constexpr (std::is_same_v<A, parser::ReadStmt> ||
+ std::is_same_v<A, parser::WriteStmt>) {
+ return std::any_of(std::begin(stmt.controls), std::end(stmt.controls),
+ isLabel);
+ }
+ if constexpr (std::is_same_v<A, parser::WaitStmt>) {
+ return std::any_of(std::begin(stmt.v), std::end(stmt.v), isLabel);
+ }
+ if constexpr (std::is_same_v<Label, parser::ErrLabel>) {
+ if constexpr (common::HasMember<
+ A, std::tuple<parser::OpenStmt, parser::CloseStmt,
+ parser::BackspaceStmt, parser::EndfileStmt,
+ parser::RewindStmt, parser::FlushStmt>>)
+ return std::any_of(std::begin(stmt.v), std::end(stmt.v), isLabel);
+ if constexpr (std::is_same_v<A, parser::InquireStmt>) {
+ const auto &specifiers{std::get<std::list<parser::InquireSpec>>(stmt.u)};
+ return std::any_of(std::begin(specifiers), std::end(specifiers), isLabel);
+ }
+ }
+ return false;
+}
+
+bool hasAltReturns(const parser::CallStmt &callStmt) {
+ const auto &args{std::get<std::list<parser::ActualArgSpec>>(callStmt.v.t)};
+ for (const auto &arg : args) {
+ const auto &actual{std::get<parser::ActualArg>(arg.t)};
+ if (std::holds_alternative<parser::AltReturnSpec>(actual.u))
+ return true;
+ }
+ return false;
+}
+
+/// Determine if `callStmt` has alternate returns and if so set `e` to be the
+/// origin of a switch-like control flow
+///
+/// \param cstr points to the current construct. It may be null at the top-level
+/// of a FunctionLikeUnit.
+void altRet(pft::Evaluation &evaluation, const parser::CallStmt &callStmt,
+ pft::Evaluation *cstr) {
+ if (hasAltReturns(callStmt))
+ evaluation.setCFG(pft::CFGAnnotation::Switch, cstr);
+}
+
+/// \param cstr points to the current construct. It may be null at the top-level
+/// of a FunctionLikeUnit.
+void annotateEvalListCFG(pft::EvaluationCollection &evaluationCollection,
+ pft::Evaluation *cstr) {
+ bool nextIsTarget = false;
+ for (auto &eval : evaluationCollection) {
+ eval.isTarget = nextIsTarget;
+ nextIsTarget = false;
+ if (auto *subs{eval.getConstructEvals()}) {
+ annotateEvalListCFG(*subs, &eval);
+ // assume that the entry and exit are both possible branch targets
+ nextIsTarget = true;
+ }
+
+ if (eval.isActionOrGenerated() && eval.lab.has_value())
+ eval.isTarget = true;
+ eval.visit(common::visitors{
+ [&](const parser::CallStmt &statement) {
+ altRet(eval, statement, cstr);
+ },
+ [&](const parser::CycleStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Goto, cstr);
+ },
+ [&](const parser::ExitStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Goto, cstr);
+ },
+ [&](const parser::FailImageStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Terminate, cstr);
+ },
+ [&](const parser::GotoStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Goto, cstr);
+ },
+ [&](const parser::IfStmt &) {
+ eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+ },
+ [&](const parser::ReturnStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Return, cstr);
+ },
+ [&](const parser::StopStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Terminate, cstr);
+ },
+ [&](const parser::ArithmeticIfStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+ },
+ [&](const parser::AssignedGotoStmt &) {
+ eval.setCFG(pft::CFGAnnotation::IndGoto, cstr);
+ },
+ [&](const parser::ComputedGotoStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+ },
+ [&](const parser::WhereStmt &) {
+ // fir.loop + fir.where around the next stmt
+ eval.isTarget = true;
+ eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+ },
+ [&](const parser::ForallStmt &) {
+ // fir.loop around the next stmt
+ eval.isTarget = true;
+ eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+ },
+ [&](pft::CGJump &) { eval.setCFG(pft::CFGAnnotation::Goto, cstr); },
+ [&](const parser::SelectCaseStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+ },
+ [&](const parser::NonLabelDoStmt &) {
+ eval.isTarget = true;
+ eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+ },
+ [&](const parser::EndDoStmt &) {
+ eval.isTarget = true;
+ eval.setCFG(pft::CFGAnnotation::Goto, cstr);
+ },
+ [&](const parser::IfThenStmt &) {
+ eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+ },
+ [&](const parser::ElseIfStmt &) {
+ eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+ },
+ [&](const parser::SelectRankStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+ },
+ [&](const parser::SelectTypeStmt &) {
+ eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+ },
+ [&](const parser::WhereConstruct &) {
+ // mark the WHERE as if it were a DO loop
+ eval.isTarget = true;
+ eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+ },
+ [&](const parser::WhereConstructStmt &) {
+ eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+ },
+ [&](const parser::MaskedElsewhereStmt &) {
+ eval.isTarget = true;
+ eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+ },
+ [&](const parser::ForallConstructStmt &) {
+ eval.isTarget = true;
+ eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+ },
+
+ [&](const auto &stmt) {
+ // Handle statements with similar impact on control flow
+ using IoStmts = std::tuple<parser::BackspaceStmt, parser::CloseStmt,
+ parser::EndfileStmt, parser::FlushStmt,
+ parser::InquireStmt, parser::OpenStmt,
+ parser::ReadStmt, parser::RewindStmt,
+ parser::WaitStmt, parser::WriteStmt>;
+
+ using TargetStmts =
+ std::tuple<parser::EndAssociateStmt, parser::EndBlockStmt,
+ parser::CaseStmt, parser::EndSelectStmt,
+ parser::EndChangeTeamStmt, parser::EndCriticalStmt,
+ parser::ElseStmt, parser::EndIfStmt,
+ parser::SelectRankCaseStmt, parser::TypeGuardStmt,
+ parser::ElsewhereStmt, parser::EndWhereStmt,
+ parser::EndForallStmt>;
+
+ using DoNothingConstructStmts =
+ std::tuple<parser::BlockStmt, parser::AssociateStmt,
+ parser::CriticalStmt, parser::ChangeTeamStmt>;
+
+ using A = std::decay_t<decltype(stmt)>;
+ if constexpr (common::HasMember<A, IoStmts>) {
+ if (hasLabel<parser::ErrLabel>(stmt) ||
+ hasLabel<parser::EorLabel>(stmt) ||
+ hasLabel<parser::EndLabel>(stmt))
+ eval.setCFG(pft::CFGAnnotation::IoSwitch, cstr);
+ } else if constexpr (common::HasMember<A, TargetStmts>) {
+ eval.isTarget = true;
+ } else if constexpr (common::HasMember<A, DoNothingConstructStmts>) {
+ // Explicitly do nothing for these construct statements
+ } else {
+ static_assert(!pft::isConstructStmt<A>,
+ "All ConstructStmts impact on the control flow "
+ "should be explicitly handled");
+ }
+ /* else do nothing */
+ },
+ });
+ }
+}
+
+/// Annotate the PFT with CFG source decorations (see CFGAnnotation) and mark
+/// potential branch targets
+inline void annotateFuncCFG(pft::FunctionLikeUnit &functionLikeUnit) {
+ annotateEvalListCFG(functionLikeUnit.evals, nullptr);
+ for (auto &internalFunc : functionLikeUnit.funcs)
+ annotateFuncCFG(internalFunc);
+}
+
+class PFTDumper {
+public:
+ void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft) {
+ for (auto &unit : pft.getUnits()) {
+ std::visit(common::visitors{
+ [&](pft::BlockDataUnit &unit) {
+ outputStream << getNodeIndex(unit) << " ";
+ outputStream << "BlockData: ";
+ outputStream << "\nEndBlockData\n\n";
+ },
+ [&](pft::FunctionLikeUnit &func) {
+ dumpFunctionLikeUnit(outputStream, func);
+ },
+ [&](pft::ModuleLikeUnit &unit) {
+ dumpModuleLikeUnit(outputStream, unit);
+ },
+ },
+ unit);
+ }
+ resetIndexes();
+ }
+
+ llvm::StringRef evalName(pft::Evaluation &eval) {
+ return eval.visit(common::visitors{
+ [](const pft::CGJump) { return "CGJump"; },
+ [](const auto &parseTreeNode) {
+ return parser::ParseTreeDumper::GetNodeName(parseTreeNode);
+ },
+ });
+ }
+
+ void dumpEvalList(llvm::raw_ostream &outputStream,
+ pft::EvaluationCollection &evaluationCollection,
+ int indent = 1) {
+ static const std::string white{" ++"};
+ std::string indentString{white.substr(0, indent * 2)};
+ for (pft::Evaluation &eval : evaluationCollection) {
+ outputStream << indentString << getNodeIndex(eval) << " ";
+ llvm::StringRef name{evalName(eval)};
+ if (auto *subs{eval.getConstructEvals()}) {
+ outputStream << "<<" << name << ">>";
+ outputStream << "\n";
+ dumpEvalList(outputStream, *subs, indent + 1);
+ outputStream << indentString << "<<End" << name << ">>\n";
+ } else {
+ outputStream << name;
+ outputStream << ": " << eval.pos.ToString() + "\n";
+ }
+ }
+ }
+
+ void dumpFunctionLikeUnit(llvm::raw_ostream &outputStream,
+ pft::FunctionLikeUnit &functionLikeUnit) {
+ outputStream << getNodeIndex(functionLikeUnit) << " ";
+ llvm::StringRef unitKind{};
+ std::string name{};
+ std::string header{};
+ if (functionLikeUnit.beginStmt) {
+ std::visit(
+ common::visitors{
+ [&](const parser::Statement<parser::ProgramStmt> *statement) {
+ unitKind = "Program";
+ name = statement->statement.v.ToString();
+ },
+ [&](const parser::Statement<parser::FunctionStmt> *statement) {
+ unitKind = "Function";
+ name =
+ std::get<parser::Name>(statement->statement.t).ToString();
+ header = statement->source.ToString();
+ },
+ [&](const parser::Statement<parser::SubroutineStmt> *statement) {
+ unitKind = "Subroutine";
+ name =
+ std::get<parser::Name>(statement->statement.t).ToString();
+ header = statement->source.ToString();
+ },
+ [&](const parser::Statement<parser::MpSubprogramStmt>
+ *statement) {
+ unitKind = "MpSubprogram";
+ name = statement->statement.v.ToString();
+ header = statement->source.ToString();
+ },
+ [&](auto *) {},
+ },
+ *functionLikeUnit.beginStmt);
+ } else {
+ unitKind = "Program";
+ name = "<anonymous>";
+ }
+ outputStream << unitKind << ' ' << name;
+ if (header.size())
+ outputStream << ": " << header;
+ outputStream << '\n';
+ dumpEvalList(outputStream, functionLikeUnit.evals);
+ if (!functionLikeUnit.funcs.empty()) {
+ outputStream << "\nContains\n";
+ for (auto &func : functionLikeUnit.funcs)
+ dumpFunctionLikeUnit(outputStream, func);
+ outputStream << "EndContains\n";
+ }
+ outputStream << "End" << unitKind << ' ' << name << "\n\n";
+ }
+
+ void dumpModuleLikeUnit(llvm::raw_ostream &outputStream,
+ pft::ModuleLikeUnit &moduleLikeUnit) {
+ outputStream << getNodeIndex(moduleLikeUnit) << " ";
+ outputStream << "ModuleLike: ";
+ outputStream << "\nContains\n";
+ for (auto &func : moduleLikeUnit.funcs)
+ dumpFunctionLikeUnit(outputStream, func);
+ outputStream << "EndContains\nEndModuleLike\n\n";
+ }
+
+ template <typename T>
+ std::size_t getNodeIndex(const T &node) {
+ auto addr{static_cast<const void *>(&node)};
+ auto it{nodeIndexes.find(addr)};
+ if (it != nodeIndexes.end()) {
+ return it->second;
+ }
+ nodeIndexes.try_emplace(addr, nextIndex);
+ return nextIndex++;
+ }
+ std::size_t getNodeIndex(const pft::Program &) { return 0; }
+
+ void resetIndexes() {
+ nodeIndexes.clear();
+ nextIndex = 1;
+ }
+
+private:
+ llvm::DenseMap<const void *, std::size_t> nodeIndexes;
+ std::size_t nextIndex{1}; // 0 is the root
+};
+
+template <typename A, typename T>
+pft::FunctionLikeUnit::FunctionStatement getFunctionStmt(const T &func) {
+ return pft::FunctionLikeUnit::FunctionStatement{
+ &std::get<parser::Statement<A>>(func.t)};
+}
+template <typename A, typename T>
+pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) {
+ return pft::ModuleLikeUnit::ModuleStatement{
+ &std::get<parser::Statement<A>>(mod.t)};
+}
+
+} // namespace
+
+pft::FunctionLikeUnit::FunctionLikeUnit(const parser::MainProgram &func,
+ const pft::ParentType &parent)
+ : ProgramUnit{func, parent} {
+ auto &ps{
+ std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t)};
+ if (ps.has_value()) {
+ const parser::Statement<parser::ProgramStmt> &statement{ps.value()};
+ beginStmt = &statement;
+ }
+ endStmt = getFunctionStmt<parser::EndProgramStmt>(func);
+}
+
+pft::FunctionLikeUnit::FunctionLikeUnit(const parser::FunctionSubprogram &func,
+ const pft::ParentType &parent)
+ : ProgramUnit{func, parent},
+ beginStmt{getFunctionStmt<parser::FunctionStmt>(func)},
+ endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)} {}
+
+pft::FunctionLikeUnit::FunctionLikeUnit(
+ const parser::SubroutineSubprogram &func, const pft::ParentType &parent)
+ : ProgramUnit{func, parent},
+ beginStmt{getFunctionStmt<parser::SubroutineStmt>(func)},
+ endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)} {}
+
+pft::FunctionLikeUnit::FunctionLikeUnit(
+ const parser::SeparateModuleSubprogram &func, const pft::ParentType &parent)
+ : ProgramUnit{func, parent},
+ beginStmt{getFunctionStmt<parser::MpSubprogramStmt>(func)},
+ endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)} {}
+
+pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Module &m,
+ const pft::ParentType &parent)
+ : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::ModuleStmt>(m)},
+ endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {}
+
+pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Submodule &m,
+ const pft::ParentType &parent)
+ : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::SubmoduleStmt>(
+ m)},
+ endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {}
+
+pft::BlockDataUnit::BlockDataUnit(const parser::BlockData &bd,
+ const pft::ParentType &parent)
+ : ProgramUnit{bd, parent} {}
+
+std::unique_ptr<pft::Program> createPFT(const parser::Program &root) {
+ PFTBuilder walker;
+ Walk(root, walker);
+ return walker.result();
+}
+
+void annotateControl(pft::Program &pft) {
+ for (auto &unit : pft.getUnits()) {
+ std::visit(common::visitors{
+ [](pft::BlockDataUnit &) {},
+ [](pft::FunctionLikeUnit &func) { annotateFuncCFG(func); },
+ [](pft::ModuleLikeUnit &unit) {
+ for (auto &func : unit.funcs)
+ annotateFuncCFG(func);
+ },
+ },
+ unit);
+ }
+}
+
+/// Dump a PFT.
+void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft) {
+ PFTDumper{}.dumpPFT(outputStream, pft);
+}
+
+} // namespace Fortran::lower
# Test runner infrastructure for Flang. This configures the Flang test trees
# for use by Lit, and delegates to LLVM's lit test handlers.
+set(FLANG_INTRINSIC_MODULES_DIR ${FLANG_BINARY_DIR}/tools/f18/include)
+
configure_lit_site_cfg(
${CMAKE_CURRENT_SOURCE_DIR}/lit.site.cfg.py.in
${CMAKE_CURRENT_BINARY_DIR}/lit.site.cfg.py
# to search to ensure that we get the tools just built and not some random
# tools that might happen to be in the user's PATH.
tool_dirs = [config.llvm_tools_dir, config.flang_tools_dir]
+flang_includes = "-I" + config.flang_intrinsic_modules_dir
tools = [ToolSubst('%flang', command=FindTool('flang'), unresolved='fatal'),
- ToolSubst('%f18', command=FindTool('f18'), unresolved='fatal')]
+ ToolSubst('%f18', command=FindTool('f18'), unresolved='fatal'),
+ ToolSubst('%f18_with_includes', command=FindTool('f18'),
+ extra_args=[flang_includes], unresolved='fatal')]
llvm_config.add_tool_substitutions(tools, tool_dirs)
config.flang_obj_root = "@FLANG_BINARY_DIR@"
config.flang_src_dir = "@FLANG_SOURCE_DIR@"
config.flang_tools_dir = "@FLANG_TOOLS_DIR@"
+config.flang_intrinsic_modules_dir = "@FLANG_INTRINSIC_MODULES_DIR@"
config.python_executable = "@PYTHON_EXECUTABLE@"
# Support substitution of the tools_dir with user parameters. This is
--- /dev/null
+! RUN: %f18 -fdebug-pre-fir-tree -fparse-only %s | FileCheck %s
+
+! Test structure of the Pre-FIR tree
+
+! CHECK: Subroutine foo
+subroutine foo()
+ ! CHECK: <<DoConstruct>>
+ ! CHECK: NonLabelDoStmt
+ do i=1,5
+ ! CHECK: PrintStmt
+ print *, "hey"
+ ! CHECK: <<DoConstruct>>
+ ! CHECK: NonLabelDoStmt
+ do j=1,5
+ ! CHECK: PrintStmt
+ print *, "hello", i, j
+ ! CHECK: EndDoStmt
+ end do
+ ! CHECK: <<EndDoConstruct>>
+ ! CHECK: EndDoStmt
+ end do
+ ! CHECK: <<EndDoConstruct>>
+end subroutine
+! CHECK: EndSubroutine foo
+
+! CHECK: BlockData
+block data
+ integer, parameter :: n = 100
+ integer, dimension(n) :: a, b, c
+ common /arrays/ a, b, c
+end
+! CHECK: EndBlockData
+
+! CHECK: ModuleLike
+module test_mod
+interface
+ ! check specification parts are not part of the PFT.
+ ! CHECK-NOT: node
+ module subroutine dump()
+ end subroutine
+end interface
+ integer :: xdim
+ real, allocatable :: pressure(:)
+contains
+ ! CHECK: Subroutine foo
+ subroutine foo()
+ contains
+ ! CHECK: Subroutine subfoo
+ subroutine subfoo()
+ end subroutine
+ ! CHECK: EndSubroutine subfoo
+ ! CHECK: Function subfoo2
+ function subfoo2()
+ end function
+ ! CHECK: EndFunction subfoo2
+ end subroutine
+ ! CHECK: EndSubroutine foo
+
+ ! CHECK: Function foo2
+ function foo2(i, j)
+ integer i, j, foo2
+ ! CHECK: AssignmentStmt
+ foo2 = i + j
+ contains
+ ! CHECK: Subroutine subfoo
+ subroutine subfoo()
+ end subroutine
+ ! CHECK: EndSubroutine subfoo
+ end function
+ ! CHECK: EndFunction foo2
+end module
+! CHECK: EndModuleLike
+
+! CHECK: ModuleLike
+submodule (test_mod) test_mod_impl
+contains
+ ! CHECK: Subroutine foo
+ subroutine foo()
+ contains
+ ! CHECK: Subroutine subfoo
+ subroutine subfoo()
+ end subroutine
+ ! CHECK: EndSubroutine subfoo
+ ! CHECK: Function subfoo2
+ function subfoo2()
+ end function
+ ! CHECK: EndFunction subfoo2
+ end subroutine
+ ! CHECK: EndSubroutine foo
+ ! CHECK: MpSubprogram dump
+ module procedure dump
+ ! CHECK: FormatStmt
+11 format (2E16.4, I6)
+ ! CHECK: <<IfConstruct>>
+ ! CHECK: IfThenStmt
+ if (xdim > 100) then
+ ! CHECK: PrintStmt
+ print *, "test: ", xdim
+ ! CHECK: ElseStmt
+ else
+ ! CHECK: WriteStmt
+ write (*, 11) "test: ", xdim, pressure
+ ! CHECK: EndIfStmt
+ end if
+ ! CHECK: <<EndIfConstruct>>
+ end procedure
+end submodule
+! CHECK: EndModuleLike
+
+! CHECK: BlockData
+block data named_block
+ integer i, j, k
+ common /indexes/ i, j, k
+end
+! CHECK: EndBlockData
+
+! CHECK: Function bar
+function bar()
+end function
+! CHECK: EndFunction bar
+
+! CHECK: Program <anonymous>
+ ! check specification parts are not part of the PFT.
+ ! CHECK-NOT: node
+ use test_mod
+ real, allocatable :: x(:)
+ ! CHECK: AllocateStmt
+ allocate(x(foo2(10, 30)))
+end
+! CHECK: EndProgram
--- /dev/null
+! RUN: %f18 -fdebug-pre-fir-tree -fparse-only %s | FileCheck %s
+
+! Test Pre-FIR Tree captures all the intended nodes from the parse-tree
+! Coarray and OpenMP related nodes are tested in other files.
+
+! CHECK: Program test_prog
+program test_prog
+ ! Check specification part is not part of the tree.
+ interface
+ subroutine incr(i)
+ integer, intent(inout) :: i
+ end subroutine
+ end interface
+ integer :: i, j, k
+ real, allocatable, target :: x(:)
+ real :: y(100)
+ ! CHECK-NOT: node
+ ! CHECK: <<DoConstruct>>
+ ! CHECK: NonLabelDoStmt
+ do i=1,5
+ ! CHECK: PrintStmt
+ print *, "hey"
+ ! CHECK: <<DoConstruct>>
+ ! CHECK: NonLabelDoStmt
+ do j=1,5
+ ! CHECK: PrintStmt
+ print *, "hello", i, j
+ ! CHECK: EndDoStmt
+ end do
+ ! CHECK: <<EndDoConstruct>>
+ ! CHECK: EndDoStmt
+ end do
+ ! CHECK: <<EndDoConstruct>>
+
+ ! CHECK: <<AssociateConstruct>>
+ ! CHECK: AssociateStmt
+ associate (k => i + j)
+ ! CHECK: AllocateStmt
+ allocate(x(k))
+ ! CHECK: EndAssociateStmt
+ end associate
+ ! CHECK: <<EndAssociateConstruct>>
+
+ ! CHECK: <<BlockConstruct>>
+ ! CHECK: BlockStmt
+ block
+ integer :: k, l
+ real, pointer :: p(:)
+ ! CHECK: PointerAssignmentStmt
+ p => x
+ ! CHECK: AssignmentStmt
+ k = size(p)
+ ! CHECK: AssignmentStmt
+ l = 1
+ ! CHECK: <<CaseConstruct>>
+ ! CHECK: SelectCaseStmt
+ select case (k)
+ ! CHECK: CaseStmt
+ case (:0)
+ ! CHECK: NullifyStmt
+ nullify(p)
+ ! CHECK: CaseStmt
+ case (1)
+ ! CHECK: <<IfConstruct>>
+ ! CHECK: IfThenStmt
+ if (p(1)>0.) then
+ ! CHECK: PrintStmt
+ print *, "+"
+ ! CHECK: ElseIfStmt
+ else if (p(1)==0.) then
+ ! CHECK: PrintStmt
+ print *, "0."
+ ! CHECK: ElseStmt
+ else
+ ! CHECK: PrintStmt
+ print *, "-"
+ ! CHECK: EndIfStmt
+ end if
+ ! CHECK: <<EndIfConstruct>>
+ ! CHECK: CaseStmt
+ case (2:10)
+ ! CHECK: CaseStmt
+ case default
+ ! Note: label-do-loop are canonicalized into do constructs
+ ! CHECK: <<DoConstruct>>
+ ! CHECK: NonLabelDoStmt
+ do 22 while(l<=k)
+ ! CHECK: IfStmt
+ if (p(l)<0.) p(l)=cos(p(l))
+ ! CHECK: CallStmt
+22 call incr(l)
+ ! CHECK: EndDoStmt
+ ! CHECK: <<EndDoConstruct>>
+ ! CHECK: CaseStmt
+ case (100:)
+ ! CHECK: EndSelectStmt
+ end select
+ ! CHECK: <<EndCaseConstruct>>
+ ! CHECK: EndBlockStmt
+ end block
+ ! CHECK: <<EndBlockConstruct>>
+
+ ! CHECK-NOT: WhereConstruct
+ ! CHECK: WhereStmt
+ where (x > 1.) x = x/2.
+
+ ! CHECK: <<WhereConstruct>>
+ ! CHECK: WhereConstructStmt
+ where (x == 0.)
+ ! CHECK: AssignmentStmt
+ x = 0.01
+ ! CHECK: MaskedElsewhereStmt
+ elsewhere (x < 0.5)
+ ! CHECK: AssignmentStmt
+ x = x*2.
+ ! CHECK: <<WhereConstruct>>
+ where (y > 0.4)
+ ! CHECK: AssignmentStmt
+ y = y/2.
+ end where
+ ! CHECK: <<EndWhereConstruct>>
+ ! CHECK: ElsewhereStmt
+ elsewhere
+ ! CHECK: AssignmentStmt
+ x = x + 1.
+ ! CHECK: EndWhereStmt
+ end where
+ ! CHECK: <<EndWhereConstruct>>
+
+ ! CHECK-NOT: ForAllConstruct
+ ! CHECK: ForallStmt
+ forall (i = 1:5) x(i) = y(i)
+
+ ! CHECK: <<ForallConstruct>>
+ ! CHECK: ForallConstructStmt
+ forall (i = 1:5)
+ ! CHECK: AssignmentStmt
+ x(i) = x(i) + y(10*i)
+ ! CHECK: EndForallStmt
+ end forall
+ ! CHECK: <<EndForallConstruct>>
+
+ ! CHECK: DeallocateStmt
+ deallocate(x)
+end
+
+! CHECK: ModuleLike
+module test
+ type :: a_type
+ integer :: x
+ end type
+ type, extends(a_type) :: b_type
+ integer :: y
+ end type
+contains
+ ! CHECK: Function foo
+ function foo(x)
+ real x(..)
+ integer :: foo
+ ! CHECK: <<SelectRankConstruct>>
+ ! CHECK: SelectRankStmt
+ select rank(x)
+ ! CHECK: SelectRankCaseStmt
+ rank (0)
+ ! CHECK: AssignmentStmt
+ foo = 0
+ ! CHECK: SelectRankCaseStmt
+ rank (*)
+ ! CHECK: AssignmentStmt
+ foo = -1
+ ! CHECK: SelectRankCaseStmt
+ rank (1)
+ ! CHECK: AssignmentStmt
+ foo = 1
+ ! CHECK: SelectRankCaseStmt
+ rank default
+ ! CHECK: AssignmentStmt
+ foo = 2
+ ! CHECK: EndSelectStmt
+ end select
+ ! CHECK: <<EndSelectRankConstruct>>
+ end function
+
+ ! CHECK: Function bar
+ function bar(x)
+ class(*) :: x
+ ! CHECK: <<SelectTypeConstruct>>
+ ! CHECK: SelectTypeStmt
+ select type(x)
+ ! CHECK: TypeGuardStmt
+ type is (integer)
+ ! CHECK: AssignmentStmt
+ bar = 0
+ ! CHECK: TypeGuardStmt
+ class is (a_type)
+ ! CHECK: AssignmentStmt
+ bar = 1
+ ! CHECK: ReturnStmt
+ return
+ ! CHECK: TypeGuardStmt
+ class default
+ ! CHECK: AssignmentStmt
+ bar = -1
+ ! CHECK: EndSelectStmt
+ end select
+ ! CHECK: <<EndSelectTypeConstruct>>
+ end function
+
+ ! CHECK: Subroutine sub
+ subroutine sub(a)
+ real(4):: a
+ ! CompilerDirective
+ ! CHECK: <<CompilerDirective>>
+ !DIR$ IGNORE_TKR a
+ end subroutine
+
+
+end module
+
+! CHECK: Subroutine altreturn
+subroutine altreturn(i, j, *, *)
+ ! CHECK: <<IfConstruct>>
+ if (i>j) then
+ ! CHECK: ReturnStmt
+ return 1
+ else
+ ! CHECK: ReturnStmt
+ return 2
+ end if
+ ! CHECK: <<EndIfConstruct>>
+end subroutine
+
+
+! Remaining TODO
+
+! CHECK: Subroutine iostmts
+subroutine iostmts(filename, a, b, c)
+ character(*) :: filename
+ integer :: length
+ logical :: file_is_opened
+ real, a, b ,c
+ ! CHECK: InquireStmt
+ inquire(file=filename, opened=file_is_opened)
+ ! CHECK: <<IfConstruct>>
+ if (file_is_opened) then
+ ! CHECK: OpenStmt
+ open(10, FILE=filename)
+ end if
+ ! CHECK: <<EndIfConstruct>>
+ ! CHECK: ReadStmt
+ read(10, *) length
+ ! CHECK: RewindStmt
+ rewind 10
+ ! CHECK: NamelistStmt
+ namelist /nlist/ a, b, c
+ ! CHECK: WriteStmt
+ write(10, NML=nlist)
+ ! CHECK: BackspaceStmt
+ backspace(10)
+ ! CHECK: FormatStmt
+1 format (1PE12.4)
+ ! CHECK: WriteStmt
+ write (10, 1) a
+ ! CHECK: EndfileStmt
+ endfile 10
+ ! CHECK: FlushStmt
+ flush 10
+ ! CHECK: WaitStmt
+ wait(10)
+ ! CHECK: CloseStmt
+ close(10)
+end subroutine
+
+
+! CHECK: Subroutine sub2
+subroutine sub2()
+ integer :: i, j, k, l
+ i = 0
+1 j = i
+ ! CHECK: ContinueStmt
+2 continue
+ i = i+1
+3 j = j+1
+! CHECK: ArithmeticIfStmt
+ if (j-i) 3, 4, 5
+ ! CHECK: GotoStmt
+4 goto 6
+
+! FIXME: is name resolution on assigned goto broken/todo ?
+! WILLCHECK: AssignStmt
+!55 assign 6 to label
+! WILLCHECK: AssignedGotoStmt
+!66 go to label (5, 6)
+
+! CHECK: ComputedGotoStmt
+ go to (5, 6), 1 + mod(i, 2)
+5 j = j + 1
+6 i = i + j/2
+
+ ! CHECK: <<DoConstruct>>
+ do1: do k=1,10
+ ! CHECK: <<DoConstruct>>
+ do2: do l=5,20
+ ! CHECK: CycleStmt
+ cycle do1
+ ! CHECK: ExitStmt
+ exit do2
+ end do do2
+ ! CHECK: <<EndDoConstruct>>
+ end do do1
+ ! CHECK: <<EndDoConstruct>>
+
+ ! CHECK: PauseStmt
+ pause 7
+ ! CHECK: StopStmt
+ stop
+end subroutine
+
+
+! CHECK: Subroutine sub3
+subroutine sub3()
+ print *, "normal"
+ ! CHECK: EntryStmt
+ entry sub4entry()
+ print *, "test"
+end subroutine
+
+! CHECK: Subroutine sub4
+subroutine sub4(i, j)
+ integer :: i
+ print*, "test"
+ ! CHECK: DataStmt
+ data i /1/
+end subroutine
--- /dev/null
+! RUN: %f18 -fdebug-pre-fir-tree -fparse-only -fopenmp %s | FileCheck %s
+
+! Test Pre-FIR Tree captures OpenMP related constructs
+
+! CHECK: Program test_omp
+program test_omp
+ ! CHECK: PrintStmt
+ print *, "sequential"
+
+ ! CHECK: <<OpenMPConstruct>>
+ !$omp parallel
+ ! CHECK: PrintStmt
+ print *, "in omp //"
+ ! CHECK: <<OpenMPConstruct>>
+ !$omp do
+ ! CHECK: <<DoConstruct>>
+ ! CHECK: LabelDoStmt
+ do i=1,100
+ ! CHECK: PrintStmt
+ print *, "in omp do"
+ ! CHECK: EndDoStmt
+ end do
+ ! CHECK: <<EndDoConstruct>>
+ ! CHECK: OmpEndLoopDirective
+ !$omp end do
+ ! CHECK: <<EndOpenMPConstruct>>
+
+ ! CHECK: PrintStmt
+ print *, "not in omp do"
+
+ ! CHECK: <<OpenMPConstruct>>
+ !$omp do
+ ! CHECK: <<DoConstruct>>
+ ! CHECK: LabelDoStmt
+ do i=1,100
+ ! CHECK: PrintStmt
+ print *, "in omp do"
+ ! CHECK: EndDoStmt
+ end do
+ ! CHECK: <<EndDoConstruct>>
+ ! CHECK: <<EndOpenMPConstruct>>
+ ! CHECK-NOT: OmpEndLoopDirective
+ ! CHECK: PrintStmt
+ print *, "no in omp do"
+ !$omp end parallel
+ ! CHECK: <<EndOpenMPConstruct>>
+
+ ! CHECK: PrintStmt
+ print *, "sequential again"
+
+ ! CHECK: <<OpenMPConstruct>>
+ !$omp task
+ ! CHECK: PrintStmt
+ print *, "in task"
+ !$omp end task
+ ! CHECK: <<EndOpenMPConstruct>>
+
+ ! CHECK: PrintStmt
+ print *, "sequential again"
+end program
--- /dev/null
+! RUN: %f18_with_includes -fdebug-pre-fir-tree -fparse-only %s | FileCheck %s
+
+! Test Pre-FIR Tree captures all the coarray related statements
+
+! CHECK: Subroutine test_coarray
+Subroutine test_coarray
+ use iso_fortran_env, only: team_type, event_type, lock_type
+ type(team_type) :: t
+ type(event_type) :: done
+ type(lock_type) :: alock
+ real :: y[10,*]
+ integer :: counter[*]
+ logical :: is_master
+ ! CHECK: <<ChangeTeamConstruct>>
+ change team(t, x[5,*] => y)
+ ! CHECK: AssignmentStmt
+ x = x[4, 1]
+ end team
+ ! CHECK: <<EndChangeTeamConstruct>>
+ ! CHECK: FormTeamStmt
+ form team(1, t)
+
+ ! CHECK: <<IfConstruct>>
+ if (this_image() == 1) then
+ ! CHECK: EventPostStmt
+ event post (done)
+ else
+ ! CHECK: EventWaitStmt
+ event wait (done)
+ end if
+ ! CHECK: <<EndIfConstruct>>
+
+ ! CHECK: <<CriticalConstruct>>
+ critical
+ ! CHECK: AssignmentStmt
+ counter[1] = counter[1] + 1
+ end critical
+ ! CHECK: <<EndCriticalConstruct>>
+
+ ! CHECK: LockStmt
+ lock(alock)
+ ! CHECK: PrintStmt
+ print *, "I have the lock"
+ ! CHECK: UnlockStmt
+ unlock(alock)
+
+ ! CHECK: SyncAllStmt
+ sync all
+ ! CHECK: SyncMemoryStmt
+ sync memory
+ ! CHECK: SyncTeamStmt
+ sync team(t)
+
+ ! CHECK: <<IfConstruct>>
+ if (this_image() == 1) then
+ ! CHECK: SyncImagesStmt
+ sync images(*)
+ else
+ ! CHECK: SyncImagesStmt
+ sync images(1)
+ end if
+ ! CHECK: <<EndIfConstruct>>
+
+ ! CHECK: <<IfConstruct>>
+ if (y<0.) then
+ ! CHECK: FailImageStmt
+ fail image
+ end if
+ ! CHECK: <<EndIfConstruct>>
+end
FortranParser
FortranEvaluate
FortranSemantics
+ LLVMSupport
+ FortranLower
)
add_executable(f18-parse-demo
#include "flang/common/Fortran-features.h"
#include "flang/common/default-kinds.h"
#include "flang/evaluate/expression.h"
+#include "flang/lower/PFTBuilder.h"
#include "flang/parser/characters.h"
#include "flang/parser/dump-parse-tree.h"
#include "flang/parser/message.h"
#include "flang/semantics/expression.h"
#include "flang/semantics/semantics.h"
#include "flang/semantics/unparse-with-symbols.h"
+#include "llvm/Support/raw_ostream.h"
#include <cerrno>
#include <cstdio>
#include <cstring>
bool dumpUnparse{false};
bool dumpUnparseWithSymbols{false};
bool dumpParseTree{false};
+ bool dumpPreFirTree{false};
bool dumpSymbols{false};
bool debugResolveNames{false};
bool debugNoSemantics{false};
nullptr /* action before each statement */, &asFortran);
return {};
}
+ if (driver.dumpPreFirTree) {
+ if (auto ast{Fortran::lower::createPFT(parseTree)}) {
+ Fortran::lower::annotateControl(*ast);
+ Fortran::lower::dumpPFT(llvm::outs(), *ast);
+ } else {
+ std::cerr << "Pre FIR Tree is NULL.\n";
+ exitStatus = EXIT_FAILURE;
+ }
+ }
if (driver.parseOnly) {
return {};
}
options.needProvenanceRangeToCharBlockMappings = true;
} else if (arg == "-fdebug-dump-parse-tree") {
driver.dumpParseTree = true;
+ } else if (arg == "-fdebug-pre-fir-tree") {
+ driver.dumpPreFirTree = true;
} else if (arg == "-fdebug-dump-symbols") {
driver.dumpSymbols = true;
} else if (arg == "-fdebug-resolve-names") {