From: Jean Perier Date: Tue, 28 Jan 2020 12:58:30 +0000 (-0800) Subject: [flang] Add Pre-FIR Tree structure to help lowering the parse-tree X-Git-Tag: llvmorg-12-init~9537^2~137 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=336408679535454f8708899cc49cda9395dd725a;p=platform%2Fupstream%2Fllvm.git [flang] Add Pre-FIR Tree structure to help lowering the parse-tree The Pre-FIR Tree structure is a transient data structure that is meant to be built from the parse tree just before lowering to FIR and that will be deleted just afterwards. It is not meant to perfrom optimization analysis and transformations. It only provides temporary information, such as label target information or parse tree parent nodes, that is meant to be used to lower the parse tree structure into FIR operations. A PFTBuilder class builds the Pre-Fir Tree from the parse-tree. A pretty printer is available to visualize this data structure. - Lit tests are added to: 1. that the PFT tree structure is as expected 2. that the PFT captures all intented nodes - Cmake changes: Prevent warnings inisde LLVM headers when compiling flang The issue is that some LLVM headers define functions where the usage of the parameters depend on environment ifdef. See for instance Size in: https://github.com/llvm/llvm-project/blob/5f940220bf9438e95ffa4a627ac1591be1e1ba6e/llvm/include/llvm/Support/Compiler.h#L574 Because flang is build with -Werror and -Wunused-parameter is default in clang, this may breaks build in some environments (like with clang9 on macos). A solution would be to add -Wno-unused-parameter to flang CmakLists.txt, but it is wished to keep this warning on flang sources for quality purposes. Fixing LLVM headers is not an easy task and `[[maybe_unused]]` is C++17 and cannot be used yet in LLVM headers. Hence, this fix simply silence warnings coming from LLVM headers by telling CMake they are to be considered as if they were system headers. - drone.io changes: remove llvm 6.0 from clang config in drone.io and link flang with libstdc++ instead of libc++ llvm-dev resolved to llvm-6.0 in clang builds on drone.io. llvm 6.0 too old. LLVM packages are linked with libstdc++ standard library whereas libc++ was used for flang. This caused link time failure when building clang. Change frone.io to build flang with libc++. Note: This commit does not reflect an actual work log, it is a feature based split of the changes done in the FIR experimental branch. The related work log can be found in the commits between: 864898cbe509d032abfe1172ec367dbd3dd92bc1 and 137c23da9c64cf90584cf81fd646053a69e91f63 Other changes come from https://github.com/flang-compiler/f18/pull/959 review. Original-commit: flang-compiler/f18@edb0943bca4b81689f320bda341040bf255d6e2e Reviewed-on: https://github.com/flang-compiler/f18/pull/959 --- diff --git a/flang/.drone.star b/flang/.drone.star index 5911a5b..47dfca7 100644 --- a/flang/.drone.star +++ b/flang/.drone.star @@ -7,9 +7,9 @@ def clang(arch): "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", ], diff --git a/flang/CMakeLists.txt b/flang/CMakeLists.txt index 999fd1f..2b7a823 100644 --- a/flang/CMakeLists.txt +++ b/flang/CMakeLists.txt @@ -70,7 +70,14 @@ include(AddLLVM) # 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 diff --git a/flang/include/flang/lower/PFTBuilder.h b/flang/include/flang/lower/PFTBuilder.h new file mode 100644 index 0000000..0b1345e --- /dev/null +++ b/flang/include/flang/lower/PFTBuilder.h @@ -0,0 +1,394 @@ +//===-- 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 + +/// 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 not 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; + +struct ParentType { + template + ParentType(A &parent) : p{&parent} {} + const std::variant + 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; + +using Constructs = + std::tuple; + +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 +constexpr static bool isActionStmt{common::HasMember}; + +template +constexpr static bool isConstruct{common::HasMember}; + +template +constexpr static bool isConstructStmt{common::HasMember}; + +template +constexpr static bool isOtherStmt{common::HasMember}; + +template +constexpr static bool isGenerated{std::is_same_v}; + +template +constexpr static bool isFunctionLike{common::HasMember< + A, std::tuple>}; + +/// 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; + + /// Hide non-nullable pointers to the parse-tree node. + template + using MakeRefType = const A *const; + using EvalVariant = + common::CombineVariants, + std::variant>; + template + constexpr auto visit(A visitor) const { + return std::visit(common::visitors{ + [&](const auto *p) { return visitor(*p); }, + [&](auto &r) { return visitor(r); }, + }, + u); + } + template + constexpr const A *getIf() const { + if constexpr (!std::is_same_v) { + if (auto *ptr{std::get_if>(&u)}) { + return *ptr; + } + } else { + return std::get_if(&u); + } + return nullptr; + } + template + constexpr bool isA() const { + if constexpr (!std::is_same_v) { + return std::holds_alternative>(u); + } + return std::holds_alternative(u); + } + + Evaluation() = delete; + Evaluation(const Evaluation &) = delete; + Evaluation(Evaluation &&) = default; + + /// General ctor + template + Evaluation(const A &a, const ParentType &p, const parser::CharBlock &pos, + const std::optional &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 + Evaluation(const A &a, const ParentType &parent) : u{&a}, parent{parent} { + static_assert(pft::isConstruct, "must be a construct"); + } + + constexpr bool isActionOrGenerated() const { + return visit(common::visitors{ + [](auto &r) { + using T = std::decay_t; + return isActionStmt || isGenerated; + }, + }); + } + + constexpr bool isStmt() const { + return visit(common::visitors{ + [](auto &r) { + using T = std::decay_t; + static constexpr bool isStmt{isActionStmt || isOtherStmt || + isConstructStmt}; + static_assert(!(isStmt && pft::isConstruct), + "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 lab; + std::unique_ptr 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 + 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 *, + const parser::Statement *, + const parser::Statement *, + const parser::Statement *, + const parser::Statement *, + const parser::Statement *, + const parser::Statement *>; + + 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 *>(endStmt); + } + const parser::FunctionStmt *getFunction() { + return getA(); + } + const parser::SubroutineStmt *getSubroutine() { + return getA(); + } + const parser::MpSubprogramStmt *getMPSubp() { + return getA(); + } + + /// Anonymous programs do not have a begin statement + std::optional beginStmt; + FunctionStatement endStmt; + EvaluationCollection evals; // statements + std::list funcs; // internal procedures + +private: + template + const A *getA() { + if (beginStmt) { + if (auto p = + std::get_if *>(&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 *, + const parser::Statement *, + const parser::Statement *>; + + 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 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; + + Program() = default; + Program(Program &&) = default; + Program(const Program &) = delete; + + std::list &getUnits() { return units; } + +private: + std::list units; +}; + +} // namespace pft + +/// Create an PFT from the parse tree +std::unique_ptr 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_ diff --git a/flang/include/flang/parser/dump-parse-tree.h b/flang/include/flang/parser/dump-parse-tree.h index aca1813..a618183 100644 --- a/flang/include/flang/parser/dump-parse-tree.h +++ b/flang/include/flang/parser/dump-parse-tree.h @@ -40,11 +40,11 @@ public: 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) diff --git a/flang/lib/CMakeLists.txt b/flang/lib/CMakeLists.txt index 343195ba..35c3e13 100644 --- a/flang/lib/CMakeLists.txt +++ b/flang/lib/CMakeLists.txt @@ -9,5 +9,6 @@ add_subdirectory(common) add_subdirectory(evaluate) add_subdirectory(decimal) +add_subdirectory(lower) add_subdirectory(parser) add_subdirectory(semantics) diff --git a/flang/lib/lower/CMakeLists.txt b/flang/lib/lower/CMakeLists.txt new file mode 100644 index 0000000..87131cd --- /dev/null +++ b/flang/lib/lower/CMakeLists.txt @@ -0,0 +1,13 @@ +add_library(FortranLower + PFTBuilder.cpp +) + +target_link_libraries(FortranLower + LLVMSupport +) + +install (TARGETS FortranLower + ARCHIVE DESTINATION lib + LIBRARY DESTINATION lib + RUNTIME DESTINATION bin +) diff --git a/flang/lib/lower/PFTBuilder.cpp b/flang/lib/lower/PFTBuilder.cpp new file mode 100644 index 0000000..d7998e2 --- /dev/null +++ b/flang/lib/lower/PFTBuilder.cpp @@ -0,0 +1,697 @@ +//===-- 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 +#include +#include + +namespace Fortran::lower { +namespace { + +/// Helpers to unveil parser node inside parser::Statement<>, +/// parser::UnlabeledStatement, and common::Indirection<> +template +struct RemoveIndirectionHelper { + using Type = A; + static constexpr const Type &unwrap(const A &a) { return a; } +}; +template +struct RemoveIndirectionHelper> { + using Type = A; + static constexpr const Type &unwrap(const common::Indirection &a) { + return a.value(); + } +}; + +template +const auto &removeIndirection(const A &a) { + return RemoveIndirectionHelper::unwrap(a); +} + +template +struct UnwrapStmt { + static constexpr bool isStmt{false}; +}; +template +struct UnwrapStmt> { + static constexpr bool isStmt{true}; + using Type = typename RemoveIndirectionHelper::Type; + constexpr UnwrapStmt(const parser::Statement &a) + : unwrapped{removeIndirection(a.statement)}, pos{a.source}, lab{a.label} { + } + const Type &unwrapped; + parser::CharBlock pos; + std::optional lab; +}; +template +struct UnwrapStmt> { + static constexpr bool isStmt{true}; + using Type = typename RemoveIndirectionHelper::Type; + constexpr UnwrapStmt(const parser::UnlabeledStatement &a) + : unwrapped{removeIndirection(a.statement)}, pos{a.source} {} + const Type &unwrapped; + parser::CharBlock pos; + std::optional 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 result() { return std::move(pgm); } + + template + constexpr bool Pre(const A &a) { + bool visit{true}; + if constexpr (pft::isFunctionLike) { + return enterFunc(a); + } else if constexpr (pft::isConstruct) { + return enterConstruct(a); + } else if constexpr (UnwrapStmt::isStmt) { + using T = typename UnwrapStmt::Type; + // Node "a" being visited has one of the following types: + // Statement, Statement, UnlabeledStatement, + // or UnlabeledStatement> + auto stmt{UnwrapStmt(a)}; + if constexpr (pft::isConstructStmt || pft::isOtherStmt) { + addEval(pft::Evaluation{stmt.unwrapped, parents.back(), stmt.pos, + stmt.lab}); + visit = false; + } else if constexpr (std::is_same_v) { + addEval(makeEvalAction(stmt.unwrapped, stmt.pos, stmt.lab)); + visit = false; + } + } + return visit; + } + + template + constexpr void Post(const A &) { + if constexpr (pft::isFunctionLike) { + exitFunc(); + } else if constexpr (pft::isConstruct) { + 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 + &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 &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 &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 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 + 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 + 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 + 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 + A &addUnit(A &&unit) { + pgm->getUnits().emplace_back(std::move(unit)); + return std::get(pgm->getUnits().back()); + } + + template + 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 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 *funclist{nullptr}; + /// evallist is a stack of pointer to FunctionLikeUnit::evals (or + /// Evaluation::subs) that are being build. + std::vector evallist; + std::vector parents; +}; + +template +constexpr bool hasLabel(const A &stmt) { + auto isLabel{ + [](const auto &v) { return std::holds_alternative, + "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 << "<>\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 *statement) { + unitKind = "Program"; + name = statement->statement.v.ToString(); + }, + [&](const parser::Statement *statement) { + unitKind = "Function"; + name = + std::get(statement->statement.t).ToString(); + header = statement->source.ToString(); + }, + [&](const parser::Statement *statement) { + unitKind = "Subroutine"; + name = + std::get(statement->statement.t).ToString(); + header = statement->source.ToString(); + }, + [&](const parser::Statement + *statement) { + unitKind = "MpSubprogram"; + name = statement->statement.v.ToString(); + header = statement->source.ToString(); + }, + [&](auto *) {}, + }, + *functionLikeUnit.beginStmt); + } else { + unitKind = "Program"; + name = ""; + } + 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 + std::size_t getNodeIndex(const T &node) { + auto addr{static_cast(&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 nodeIndexes; + std::size_t nextIndex{1}; // 0 is the root +}; + +template +pft::FunctionLikeUnit::FunctionStatement getFunctionStmt(const T &func) { + return pft::FunctionLikeUnit::FunctionStatement{ + &std::get>(func.t)}; +} +template +pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) { + return pft::ModuleLikeUnit::ModuleStatement{ + &std::get>(mod.t)}; +} + +} // namespace + +pft::FunctionLikeUnit::FunctionLikeUnit(const parser::MainProgram &func, + const pft::ParentType &parent) + : ProgramUnit{func, parent} { + auto &ps{ + std::get>>(func.t)}; + if (ps.has_value()) { + const parser::Statement &statement{ps.value()}; + beginStmt = &statement; + } + endStmt = getFunctionStmt(func); +} + +pft::FunctionLikeUnit::FunctionLikeUnit(const parser::FunctionSubprogram &func, + const pft::ParentType &parent) + : ProgramUnit{func, parent}, + beginStmt{getFunctionStmt(func)}, + endStmt{getFunctionStmt(func)} {} + +pft::FunctionLikeUnit::FunctionLikeUnit( + const parser::SubroutineSubprogram &func, const pft::ParentType &parent) + : ProgramUnit{func, parent}, + beginStmt{getFunctionStmt(func)}, + endStmt{getFunctionStmt(func)} {} + +pft::FunctionLikeUnit::FunctionLikeUnit( + const parser::SeparateModuleSubprogram &func, const pft::ParentType &parent) + : ProgramUnit{func, parent}, + beginStmt{getFunctionStmt(func)}, + endStmt{getFunctionStmt(func)} {} + +pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Module &m, + const pft::ParentType &parent) + : ProgramUnit{m, parent}, beginStmt{getModuleStmt(m)}, + endStmt{getModuleStmt(m)} {} + +pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Submodule &m, + const pft::ParentType &parent) + : ProgramUnit{m, parent}, beginStmt{getModuleStmt( + m)}, + endStmt{getModuleStmt(m)} {} + +pft::BlockDataUnit::BlockDataUnit(const parser::BlockData &bd, + const pft::ParentType &parent) + : ProgramUnit{bd, parent} {} + +std::unique_ptr 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 diff --git a/flang/test-lit/CMakeLists.txt b/flang/test-lit/CMakeLists.txt index 0819e57..1118143 100644 --- a/flang/test-lit/CMakeLists.txt +++ b/flang/test-lit/CMakeLists.txt @@ -1,6 +1,8 @@ # 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 diff --git a/flang/test-lit/lit.cfg.py b/flang/test-lit/lit.cfg.py index c27e6a6..3ca3c8a 100644 --- a/flang/test-lit/lit.cfg.py +++ b/flang/test-lit/lit.cfg.py @@ -61,9 +61,12 @@ llvm_config.with_environment('PATH', config.llvm_tools_dir, append_path=True) # 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) diff --git a/flang/test-lit/lit.site.cfg.py.in b/flang/test-lit/lit.site.cfg.py.in index ad31bf1..d00f385 100644 --- a/flang/test-lit/lit.site.cfg.py.in +++ b/flang/test-lit/lit.site.cfg.py.in @@ -6,6 +6,7 @@ config.llvm_tools_dir = "@LLVM_TOOLS_DIR@" 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 diff --git a/flang/test-lit/lower/pre-fir-tree01.f90 b/flang/test-lit/lower/pre-fir-tree01.f90 new file mode 100644 index 0000000..97f15ee --- /dev/null +++ b/flang/test-lit/lower/pre-fir-tree01.f90 @@ -0,0 +1,130 @@ +! RUN: %f18 -fdebug-pre-fir-tree -fparse-only %s | FileCheck %s + +! Test structure of the Pre-FIR tree + +! CHECK: Subroutine foo +subroutine foo() + ! CHECK: <> + ! CHECK: NonLabelDoStmt + do i=1,5 + ! CHECK: PrintStmt + print *, "hey" + ! CHECK: <> + ! CHECK: NonLabelDoStmt + do j=1,5 + ! CHECK: PrintStmt + print *, "hello", i, j + ! CHECK: EndDoStmt + end do + ! CHECK: <> + ! CHECK: EndDoStmt + end do + ! CHECK: <> +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: <> + ! 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: <> + 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 + ! 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 diff --git a/flang/test-lit/lower/pre-fir-tree02.f90 b/flang/test-lit/lower/pre-fir-tree02.f90 new file mode 100644 index 0000000..ec9077a --- /dev/null +++ b/flang/test-lit/lower/pre-fir-tree02.f90 @@ -0,0 +1,334 @@ +! 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: <> + ! CHECK: NonLabelDoStmt + do i=1,5 + ! CHECK: PrintStmt + print *, "hey" + ! CHECK: <> + ! CHECK: NonLabelDoStmt + do j=1,5 + ! CHECK: PrintStmt + print *, "hello", i, j + ! CHECK: EndDoStmt + end do + ! CHECK: <> + ! CHECK: EndDoStmt + end do + ! CHECK: <> + + ! CHECK: <> + ! CHECK: AssociateStmt + associate (k => i + j) + ! CHECK: AllocateStmt + allocate(x(k)) + ! CHECK: EndAssociateStmt + end associate + ! CHECK: <> + + ! CHECK: <> + ! CHECK: BlockStmt + block + integer :: k, l + real, pointer :: p(:) + ! CHECK: PointerAssignmentStmt + p => x + ! CHECK: AssignmentStmt + k = size(p) + ! CHECK: AssignmentStmt + l = 1 + ! CHECK: <> + ! CHECK: SelectCaseStmt + select case (k) + ! CHECK: CaseStmt + case (:0) + ! CHECK: NullifyStmt + nullify(p) + ! CHECK: CaseStmt + case (1) + ! CHECK: <> + ! 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: <> + ! CHECK: CaseStmt + case (2:10) + ! CHECK: CaseStmt + case default + ! Note: label-do-loop are canonicalized into do constructs + ! CHECK: <> + ! 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: <> + ! CHECK: CaseStmt + case (100:) + ! CHECK: EndSelectStmt + end select + ! CHECK: <> + ! CHECK: EndBlockStmt + end block + ! CHECK: <> + + ! CHECK-NOT: WhereConstruct + ! CHECK: WhereStmt + where (x > 1.) x = x/2. + + ! CHECK: <> + ! CHECK: WhereConstructStmt + where (x == 0.) + ! CHECK: AssignmentStmt + x = 0.01 + ! CHECK: MaskedElsewhereStmt + elsewhere (x < 0.5) + ! CHECK: AssignmentStmt + x = x*2. + ! CHECK: <> + where (y > 0.4) + ! CHECK: AssignmentStmt + y = y/2. + end where + ! CHECK: <> + ! CHECK: ElsewhereStmt + elsewhere + ! CHECK: AssignmentStmt + x = x + 1. + ! CHECK: EndWhereStmt + end where + ! CHECK: <> + + ! CHECK-NOT: ForAllConstruct + ! CHECK: ForallStmt + forall (i = 1:5) x(i) = y(i) + + ! CHECK: <> + ! CHECK: ForallConstructStmt + forall (i = 1:5) + ! CHECK: AssignmentStmt + x(i) = x(i) + y(10*i) + ! CHECK: EndForallStmt + end forall + ! CHECK: <> + + ! 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: <> + ! 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: <> + end function + + ! CHECK: Function bar + function bar(x) + class(*) :: x + ! CHECK: <> + ! 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: <> + end function + + ! CHECK: Subroutine sub + subroutine sub(a) + real(4):: a + ! CompilerDirective + ! CHECK: <> + !DIR$ IGNORE_TKR a + end subroutine + + +end module + +! CHECK: Subroutine altreturn +subroutine altreturn(i, j, *, *) + ! CHECK: <> + if (i>j) then + ! CHECK: ReturnStmt + return 1 + else + ! CHECK: ReturnStmt + return 2 + end if + ! CHECK: <> +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: <> + if (file_is_opened) then + ! CHECK: OpenStmt + open(10, FILE=filename) + end if + ! CHECK: <> + ! 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: <> + do1: do k=1,10 + ! CHECK: <> + do2: do l=5,20 + ! CHECK: CycleStmt + cycle do1 + ! CHECK: ExitStmt + exit do2 + end do do2 + ! CHECK: <> + end do do1 + ! CHECK: <> + + ! 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 diff --git a/flang/test-lit/lower/pre-fir-tree03.f90 b/flang/test-lit/lower/pre-fir-tree03.f90 new file mode 100644 index 0000000..2eedfe7 --- /dev/null +++ b/flang/test-lit/lower/pre-fir-tree03.f90 @@ -0,0 +1,60 @@ +! 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: <> + !$omp parallel + ! CHECK: PrintStmt + print *, "in omp //" + ! CHECK: <> + !$omp do + ! CHECK: <> + ! CHECK: LabelDoStmt + do i=1,100 + ! CHECK: PrintStmt + print *, "in omp do" + ! CHECK: EndDoStmt + end do + ! CHECK: <> + ! CHECK: OmpEndLoopDirective + !$omp end do + ! CHECK: <> + + ! CHECK: PrintStmt + print *, "not in omp do" + + ! CHECK: <> + !$omp do + ! CHECK: <> + ! CHECK: LabelDoStmt + do i=1,100 + ! CHECK: PrintStmt + print *, "in omp do" + ! CHECK: EndDoStmt + end do + ! CHECK: <> + ! CHECK: <> + ! CHECK-NOT: OmpEndLoopDirective + ! CHECK: PrintStmt + print *, "no in omp do" + !$omp end parallel + ! CHECK: <> + + ! CHECK: PrintStmt + print *, "sequential again" + + ! CHECK: <> + !$omp task + ! CHECK: PrintStmt + print *, "in task" + !$omp end task + ! CHECK: <> + + ! CHECK: PrintStmt + print *, "sequential again" +end program diff --git a/flang/test-lit/lower/pre-fir-tree04.f90 b/flang/test-lit/lower/pre-fir-tree04.f90 new file mode 100644 index 0000000..3e8516e5 --- /dev/null +++ b/flang/test-lit/lower/pre-fir-tree04.f90 @@ -0,0 +1,70 @@ +! 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: <> + change team(t, x[5,*] => y) + ! CHECK: AssignmentStmt + x = x[4, 1] + end team + ! CHECK: <> + ! CHECK: FormTeamStmt + form team(1, t) + + ! CHECK: <> + if (this_image() == 1) then + ! CHECK: EventPostStmt + event post (done) + else + ! CHECK: EventWaitStmt + event wait (done) + end if + ! CHECK: <> + + ! CHECK: <> + critical + ! CHECK: AssignmentStmt + counter[1] = counter[1] + 1 + end critical + ! CHECK: <> + + ! 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: <> + if (this_image() == 1) then + ! CHECK: SyncImagesStmt + sync images(*) + else + ! CHECK: SyncImagesStmt + sync images(1) + end if + ! CHECK: <> + + ! CHECK: <> + if (y<0.) then + ! CHECK: FailImageStmt + fail image + end if + ! CHECK: <> +end diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index 676549c..79f5c52 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -18,6 +18,8 @@ target_link_libraries(f18 FortranParser FortranEvaluate FortranSemantics + LLVMSupport + FortranLower ) add_executable(f18-parse-demo diff --git a/flang/tools/f18/f18.cpp b/flang/tools/f18/f18.cpp index 56f008b..b54d1a9 100644 --- a/flang/tools/f18/f18.cpp +++ b/flang/tools/f18/f18.cpp @@ -11,6 +11,7 @@ #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" @@ -22,6 +23,7 @@ #include "flang/semantics/expression.h" #include "flang/semantics/semantics.h" #include "flang/semantics/unparse-with-symbols.h" +#include "llvm/Support/raw_ostream.h" #include #include #include @@ -92,6 +94,7 @@ struct DriverOptions { bool dumpUnparse{false}; bool dumpUnparseWithSymbols{false}; bool dumpParseTree{false}; + bool dumpPreFirTree{false}; bool dumpSymbols{false}; bool debugResolveNames{false}; bool debugNoSemantics{false}; @@ -308,6 +311,15 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options, 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 {}; } @@ -475,6 +487,8 @@ int main(int argc, char *const argv[]) { 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") {