diff --git a/.gitignore b/.gitignore index 70151b97..f0f18e4c 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,6 @@ cmake-build*/ spack.yaml spack.lock .spack-env/ + +cgfcollector/test/multi/cmake_base.txt +cgfcollector/test/multi/make_base diff --git a/CMakeLists.txt b/CMakeLists.txt index cf535882..523567b0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -213,3 +213,15 @@ if(METACG_BUILD_PYMETACG) endif() add_subdirectory(utils) + +# Build fortran collector +option( + METACG_BUILD_CGFCOLLECTOR + "On or off" + OFF +) + +if(METACG_BUILD_CGFCOLLECTOR) + include(FlangLLVM) + add_subdirectory(cgfcollector) +endif() diff --git a/cgfcollector/CMakeLists.txt b/cgfcollector/CMakeLists.txt new file mode 100644 index 00000000..5e54cd99 --- /dev/null +++ b/cgfcollector/CMakeLists.txt @@ -0,0 +1,129 @@ +set(PROJECT_NAME cgfcollector) +set(TARGETS_EXPORT_NAME ${PROJECT_NAME}-target) + +file( + GLOB + CGFCOLLECTOR_SOURCES + src/*.cpp +) + +add_library(${PROJECT_NAME} SHARED ${CGFCOLLECTOR_SOURCES}) +add_flang(${PROJECT_NAME}) +add_metacg(${PROJECT_NAME}) +add_spdlog_libraries(${PROJECT_NAME}) + +target_include_directories(${PROJECT_NAME} PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/include) + +install( + TARGETS ${PROJECT_NAME} + EXPORT ${TARGETS_EXPORT_NAME} + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib +) + +configure_package_config_file( + ${METACG_Directory}/cmake/Config.cmake.in ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}Config.cmake + INSTALL_DESTINATION lib/cmake +) + +install(FILES ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}Config.cmake DESTINATION lib/cmake) + +# visuel program to generate dot file from graph +add_executable(${PROJECT_NAME}-visuel ${CMAKE_CURRENT_SOURCE_DIR}/tools/visuel.cpp) +add_metacg(${PROJECT_NAME}-visuel) +add_spdlog_libraries(${PROJECT_NAME}-visuel) +install( + TARGETS ${PROJECT_NAME}-visuel + LIBRARY DESTINATION bin + ARCHIVE DESTINATION bin +) + +# generate wrapper scripts + +function( + configure_file_and_install + TEMPLATE + OUTPUT_BASENAME + DESTINATION +) + set(BUILD_OUTPUT "${CMAKE_CURRENT_BINARY_DIR}/${OUTPUT_BASENAME}") + set(INSTALL_OUTPUT "${CMAKE_CURRENT_BINARY_DIR}/${OUTPUT_BASENAME}.install") + + # build-time values for development + set(CGFCOLLECTOR_FILE_NAME "${CMAKE_CURRENT_BINARY_DIR}/lib${PROJECT_NAME}.so") + set(CGFCOLLECTOR_CGDIFF "${CMAKE_BINARY_DIR}/tools/cgdiff/cgdiff") + set(CGFCOLLECTOR_WRAPPER "${CMAKE_CURRENT_BINARY_DIR}/cgfcollector_wrapper.sh") + set(CGFCOLLECTOR_TEST_CASES_DIR "${CMAKE_CURRENT_SOURCE_DIR}/test") + set(CGMERGE2_EXECUTABLE "${CMAKE_BINARY_DIR}/tools/cgmerge2/cgmerge2") + + configure_file( + "${TEMPLATE}" + "${BUILD_OUTPUT}" + @ONLY + ) + + if(DESTINATION + STREQUAL + "" + ) + return() + endif() + + # install-time values + set(CGFCOLLECTOR_FILE_NAME "${CMAKE_INSTALL_PREFIX}/lib/lib${PROJECT_NAME}.so") + + configure_file( + "${TEMPLATE}" + "${INSTALL_OUTPUT}" + @ONLY + ) + + install( + PROGRAMS "${INSTALL_OUTPUT}" + DESTINATION "${DESTINATION}" + RENAME "${OUTPUT_BASENAME}" + ) +endfunction() + +configure_file_and_install( + "${CMAKE_CURRENT_SOURCE_DIR}/tools/cgfcollector_wrapper.sh.in" + "cgfcollector_wrapper.sh" + "bin" +) + +configure_file_and_install( + "${CMAKE_CURRENT_SOURCE_DIR}/tools/cgfcollector_comp_wrapper.sh.in" + "cgfcollector_comp_wrapper.sh" + "bin" +) + +configure_file_and_install( + "${CMAKE_CURRENT_SOURCE_DIR}/tools/test_runner.sh.in" + "test_runner.sh" + "" +) + +configure_file_and_install( + "${CMAKE_CURRENT_SOURCE_DIR}/test/multi/cmake_base.txt.in" + "cmake_base.txt" + "" +) +file( + RENAME + "${CMAKE_CURRENT_BINARY_DIR}/cmake_base.txt" + "${CMAKE_CURRENT_SOURCE_DIR}/test/multi/cmake_base.txt" +) + +configure_file_and_install( + "${CMAKE_CURRENT_SOURCE_DIR}/test/multi/make_base.in" + "make_base" + "" +) +file( + RENAME + "${CMAKE_CURRENT_BINARY_DIR}/make_base" + "${CMAKE_CURRENT_SOURCE_DIR}/test/multi/make_base" +) + +# tests +add_test(NAME cgfcollector_tests COMMAND ${CMAKE_CURRENT_BINARY_DIR}/test_runner.sh) diff --git a/cgfcollector/README.md b/cgfcollector/README.md new file mode 100644 index 00000000..0506eff3 --- /dev/null +++ b/cgfcollector/README.md @@ -0,0 +1,87 @@ +# CG Fortran collector + +Fortran call graph generation tool for MetaCG. This tool is implemented as a +Flang plugin and generates a call graph from source-level. + +## Usage + +For single file projects or projects not using modules use: + +```sh +cgfcollector_wrapper.sh +``` + +For any other projects you need a build system. For this we provide another +script that acts as the normal Flang compiler but also produces a call graph. +[More info below](#generate-a-call-graph). + +```sh +cgfcollector_comp_wrapper.sh +``` + +You can also run the plugin directly with Flang: + +```sh +flang -fc1 -load "libcgfcollector.so" -plugin "genCG" +``` + +There are three kinds of plugins: + +- `genCG`: generates a call graph in the MetaCG json format. +- `genCGwithDot`: like `genCG` but also generate a `.dot` file. Mostly used for debugging. +- `genCGNoRename`: like `genCG` but does not rename the output file. + +Additionally these other tools are included: + +- `cgfcollector_wrapper.sh`: convenience wrapper to run parse plugin. +- `cgfcollector_comp_wrapper.sh`: acts like a normal Flang compiler but also generates a call graph. +- `test_runner.sh`: run tests. + +## How to build + +To build the cgfcollector the option `METACG_BUILD_CGFCOLLECTOR` must be set to +`ON`. + +## Generate a call graph + +### from a CMake project + +Paste this into your CMakeLists.txt. + +``` +set(CMAKE_Fortran_COMPILER ) +set(CMAKE_Fortran_FLAGS "") +set(CMAKE_Fortran_COMPILE_OBJECT " -dot -o ") +set(CMAKE_Fortran_LINK_EXECUTABLE " ") +set(CMAKE_EXECUTABLE_SUFFIX .json) +``` + +This will hook into the CMake build process and generate a call graph instead of +an executable. + +An example can be found in `test/multi/deps`. + +### from other projects + +Use `cgfcollector_comp_wrapper.sh` or `cgfcollector_wrapper.sh` to hook into the +build process of your favorite tool and use the `cgmerge2` utility to merge the +partial generated call graphs. + +An example can be found in `test/multi/fortdepend_deps`. This example uses +fortdepend to generate a module dependency list. If your build system already +generates such a list and executes the compiler on the files in the correct order +you probably don't need this. + +## Running test + +run `test_runner.sh` + +NOTE: The test `test/multi/fortdepend_deps` has a dependency on [fortdepend](https://fortdepend.readthedocs.io/en/latest/) + +## Debugging + +### print parse tree + +```sh +flang-new -fc1 -fdebug-dump-parse-tree file.f90 +``` diff --git a/cgfcollector/include/Edge.h b/cgfcollector/include/Edge.h new file mode 100644 index 00000000..1ef03242 --- /dev/null +++ b/cgfcollector/include/Edge.h @@ -0,0 +1,74 @@ +/** + * File: Edge.h + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#pragma once + +#include "FortranUtil.h" +#include "Type.h" + +#include +#include +#include +#include +#include + +struct Edge { + std::string caller; + std::string callee; + + Edge(std::string caller, std::string callee) : caller(std::move(caller)), callee(std::move(callee)) {} + + bool operator==(const Edge& other) const { return caller == other.caller && callee == other.callee; } + bool operator<(const Edge& other) const { + return caller < other.caller || (caller == other.caller && callee < other.callee); + } +}; + +struct EdgeSymbol { + const Fortran::semantics::Symbol* caller; + const Fortran::semantics::Symbol* callee; + + EdgeSymbol(const Fortran::semantics::Symbol* caller, const Fortran::semantics::Symbol* callee) + : caller(caller), callee(callee) {} + + bool operator==(const EdgeSymbol& other) const { return caller == other.caller && callee == other.callee; } + bool operator<(const EdgeSymbol& other) const { + return caller < other.caller || (caller == other.caller && callee < other.callee); + } +}; + +struct EdgeManager { + std::vector& edges; + + EdgeManager(std::vector& edges) : edges(edges) {} + + void addEdge(const EdgeSymbol& e, bool debug = true); + void addEdge(const Fortran::semantics::Symbol* caller, const Fortran::semantics::Symbol* callee, bool debug = true); + void addEdge(const Edge& e, bool debug = true); + void addEdge(const std::string& caller, const std::string& callee, bool debug = true); + void addEdges(const std::vector& newEdges, bool debug = true); + void addEdges(const std::vector& newEdges, bool debug = true); + + /** + * @brief For a given symbol, returns a list of edges from the current function to all finalizers of that type. + * + * @param types + * @param currentFunctionSymbol + * @param symbol + */ + std::vector getEdgesForFinalizers(const std::vector& types, + const Fortran::semantics::Symbol* currentFunctionSymbol, + const Fortran::semantics::Symbol* symbol); + /** + * @brief Calls getEdgesForFinalizers and adds them to the edges vector. + * + * @param types + * @param currentFunctionSymbol + * @param symbol + */ + void addEdgesForFinalizers(const std::vector& types, const Fortran::semantics::Symbol* currentFunctionSymbol, + const Fortran::semantics::Symbol* symbol); +}; diff --git a/cgfcollector/include/FortranUtil.h b/cgfcollector/include/FortranUtil.h new file mode 100644 index 00000000..035d516c --- /dev/null +++ b/cgfcollector/include/FortranUtil.h @@ -0,0 +1,143 @@ +/** + * File: FortranUtil.h + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#pragma once + +#include "Type.h" + +#include +#include +#include +#include +#include +#include + +/** + * @brief Formatter for CharBlock + */ +template <> +struct fmt::formatter { + constexpr auto parse(fmt::format_parse_context& ctx) { return ctx.begin(); } + + template + auto format(const Fortran::parser::CharBlock& cb, FormatContext& ctx) const { + return fmt::format_to(ctx.out(), "{}", std::string_view(cb.begin(), cb.size())); + } +}; + +/** + * @brief Variant check if it holds any of the given types + * + * @tparam Variant + * @tparam Ts + * @param v + * @return + */ +template +bool holds_any_of(const Variant& v) { + return (std::holds_alternative(v) || ...); +} + +/** + * @brief Get Name from type that has a designator + * + * @tparam T + * @param t + * @return + */ +template +const Fortran::parser::Name* getNameFromClassWithDesignator(const T& t) { + if (const Fortran::common::Indirection* designator = + std::get_if>(&t.u)) { + if (const Fortran::parser::DataRef* dataRef = std::get_if(&designator->value().u)) { + if (const Fortran::parser::Name* name = std::get_if(&dataRef->u)) { + return name; + } + } + } + return nullptr; +} + +/** + * @brief Compares two symbols for equality also resolves the original construct the symbol comes from. + * This could have been defined in another module/file + * + * @param a + * @param b + * @return true if both symbols are equal + */ +bool compareSymbols(const Fortran::semantics::Symbol* a, const Fortran::semantics::Symbol* b); + +/** + * @brief Generate mangled name from symbol + * + * @param sym + * @return + */ +std::string mangleSymbol(const Fortran::semantics::Symbol* sym); + +/** + * @brief Check if expression is an operator expression + * + * @param e + * @return + */ +bool isOperator(const Fortran::parser::Expr* e); + +/** + * @brief Compare if expression match given intrinsic operator + * + * @param expr + * @param op + * @return + */ +bool compareExprIntrinsicOperator(const Fortran::parser::Expr* expr, + Fortran::parser::DefinedOperator::IntrinsicOperator op); + +/** + * @brief Check if binary operator expression + * + * @param e + * @return + */ +bool isBinaryOperator(const Fortran::parser::Expr* e); + +/** + * @brief Check if unary operator expression + * + * @param e + * @return + */ +bool isUnaryOperator(const Fortran::parser::Expr* e); + +/** + * @brief Get intrinsic operator from a variant of several operator types (RelationalOperator, LogicalOperator, + * NumericOperator) + * + * @tparam Variant + * @param op + * @return + */ +Fortran::parser::DefinedOperator::IntrinsicOperator variantGetIntrinsicOperator( + const Fortran::semantics::GenericKind& gk); + +/** + * @brief Get type symbol from a given symbol + * + * @param symbol + * @return + */ +const Fortran::semantics::Symbol* getTypeSymbolFromSymbol(const Fortran::semantics::Symbol* symbol); + +/** + * @brief Searches the types vector for given symbol and returns pointers to vectors of type with derived types. The + * type symbol is derived from the given symbol. + * + * @param typeSymbol symbol to search for + * @return vector with type and all derived types + */ +std::vector findTypeWithDerivedTypes(const std::vector& types, + const Fortran::semantics::Symbol* symbol); diff --git a/cgfcollector/include/Function.h b/cgfcollector/include/Function.h new file mode 100644 index 00000000..5e9d8cd7 --- /dev/null +++ b/cgfcollector/include/Function.h @@ -0,0 +1,29 @@ +/** + * File: Function.h + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#pragma once + +#include +#include + +struct Function { + struct DummyArg { + const Fortran::semantics::Symbol* symbol; + bool hasBeenInitialized = false; + + explicit DummyArg(const Fortran::semantics::Symbol* sym) : symbol(sym) {} + explicit DummyArg(const Fortran::semantics::Symbol* sym, bool init) : symbol(sym), hasBeenInitialized(init) {} + }; + + const Fortran::semantics::Symbol* symbol; // function symbol + std::vector dummyArgs; + + explicit Function(const Fortran::semantics::Symbol* sym) : symbol(sym) {} + explicit Function(const Fortran::semantics::Symbol* sym, std::vector args) + : symbol(sym), dummyArgs(std::move(args)) {} + + void addDummyArg(const Fortran::semantics::Symbol* sym) { dummyArgs.emplace_back(sym); } +}; diff --git a/cgfcollector/include/ParseTreeVisitor.h b/cgfcollector/include/ParseTreeVisitor.h new file mode 100644 index 00000000..1403f83a --- /dev/null +++ b/cgfcollector/include/ParseTreeVisitor.h @@ -0,0 +1,252 @@ +/** + * File: ParseTreeVisitor.h + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#pragma once + +#include "Edge.h" +#include "FortranUtil.h" +#include "Function.h" +#include "PotentialFinalizer.h" +#include "Type.h" +#include "VariableTracking.h" + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/** + * @class ParseTreeVisitor + * @brief Implements visitor methods to traverse parse tree and generate callgraph + * + */ +class ParseTreeVisitor { + public: + ParseTreeVisitor(metacg::Callgraph* cg, std::string currentFileName) + : cg(cg), + currentFileName(currentFileName), + edgeM(std::make_unique(edges)), + varTracking(std::make_unique(trackedVars, types, functions)) {}; + + /** + * @brief Collects function/subroutine statements (begin) and their dummy args. + * + * @tparam T + * @param stmt + */ + template + void handleFuncSubStmt(const T& stmt); + + /** + * @brief Handles function/subroutine end statements. + */ + void handleEndFuncSubStmt(); + + /** + * @brief Searches with typeSymbol for a type in types vector and adds edges for procedures that matches + * procedureSymbol. And also adds edges from types that extends from typeSymbol. + * + * @param typeWithDerived + * @param procedureSymbol + */ + void addEdgesForProducesAndDerivedTypes(std::vector typeWithDerived, + const Fortran::semantics::Symbol* procedureSymbol); + + /** + * @brief Adds edges and potential finalizers edges to cg. + */ + void postProcess(); + + // visitor methods + + template + bool Pre(const A&) { + return true; + } + template + void Post(const A&) {} + + bool Pre(const Fortran::parser::MainProgram& p); + void Post(const Fortran::parser::MainProgram&); + + bool Pre(const Fortran::parser::FunctionSubprogram&); + void Post(const Fortran::parser::FunctionSubprogram&); + bool Pre(const Fortran::parser::SubroutineSubprogram&); + void Post(const Fortran::parser::SubroutineSubprogram&); + + /** + * @brief Set hasBody field. + * + * @param e + */ + void Post(const Fortran::parser::ExecutionPart& e); + + void Post(const Fortran::parser::EntryStmt& e); + + void Post(const Fortran::parser::FunctionStmt& f); + void Post(const Fortran::parser::EndFunctionStmt&); + void Post(const Fortran::parser::SubroutineStmt& s); + void Post(const Fortran::parser::EndSubroutineStmt&); + + /** + * @brief ProcedureDesignator: A procedure being called. Handles both cases a call with call statement and without. + * + * @param p + */ + void Post(const Fortran::parser::ProcedureDesignator& p); + + /** + * @brief Handle trackedVar assignment + * + * @param a + */ + void Post(const Fortran::parser::AssignmentStmt& a); + + /** + * @brief Handle trackedVar assignment through allocate statement. + * + * @param a + */ + void Post(const Fortran::parser::AllocateStmt& a); + + /** + * @brief Mostly add potential finalizers for variables that get initialized through procedure arguments. + * + * @param c + */ + void Post(const Fortran::parser::Call& c); + + /** + * @brief Mostly handles finalizers. Handles the different ways a variable can be parsed to a procedure and gets + * initialized. + * + * @param t + */ + void Post(const Fortran::parser::TypeDeclarationStmt& t); + + // The following methods are for collecting types and their procedures. See type struct and vector. + + /** + * @brief Type definition start + * + * @return + */ + bool Pre(const Fortran::parser::DerivedTypeDef&); + /** + * @brief Type definiiton end + */ + void Post(const Fortran::parser::DerivedTypeDef&); + + /** + * @brief Type stmt like type [, extends(...)] :: body (not exhaustive and not extends) + * + * @param t + * @return + */ + bool Pre(const Fortran::parser::DerivedTypeStmt& t); + + /** + * @brief Type attributes like extends + * + * @param a + */ + void Post(const Fortran::parser::TypeAttrSpec& a); + + /** + * @brief Collect type bound procedures in derived type definitions + * + * @param s + */ + void Post(const Fortran::parser::TypeBoundProcedureStmt& s); + + /** + * @brief Collect defined operators in type definition (operator overloading) + * + * @param s + */ + void Post(const Fortran::parser::TypeBoundGenericStmt& s); + + // The following methods are for collecting defined operators in interface statements + + bool Pre(const Fortran::parser::InterfaceStmt&); + bool Pre(const Fortran::parser::EndInterfaceStmt&); + void Post(const Fortran::parser::DefinedOperator& op); + void Post(const Fortran::parser::ProcedureStmt& p); + + /** + * @brief Parse operators in expressions + * + * @param e + * @return + */ + bool Pre(const Fortran::parser::Expr& e); + /** + * @brief Post cleanup parse operators in expressions + * + * @param e + */ + void Post(const Fortran::parser::Expr& e); + + /** + * @brief Extract additional information from use statements + * + * @param u + */ + void Post(const Fortran::parser::UseStmt& u); + + private: + metacg::Callgraph* cg; + std::string currentFileName; + std::unique_ptr edgeM; + std::unique_ptr varTracking; + + bool inFunctionOrSubroutineSubProgram = false; + bool inMainProgram = false; + bool inDerivedTypeDef = false; + bool inInterfaceStmt = false; + bool inInterfaceStmtDefinedOperator = false; + bool inInterfaceSpecification = false; + + // added to cg in postProcess step + std::vector edges; + + // all functions + std::vector functions; + + // intended as a stack. It holds the current function symbol and its dummy + // args when the AST walker is in the respective function. + std::vector currentFunctions; + + // all types + std::vector types; + + // all interface operators. First is either a symbol of a DefinedOpName or + // IntrinsicOperator. Second is a vector procedure symbols, bound to that operator. + std::vector< + std::pair, + std::vector>> + interfaceOperators; + + std::vector exprStmtWithOps; + + // mainly used for destructor handling + std::vector trackedVars; + + std::vector potentialFinalizers; +}; diff --git a/cgfcollector/include/PotentialFinalizer.h b/cgfcollector/include/PotentialFinalizer.h new file mode 100644 index 00000000..e3d6cf8b --- /dev/null +++ b/cgfcollector/include/PotentialFinalizer.h @@ -0,0 +1,23 @@ +/** + * File: PotentialFinalizer.h + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#pragma once + +#include "Edge.h" + +#include +#include + +struct PotentialFinalizer { + std::size_t argPos; + std::string procedureCalled; + std::vector finalizerEdges; + + explicit PotentialFinalizer(std::size_t pos, std::string procCalled) + : argPos(pos), procedureCalled(std::move(procCalled)) {} + + void addFinalizerEdge(const Edge& e) { finalizerEdges.emplace_back(e); } +}; diff --git a/cgfcollector/include/Type.h b/cgfcollector/include/Type.h new file mode 100644 index 00000000..ba90b8ef --- /dev/null +++ b/cgfcollector/include/Type.h @@ -0,0 +1,24 @@ +/** + * File: Type.h + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#pragma once + +#include +#include +#include +#include + +struct Type { + const Fortran::semantics::Symbol* typeSymbol; + const Fortran::semantics::Symbol* extendsFrom; + + // name(symbol) => optname(symbol) + std::vector> procedures; + + // operator => name(symbol) + std::vector> + operators; +}; diff --git a/cgfcollector/include/VariableTracking.h b/cgfcollector/include/VariableTracking.h new file mode 100644 index 00000000..3441bbea --- /dev/null +++ b/cgfcollector/include/VariableTracking.h @@ -0,0 +1,83 @@ +/** + * File: VariableTracking.h + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#pragma once + +#include "Edge.h" +#include "Function.h" +#include "Type.h" + +#include + +struct TrackedVar { + const Fortran::semantics::Symbol* var; + + // procedure in which var was defined + const Fortran::semantics::Symbol* procedure; + + bool hasBeenInitialized = false; + bool addFinalizers = false; + + TrackedVar(const Fortran::semantics::Symbol* var, const Fortran::semantics::Symbol* procedure) + : var(var), procedure(procedure), hasBeenInitialized(false), addFinalizers(false) {} + TrackedVar(const Fortran::semantics::Symbol* var, const Fortran::semantics::Symbol* procedure, bool initialized, + bool addFinalizers) + : var(var), procedure(procedure), hasBeenInitialized(initialized), addFinalizers(addFinalizers) {} +}; + +struct VariableTracking { + public: + VariableTracking(std::vector& trackedVars, std::vector& types, std::vector& functions) + : trackedVars(trackedVars), types(types), functions(functions) {} + + /** + * @brief Search trackedVars for a canditate by sourceName. Also taking the current function scope into account. + * + * @param currentFunctionSymbol + * @param sourceName + * @return trackedVar* or nullptr if not found + */ + TrackedVar* getTrackedVarFromSourceName(const Fortran::semantics::Symbol* currentFunctionSymbol, + Fortran::semantics::SourceName sourceName); + + /** + * @brief Search trackedVars for a canditate and set it as initialized. + * + * @param currentFunctionSymbol + * @param sourceName + */ + void handleTrackedVarAssignment(const Fortran::semantics::Symbol* currentFunctionSymbol, + Fortran::semantics::SourceName sourceName); + + /** + * @brief Is called at the end of a function/subroutine end statement. It checks trackedVars for any initialized + * variables and adds edges. Currently only adds finalizer edges. + * + * @param currentFunctionSymbol + * @param edgeM TODO: remove dep + */ + void handleTrackedVars(const Fortran::semantics::Symbol* currentFunctionSymbol, std::unique_ptr& edgeM); + + /** + * @brief Register a variable for tracking. + * + * @param var + */ + void addTrackedVar(TrackedVar var); + + /** + * @brief Remove all tracked variables that are not needed anymore after the function/subroutine end statement. Should + * be called at the end of function/subroutine processing. + * + * @param procedureSymbol + */ + void removeTrackedVars(const Fortran::semantics::Symbol* procedureSymbol); + + private: + std::vector& trackedVars; + std::vector& types; + std::vector& functions; +}; diff --git a/cgfcollector/src/Edge.cpp b/cgfcollector/src/Edge.cpp new file mode 100644 index 00000000..8ed29895 --- /dev/null +++ b/cgfcollector/src/Edge.cpp @@ -0,0 +1,84 @@ +/** + * File: Edge.cpp + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#include "Edge.h" + +using namespace Fortran::semantics; +using namespace Fortran::parser; +using namespace metacg; + +std::vector EdgeManager::getEdgesForFinalizers(const std::vector& types, + const Symbol* currentFunctionSymbol, const Symbol* symbol) { + std::vector edges; + + std::vector typePtrs = findTypeWithDerivedTypes(types, symbol); + + for (const Type* type : typePtrs) { + const Symbol* typeSymbol = type->typeSymbol; + + const DerivedTypeDetails* details = std::get_if(&typeSymbol->details()); + if (!details) + continue; + + // add edges for finalizers + for (const auto& final : details->finals()) { + edges.emplace_back(currentFunctionSymbol, &final.second.get()); + } + } + + return edges; +} + +void EdgeManager::addEdgesForFinalizers(const std::vector& types, const Symbol* currentFunctionSymbol, + const Symbol* symbol) { + for (const EdgeSymbol& edge : getEdgesForFinalizers(types, currentFunctionSymbol, symbol)) { + addEdge(edge, false); + MCGLogger::logDebug("Add edge for finalizer: {} ({}) -> {} ({})", mangleSymbol(edge.caller), fmt::ptr(edge.caller), + mangleSymbol(edge.callee), fmt::ptr(edge.callee)); + } +} + +void EdgeManager::addEdge(const EdgeSymbol& e, bool debug) { + edges.emplace_back(mangleSymbol(e.caller), mangleSymbol(e.callee)); + if (debug) { + MCGLogger::logDebug("Add edge: {} ({}) -> {} ({})", mangleSymbol(e.caller), fmt::ptr(e.caller), + mangleSymbol(e.callee), fmt::ptr(e.callee)); + } +} + +void EdgeManager::addEdge(const Symbol* caller, const Symbol* callee, bool debug) { + edges.emplace_back(mangleSymbol(caller), mangleSymbol(callee)); + if (debug) { + MCGLogger::logDebug("Add edge: {} ({}) -> {} ({})", mangleSymbol(caller), fmt::ptr(caller), mangleSymbol(callee), + fmt::ptr(callee)); + } +} + +void EdgeManager::addEdge(const Edge& e, bool debug) { + edges.emplace_back(e.caller, e.callee); + if (debug) { + MCGLogger::logDebug("Add edge: {} -> {}", e.caller, e.callee); + } +} + +void EdgeManager::addEdge(const std::string& caller, const std::string& callee, bool debug) { + edges.emplace_back(caller, callee); + if (debug) { + MCGLogger::logDebug("Add edge: {} -> {}", caller, callee); + } +} + +void EdgeManager::addEdges(const std::vector& newEdges, bool debug) { + for (const Edge& e : newEdges) { + addEdge(e, debug); + } +} + +void EdgeManager::addEdges(const std::vector& newEdges, bool debug) { + for (const EdgeSymbol& e : newEdges) { + addEdge(e, debug); + } +} diff --git a/cgfcollector/src/FortranUtil.cpp b/cgfcollector/src/FortranUtil.cpp new file mode 100644 index 00000000..7adbff2b --- /dev/null +++ b/cgfcollector/src/FortranUtil.cpp @@ -0,0 +1,287 @@ +/** + * File: FortranUtil.cpp + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#include "FortranUtil.h" + +using namespace Fortran::semantics; +using namespace Fortran::parser; +using namespace Fortran::common; +using namespace metacg; + +bool compareSymbols(const Symbol* a, const Symbol* b) { + if (a == b) + return true; + if (!a || !b) + return false; + if (a->name() != b->name()) + return false; + + auto resolveHostAssoc = [](const Symbol* sym) -> const Symbol* { + while (sym) { + if (sym->has()) { + sym = &sym->get().symbol(); + } else if (sym->has()) { + sym = &sym->get().symbol(); + } else { + break; + } + } + return sym; + }; + if (resolveHostAssoc(a) != resolveHostAssoc(b)) + return false; + + if (a->attrs() != b->attrs()) + return false; + + // this only compares only the type and not all details like variables, procedures, generics, etc. But should be + // enough for now. + if (a->GetType() != b->GetType()) + return false; + + return true; +} + +std::string mangleSymbol(const Symbol* sym) { + assert(sym && "mangleSymbol called with nullptr"); + + std::string mangledName = Fortran::lower::mangle::mangleName(*sym); + + // Legacy Fortran - C interoperability before BIND(C) existed. + // We have to do this manually because normally it would run as + // a pass (ExternalNameConversionPass). + // + // NOTE: underscoring can be disabled with `-fno-underscoring` + auto result = fir::NameUniquer::deconstruct(mangledName); + if (fir::NameUniquer::isExternalFacingUniquedName(result)) { + if (result.first == fir::NameUniquer::NameKind::COMMON && result.second.name.empty()) + mangledName = blankCommonObjectName; + mangledName = GetExternalAssemblyName(result.second.name, true); + } + + return mangledName; +} + +bool isOperator(const Expr* e) { + /* Operators: see 15.4.3.4.2, 10.1.6.1, 6.2.4 (https://j3-fortran.org/doc/year/23/23-007r1.pdf) + Negate, NOT, Power, Multiply, Divide, Add, Subtract, Concat, + LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV, + DefinedUnary, DefinedBinary + */ + + return holds_any_ofu), Expr::UnaryPlus, Expr::Negate, Expr::NOT, Expr::Power, Expr::Multiply, + Expr::Divide, Expr::Add, Expr::Subtract, Expr::Concat, Expr::LT, Expr::LE, Expr::EQ, Expr::NE, + Expr::GE, Expr::GT, Expr::AND, Expr::OR, Expr::EQV, Expr::NEQV, Expr::DefinedUnary, + Expr::DefinedBinary>(e->u); +} + +bool compareExprIntrinsicOperator(const Expr* expr, DefinedOperator::IntrinsicOperator op) { + if (!expr) + return false; + + using IO = DefinedOperator::IntrinsicOperator; + + switch (op) { + case IO::NOT: + return std::get_if(&expr->u) != nullptr; + case IO::Power: + return std::get_if(&expr->u) != nullptr; + case IO::Multiply: + return std::get_if(&expr->u) != nullptr; + case IO::Divide: + return std::get_if(&expr->u) != nullptr; + case IO::Add: + return std::get_if(&expr->u) != nullptr || + std::get_if(&expr->u) != nullptr; // UnaryPlus also uses + + case IO::Subtract: + return std::get_if(&expr->u) != nullptr || + std::get_if(&expr->u) != nullptr; // Negate also uses - + case IO::Concat: + return std::get_if(&expr->u) != nullptr; + case IO::LT: + return std::get_if(&expr->u) != nullptr; + case IO::LE: + return std::get_if(&expr->u) != nullptr; + case IO::EQ: + return std::get_if(&expr->u) != nullptr; + case IO::NE: + return std::get_if(&expr->u) != nullptr; + case IO::GE: + return std::get_if(&expr->u) != nullptr; + case IO::GT: + return std::get_if(&expr->u) != nullptr; + case IO::AND: + return std::get_if(&expr->u) != nullptr; + case IO::OR: + return std::get_if(&expr->u) != nullptr; + case IO::EQV: + return std::get_if(&expr->u) != nullptr; + case IO::NEQV: + return std::get_if(&expr->u) != nullptr; + default: + return false; + } +} + +bool isBinaryOperator(const Expr* e) { + if (!e) + return false; + + return holds_any_ofu), Expr::Power, Expr::Multiply, Expr::Divide, Expr::Add, Expr::Subtract, + Expr::Concat, Expr::LT, Expr::LE, Expr::EQ, Expr::NE, Expr::GE, Expr::GT, Expr::AND, Expr::OR, + Expr::EQV, Expr::NEQV, Expr::DefinedBinary>(e->u); +} + +bool isUnaryOperator(const Expr* e) { + if (!e) + return false; + + return holds_any_ofu), Expr::UnaryPlus, Expr::Negate, Expr::NOT, Expr::DefinedUnary>(e->u); +} + +DefinedOperator::IntrinsicOperator variantGetIntrinsicOperator(const GenericKind& gk) { + return std::visit(visitors{[](const RelationalOperator& op) { + using RO = RelationalOperator; + using IO = DefinedOperator::IntrinsicOperator; + + switch (op) { + case RO::LT: + return IO::LT; + case RO::LE: + return IO::LE; + case RO::EQ: + return IO::EQ; + case RO::NE: + return IO::NE; + case RO::GE: + return IO::GE; + case RO::GT: + return IO::GT; + default: + MCGLogger::logDebug("Error: Unknown RelationalOperator in mapToIntrinsicOperator"); + return IO::LT; // avoid warning + } + }, + [](const LogicalOperator& op) { + using LO = LogicalOperator; + using IO = DefinedOperator::IntrinsicOperator; + + switch (op) { + case LO::And: + return IO::AND; + case LO::Or: + return IO::OR; + case LO::Eqv: + return IO::EQV; + case LO::Neqv: + return IO::NEQV; + case LO::Not: + return IO::NOT; + default: + MCGLogger::logDebug("Error: Unknown LogicalOperator in mapToIntrinsicOperator"); + return IO::AND; // avoid warning + } + }, + [](const NumericOperator& op) { + using NO = NumericOperator; + using IO = DefinedOperator::IntrinsicOperator; + + switch (op) { + case NO::Power: + return IO::Power; + case NO::Multiply: + return IO::Multiply; + case NO::Divide: + return IO::Divide; + case NO::Add: + return IO::Add; + case NO::Subtract: + return IO::Subtract; + default: + MCGLogger::logDebug("Error: Unknown NumericOperator in mapToIntrinsicOperator"); + return IO::Add; // avoid warning + } + }, + [](const auto& op) { + MCGLogger::logDebug("Error: Unknown operator type in mapToIntrinsicOperator"); + return DefinedOperator::IntrinsicOperator::Add; // avoid warning + }}, + gk.u); +} + +const Symbol* getTypeSymbolFromSymbol(const Symbol* symbol) { + const DeclTypeSpec* type = symbol->GetType(); + if (!type) + return nullptr; + const Fortran::semantics::DerivedTypeSpec* derived = type->AsDerived(); + if (!derived) + return nullptr; + const Symbol* typeSymbol = &derived->typeSymbol(); + if (!typeSymbol) + return nullptr; + return typeSymbol; +} + +std::vector findTypeWithDerivedTypes(const std::vector& types, const Symbol* symbol) { + std::vector typesWithDerived; + std::unordered_set visited; + + const Symbol* typeSymbol = getTypeSymbolFromSymbol(symbol); + if (!typeSymbol) { + return typesWithDerived; + } + + auto findTypeIt = + std::find_if(types.begin(), types.end(), [&typeSymbol](const Type& t) { return t.typeSymbol == typeSymbol; }); + + if (findTypeIt == types.end()) { + return typesWithDerived; + } + + // Add the initial type + typesWithDerived.push_back(&(*findTypeIt)); + + visited.insert(typeSymbol); + + // collect descendants + std::function collectDescendants = [&](const Type* parent) { + for (const Type& t : types) { + if (t.extendsFrom == parent->typeSymbol && !visited.count(t.typeSymbol)) { + visited.insert(t.typeSymbol); + typesWithDerived.push_back(&t); + + // recursive call to find further descendants + collectDescendants(&t); + } + } + }; + collectDescendants(&(*findTypeIt)); + + // collect ancestors + const Symbol* currentExtendsFrom = findTypeIt->extendsFrom; + while (currentExtendsFrom) { + // not sure if Fortran even allows this. But better be safe + if (!visited.insert(currentExtendsFrom).second) { + MCGLogger::logError("Error: Detected cyclic inheritance involving type \"" + + (currentExtendsFrom ? currentExtendsFrom->name().ToString() : "null") + "\""); + break; + } + + auto currentTypeIt = std::find_if(types.begin(), types.end(), + [&](const Type& t) { return compareSymbols(t.typeSymbol, currentExtendsFrom); }); + + if (currentTypeIt == types.end()) { + MCGLogger::logError("Error: Types array (extendsFrom) field entry for \"" + + (currentExtendsFrom ? currentExtendsFrom->name().ToString() : "null") + "\" missing"); + break; + } + + typesWithDerived.push_back(&(*currentTypeIt)); + currentExtendsFrom = currentTypeIt->extendsFrom; + } + + return typesWithDerived; +} diff --git a/cgfcollector/src/Main.cpp b/cgfcollector/src/Main.cpp new file mode 100644 index 00000000..014efb26 --- /dev/null +++ b/cgfcollector/src/Main.cpp @@ -0,0 +1,156 @@ +/** + * File: Main.cpp + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#include "ParseTreeVisitor.h" + +#include + +using namespace metacg; +using namespace metacg::graph; +using namespace metacg::io; +using namespace Fortran::parser; + +static MCGManager& mcgManager = MCGManager::get(); + +/** + * @brief Create output file with given extension + * + * @param compInst + * @param currentFile + * @param extension + * @return + */ +std::unique_ptr createOutputFile(Fortran::frontend::CompilerInstance& compInst, + llvm::StringRef currentFile, llvm::StringRef extension) { + llvm::SmallString<128> outputPath(compInst.getFrontendOpts().outputFile); + if (outputPath.empty()) { + outputPath = currentFile; + } + if (extension != "") + llvm::sys::path::replace_extension(outputPath, extension); + std::unique_ptr os; + std::error_code ec; + os.reset(new llvm::raw_fd_ostream(outputPath.str(), ec, llvm::sys::fs::OF_TextWithCRLF)); + if (ec) { + MCGLogger::logError("Error opening output file: {}", ec.message()); + return nullptr; + } + return os; +} + +/** + * @brief Create callgraph in mcgManager and populate it by traversing the parse tree + * + * @param parseTree + * @param currentFile + */ +void generateCG(std::optional& parseTree, llvm::StringRef currentFile) { + mcgManager.addToManagedGraphs("cg", std::make_unique(), true); + Callgraph* cg = mcgManager.getCallgraph("cg"); + +#ifndef NDEBUG + metacg::MCGLogger::instance().getConsole()->set_level(spdlog::level::debug); + metacg::MCGLogger::instance().getConsole()->set_pattern("%v"); +#endif + + ParseTreeVisitor visitor(cg, currentFile.str()); + Fortran::parser::Walk(parseTree, visitor); + visitor.postProcess(); + + mcgManager.mergeIntoActiveGraph(metacg::MergeByName()); +} + +/** + * @brief Dump callgraph as JSON string + * + * @return + */ +std::string dumpCG() { + Callgraph* cg = mcgManager.getCallgraph("cg"); + if (cg == nullptr) { + MCGLogger::logError("No callgraph generated"); + return ""; + } + + std::unique_ptr mcgWriter = createWriter(4); + if (!mcgWriter) { + MCGLogger::logError("Unable to create a writer"); + return ""; + }; + + JsonSink jsonSink; + mcgWriter->writeActiveGraph(jsonSink); + + return jsonSink.getJson().dump(); +} + +/** + * @class CollectCG + * @brief Plugin action to collect callgraph and dump it as JSON file + * + */ +class CollectCG : public Fortran::frontend::PluginParseTreeAction { + public: + void executeAction() override { + generateCG(getParsing().parseTree(), getCurrentFile()); + + std::string cgString = dumpCG(); + std::unique_ptr file = ::createOutputFile(getInstance(), getCurrentFile(), "json"); + file->write(cgString.c_str(), cgString.size()); + } +}; + +/** + * @class CollectCGwithDot + * @brief Like CollectCG but also generates a DOT file of callgraph + * + */ +class CollectCGwithDot : public Fortran::frontend::PluginParseTreeAction { + public: + void executeAction() override { + generateCG(getParsing().parseTree(), getCurrentFile()); + + std::string cgString = dumpCG(); + std::unique_ptr file = ::createOutputFile(getInstance(), getCurrentFile(), "json"); + file->write(cgString.c_str(), cgString.size()); + + // dot file + Callgraph* cg = mcgManager.getCallgraph("cg"); + if (cg == nullptr) { + MCGLogger::logError("No callgraph generated"); + return; + } + + dot::DotGenerator dotGen(cg); + dotGen.generate(); + + std::unique_ptr dotfile = ::createOutputFile(getInstance(), getCurrentFile(), "dot"); + std::string dotString = dotGen.getDotString(); + dotfile->write(dotString.c_str(), dotString.size()); + } +}; + +/** + * @class CollectCGNoRename + * @brief Like CollectCG but does not rename output file + * + */ +class CollectCGNoRename : public Fortran::frontend::PluginParseTreeAction { + public: + void executeAction() override { + generateCG(getParsing().parseTree(), getCurrentFile()); + + std::string cgString = dumpCG(); + + std::unique_ptr file = ::createOutputFile(getInstance(), getCurrentFile(), ""); + file->write(cgString.c_str(), cgString.size()); + } +}; + +static Fortran::frontend::FrontendPluginRegistry::Add X("genCG", "Generate Callgraph"); +static Fortran::frontend::FrontendPluginRegistry::Add Y("genCGwithDot", "Generate Callgraph"); +static Fortran::frontend::FrontendPluginRegistry::Add Z( + "genCGNoRename", "Generate Callgraph without renaming output file"); diff --git a/cgfcollector/src/ParseTreeVisitor.cpp b/cgfcollector/src/ParseTreeVisitor.cpp new file mode 100644 index 00000000..f4df18c7 --- /dev/null +++ b/cgfcollector/src/ParseTreeVisitor.cpp @@ -0,0 +1,737 @@ +/** + * File: ParseTreeVisitor.cpp + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#include "ParseTreeVisitor.h" + +using namespace Fortran::parser; +using namespace Fortran::semantics; +using namespace Fortran::common; +using namespace metacg; + +template void ParseTreeVisitor::handleFuncSubStmt(const FunctionStmt&); +template void ParseTreeVisitor::handleFuncSubStmt(const SubroutineStmt&); + +template +void ParseTreeVisitor::handleFuncSubStmt(const T& stmt) { + if (const Symbol* sym = std::get(stmt.t).symbol) { + currentFunctions.emplace_back(sym, std::vector()); + functions.emplace_back(sym, std::vector()); + cg->getOrInsertNode(mangleSymbol(sym), currentFileName, false, false); + + MCGLogger::logDebug("Add node: {} ({})", mangleSymbol(sym), fmt::ptr(sym)); + } +} + +void ParseTreeVisitor::handleEndFuncSubStmt() { + varTracking->handleTrackedVars(currentFunctions.back().symbol, edgeM); + + if (!currentFunctions.empty()) { + currentFunctions.pop_back(); + } +} + +void ParseTreeVisitor::addEdgesForProducesAndDerivedTypes(std::vector typeWithDerived, + const Symbol* procedureSymbol) { + for (const Type* t : typeWithDerived) { + auto procIt = std::find_if(t->procedures.begin(), t->procedures.end(), [&procedureSymbol](const auto& p) { + return p.first->name() == procedureSymbol->name(); + }); + if (procIt == t->procedures.end()) + continue; + + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + edgeM->addEdge(currentFunctionSymbol, procIt->second); + } +} + +void ParseTreeVisitor::postProcess() { + // handle potential finalizers from function calls + for (PotentialFinalizer pf : potentialFinalizers) { + auto calledIt = std::find_if(functions.begin(), functions.end(), + [&](const Function& f) { return mangleSymbol(f.symbol) == pf.procedureCalled; }); + if (calledIt == functions.end()) + continue; + + auto arg = calledIt->dummyArgs.begin() + pf.argPos; + + if (!arg->hasBeenInitialized) + continue; + + for (const Edge& edge : pf.finalizerEdges) { + edgeM->addEdge(edge, false); + MCGLogger::logDebug("Add edge for potential finalizer: {} -> {}", edge.caller, edge.callee); + } + } + + // sort unique edges + std::sort(edges.begin(), edges.end()); + auto it = std::unique(edges.begin(), edges.end()); + edges.erase(it, edges.end()); + + // add edges + for (const Edge& edge : edges) { + const CgNode& callerNode = cg->getOrInsertNode(edge.caller); + const CgNode& calleeNode = cg->getOrInsertNode(edge.callee); + + cg->addEdge(callerNode, calleeNode); + } +} + +// Visitor implementations + +bool ParseTreeVisitor::Pre(const MainProgram& p) { + inMainProgram = true; + + if (const auto& maybeStmt = std::get<0>(p.t)) { + if (!maybeStmt->statement.v.symbol) + return true; + + const Symbol* currentFunctionSymbol = + currentFunctions.emplace_back(maybeStmt->statement.v.symbol, std::vector()).symbol; + cg->getOrInsertNode(mangleSymbol(currentFunctionSymbol), currentFileName, false, false); + + MCGLogger::logDebug("\nIn main program: {} ({})", mangleSymbol(currentFunctionSymbol), + fmt::ptr(currentFunctionSymbol)); + } + return true; +} + +void ParseTreeVisitor::Post(const MainProgram&) { + varTracking->handleTrackedVars(currentFunctions.back().symbol, edgeM); + + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + MCGLogger::logDebug("End main program: {} ({})", mangleSymbol(currentFunctionSymbol), + fmt::ptr(currentFunctionSymbol)); + + if (!currentFunctions.empty()) { + currentFunctions.pop_back(); + } + + inMainProgram = false; +} + +bool ParseTreeVisitor::Pre(const FunctionSubprogram&) { + inFunctionOrSubroutineSubProgram = true; + return true; +} + +void ParseTreeVisitor::Post(const FunctionSubprogram&) { inFunctionOrSubroutineSubProgram = false; } + +bool ParseTreeVisitor::Pre(const SubroutineSubprogram&) { + inFunctionOrSubroutineSubProgram = true; + return true; +} + +void ParseTreeVisitor::Post(const SubroutineSubprogram&) { inFunctionOrSubroutineSubProgram = false; } + +void ParseTreeVisitor::Post(const ExecutionPart& e) { + if (!inFunctionOrSubroutineSubProgram && !inMainProgram) + return; + + CgNode* node = cg->getFirstNode(mangleSymbol(currentFunctions.back().symbol)); + if (!node) { + return; + } + + node->setHasBody(true); +} + +void ParseTreeVisitor::Post(const EntryStmt& e) { + const Name* name = &std::get(e.t); + if (!name->symbol) + return; + + MCGLogger::logDebug("Add Entry point: {} ({})", mangleSymbol(name->symbol), fmt::ptr(name->symbol)); + + // handle entry statement as normal function. + cg->getOrInsertNode(mangleSymbol(name->symbol), currentFileName, false, true); +} + +void ParseTreeVisitor::Post(const FunctionStmt& f) { + MCGLogger::logDebug("\nIn function: {} ({})", mangleSymbol(std::get(f.t).symbol), + fmt::ptr(std::get(f.t).symbol)); + + handleFuncSubStmt(f); + + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + auto functionsIt = std::find_if(functions.begin(), functions.end(), + [&](const Function& func) { return func.symbol == currentFunctionSymbol; }); + + // collect function arguments + const std::list& name_list = std::get>(f.t); + for (const Name& name : name_list) { + currentFunctions.back().addDummyArg(name.symbol); + if (functionsIt != functions.end()) { + functionsIt->addDummyArg(name.symbol); + varTracking->addTrackedVar({name.symbol, currentFunctionSymbol}); + } + } +} + +void ParseTreeVisitor::Post(const EndFunctionStmt&) { + if (!currentFunctions.empty()) { + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + MCGLogger::logDebug("End function: {} ({})", mangleSymbol(currentFunctionSymbol), fmt::ptr(currentFunctionSymbol)); + } + + handleEndFuncSubStmt(); +} + +void ParseTreeVisitor::Post(const SubroutineStmt& s) { + MCGLogger::logDebug("\nIn subroutine: {} ({})", mangleSymbol(std::get(s.t).symbol), + fmt::ptr(std::get(s.t).symbol)); + + handleFuncSubStmt(s); + + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + auto functionsIt = std::find_if(functions.begin(), functions.end(), + [&](const Function& func) { return func.symbol == currentFunctionSymbol; }); + + // collect subroutine arguments (dummy args) + const std::list* dummyArg_list = &std::get>(s.t); + for (const DummyArg& dummyArg : *dummyArg_list) { + const Name* name = std::get_if(&dummyArg.u); + currentFunctions.back().addDummyArg(name->symbol); + if (functionsIt != functions.end()) { + functionsIt->addDummyArg(name->symbol); + varTracking->addTrackedVar({name->symbol, currentFunctionSymbol}); + } + } +} + +void ParseTreeVisitor::Post(const EndSubroutineStmt&) { + if (!currentFunctions.empty()) { + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + MCGLogger::logDebug("End subroutine: {} ({})", mangleSymbol(currentFunctionSymbol), + fmt::ptr(currentFunctionSymbol)); + } + + handleEndFuncSubStmt(); +} + +void ParseTreeVisitor::Post(const ProcedureDesignator& p) { + if (currentFunctions.empty()) + return; + + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + // if just the name is called. (as subroutine with call and as function without call) + if (const Name* name = std::get_if(&p.u)) { + if (!name->symbol) + return; + + // ignore intrinsic functions + if (name->symbol->attrs().test(Attr::INTRINSIC)) + return; + + edgeM->addEdge(currentFunctionSymbol, name->symbol); + + // if called from a object with %. (base % component) + } else if (const ProcComponentRef* procCompRef = std::get_if(&p.u)) { + const Symbol* symbolComp = procCompRef->v.thing.component.symbol; + if (!symbolComp) + return; + + edgeM->addEdge(currentFunctionSymbol, symbolComp); + + const Name* baseName = std::get_if(&procCompRef->v.thing.base.u); + if (!baseName || !baseName->symbol) + return; + const Symbol* symbolBase = baseName->symbol; + + // handle derived types edges + + addEdgesForProducesAndDerivedTypes(findTypeWithDerivedTypes(types, symbolBase), symbolComp); + } +} + +void ParseTreeVisitor::Post(const AssignmentStmt& a) { + const Variable* var = &std::get(a.t); + + const Name* name = getNameFromClassWithDesignator(*var); + if (!name || !name->symbol) + return; + + varTracking->handleTrackedVarAssignment(currentFunctions.back().symbol, name->symbol->name()); +} + +void ParseTreeVisitor::Post(const AllocateStmt& a) { + const std::list* allocs = &std::get>(a.t); + + for (const Allocation& alloc : *allocs) { + const AllocateObject* allocObj = &std::get(alloc.t); + const Name* name = std::get_if(&allocObj->u); + if (!name || !name->symbol) { + continue; + } + + varTracking->handleTrackedVarAssignment(currentFunctions.back().symbol, name->symbol->name()); + } +} + +void ParseTreeVisitor::Post(const Call& c) { + const ProcedureDesignator* designator = &std::get(c.t); + const std::list* args = &std::get>(c.t); + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + const Name* procName = std::get_if(&designator->u); + if (!procName || !procName->symbol) + return; + + std::size_t argPos = 0; + for (const ActualArgSpec& arg : *args) { + const ActualArg* actualArg = &std::get(arg.t); + const Indirection* expr = std::get_if>(&actualArg->u); + if (!expr) + return; + const Name* name = getNameFromClassWithDesignator(expr->value()); + if (!name || !name->symbol) + return; + + // handle move_alloc intrinsic for allocatable vars + if (procName->symbol->attrs().test(Attr::INTRINSIC) && procName->symbol->name() == "move_alloc") { + varTracking->handleTrackedVarAssignment(currentFunctionSymbol, name->symbol->name()); + } else { + // handle finalizers for allocatable vars. + // This collects info from variables that are parse as arguments to functions. Function are defined below the + // execution part, so this need to be handled at the end of the parse tree traversal. + TrackedVar* trackedVar = varTracking->getTrackedVarFromSourceName(currentFunctionSymbol, name->symbol->name()); + if (!trackedVar) + continue; + + MCGLogger::logDebug("Add potential finalizers for var: {} ({})", name->symbol->name(), fmt::ptr(name->symbol)); + PotentialFinalizer& pf = potentialFinalizers.emplace_back(argPos, mangleSymbol(procName->symbol)); + for (const EdgeSymbol& edge : edgeM->getEdgesForFinalizers(types, currentFunctionSymbol, trackedVar->var)) { + pf.addFinalizerEdge({mangleSymbol(edge.caller), mangleSymbol(edge.callee)}); + MCGLogger::logDebug(" Potential finalizer edge: {} -> {}", mangleSymbol(edge.caller), + mangleSymbol(edge.callee)); + } + } + } +} + +void ParseTreeVisitor::Post(const TypeDeclarationStmt& t) { + if (currentFunctions.empty()) { + return; + } + + for (const EntityDecl& entity : std::get>(t.t)) { + const Name& name = std::get(entity.t); + if (!name.symbol) + continue; + + // skip if name is an argument to a function or subroutine + bool isFunctionArg = false; + std::vector& currentDummyArgs = currentFunctions.back().dummyArgs; + if (!currentDummyArgs.empty()) { + auto it = std::find_if(currentDummyArgs.begin(), currentDummyArgs.end(), + [&name](const Function::DummyArg& dummyArg) { return dummyArg.symbol == name.symbol; }); + + if (it != currentDummyArgs.end()) + isFunctionArg = true; + } + + bool holds_allocatable = false; + const IntentSpec* holds_intent = nullptr; + bool holds_save = false; + for (const AttrSpec& attr : std::get>(t.t)) { + if (std::holds_alternative(attr.u)) + holds_allocatable = true; + else if (std::holds_alternative(attr.u)) + holds_intent = &std::get(attr.u); + else if (std::holds_alternative(attr.u)) + holds_save = true; + } + + if (holds_save) + continue; // vars with save attr are not destructed + + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + if (isFunctionArg) { + if (!holds_allocatable) { + if (!holds_intent) { + // no intent attr, if not set does not call finalizer. Why? idk. + MCGLogger::logDebug("Add tracking for function argument: {} ({})", name.symbol->name(), + fmt::ptr(name.symbol)); + varTracking->addTrackedVar({name.symbol, currentFunctionSymbol, false, true}); + } else { + if (holds_intent->v == IntentSpec::Intent::Out) { + // intent out, calls finalizer because (7.5.6.3 line 21 and onwards) + edgeM->addEdgesForFinalizers(types, currentFunctionSymbol, name.symbol); + } else if (holds_intent->v == IntentSpec::Intent::InOut) { + // intent inout, calls finalizer when set. + MCGLogger::logDebug("Add tracking for inout argument: {} ({})", name.symbol->name(), fmt::ptr(name.symbol)); + varTracking->addTrackedVar({name.symbol, currentFunctionSymbol, false, true}); + } + } + } + } else { + if (holds_allocatable) { + MCGLogger::logDebug("Add tracking for allocatable variable: {} ({})", name.symbol->name(), + fmt::ptr(name.symbol)); + varTracking->addTrackedVar({name.symbol, currentFunctionSymbol, false, true}); + // skip var with allocatable attr. + // Add to trackedVars because it needs to be assigned at least once before calling a finalizers make sense. + } else { + edgeM->addEdgesForFinalizers(types, currentFunctionSymbol, name.symbol); + } + } + } +} + +bool ParseTreeVisitor::Pre(const DerivedTypeDef&) { + inDerivedTypeDef = true; + types.emplace_back(); + + return true; +} + +void ParseTreeVisitor::Post(const DerivedTypeDef&) { + inDerivedTypeDef = false; + MCGLogger::logDebug("End derived type: {} ({})", types.back().typeSymbol->name(), fmt::ptr(types.back().typeSymbol)); +} + +bool ParseTreeVisitor::Pre(const DerivedTypeStmt& t) { + if (!inDerivedTypeDef) + return true; + + Type& currentType = types.back(); + const Name& name = std::get(t.t); + currentType.typeSymbol = name.symbol; + + MCGLogger::logDebug("\nIn derived type: {} ({})", currentType.typeSymbol->name(), fmt::ptr(currentType.typeSymbol)); + + return true; +} + +void ParseTreeVisitor::Post(const TypeAttrSpec& a) { + if (!inDerivedTypeDef) + return; + + Type& currentType = types.back(); + if (std::holds_alternative(a.u)) { + const TypeAttrSpec::Extends& extends = std::get(a.u); + currentType.extendsFrom = extends.v.symbol; + + MCGLogger::logDebug("Extends from: {} ({})", currentType.extendsFrom->name(), fmt::ptr(currentType.extendsFrom)); + } +} + +void ParseTreeVisitor::Post(const TypeBoundProcedureStmt& s) { + if (!inDerivedTypeDef) + return; + + if (const TypeBoundProcedureStmt::WithoutInterface* withoutInterface = + std::get_if(&s.u)) { + for (const TypeBoundProcDecl& d : withoutInterface->declarations) { + const Name& name = std::get(d.t); + if (!name.symbol) + return; + + const std::optional& optname = std::get>(d.t); + if (!optname || !optname->symbol) { + return; + } + + Type& currentType = types.back(); + currentType.procedures.emplace_back(name.symbol, optname->symbol); + + MCGLogger::logDebug("Add procedure: {} ({}) -> {} ({})", name.symbol->name(), fmt::ptr(name.symbol), + optname->symbol->name(), fmt::ptr(optname->symbol)); + } + + // only for abstract types, with deferred in binding attr list + } else if (const TypeBoundProcedureStmt::WithInterface* withInterface = + std::get_if(&s.u)) { + for (const Name& n : withInterface->bindingNames) { + if (!n.symbol) + return; + + Type& currentType = types.back(); + currentType.procedures.emplace_back(n.symbol, n.symbol); + + MCGLogger::logDebug("Add procedure: {} ({}) -> {} ({})", n.symbol->name(), fmt::ptr(n.symbol), n.symbol->name(), + fmt::ptr(n.symbol)); + } + } +} + +void ParseTreeVisitor::Post(const TypeBoundGenericStmt& s) { + if (!inDerivedTypeDef) + return; + + const Indirection& genericSpec = std::get>(s.t); + if (const DefinedOperator* definedOperator = std::get_if(&genericSpec.value().u)) { + if (const DefinedOperator::IntrinsicOperator* intrinsicOp = + std::get_if(&definedOperator->u)) { + const std::list& names = std::get>(s.t); + + Type& currentType = types.back(); + + for (const Name& name : names) { + if (!name.symbol) + continue; + + currentType.operators.emplace_back(*intrinsicOp, name.symbol); + + MCGLogger::logDebug("Add operator: {} -> {} ({})", DefinedOperator::EnumToString(*intrinsicOp), + name.symbol->name(), fmt::ptr(name.symbol)); + } + } + } +} + +bool ParseTreeVisitor::Pre(const InterfaceStmt&) { + inInterfaceStmt = true; + return true; +} + +bool ParseTreeVisitor::Pre(const EndInterfaceStmt&) { + inInterfaceStmt = false; + inInterfaceStmtDefinedOperator = false; + return true; +} + +void ParseTreeVisitor::Post(const DefinedOperator& op) { + if (!inInterfaceStmt) + return; + + inInterfaceStmtDefinedOperator = true; + + if (std::holds_alternative(op.u)) { + DefinedOperator::IntrinsicOperator intrinsicOp = std::get(op.u); + interfaceOperators.emplace_back(intrinsicOp, std::vector()); + } else if (std::holds_alternative(op.u)) { + const DefinedOpName& opName = std::get(op.u); + if (!opName.v.symbol) + return; + + interfaceOperators.emplace_back(opName.v.symbol, std::vector()); + } +} + +void ParseTreeVisitor::Post(const ProcedureStmt& p) { + if (!inInterfaceStmtDefinedOperator) + return; + + const std::list& name = std::get>(p.t); + for (const Name& n : name) { + if (!n.symbol) + continue; + + if (interfaceOperators.empty()) { + MCGLogger::logError("This should no happen. Likely there is a bug with parsing DefinedOperator's"); + continue; + } + + interfaceOperators.back().second.push_back(n.symbol); + } +} + +bool ParseTreeVisitor::Pre(const Expr& e) { + const Name* name = getNameFromClassWithDesignator(e); + // true if not in a designator expr + if (!name || !name->symbol || exprStmtWithOps.empty()) { + if (isOperator(&e)) { + exprStmtWithOps.emplace_back(&e); + } + + return true; + } + + // not in a function. So no overloaded operator is called. + if (currentFunctions.empty()) + return true; + + for (const Expr* e : exprStmtWithOps) { + // search in interfaceOperators first before search in derived types + auto interfaceOp = std::find_if(interfaceOperators.begin(), interfaceOperators.end(), [&](const auto& op) { + if (std::holds_alternative(op.first)) { + DefinedOperator::IntrinsicOperator intrinsicOp = std::get(op.first); + return compareExprIntrinsicOperator(e, intrinsicOp); + } else if (std::holds_alternative(op.first)) { + const Symbol* definedOpNameSym = std::get(op.first); + if (const Expr::DefinedUnary* definedUnary = std::get_if(&e->u)) { + const auto& exprOpName = std::get<0>(definedUnary->t); + return definedOpNameSym->name() == exprOpName.v.symbol->name(); + } else if (const Expr::DefinedBinary* definedBinary = std::get_if(&e->u)) { + const auto& exprOpName = std::get<0>(definedBinary->t); + return definedOpNameSym->name() == exprOpName.v.symbol->name(); + } + } + return false; + }); + if (interfaceOp != interfaceOperators.end()) { + bool isUnaryOp = isUnaryOperator(e); + bool isBinaryOp = isBinaryOperator(e); + + for (const Symbol* sym : interfaceOp->second) { + const Symbol* currentFunctionSymbol = currentFunctions.back().symbol; + + // skip self calls + if (mangleSymbol(sym) == mangleSymbol(currentFunctionSymbol)) + continue; + + // if unary, add potential unary operators. Same for binary operators. + auto functionIt = + std::find_if(functions.begin(), functions.end(), [&](const Function& f) { return f.symbol == sym; }); + if (functionIt != functions.end()) { + if ((!isUnaryOp || functionIt->dummyArgs.size() != 1) && (!isBinaryOp || functionIt->dummyArgs.size() != 2)) { + continue; + } + } + + edgeM->addEdge(currentFunctionSymbol, sym); + } + } + + // search in derived types + + std::vector typeWithDerived = findTypeWithDerivedTypes(types, name->symbol); + + for (const Type* t : typeWithDerived) { + auto opIt = std::find_if(t->operators.begin(), t->operators.end(), + [&](const auto& p) { return compareExprIntrinsicOperator(e, p.first); }); + if (opIt == t->operators.end()) + continue; + + const Symbol* funcSymbol = opIt->second; + + bool skipSelfCall = false; + for (const Type* t : typeWithDerived) { + auto procIt = std::find_if(t->procedures.begin(), t->procedures.end(), + [&funcSymbol](const auto& p) { return p.first->name() == funcSymbol->name(); }); + if (procIt == t->procedures.end()) + continue; + + if (procIt->second->name() == currentFunctions.back().symbol->name()) { + skipSelfCall = true; + break; + } + } + + if (!skipSelfCall) + addEdgesForProducesAndDerivedTypes(typeWithDerived, funcSymbol); + } + } + + return true; +} + +void ParseTreeVisitor::Post(const Expr& e) { + if (!isOperator(&e)) { + return; + } + + if (!exprStmtWithOps.empty()) { + exprStmtWithOps.pop_back(); + } +} + +void ParseTreeVisitor::Post(const UseStmt& u) { + const Symbol* useSymbol = u.moduleName.symbol; + + MCGLogger::logDebug("Use module: {} ({})", useSymbol->name(), fmt::ptr(useSymbol)); + + if (const Scope* modScope = useSymbol->scope()) { + for (const auto& pair : *modScope) { + const Symbol* symbol = &*pair.second; + + // extract derived types from module and populate types var + if (const DerivedTypeDetails* details = symbol->detailsIf()) { + const Symbol* extendsFrom = nullptr; + std::vector> procedures; + std::vector> operators; + + for (auto pair : *symbol->scope()) { + const Symbol* component = &*pair.second; + + // extends + if (component->test(Symbol::Flag::ParentComp)) { + extendsFrom = getTypeSymbolFromSymbol(component); + } + + // type bound procedures + if (component->has()) { + const ProcBindingDetails& procDetails = component->get(); + MCGLogger::logDebug("Found procedure in module derived type: {} ({})", component->name(), + fmt::ptr(&component)); + procedures.emplace_back(component, component); + } + + // type generic operators + if (const GenericDetails* gen = component->detailsIf()) { + if (!gen->kind().IsIntrinsicOperator()) + continue; + + DefinedOperator::IntrinsicOperator intrinsicOp = variantGetIntrinsicOperator(gen->kind()); + + if (gen->specificProcs().size() != 1) + MCGLogger::logError("Type-bound generic more than one specific proc not handled. Should not happen."); + + const Symbol* op_func_sym = nullptr; + op_func_sym = &gen->specificProcs().front().get(); + + MCGLogger::logDebug("Found operator in module derived type: {} -> {} ({})", + DefinedOperator::EnumToString(intrinsicOp), op_func_sym->name(), fmt::ptr(op_func_sym)); + + operators.push_back({intrinsicOp, op_func_sym}); + } + } + + types.push_back({symbol, extendsFrom, procedures, operators}); + MCGLogger::logDebug("Found derived type in module: {} ({})", symbol->name(), fmt::ptr(symbol)); + } + + // same but with interface operators + if (const GenericDetails* gen = symbol->detailsIf()) { + std::variant interfaceOp; + std::vector procs; + + if (gen->kind().IsIntrinsicOperator()) { + interfaceOp = variantGetIntrinsicOperator(gen->kind()); + MCGLogger::logDebug("Found interface operator in module: {}", + DefinedOperator::EnumToString(std::get(interfaceOp))); + } else if (gen->kind().IsDefinedOperator()) { + interfaceOp = symbol; + MCGLogger::logDebug("Found interface operator in module: {}", symbol->name()); + } else { + continue; + } + + for (const auto& p : gen->specificProcs()) { + procs.push_back(&p.get()); + MCGLogger::logDebug(" with procedure: {} ({})", p.get().name(), fmt::ptr(&p.get())); + } + + interfaceOperators.push_back({interfaceOp, procs}); + } + + // same but with functions + if (const SubprogramDetails* details = symbol->detailsIf()) { + if (!details->isFunction() && !details->isInterface()) // function and function dummy definition in interface + continue; + + std::vector dummyArgs; + for (const Symbol* arg : details->dummyArgs()) { + dummyArgs.emplace_back(arg, false); + } + + functions.emplace_back(symbol, dummyArgs); + MCGLogger::logDebug("Found function in module: {} ({})", symbol->name(), fmt::ptr(symbol)); + } + } + } + + MCGLogger::logDebug("Finished Use module: {} ({})", useSymbol->name(), fmt::ptr(useSymbol)); +} diff --git a/cgfcollector/src/VariableTracking.cpp b/cgfcollector/src/VariableTracking.cpp new file mode 100644 index 00000000..17b23afd --- /dev/null +++ b/cgfcollector/src/VariableTracking.cpp @@ -0,0 +1,90 @@ +/** + * File: VariableTracking.cpp + * License: Part of the MetaCG project. Licensed under BSD 3 clause license. See LICENSE.txt file at + * https://github.com/tudasc/metacg/LICENSE.txt + */ + +#include "VariableTracking.h" + +#include "FortranUtil.h" + +using namespace Fortran::semantics; +using namespace metacg; + +TrackedVar* VariableTracking::getTrackedVarFromSourceName(const Symbol* currentFunctionSymbol, SourceName sourceName) { + auto anyTrackedVarIt = std::find_if(trackedVars.begin(), trackedVars.end(), + [&](const TrackedVar& t) { return t.var->name() == sourceName; }); + if (anyTrackedVarIt == trackedVars.end()) + return nullptr; + + // find local variable with the same name in the current function scope (shadowed) + auto localVarIt = std::find_if(trackedVars.begin(), trackedVars.end(), [&](const TrackedVar& t) { + return t.var->name() == sourceName && t.procedure == currentFunctionSymbol; + }); + + // prefer local var if found + return (localVarIt != trackedVars.end()) ? &(*localVarIt) : &(*anyTrackedVarIt); +} + +void VariableTracking::handleTrackedVarAssignment(const Symbol* currentFunctionSymbol, SourceName sourceName) { + TrackedVar* trackedVar = getTrackedVarFromSourceName(currentFunctionSymbol, sourceName); + if (!trackedVar) + return; + + trackedVar->hasBeenInitialized = true; + + MCGLogger::logDebug("Tracked var assigned: {} ({})", trackedVar->var->name(), fmt::ptr(trackedVar->var)); +} + +void VariableTracking::handleTrackedVars(const Symbol* currentFunctionSymbol, std::unique_ptr& edgeM) { + if (mangleSymbol(currentFunctionSymbol) != "_QQmain") { + if (!trackedVars.empty()) + MCGLogger::logDebug("Handle tracked vars for function"); + + for (TrackedVar& trackedVar : trackedVars) { + if (!trackedVar.hasBeenInitialized) + continue; + if (trackedVar.procedure != currentFunctionSymbol) + continue; + + // add edge for deconstruction (finalizer) + if (trackedVar.addFinalizers) { + edgeM->addEdgesForFinalizers(types, currentFunctionSymbol, trackedVar.var); + } + + // set init on dummy function args + auto functionIt = std::find_if(functions.begin(), functions.end(), + [&](const Function& f) { return f.symbol == currentFunctionSymbol; }); + if (functionIt != functions.end()) { + auto dummyArgIt = std::find_if(functionIt->dummyArgs.begin(), functionIt->dummyArgs.end(), + [&](const Function::DummyArg& d) { return d.symbol == trackedVar.var; }); + if (dummyArgIt != functionIt->dummyArgs.end()) { + dummyArgIt->hasBeenInitialized = true; + } + } + } + } + + // cleanup trackedVars + removeTrackedVars(currentFunctionSymbol); +} + +void VariableTracking::addTrackedVar(TrackedVar var) { + auto it = std::find_if(trackedVars.begin(), trackedVars.end(), [&](const TrackedVar& t) { return t.var == var.var; }); + if (it != trackedVars.end()) { + // update info + it->addFinalizers = var.addFinalizers; + it->hasBeenInitialized = var.hasBeenInitialized; + MCGLogger::logDebug("Update tracked variable: {} ({})", var.var->name(), fmt::ptr(var.var)); + return; + } + + trackedVars.push_back(var); + MCGLogger::logDebug("Add tracking for variable: {} ({})", var.var->name(), fmt::ptr(var.var)); +} + +void VariableTracking::removeTrackedVars(const Symbol* procedureSymbol) { + trackedVars.erase(std::remove_if(trackedVars.begin(), trackedVars.end(), + [&](const TrackedVar& t) { return t.procedure == procedureSymbol; }), + trackedVars.end()); +} diff --git a/cgfcollector/test/multi/cmake_base.txt.in b/cgfcollector/test/multi/cmake_base.txt.in new file mode 100644 index 00000000..33500d99 --- /dev/null +++ b/cgfcollector/test/multi/cmake_base.txt.in @@ -0,0 +1,5 @@ +set(CMAKE_Fortran_COMPILER "@CGFCOLLECTOR_WRAPPER@") +set(CMAKE_Fortran_FLAGS "") +set(CMAKE_Fortran_COMPILE_OBJECT " -norename -o ") +set(CMAKE_Fortran_LINK_EXECUTABLE "@CGMERGE2_EXECUTABLE@ ") +set(CMAKE_EXECUTABLE_SUFFIX .json) diff --git a/cgfcollector/test/multi/deps/CMakeLists.txt b/cgfcollector/test/multi/deps/CMakeLists.txt new file mode 100644 index 00000000..abf09466 --- /dev/null +++ b/cgfcollector/test/multi/deps/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 3.20) + +project(deps LANGUAGES Fortran) + +include(../cmake_base.txt) + +file( + GLOB + SOURCES + "*.f90" +) + +add_executable(${CMAKE_PROJECT_NAME} ${SOURCES}) diff --git a/cgfcollector/test/multi/deps/main.f90 b/cgfcollector/test/multi/deps/main.f90 new file mode 100644 index 00000000..def16537 --- /dev/null +++ b/cgfcollector/test/multi/deps/main.f90 @@ -0,0 +1,10 @@ +program main + use my_module, only: my_subroutine + use module3 + + implicit none + + call my_subroutine(5) + +end program main + diff --git a/cgfcollector/test/multi/deps/module.f90 b/cgfcollector/test/multi/deps/module.f90 new file mode 100644 index 00000000..2a1b0134 --- /dev/null +++ b/cgfcollector/test/multi/deps/module.f90 @@ -0,0 +1,20 @@ +module my_module + use module0_5 + + implicit none + +contains + subroutine subsub() + integer :: n + end subroutine subsub + + subroutine my_subroutine(n) + integer, intent(in) :: n + + write (*, *) n + + call func() + + end subroutine my_subroutine +end module my_module + diff --git a/cgfcollector/test/multi/deps/module0_5.f90 b/cgfcollector/test/multi/deps/module0_5.f90 new file mode 100644 index 00000000..0ff134db --- /dev/null +++ b/cgfcollector/test/multi/deps/module0_5.f90 @@ -0,0 +1,13 @@ +module module0_5 + use module2, only: func2 => func + + implicit none + +contains + subroutine func() + call func2() + print *, "This is module2" + end subroutine func + +end module module0_5 + diff --git a/cgfcollector/test/multi/deps/module2.f90 b/cgfcollector/test/multi/deps/module2.f90 new file mode 100644 index 00000000..9c7af856 --- /dev/null +++ b/cgfcollector/test/multi/deps/module2.f90 @@ -0,0 +1,10 @@ +module module2 + + implicit none +contains + subroutine func() + print *, "This is module2" + end subroutine func + +end module module2 + diff --git a/cgfcollector/test/multi/deps/module3.f90 b/cgfcollector/test/multi/deps/module3.f90 new file mode 100644 index 00000000..1abff39f --- /dev/null +++ b/cgfcollector/test/multi/deps/module3.f90 @@ -0,0 +1,13 @@ +module module3 + use module2, only: func2 => func + + implicit none + +contains + subroutine func() + call func2() + print *, "This is module3" + end subroutine func + +end module module3 + diff --git a/cgfcollector/test/multi/deps/output.json b/cgfcollector/test/multi/deps/output.json new file mode 100644 index 00000000..1e0e91a5 --- /dev/null +++ b/cgfcollector/test/multi/deps/output.json @@ -0,0 +1,57 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": { "1": {} }, + "functionName": "_QMmodule0_5Pfunc", + "hasBody": true, + "meta": {}, + "origin": "module0_5.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodule2Pfunc", + "hasBody": true, + "meta": {}, + "origin": null + }, + "2": { + "callees": { "1": {} }, + "functionName": "_QMmodule3Pfunc", + "hasBody": true, + "meta": {}, + "origin": "module3.f90" + }, + "3": { + "callees": { "0": {} }, + "functionName": "_QMmy_modulePmy_subroutine", + "hasBody": true, + "meta": {}, + "origin": null + }, + "4": { + "callees": {}, + "functionName": "_QMmy_modulePsubsub", + "hasBody": true, + "meta": {}, + "origin": "module.f90" + }, + "5": { + "callees": { "3": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/multi/fortdepend_deps/Makefile b/cgfcollector/test/multi/fortdepend_deps/Makefile new file mode 100644 index 00000000..47042d46 --- /dev/null +++ b/cgfcollector/test/multi/fortdepend_deps/Makefile @@ -0,0 +1,35 @@ +include ../make_base + +BUILD_DIR = build +DEP_FILE = $(BUILD_DIR)/Makefile.dep +TARGET = $(BUILD_DIR)/output + +SRCS := $(wildcard *.f90) +OBJS := $(SRCS:.f90=.o) +OBJS := $(addprefix $(BUILD_DIR)/, $(OBJS)) +OBJS_JSON := $(SRCS:.f90=.json) +OBJS_JSON := $(addprefix $(BUILD_DIR)/, $(OBJS_JSON)) + +all: $(TARGET) $(DEP_FILE) + +$(TARGET): $(OBJS) + $(LD) $(TARGET).json $(OBJS_JSON) + +$(BUILD_DIR)/%.o: %.f90 | $(BUILD_DIR) + $(FC) -module-dir $(BUILD_DIR) -o $@ $< + +$(BUILD_DIR): + mkdir -p $(BUILD_DIR) + +.PHONY: depend +depend: $(DEP_FILE) + +$(DEP_FILE): $(SRCS) | $(BUILD_DIR) + @echo "Making dependencies!" + $(MAKEDEPEND) --build $(BUILD_DIR) -w -o $(DEP_FILE) -f $(SRCS) + +.PHONY: clean +clean: + rm -rf $(BUILD_DIR) + +include $(DEP_FILE) diff --git a/cgfcollector/test/multi/fortdepend_deps/main.f90 b/cgfcollector/test/multi/fortdepend_deps/main.f90 new file mode 100644 index 00000000..def16537 --- /dev/null +++ b/cgfcollector/test/multi/fortdepend_deps/main.f90 @@ -0,0 +1,10 @@ +program main + use my_module, only: my_subroutine + use module3 + + implicit none + + call my_subroutine(5) + +end program main + diff --git a/cgfcollector/test/multi/fortdepend_deps/module.f90 b/cgfcollector/test/multi/fortdepend_deps/module.f90 new file mode 100644 index 00000000..2a1b0134 --- /dev/null +++ b/cgfcollector/test/multi/fortdepend_deps/module.f90 @@ -0,0 +1,20 @@ +module my_module + use module0_5 + + implicit none + +contains + subroutine subsub() + integer :: n + end subroutine subsub + + subroutine my_subroutine(n) + integer, intent(in) :: n + + write (*, *) n + + call func() + + end subroutine my_subroutine +end module my_module + diff --git a/cgfcollector/test/multi/fortdepend_deps/module0_5.f90 b/cgfcollector/test/multi/fortdepend_deps/module0_5.f90 new file mode 100644 index 00000000..0ff134db --- /dev/null +++ b/cgfcollector/test/multi/fortdepend_deps/module0_5.f90 @@ -0,0 +1,13 @@ +module module0_5 + use module2, only: func2 => func + + implicit none + +contains + subroutine func() + call func2() + print *, "This is module2" + end subroutine func + +end module module0_5 + diff --git a/cgfcollector/test/multi/fortdepend_deps/module2.f90 b/cgfcollector/test/multi/fortdepend_deps/module2.f90 new file mode 100644 index 00000000..9c7af856 --- /dev/null +++ b/cgfcollector/test/multi/fortdepend_deps/module2.f90 @@ -0,0 +1,10 @@ +module module2 + + implicit none +contains + subroutine func() + print *, "This is module2" + end subroutine func + +end module module2 + diff --git a/cgfcollector/test/multi/fortdepend_deps/module3.f90 b/cgfcollector/test/multi/fortdepend_deps/module3.f90 new file mode 100644 index 00000000..1abff39f --- /dev/null +++ b/cgfcollector/test/multi/fortdepend_deps/module3.f90 @@ -0,0 +1,13 @@ +module module3 + use module2, only: func2 => func + + implicit none + +contains + subroutine func() + call func2() + print *, "This is module3" + end subroutine func + +end module module3 + diff --git a/cgfcollector/test/multi/fortdepend_deps/output.json b/cgfcollector/test/multi/fortdepend_deps/output.json new file mode 100644 index 00000000..1e0e91a5 --- /dev/null +++ b/cgfcollector/test/multi/fortdepend_deps/output.json @@ -0,0 +1,57 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": { "1": {} }, + "functionName": "_QMmodule0_5Pfunc", + "hasBody": true, + "meta": {}, + "origin": "module0_5.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodule2Pfunc", + "hasBody": true, + "meta": {}, + "origin": null + }, + "2": { + "callees": { "1": {} }, + "functionName": "_QMmodule3Pfunc", + "hasBody": true, + "meta": {}, + "origin": "module3.f90" + }, + "3": { + "callees": { "0": {} }, + "functionName": "_QMmy_modulePmy_subroutine", + "hasBody": true, + "meta": {}, + "origin": null + }, + "4": { + "callees": {}, + "functionName": "_QMmy_modulePsubsub", + "hasBody": true, + "meta": {}, + "origin": "module.f90" + }, + "5": { + "callees": { "3": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/multi/make_base.in b/cgfcollector/test/multi/make_base.in new file mode 100644 index 00000000..230b993d --- /dev/null +++ b/cgfcollector/test/multi/make_base.in @@ -0,0 +1,3 @@ +MAKEDEPEND = fortdepend +FC = @CGFCOLLECTOR_WRAPPER@ +LD = @CGMERGE2_EXECUTABLE@ diff --git a/cgfcollector/test/multi/module_inherit/CMakeLists.txt b/cgfcollector/test/multi/module_inherit/CMakeLists.txt new file mode 100644 index 00000000..4d426e4a --- /dev/null +++ b/cgfcollector/test/multi/module_inherit/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 3.20) + +project(module_inherit LANGUAGES Fortran) + +include(../cmake_base.txt) + +file( + GLOB + SOURCES + "*.f90" +) + +add_executable(${CMAKE_PROJECT_NAME} ${SOURCES}) diff --git a/cgfcollector/test/multi/module_inherit/main.f90 b/cgfcollector/test/multi/module_inherit/main.f90 new file mode 100644 index 00000000..24caf86e --- /dev/null +++ b/cgfcollector/test/multi/module_inherit/main.f90 @@ -0,0 +1,67 @@ +module mod2 + use mod + implicit none + + type, extends(base) :: derived + contains + procedure :: set_var => set_var_derived + end type derived + + type, extends(derived) :: more_derived + contains + procedure :: set_var => set_var_more_derived + end type more_derived + +contains + + subroutine set_var_derived(this, a) + class(derived), intent(inout) :: this + real, intent(in) :: a + print *, 'Setting var from derived' + this%var = a + end subroutine set_var_derived + + subroutine set_var_more_derived(this, a) + class(more_derived), intent(inout) :: this + real, intent(in) :: a + print *, 'Setting var from more_derived' + this%var = a + end subroutine set_var_more_derived + + subroutine set_from_item(item, a) + class(derived), intent(inout) :: item + real, intent(in) :: a + + print *, 'Setting var from item' + call item%set_var(a) + end subroutine set_from_item + +end module mod2 + +program main + use mod2 + + implicit none + + call case1() + call case2() + +contains + subroutine case1() + type(derived) :: b + + call b%set_var(3.14) + + call set_from_item(b, 2.71) + end subroutine case1 + + subroutine case2() + class(derived), allocatable :: b + + allocate (more_derived :: b) + + call b%set_var(3.14) + end subroutine case2 + +end program main + diff --git a/cgfcollector/test/multi/module_inherit/mod.f90 b/cgfcollector/test/multi/module_inherit/mod.f90 new file mode 100644 index 00000000..417aeaa7 --- /dev/null +++ b/cgfcollector/test/multi/module_inherit/mod.f90 @@ -0,0 +1,21 @@ +module mod + + implicit none + + type :: base + real ::var + contains + procedure :: set_var => set_var_base + end type base + +contains + + subroutine set_var_base(this, a) + class(base), intent(inout) :: this + real, intent(in) :: a + print *, 'Setting var from base' + this%var = a + end subroutine set_var_base + +end module mod + diff --git a/cgfcollector/test/multi/module_inherit/output.json b/cgfcollector/test/multi/module_inherit/output.json new file mode 100644 index 00000000..ee3c8afb --- /dev/null +++ b/cgfcollector/test/multi/module_inherit/output.json @@ -0,0 +1,64 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPset_var_base", + "hasBody": true, + "meta": {}, + "origin": "mod.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmod2Pset_var_derived", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "0": {}, "1": {}, "3": {} }, + "functionName": "_QMmod2Pset_from_item", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "_QMmod2Pset_var_more_derived", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": { "5": {}, "6": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "5": { + "callees": { "0": {}, "1": {}, "2": {}, "3": {} }, + "functionName": "_QFPcase1", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "6": { + "callees": { "0": {}, "1": {}, "3": {} }, + "functionName": "_QFPcase2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "5b45b5518fe1d09584c1518ceeb337c7389df48a", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/multi/operator/CMakeLists.txt b/cgfcollector/test/multi/operator/CMakeLists.txt new file mode 100644 index 00000000..bb5d0cbc --- /dev/null +++ b/cgfcollector/test/multi/operator/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 3.20) + +project(operator LANGUAGES Fortran) + +include(../cmake_base.txt) + +file( + GLOB + SOURCES + "*.f90" +) + +add_executable(${CMAKE_PROJECT_NAME} ${SOURCES}) diff --git a/cgfcollector/test/multi/operator/main.f90 b/cgfcollector/test/multi/operator/main.f90 new file mode 100644 index 00000000..a8766598 --- /dev/null +++ b/cgfcollector/test/multi/operator/main.f90 @@ -0,0 +1,27 @@ +program main + use mod + + implicit none + + call test_compare() + +contains + subroutine test_compare() + class(sortable), allocatable :: a, b + type(integer_sortable) :: c, d + + c%value = 5 + d%value = 10 + + allocate (a, source=c) + allocate (b, source=d) + + if (a < b) then + print *, "a is less then b" + else + print *, "a is nat less then b" + end if + end subroutine test_compare + +end program main + diff --git a/cgfcollector/test/multi/operator/mod.f90 b/cgfcollector/test/multi/operator/mod.f90 new file mode 100644 index 00000000..2b8a8629 --- /dev/null +++ b/cgfcollector/test/multi/operator/mod.f90 @@ -0,0 +1,39 @@ +module mod + + implicit none + + type, abstract :: sortable + contains + procedure(compare), deferred :: less_then + generic :: operator(<) => less_then + end type sortable + + interface + logical function compare(this, other) + import :: sortable + implicit none + class(sortable), intent(in) :: this, other + end function compare + end interface + + type, extends(sortable) :: integer_sortable + integer :: value + contains + procedure :: less_then => less_then_integer + end type integer_sortable + +contains + + logical function less_then_integer(this, other) + class(integer_sortable), intent(in) :: this + class(sortable), intent(in) :: other + + select type (other) + type is (integer_sortable) + less_then_integer = this%value < other%value + print *, "Comparing integer_sortable: ", this%value, " < ", other%value + class default + error stop "Type mismatch in comparison" + end select + end function less_then_integer +end module mod diff --git a/cgfcollector/test/multi/operator/output.json b/cgfcollector/test/multi/operator/output.json new file mode 100644 index 00000000..58a91784 --- /dev/null +++ b/cgfcollector/test/multi/operator/output.json @@ -0,0 +1,43 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "compare_", + "hasBody": false, + "meta": {}, + "origin": "mod.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPless_then_integer", + "hasBody": true, + "meta": {}, + "origin": "mod.f90" + }, + "2": { + "callees": { "3": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": { "0": {}, "1": {} }, + "functionName": "_QFPtest_compare", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "b2cf8d25b16310481bf5ba0fda1c99fbe2e69267", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/multi/operator_interface/CMakeLists.txt b/cgfcollector/test/multi/operator_interface/CMakeLists.txt new file mode 100644 index 00000000..4576061d --- /dev/null +++ b/cgfcollector/test/multi/operator_interface/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 3.20) + +project(operator_interface LANGUAGES Fortran) + +include(../cmake_base.txt) + +file( + GLOB + SOURCES + "*.f90" +) + +add_executable(${CMAKE_PROJECT_NAME} ${SOURCES}) diff --git a/cgfcollector/test/multi/operator_interface/main.f90 b/cgfcollector/test/multi/operator_interface/main.f90 new file mode 100644 index 00000000..f3e08d8b --- /dev/null +++ b/cgfcollector/test/multi/operator_interface/main.f90 @@ -0,0 +1,20 @@ +program main + use mod + + implicit none + + integer :: x, y, res + real :: e = 5.0, f + + x = 5 + y = 10 + + res = x + y + + print *, "Result of x + y = ", res + + f = .NEGX.e + + print *, "Negated value: ", f +end program main + diff --git a/cgfcollector/test/multi/operator_interface/mod.f90 b/cgfcollector/test/multi/operator_interface/mod.f90 new file mode 100644 index 00000000..013fc4e8 --- /dev/null +++ b/cgfcollector/test/multi/operator_interface/mod.f90 @@ -0,0 +1,42 @@ +module mod + + implicit none + + type :: integer_wrapper + integer :: value + end type integer_wrapper + + interface operator(+) + procedure add_stuff + module procedure unary_plus + end interface + + interface operator(.NEGX.) + module procedure negx + end interface + +contains + + function add_stuff(x, y) result(res) + type(integer_wrapper), intent(in) :: x, y + type(integer_wrapper) :: res + res%value = x%value + y%value + print *, "Hello from add_stuff" + end function add_stuff + + function unary_plus(x) result(res) + type(integer_wrapper), intent(in) :: x + type(integer_wrapper) :: res + res%value = x%value + print *, "Hello from unary_plus" + end function unary_plus + + function negx(x) result(res) + real, intent(in) :: x + real :: res + res = -x + print *, "Hello from negx" + end function negx + +end module mod + diff --git a/cgfcollector/test/multi/operator_interface/output.json b/cgfcollector/test/multi/operator_interface/output.json new file mode 100644 index 00000000..037ac23c --- /dev/null +++ b/cgfcollector/test/multi/operator_interface/output.json @@ -0,0 +1,43 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPadd_stuff", + "hasBody": true, + "meta": {}, + "origin": "mod.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPunary_plus", + "hasBody": true, + "meta": {}, + "origin": "mod.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPnegx", + "hasBody": true, + "meta": {}, + "origin": "mod.f90" + }, + "3": { + "callees": { "0": {}, "2": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "37c33e071f7bc6b1dba2e01ff2e7305aaeb3ccee", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/multi/use/CMakeLists.txt b/cgfcollector/test/multi/use/CMakeLists.txt new file mode 100644 index 00000000..dd95a937 --- /dev/null +++ b/cgfcollector/test/multi/use/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 3.20) + +project(use LANGUAGES Fortran) + +include(../cmake_base.txt) + +file( + GLOB + SOURCES + "*.f90" +) + +add_executable(${CMAKE_PROJECT_NAME} ${SOURCES}) diff --git a/cgfcollector/test/multi/use/main.f90 b/cgfcollector/test/multi/use/main.f90 new file mode 100644 index 00000000..4faf339b --- /dev/null +++ b/cgfcollector/test/multi/use/main.f90 @@ -0,0 +1,11 @@ +program main + use mod + implicit none + + class(base), allocatable :: b + allocate (derived :: b) + + call b%set_var(3.14) + +end program main + diff --git a/cgfcollector/test/multi/use/mod.f90 b/cgfcollector/test/multi/use/mod.f90 new file mode 100644 index 00000000..e60d4155 --- /dev/null +++ b/cgfcollector/test/multi/use/mod.f90 @@ -0,0 +1,34 @@ +module mod + + implicit none + + type :: base + private + real ::var + contains + procedure :: set_var => set_var_base + end type base + + type, extends(base) :: derived + contains + procedure :: set_var => set_var_derived + end type derived + +contains + + subroutine set_var_base(this, a) + class(base), intent(inout) :: this + real, intent(in) :: a + print *, 'Setting var from base' + this%var = a + end subroutine set_var_base + + subroutine set_var_derived(this, a) + class(derived), intent(inout) :: this + real, intent(in) :: a + print *, 'Setting var from derived' + this%var = a + end subroutine set_var_derived + +end module mod + diff --git a/cgfcollector/test/multi/use/output.json b/cgfcollector/test/multi/use/output.json new file mode 100644 index 00000000..2c7c7b15 --- /dev/null +++ b/cgfcollector/test/multi/use/output.json @@ -0,0 +1,36 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPset_var_base", + "hasBody": true, + "meta": {}, + "origin": "mod.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPset_var_derived", + "hasBody": true, + "meta": {}, + "origin": "mod.f90" + }, + "2": { + "callees": { "0": {}, "1": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "b2cf8d25b16310481bf5ba0fda1c99fbe2e69267", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/empty_main/main.f90 b/cgfcollector/test/simple/empty_main/main.f90 new file mode 100644 index 00000000..83b66288 --- /dev/null +++ b/cgfcollector/test/simple/empty_main/main.f90 @@ -0,0 +1,6 @@ +program main + + implicit none + +end program main + diff --git a/cgfcollector/test/simple/empty_main/output.json b/cgfcollector/test/simple/empty_main/output.json new file mode 100644 index 00000000..cf4669c2 --- /dev/null +++ b/cgfcollector/test/simple/empty_main/output.json @@ -0,0 +1,22 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "1cd843384a952a5a8ece2d8f7f3d6726964583f8", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/empty_module/mod.f90 b/cgfcollector/test/simple/empty_module/mod.f90 new file mode 100644 index 00000000..2caa6d54 --- /dev/null +++ b/cgfcollector/test/simple/empty_module/mod.f90 @@ -0,0 +1,5 @@ +module mod + + implicit none + +end module mod diff --git a/cgfcollector/test/simple/empty_module/output.json b/cgfcollector/test/simple/empty_module/output.json new file mode 100644 index 00000000..df47c1cb --- /dev/null +++ b/cgfcollector/test/simple/empty_module/output.json @@ -0,0 +1,11 @@ +{ + "_CG": { "meta": {}, "nodes": {} }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "1cd843384a952a5a8ece2d8f7f3d6726964583f8", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/entry/main.f90 b/cgfcollector/test/simple/entry/main.f90 new file mode 100644 index 00000000..46027443 --- /dev/null +++ b/cgfcollector/test/simple/entry/main.f90 @@ -0,0 +1,31 @@ +module mod + + implicit none + +contains + subroutine func(a, b, c) + integer :: a, b + character(4) :: c + print *, "entry func" + return + + entry entry1(a, b, c) + print *, "entry entry1" + return + + entry entry2 + print *, "entry entry2" + return + end +end module mod + +program main + use mod + implicit none + + call func(1, 2, "1234") + call entry1(1, 2, "1234") + call entry2() + +end program main + diff --git a/cgfcollector/test/simple/entry/output.json b/cgfcollector/test/simple/entry/output.json new file mode 100644 index 00000000..0fae7506 --- /dev/null +++ b/cgfcollector/test/simple/entry/output.json @@ -0,0 +1,43 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPentry1", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPentry2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPfunc", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": { "0": {}, "1": {}, "2": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/final/input.f90 b/cgfcollector/test/simple/final/input.f90 new file mode 100644 index 00000000..31d82da9 --- /dev/null +++ b/cgfcollector/test/simple/final/input.f90 @@ -0,0 +1,123 @@ +module mod + implicit none + + type :: polynomial + private + real, allocatable :: a(:) + contains + procedure :: print_polynomial + final :: finalize_polynomial + end type polynomial + + interface polynomial + module procedure create_polynomial + end interface + +contains + + type(polynomial) function create_polynomial(a) + real, intent(in) :: a(0:) + integer :: degree(1) + + degree = findloc(a /= 0.0, value=.true., back=.true.) - 1 + allocate (create_polynomial%a(0:degree(1))) + create_polynomial%a(0:) = a(0:degree(1)) + end function create_polynomial + + subroutine print_polynomial(this) + class(polynomial), intent(in) :: this + write (*, *) 'Polynomial:', this%a + end subroutine print_polynomial + + subroutine finalize_polynomial(this) + type(polynomial), intent(inout) :: this + if (allocated(this%a)) then + deallocate (this%a) + end if + write (*, *) 'Finalizing polynomial' + end subroutine finalize_polynomial + +end module mod + +module mod_use + use mod + + implicit none + +contains + + subroutine func_calls_final() + type(polynomial), allocatable :: q + + q = polynomial([2., 3., 1., 0., 0.]) + call q%print_polynomial() + end subroutine func_calls_final + + subroutine func_calls_final2() + type(polynomial) :: q + end subroutine func_calls_final2 + + subroutine func_calls_final3() + type(polynomial), allocatable :: q + + call set_q() + ! call set_q_alloc() + ! call set_q_alloc2() + ! call set_q_move_alloc() + + contains + subroutine set_q() + q = polynomial([2., 3., 1., 0., 0.]) + end subroutine set_q + subroutine set_q_alloc() + type(polynomial), allocatable :: p + p = polynomial([2., 3., 1., 0., 0.]) + + allocate (q, source=p) + end subroutine set_q_alloc + subroutine set_q_alloc2() + type(polynomial), allocatable :: q + allocate (q) + end subroutine set_q_alloc2 + subroutine set_nothing() + end subroutine set_nothing + subroutine set_q_move_alloc() + type(polynomial), allocatable :: p + p = polynomial([2., 3., 1., 0., 0.]) + + call move_alloc(p, q) + end subroutine set_q_move_alloc + end subroutine func_calls_final3 + + subroutine func_does_not_call_final() + type(polynomial), allocatable :: q + end subroutine func_does_not_call_final + +end module mod_use + +program main + use mod + use mod_use + implicit none + + call func() + +contains + subroutine func() + work: block + type(polynomial), allocatable :: q + + q = polynomial([2., 3., 1., 0., 0.]) + call q%print_polynomial() + end block work + + print *, 'Calling func_calls_final' + call func_calls_final() + print *, 'Calling func_calls_final2' + call func_calls_final2() + print *, 'Calling func_does_not_call_final' + call func_does_not_call_final() + print *, 'Calling func_calls_final3' + call func_calls_final3() + end subroutine func +end program main diff --git a/cgfcollector/test/simple/final/output.json b/cgfcollector/test/simple/final/output.json new file mode 100644 index 00000000..66fe22a7 --- /dev/null +++ b/cgfcollector/test/simple/final/output.json @@ -0,0 +1,121 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": { + "1": {}, + "10": {}, + "11": {}, + "12": {}, + "2": {}, + "3": {}, + "9": {} + }, + "functionName": "_QFPfunc", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPcreate_polynomial", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "10": { + "callees": { "2": {} }, + "functionName": "_QMmod_usePfunc_calls_final2", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "11": { + "callees": { "2": {}, "5": {} }, + "functionName": "_QMmod_usePfunc_calls_final3", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "12": { + "callees": {}, + "functionName": "_QMmod_usePfunc_does_not_call_final", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "13": { + "callees": { "0": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPfinalize_polynomial", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "3": { + "callees": {}, + "functionName": "_QMmodPprint_polynomial", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "4": { + "callees": {}, + "functionName": "_QMmod_useFfunc_calls_final3Pset_nothing", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "5": { + "callees": { "1": {} }, + "functionName": "_QMmod_useFfunc_calls_final3Pset_q", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "6": { + "callees": { "1": {}, "2": {} }, + "functionName": "_QMmod_useFfunc_calls_final3Pset_q_alloc", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "7": { + "callees": { "2": {} }, + "functionName": "_QMmod_useFfunc_calls_final3Pset_q_alloc2", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "8": { + "callees": { "1": {}, "2": {} }, + "functionName": "_QMmod_useFfunc_calls_final3Pset_q_move_alloc", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "9": { + "callees": { "1": {}, "2": {}, "3": {} }, + "functionName": "_QMmod_usePfunc_calls_final", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/final2/main.f90 b/cgfcollector/test/simple/final2/main.f90 new file mode 100644 index 00000000..745761a1 --- /dev/null +++ b/cgfcollector/test/simple/final2/main.f90 @@ -0,0 +1,94 @@ +module mod + + implicit none + + type :: base + integer :: a + contains + final :: finalize_base + end type base + + type, extends(base) :: derived + integer :: b + contains + final :: finalize_derived + end type derived + +contains + + subroutine finalize_base(this) + type(base), intent(inout) :: this + print *, "Finalizing base" + end subroutine finalize_base + + subroutine finalize_derived(this) + type(derived), intent(inout) :: this + print *, "Finalizing derived" + end subroutine finalize_derived + + subroutine func_arg(this) + ! this does not call a finalize + type(derived) :: this + print *, "In func_arg" + end subroutine func_arg + + subroutine func_arg2(this) + ! this calls a finalize + type(derived) :: this + print *, "In func_arg2" + this = derived(1, 2) + end subroutine func_arg2 + + subroutine func_arg_out(this) + ! this calls a finalize (7.5.6.3 line 21 and onwards) + type(derived), intent(out) :: this + print *, "In func_arg_out" + end subroutine func_arg_out + + subroutine func_arg_inout(this) + ! does not call a finalize + type(derived), intent(inout) :: this + print *, "In func_arg_inout" + end subroutine func_arg_inout + + subroutine func_arg_inout2(this) + ! this calls a finalize + type(derived), intent(inout) :: this + print *, "In func_arg_inout2" + this = derived(1, 2) + end subroutine func_arg_inout2 + +end module mod + +program main + use mod + + implicit none + + call func() + +contains + + subroutine func() + type(derived) :: obj + + print *, "Before func_arg" + call func_arg(obj) + print *, "After func_arg" + print *, "Before func_arg2" + call func_arg2(obj) + print *, "After func_arg2" + print *, "Before func_arg_out" + call func_arg_out(obj) + print *, "After func_arg_out" + print *, "Before func_arg_inout" + call func_arg_inout(obj) + print *, "After func_arg_inout" + print *, "Before func_arg_inout2" + call func_arg_inout2(obj) + print *, "After func_arg_inout2" + + end subroutine func + +end program main + diff --git a/cgfcollector/test/simple/final2/output.json b/cgfcollector/test/simple/final2/output.json new file mode 100644 index 00000000..139e208a --- /dev/null +++ b/cgfcollector/test/simple/final2/output.json @@ -0,0 +1,86 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": { + "1": {}, + "2": {}, + "3": {}, + "4": {}, + "5": {}, + "6": {}, + "7": {} + }, + "functionName": "_QFPfunc", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPfinalize_base", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPfinalize_derived", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "_QMmodPfunc_arg", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": { "1": {}, "2": {} }, + "functionName": "_QMmodPfunc_arg2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "5": { + "callees": {}, + "functionName": "_QMmodPfunc_arg_inout", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "6": { + "callees": { "1": {}, "2": {} }, + "functionName": "_QMmodPfunc_arg_inout2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "7": { + "callees": { "1": {}, "2": {} }, + "functionName": "_QMmodPfunc_arg_out", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "8": { + "callees": { "0": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/final3/main.f90 b/cgfcollector/test/simple/final3/main.f90 new file mode 100644 index 00000000..bcb7dae2 --- /dev/null +++ b/cgfcollector/test/simple/final3/main.f90 @@ -0,0 +1,126 @@ +module mod + + implicit none + + type :: base + integer :: a + contains + final :: finalize_base + end type base + + type, extends(base) :: derived + integer :: b + contains + final :: finalize_derived + end type derived + +contains + + subroutine finalize_base(this) + type(base), intent(inout) :: this + print *, "Finalizing base" + end subroutine finalize_base + + subroutine finalize_derived(this) + type(derived), intent(inout) :: this + print *, "Finalizing derived" + end subroutine finalize_derived + + subroutine func_arg(this) + type(derived), allocatable :: this + print *, "In func_arg" + allocate (this) + end subroutine func_arg + + subroutine func_arg_out(this) + type(derived), allocatable, intent(out) :: this + print *, "In func_arg_out" + allocate (this) + end subroutine func_arg_out + + subroutine func_arg_inout(this) + type(derived), allocatable, intent(inout) :: this + print *, "In func_arg_inout" + allocate (this) + end subroutine func_arg_inout + + subroutine func_arg2(this) + type(derived), allocatable :: this + print *, "In func_arg2" + end subroutine func_arg2 + + subroutine func_arg_out2(this) + type(derived), allocatable, intent(out) :: this + print *, "In func_arg_out2" + end subroutine func_arg_out2 + + subroutine func_arg_inout2(this) + type(derived), allocatable, intent(inout) :: this + print *, "In func_arg_inout2" + end subroutine func_arg_inout2 + +end module mod + +program main + use mod + + implicit none + + print *, "Calling func" + call func() + print *, "Calling func_no_finalize" + call func_no_finalize() + +contains + + subroutine func() + type(derived), allocatable :: obj + type(derived), allocatable :: obj2 + type(derived), allocatable :: obj3 + + print *, "Before func_arg" + call func_arg(obj) + print *, "After func_arg" + print *, "Before func_arg_out" + call func_arg_out(obj2) + print *, "After func_arg_out" + print *, "Before func_arg_inout" + call func_arg_inout(obj3) + print *, "After func_arg_inout" + + end subroutine func + + subroutine func_no_finalize() + type(derived), allocatable :: obj + type(derived), allocatable :: obj2 + type(derived), allocatable :: obj3 + + print *, "Before func_arg2" + call func_arg2(obj) + print *, "After func_arg2" + print *, "Before func_arg_out2" + call func_arg_out2(obj2) + print *, "After func_arg_out2" + print *, "Before func_arg_inout2" + call func_arg_inout2(obj3) + print *, "After func_arg_inout2" + + end subroutine func_no_finalize + + ! TODO: + ! subroutine func_more() + ! type(derived), allocatable :: obj + + ! call func_more_internal(obj) + + ! contains + ! subroutine func_more_internal(obj_internal) + ! type(derived), intent(out), allocatable :: obj_internal + + ! call func_arg_out(obj_internal) + + ! end subroutine func_more_internal + ! end subroutine func_more + +end program main + diff --git a/cgfcollector/test/simple/final3/output.json b/cgfcollector/test/simple/final3/output.json new file mode 100644 index 00000000..548c165d --- /dev/null +++ b/cgfcollector/test/simple/final3/output.json @@ -0,0 +1,92 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": { "2": {}, "3": {}, "4": {}, "6": {}, "8": {} }, + "functionName": "_QFPfunc", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": { "5": {}, "7": {}, "9": {} }, + "functionName": "_QFPfunc_no_finalize", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "10": { + "callees": { "0": {}, "1": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPfinalize_base", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "_QMmodPfinalize_derived", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": {}, + "functionName": "_QMmodPfunc_arg", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "5": { + "callees": {}, + "functionName": "_QMmodPfunc_arg2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "6": { + "callees": {}, + "functionName": "_QMmodPfunc_arg_inout", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "7": { + "callees": {}, + "functionName": "_QMmodPfunc_arg_inout2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "8": { + "callees": {}, + "functionName": "_QMmodPfunc_arg_out", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "9": { + "callees": {}, + "functionName": "_QMmodPfunc_arg_out2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/final4/main.f90 b/cgfcollector/test/simple/final4/main.f90 new file mode 100644 index 00000000..0d7e2fbb --- /dev/null +++ b/cgfcollector/test/simple/final4/main.f90 @@ -0,0 +1,36 @@ +module mod + implicit none + + type dummy_type + integer :: i + contains + final :: finalize_dummy + end type dummy_type + + interface dummy_type + module procedure create_dummy_type + end interface dummy_type +contains + subroutine finalize_dummy(this) + type(dummy_type), intent(inout) :: this + write (*, *) 'Finalizing dummy_type' + end subroutine finalize_dummy + + type(dummy_type) function create_dummy_type(i) + integer, intent(in) :: i + create_dummy_type%i = i + write (*, *) 'Creating dummy_type with i = ', create_dummy_type%i + end function create_dummy_type +end module mod + +program main + use mod + + implicit none + + type(dummy_type), allocatable :: dummy + dummy = dummy_type(1) + + ! dummy finalizer is called here but this is not confrom with the fortran specification (7.5.6.4) +end program main + diff --git a/cgfcollector/test/simple/final4/output.json b/cgfcollector/test/simple/final4/output.json new file mode 100644 index 00000000..f633ac20 --- /dev/null +++ b/cgfcollector/test/simple/final4/output.json @@ -0,0 +1,36 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPcreate_dummy_type", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPfinalize_dummy", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "0": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/final5/main.f90 b/cgfcollector/test/simple/final5/main.f90 new file mode 100644 index 00000000..c8ea710a --- /dev/null +++ b/cgfcollector/test/simple/final5/main.f90 @@ -0,0 +1,46 @@ +module mod + + implicit none + + type :: base + integer :: a + contains + final :: finalize_base + end type base + + type, extends(base) :: derived + integer :: b + contains + final :: finalize_derived + end type derived + + type(derived) :: derivedInModule ! not destructed because static lifetime + +contains + + subroutine finalize_base(this) + type(base), intent(inout) :: this + print *, "Finalizing base" + end subroutine finalize_base + + subroutine finalize_derived(this) + type(derived), intent(inout) :: this + print *, "Finalizing derived" + end subroutine finalize_derived + +end module mod + +program main + + implicit none + +contains + subroutine func() + use mod + type(derived), save :: obj ! save = static lifetime + + obj = derived(1, 2) + end subroutine func + +end program main + diff --git a/cgfcollector/test/simple/final5/output.json b/cgfcollector/test/simple/final5/output.json new file mode 100644 index 00000000..c54c2e59 --- /dev/null +++ b/cgfcollector/test/simple/final5/output.json @@ -0,0 +1,43 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QFPfunc", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPfinalize_base", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPfinalize_derived", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/function_pointer/main.f90 b/cgfcollector/test/simple/function_pointer/main.f90 new file mode 100644 index 00000000..a08975b0 --- /dev/null +++ b/cgfcollector/test/simple/function_pointer/main.f90 @@ -0,0 +1,36 @@ +program main + implicit none + + abstract interface + function func(x) result(y) + real, intent(in) :: x + end function func + end interface + + procedure(func), pointer :: func_ptr => null() + real :: result + + result = 0.0 + func_ptr => square + result = func_ptr(2.0) + print *, "Square of 2.0 is: ", result + + func_ptr => cube + result = func_ptr(2.0) + print *, "Cube of 2.0 is: ", result + +contains + + function square(x) result(y) + real, intent(in) :: x + real :: y + y = x*x + end function square + + function cube(x) result(y) + real, intent(in) :: x + real :: y + y = x*x*x + end function cube + +end program main diff --git a/cgfcollector/test/simple/function_test/main.f90 b/cgfcollector/test/simple/function_test/main.f90 new file mode 100644 index 00000000..e9485175 --- /dev/null +++ b/cgfcollector/test/simple/function_test/main.f90 @@ -0,0 +1,92 @@ +module vector_operations +contains + function vector_add(a, b) result(result) + implicit none + real, dimension(:), intent(in) :: a, b + real, dimension(size(a)) :: result + integer :: i + + if (size(a) /= size(b)) then + print *, "Error: Vectors must be of the same size." + stop + end if + + do i = 1, size(a) + result(i) = a(i) + b(i) + end do + end function vector_add + function vector_norm(n, vec) result(norm) + implicit none + integer, intent(in) :: n + real, intent(in) :: vec(n) + real :: norm + + norm = sqrt(sum(vec**2)) + + end function vector_norm +end module vector_operations + +function vector_norm2(n, vec) result(norm) + implicit none + integer, intent(in) :: n + real, intent(in) :: vec(n) + real :: norm + + norm = sqrt(sum(vec**2)) + +end function vector_norm2 + +function size(arr) result(s) + implicit none + real, dimension(:), intent(in) :: arr + integer :: s + + s = 10 + +contains + function func1(arr) result(s) + implicit none + real, dimension(:), intent(in) :: arr + integer :: s + + s = size(arr) + end function func1 + subroutine func2(arr) + implicit none + real, dimension(:), intent(in) :: arr + integer :: s + + s = size(arr) + end subroutine func2 +end function size + +program main + use vector_operations, only: vector_add, vector_norm2 => vector_norm + implicit none + + real, dimension(3) :: a, b, result + integer :: i + + interface + function size(arr) result(s) + implicit none + real, dimension(:), intent(in) :: arr + integer :: s + end function size + end interface + + a = [1.0, 2.0, 3.0] + b = [4.0, 5.0, 6.0] + result = vector_add(a, b) + + print *, "Result of vector addition:" + do i = 1, size(result) + print *, result(i) + end do + + i = size(a) + print *, "i: ", i + + print *, "Norm of vector a:" + print *, vector_norm2(size(a), a) +end program main diff --git a/cgfcollector/test/simple/function_test/output.json b/cgfcollector/test/simple/function_test/output.json new file mode 100644 index 00000000..7b5bcd12 --- /dev/null +++ b/cgfcollector/test/simple/function_test/output.json @@ -0,0 +1,64 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMvector_operationsPvector_add", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMvector_operationsPvector_norm", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "vector_norm2_", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "size_", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": { "3": {} }, + "functionName": "_QFsizePfunc1", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "5": { + "callees": { "3": {} }, + "functionName": "_QFsizePfunc2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "6": { + "callees": { "0": {}, "1": {}, "3": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "96b749864d4e9ffe279252205b6ef755a6a86056", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/generic_interface/main.f90 b/cgfcollector/test/simple/generic_interface/main.f90 new file mode 100644 index 00000000..325deb15 --- /dev/null +++ b/cgfcollector/test/simple/generic_interface/main.f90 @@ -0,0 +1,44 @@ +module mod + + implicit none + + interface add + module procedure add_int, add_real + end interface add + +contains + + subroutine add_int(x, y) + implicit none + integer, intent(inout) :: x, y + x = x + y + end subroutine add_int + + subroutine add_real(x, y) + implicit none + real, intent(inout) :: x, y + x = x + y + end subroutine add_real + +end module mod + +program main + use mod + + implicit none + + integer :: x, y + real :: r1, r2 + x = 1 + y = 2 + r1 = 3.3 + r2 = 4.4 + + call add(x, y) + call add(r1, r2) + + print *, "Integer addition result: ", x + print *, "Real addition result: ", r1 + +end program main + diff --git a/cgfcollector/test/simple/generic_interface/output.json b/cgfcollector/test/simple/generic_interface/output.json new file mode 100644 index 00000000..48e756a3 --- /dev/null +++ b/cgfcollector/test/simple/generic_interface/output.json @@ -0,0 +1,36 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPadd_int", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPadd_real", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "0": {}, "1": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/interop/func.c b/cgfcollector/test/simple/interop/func.c new file mode 100644 index 00000000..1f764483 --- /dev/null +++ b/cgfcollector/test/simple/interop/func.c @@ -0,0 +1 @@ +int add(int a, int b) { return a + b; } diff --git a/cgfcollector/test/simple/interop/main.f90 b/cgfcollector/test/simple/interop/main.f90 new file mode 100644 index 00000000..d8ecb4b9 --- /dev/null +++ b/cgfcollector/test/simple/interop/main.f90 @@ -0,0 +1,24 @@ +program main + use iso_c_binding + implicit none + + interface + function add(a, b) bind(C) result(res) + import :: C_INT + implicit none + integer(C_INT), value :: a, b + integer(C_INT) :: res + end function add + end interface + + integer(C_INT) :: result + integer(C_INT) :: var1 + integer(C_INT) :: var2 + var1 = 3 + var2 = 23 + + result = add(var1, var2) + print *, "Result from C add function:", result + +end program main + diff --git a/cgfcollector/test/simple/interop/output.json b/cgfcollector/test/simple/interop/output.json new file mode 100644 index 00000000..5fda0b43 --- /dev/null +++ b/cgfcollector/test/simple/interop/output.json @@ -0,0 +1,29 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": { "1": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "add", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/interop_external/func.c b/cgfcollector/test/simple/interop_external/func.c new file mode 100644 index 00000000..ba2771bf --- /dev/null +++ b/cgfcollector/test/simple/interop_external/func.c @@ -0,0 +1 @@ +int add_(int* a, int* b) { return *a + *b; } diff --git a/cgfcollector/test/simple/interop_external/main.f90 b/cgfcollector/test/simple/interop_external/main.f90 new file mode 100644 index 00000000..1c34e2ed --- /dev/null +++ b/cgfcollector/test/simple/interop_external/main.f90 @@ -0,0 +1,15 @@ +program main + use iso_c_binding + implicit none + + integer(C_INT), external :: add + + integer(C_INT) :: result + integer(C_INT) :: var1 + integer(C_INT) :: var2 + var1 = 3 + var2 = 23 + + result = add(var1, var2) + print *, "Result from C add function:", result +end program main diff --git a/cgfcollector/test/simple/interop_external/output.json b/cgfcollector/test/simple/interop_external/output.json new file mode 100644 index 00000000..9e49af94 --- /dev/null +++ b/cgfcollector/test/simple/interop_external/output.json @@ -0,0 +1,29 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "add_", + "hasBody": false, + "meta": {}, + "origin": null + }, + "1": { + "callees": { "0": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/math_demo/main.f90 b/cgfcollector/test/simple/math_demo/main.f90 new file mode 100644 index 00000000..e73ba738 --- /dev/null +++ b/cgfcollector/test/simple/math_demo/main.f90 @@ -0,0 +1,73 @@ +module math_utils + implicit none + private + public :: factorial, array_stats, dot_product_custom, normalize_vector + +contains + recursive function factorial(n) result(fact) + integer, intent(in) :: n + integer :: fact + if (n <= 1) then + fact = 1 + else + fact = n*factorial(n - 1) + end if + end function factorial + + subroutine array_stats(arr, mean, std_dev) + real, intent(in) :: arr(:) + real, intent(out) :: mean, std_dev + real :: sum_arr, variance + integer :: n + n = size(arr) + sum_arr = sum(arr) + mean = sum_arr/n + variance = sum((arr - mean)**2)/n + std_dev = sqrt(variance) + end subroutine array_stats + + function dot_product_custom(a, b) result(dp) + real, intent(in) :: a(:), b(:) + real :: dp + dp = sum(a*b) + end function dot_product_custom + + subroutine normalize_vector(vec, norm_vec) + real, intent(in) :: vec(:) + real, intent(out) :: norm_vec(size(vec)) + real :: magnitude + magnitude = sqrt(sum(vec**2)) + if (magnitude /= 0.0) then + norm_vec = vec/magnitude + else + norm_vec = 0.0 + end if + end subroutine normalize_vector + +end module math_utils + +program complex_demo + use math_utils, only: factorial, array_stats, dot_product_custom, normalize_vector + implicit none + + real :: x(5), mean, std_dev, dp + real :: vec1(3), vec2(3), norm_vec(3) + integer :: i, fact + + x = [1.0, 2.0, 3.0, 4.0, 5.0] + call array_stats(x, mean, std_dev) + print *, 'Mean:', mean, 'Std Dev:', std_dev + + vec1 = [1.0, 0.0, 0.0] + vec2 = [0.0, 1.0, 0.0] + dp = dot_product_custom(vec1, vec2) + print *, 'Dot Product:', dp + + call normalize_vector(vec1, norm_vec) + print *, 'Normalized Vector:', norm_vec + + do i = 1, 5 + fact = factorial(i) + print *, 'Factorial(', i, ') = ', fact + end do +end program complex_demo diff --git a/cgfcollector/test/simple/math_demo/output.json b/cgfcollector/test/simple/math_demo/output.json new file mode 100644 index 00000000..01155e90 --- /dev/null +++ b/cgfcollector/test/simple/math_demo/output.json @@ -0,0 +1,50 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmath_utilsParray_stats", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmath_utilsPdot_product_custom", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "2": {} }, + "functionName": "_QMmath_utilsPfactorial", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "_QMmath_utilsPnormalize_vector", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": { "0": {}, "1": {}, "2": {}, "3": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/nesting/main.f90 b/cgfcollector/test/simple/nesting/main.f90 new file mode 100644 index 00000000..85b73c69 --- /dev/null +++ b/cgfcollector/test/simple/nesting/main.f90 @@ -0,0 +1,29 @@ +module m + implicit none + + type :: inner + contains + procedure :: say + end type inner + + type :: outer + type(inner) :: b + end type outer + +contains + + subroutine say(this) + class(inner), intent(in) :: this + print *, "Hello from inner" + end subroutine say + +end module m + +program main + use m + implicit none + + type(outer) :: a + + call a%b%say() +end program main diff --git a/cgfcollector/test/simple/nesting/output.json b/cgfcollector/test/simple/nesting/output.json new file mode 100644 index 00000000..e827c325 --- /dev/null +++ b/cgfcollector/test/simple/nesting/output.json @@ -0,0 +1,29 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmPsay", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": { "0": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/nesting_calls/main.f90 b/cgfcollector/test/simple/nesting_calls/main.f90 new file mode 100644 index 00000000..5d715a89 --- /dev/null +++ b/cgfcollector/test/simple/nesting_calls/main.f90 @@ -0,0 +1,38 @@ +module m + implicit none + + type :: T + contains + procedure :: func => return_ptr + procedure :: say + end type T + +contains + + function return_ptr(this) result(p) + class(T), intent(in) :: this + class(T), pointer :: p + allocate (T :: p) + select type (p) + type is (T) + p = this + end select + end function return_ptr + + subroutine say(this) + class(T), intent(in) :: this + print *, 'Hello from say' + end subroutine say + +end module m + +program main + use m + implicit none + + type(T) :: a + class(T), pointer :: tmp + + tmp => a%func() + call tmp%say() +end program main diff --git a/cgfcollector/test/simple/nesting_calls/output.json b/cgfcollector/test/simple/nesting_calls/output.json new file mode 100644 index 00000000..2f3a3626 --- /dev/null +++ b/cgfcollector/test/simple/nesting_calls/output.json @@ -0,0 +1,36 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmPreturn_ptr", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmPsay", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "0": {}, "1": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/no_body/main.f90 b/cgfcollector/test/simple/no_body/main.f90 new file mode 100644 index 00000000..ea37b6b0 --- /dev/null +++ b/cgfcollector/test/simple/no_body/main.f90 @@ -0,0 +1,39 @@ +program main + implicit none + + interface + subroutine print_stuff(n) + implicit none + integer, intent(in)::n + end subroutine print_stuff + end interface + + call print_stuff(1) + + call print_stars(5) +contains + subroutine print_stars(n) + implicit none + integer, intent(in) :: n + integer :: i + + interface + subroutine print_stuff2(f) + implicit none + integer, intent(in)::f + end subroutine print_stuff2 + end interface + + call print_stuff(1) + + do i = 1, n + write (*, *) '*' + end do + + contains + subroutine subsub(d) + integer, intent(in) :: d + end subroutine subsub + + end subroutine print_stars +end program main diff --git a/cgfcollector/test/simple/no_body/output.json b/cgfcollector/test/simple/no_body/output.json new file mode 100644 index 00000000..45d85e95 --- /dev/null +++ b/cgfcollector/test/simple/no_body/output.json @@ -0,0 +1,50 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": { "1": {}, "2": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "print_stuff_", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "1": {} }, + "functionName": "_QFPprint_stars", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "print_stuff2_", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": {}, + "functionName": "_QFFprint_starsPsubsub", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "96b749864d4e9ffe279252205b6ef755a6a86056", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/operator/main.f90 b/cgfcollector/test/simple/operator/main.f90 new file mode 100644 index 00000000..d034daf3 --- /dev/null +++ b/cgfcollector/test/simple/operator/main.f90 @@ -0,0 +1,196 @@ +module mod + + implicit none + + type, abstract :: sortable + contains + procedure(compare), deferred :: less_then + procedure(not), deferred :: not_impl + generic :: operator(<) => less_then + generic :: operator(.NOT.) => not_impl + end type sortable + + interface + logical function compare(this, other) + import :: sortable + implicit none + class(sortable), intent(in) :: this, other + end function compare + logical function not(this) + import :: sortable + implicit none + class(sortable), intent(in) :: this + end function not + end interface + + type, extends(sortable) :: integer_sortable + integer :: value + contains + procedure :: less_then => less_then_integer + procedure :: not_impl => not_impl_integer + end type integer_sortable + + type :: integer_wrapper + integer :: value + end type integer_wrapper + + interface operator(.NEGX.) + module procedure negx + end interface + + interface operator(+) + procedure add_stuff, add_stuff2 + module procedure unary_plus + end interface + +contains + logical function less_then_integer(this, other) + class(integer_sortable), intent(in) :: this + class(sortable), intent(in) :: other + + select type (other) + type is (integer_sortable) + less_then_integer = this%value < other%value + print *, "Comparing integer_sortable: ", this%value, " < ", other%value + class default + error stop "Type mismatch in comparison" + end select + end function less_then_integer + + logical function not_impl(this) + class(sortable), intent(in) :: this + not_impl = .NOT. this%less_then(this) + print *, "Hello from not_impl" + end function not_impl + + logical function not_impl_integer(this) + class(integer_sortable), intent(in) :: this + not_impl_integer = .NOT. this < this + print *, "Hello from not_impl_integer" + end function not_impl_integer + + function negx(x) result(res) + real, intent(in) :: x + real :: res + res = -x + print *, "Hello from negx" + end function negx + + function add_stuff(x, y) result(res) + type(integer_sortable), intent(in) :: x, y + type(integer_sortable) :: res + res%value = x%value + y%value + print *, "Hello from add_stuff" + end function add_stuff + + function add_stuff2(x, y) result(res) + type(integer_wrapper), intent(in) :: x, y + type(integer_wrapper) :: res + res%value = x%value + y%value + print *, "Hello from add_stuff2" + end function add_stuff2 + + function unary_plus(x) result(res) + class(integer_sortable), intent(in) :: x + type(integer_sortable) :: res + + res%value = x%value + print *, "Hello from unary_plus" + end function unary_plus +end module mod + +program main + use mod + + implicit none + + call test_compare() + call test_compare2() + call test_not() + call test_negx() + call test_add() + call test_add2() + call test_unary_plus() + call test_expr() + +contains + subroutine test_compare() + class(sortable), allocatable :: a, b + type(integer_sortable) :: c, d + type(integer_sortable) :: res + + c%value = 5 + d%value = 10 + allocate (a, source=c) + allocate (b, source=d) + + if (a < b) then + print *, "a is less then b" + else + print *, "a is nat less then b" + end if + end subroutine test_compare + + subroutine test_compare2() + class(sortable), allocatable :: a, b + type(integer_sortable) :: c, d + type(integer_sortable) :: res + + c%value = 5 + d%value = 10 + allocate (a, source=c) + allocate (b, source=d) + + if (c < d) then + print *, "c is less then d" + else + print *, "c is not less then d" + end if + end subroutine test_compare2 + + subroutine test_not() + type(integer_sortable) :: c + + if (.NOT. c) then + print *, "c is not true" + else + print *, "c is true" + end if + end subroutine test_not + + subroutine test_negx() + real :: e = 5.0, f + f = .NEGX.e + print *, "Negated value: ", f + end subroutine test_negx + + subroutine test_add() + type(integer_sortable) :: c, d, res + c%value = 5 + d%value = 10 + res = c + d + print *, "Result of addition: ", res%value + end subroutine test_add + + subroutine test_add2() + type(integer_wrapper) :: c, d, res + c%value = 5 + d%value = 10 + res = c + d + c + print *, "Result of addition: ", res%value + end subroutine test_add2 + + subroutine test_unary_plus() + type(integer_sortable) :: c, res + c%value = 5 + res = +c + print *, "Result of unary plus: ", res%value + end subroutine test_unary_plus + + subroutine test_expr() + logical :: ad + + ad = (.NOT. 324 < 2) .EQV. .true. + end subroutine test_expr + +end program main diff --git a/cgfcollector/test/simple/operator/output.json b/cgfcollector/test/simple/operator/output.json new file mode 100644 index 00000000..39629dbf --- /dev/null +++ b/cgfcollector/test/simple/operator/output.json @@ -0,0 +1,150 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "compare_", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "not_", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + }, + "10": { + "callees": { "0": {}, "2": {} }, + "functionName": "_QFPtest_compare", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "11": { + "callees": { "0": {}, "2": {} }, + "functionName": "_QFPtest_compare2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "12": { + "callees": { "1": {}, "4": {} }, + "functionName": "_QFPtest_not", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "13": { + "callees": { "5": {} }, + "functionName": "_QFPtest_negx", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "14": { + "callees": { "6": {}, "7": {} }, + "functionName": "_QFPtest_add", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "15": { + "callees": { "6": {}, "7": {} }, + "functionName": "_QFPtest_add2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "16": { + "callees": { "8": {} }, + "functionName": "_QFPtest_unary_plus", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "17": { + "callees": {}, + "functionName": "_QFPtest_expr", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPless_then_integer", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": { "0": {}, "2": {} }, + "functionName": "_QMmodPnot_impl", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": { "0": {}, "2": {} }, + "functionName": "_QMmodPnot_impl_integer", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "5": { + "callees": {}, + "functionName": "_QMmodPnegx", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "6": { + "callees": {}, + "functionName": "_QMmodPadd_stuff", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "7": { + "callees": {}, + "functionName": "_QMmodPadd_stuff2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "8": { + "callees": {}, + "functionName": "_QMmodPunary_plus", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "9": { + "callees": { + "10": {}, + "11": {}, + "12": {}, + "13": {}, + "14": {}, + "15": {}, + "16": {}, + "17": {} + }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "96b749864d4e9ffe279252205b6ef755a6a86056", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/operator2/main.f90 b/cgfcollector/test/simple/operator2/main.f90 new file mode 100644 index 00000000..9ea4245d --- /dev/null +++ b/cgfcollector/test/simple/operator2/main.f90 @@ -0,0 +1,72 @@ +module mod + + implicit none + + type, abstract :: base + integer :: value + contains + procedure(fbase), deferred :: function_base + end type base + + abstract interface + logical function fbase(this) + import :: base + implicit none + class(base), intent(in) :: this + end function fbase + end interface + + type, extends(base) :: derived + integer :: extra_value + contains + procedure :: function_base => function_base2 + end type derived + + interface operator(.NOT.) + module procedure not_base + end interface + +contains + + logical function not_base(this) + class(base), intent(in) :: this + + select type (this) + type is (derived) + print *, "Derived NOT called with value: ", this%value, " and extra value: ", this%extra_value + not_base = .true. + class default + print *, "Base NOT called with value: ", this%value + not_base = .false. + end select + end function not_base + + logical function function_base2(this) + class(derived), intent(in) :: this + print *, "Derived function called with value: ", this%value, " and extra value: ", this%extra_value + function_base2 = .true. + end function function_base2 +end module mod + +program main + use mod + implicit none + + class(base), allocatable :: obj1, obj2, result + + class(base), allocatable :: obj3 + logical :: obj3_result, obj3_result2 + + allocate (derived :: obj3) + obj3%value = 20 + select type (d => obj3) + type is (derived) + d%extra_value = 30 + end select + obj3_result = (.NOT. obj3) + obj3_result2 = obj3%function_base() + print *, "Base object NOT: ", obj3_result + print *, "Base function: ", obj3_result2 + +end program main + diff --git a/cgfcollector/test/simple/operator2/output.json b/cgfcollector/test/simple/operator2/output.json new file mode 100644 index 00000000..a5663baa --- /dev/null +++ b/cgfcollector/test/simple/operator2/output.json @@ -0,0 +1,43 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPfbase", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPfunction_base2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPnot_base", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": { "0": {}, "1": {}, "2": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/operator3/main.f90 b/cgfcollector/test/simple/operator3/main.f90 new file mode 100644 index 00000000..31475fec --- /dev/null +++ b/cgfcollector/test/simple/operator3/main.f90 @@ -0,0 +1,102 @@ +module mod + + implicit none + + type, abstract :: base + integer :: value + contains + procedure(s), deferred :: show + end type base + + abstract interface + subroutine s(this) + import :: base + implicit none + class(base), intent(in) :: this + end subroutine s + end interface + + type, extends(base) :: derived1 + contains + procedure :: show => show_derived1 + end type derived1 + + type, extends(base) :: derived2 + contains + procedure :: show => show_derived2 + end type derived2 + + interface operator(+) + module procedure add_base + end interface + + interface operator(-) + module procedure sub_derived1 + end interface + +contains + + function add_base(a, b) result(c) + class(base), intent(in) :: a, b + class(base), allocatable :: c + + select type (a) + type is (derived1) + allocate (derived1 :: c) + c%value = a%value + b%value + type is (derived2) + allocate (derived2 :: c) + c%value = a%value + b%value + class default + allocate (derived1 :: c) + c%value = a%value + b%value + end select + end function add_base + + function sub_derived1(a, b) result(c) + class(base), intent(in) :: a, b + class(base), allocatable :: c + + allocate (derived1 :: c) + c%value = a%value - b%value + end function sub_derived1 + + subroutine show_derived1(this) + class(derived1), intent(in) :: this + print *, "Derived1 with value: ", this%value + end subroutine show_derived1 + + subroutine show_derived2(this) + class(derived2), intent(in) :: this + print *, "Derived2 with value: ", this%value + end subroutine show_derived2 + +end module mod + +program main + use mod + + implicit none + + class(base), allocatable :: obj1, obj2, result + + class(derived1), allocatable :: obj_d1 + class(base), allocatable :: obj_d2 + + allocate (derived1 :: obj1) + obj1%value = 5 + allocate (derived2 :: obj2) + obj2%value = 7 + allocate (derived1 :: obj_d1) + obj_d1%value = 10 + allocate (derived1 :: obj_d2) + obj_d2%value = 10 + + result = (obj1 + obj2) - obj1 + call result%show() + + result = obj_d1 + obj_d2 + call result%show() + +end program main + diff --git a/cgfcollector/test/simple/operator3/output.json b/cgfcollector/test/simple/operator3/output.json new file mode 100644 index 00000000..f1c5b0f2 --- /dev/null +++ b/cgfcollector/test/simple/operator3/output.json @@ -0,0 +1,57 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPadd_base", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPs", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMmodPshow_derived1", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": {}, + "functionName": "_QMmodPshow_derived2", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "4": { + "callees": {}, + "functionName": "_QMmodPsub_derived1", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "5": { + "callees": { "0": {}, "1": {}, "2": {}, "3": {}, "4": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/operator4/main.f90 b/cgfcollector/test/simple/operator4/main.f90 new file mode 100644 index 00000000..4b6e1a40 --- /dev/null +++ b/cgfcollector/test/simple/operator4/main.f90 @@ -0,0 +1,34 @@ +module mod + implicit none + + type :: base + integer :: value + end type base + + interface operator(*) + module procedure multiply_base + end interface + + real, parameter :: num = 2*3.1415926535898 + real, parameter :: num2 = num*0.5, num3 = num2*0.5 + + type(base), parameter :: pi = base(3.1415926535898) + type(base), parameter :: half = base(0.5) + ! type(base) :: half_pi = pi*half not possible becasue no constant + +contains + + function multiply_base(a, b) result(res) + type(base), intent(in) :: a, b + type(base) :: res + res%value = a%value*b%value + print *, "Multiplying base values: ", a%value, " * ", b%value, " = ", res%value + end function multiply_base + +end module mod + +program main + use mod + implicit none + +end program main diff --git a/cgfcollector/test/simple/operator4/output.json b/cgfcollector/test/simple/operator4/output.json new file mode 100644 index 00000000..20660d4d --- /dev/null +++ b/cgfcollector/test/simple/operator4/output.json @@ -0,0 +1,29 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPmultiply_base", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "4cc8210c90cb04678c623259ac8d2665c6474f45", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/polymorphism/main.f90 b/cgfcollector/test/simple/polymorphism/main.f90 new file mode 100644 index 00000000..34842f48 --- /dev/null +++ b/cgfcollector/test/simple/polymorphism/main.f90 @@ -0,0 +1,51 @@ +module mod + + implicit none + + type :: body + private + real :: mass + real :: pos(3), vel(3) + contains + procedure :: set_mass => set_mass_body + end type body + + type, extends(body) :: charged_body + real :: charge + contains + procedure :: set_mass => set_mass_charged_body + end type charged_body + + class(body), allocatable :: polymorphic_body + +contains + subroutine set_mass_body(this, a) + class(body), intent(inout) :: this + real, intent(in) :: a + + write (*, *) 'Setting mass in body' + + this%mass = a + end subroutine set_mass_body + + subroutine set_mass_charged_body(this, a) + class(charged_body), intent(inout) :: this + real, intent(in) :: a + + write (*, *) 'Setting mass in charged body' + + this%mass = a + end subroutine set_mass_charged_body + +end module mod + +program main + use mod + + implicit none + + allocate (charged_body :: polymorphic_body) + call polymorphic_body%set_mass(5.0) + +end program main + diff --git a/cgfcollector/test/simple/polymorphism/output.json b/cgfcollector/test/simple/polymorphism/output.json new file mode 100644 index 00000000..92d5227e --- /dev/null +++ b/cgfcollector/test/simple/polymorphism/output.json @@ -0,0 +1,36 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPset_mass_body", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPset_mass_charged_body", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "0": {}, "1": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/polymorphism2/main.f90 b/cgfcollector/test/simple/polymorphism2/main.f90 new file mode 100644 index 00000000..6f2dc900 --- /dev/null +++ b/cgfcollector/test/simple/polymorphism2/main.f90 @@ -0,0 +1,59 @@ +module shapes + implicit none + + type, abstract :: Shape + contains + procedure(draw), deferred :: draw_shape + end type Shape + + abstract interface + subroutine draw(self) + import :: Shape + class(Shape), intent(in) :: self + end subroutine draw + end interface + + type, extends(Shape) :: Circle + real :: radius + contains + procedure :: draw_shape => draw_circle + end type Circle + + type, extends(Shape) :: Rectangle + real :: width, height + contains + procedure :: draw_shape => draw_rectangle + end type Rectangle + +contains + + subroutine draw_circle(self) + class(Circle), intent(in) :: self + print *, "Drawing a circle with radius:", self%radius + end subroutine draw_circle + + subroutine draw_rectangle(self) + class(Rectangle), intent(in) :: self + print *, "Drawing a rectangle with width:", self%width, "and height:", self%height + end subroutine draw_rectangle + +end module shapes + +program main + use shapes + implicit none + + class(Shape), allocatable :: s + type(Circle) :: c + type(Rectangle) :: r + + c%radius = 5.0 + s = c + call s%draw_shape() + + r%width = 10.0 + r%height = 20.0 + s = r + call s%draw_shape() + +end program main diff --git a/cgfcollector/test/simple/polymorphism2/output.json b/cgfcollector/test/simple/polymorphism2/output.json new file mode 100644 index 00000000..8b6fcd7a --- /dev/null +++ b/cgfcollector/test/simple/polymorphism2/output.json @@ -0,0 +1,43 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMshapesPdraw", + "hasBody": false, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMshapesPdraw_circle", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": {}, + "functionName": "_QMshapesPdraw_rectangle", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "3": { + "callees": { "0": {}, "1": {}, "2": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/simple/input.f90 b/cgfcollector/test/simple/simple/input.f90 new file mode 100644 index 00000000..8d049bea --- /dev/null +++ b/cgfcollector/test/simple/simple/input.f90 @@ -0,0 +1,15 @@ +program main + implicit none + + call print_stars(5) +contains + subroutine print_stars(n) + implicit none + integer, intent(in) :: n + integer :: i + + do i = 1, n + write (*, *) '*' + end do + end subroutine print_stars +end program main diff --git a/cgfcollector/test/simple/simple/output.json b/cgfcollector/test/simple/simple/output.json new file mode 100644 index 00000000..2821fc4a --- /dev/null +++ b/cgfcollector/test/simple/simple/output.json @@ -0,0 +1,29 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QFPprint_stars", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + }, + "1": { + "callees": { "0": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "input.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/test/simple/unlimited_polymorphism/main.f90 b/cgfcollector/test/simple/unlimited_polymorphism/main.f90 new file mode 100644 index 00000000..58eaea4d --- /dev/null +++ b/cgfcollector/test/simple/unlimited_polymorphism/main.f90 @@ -0,0 +1,71 @@ +module mod + + implicit none + + type :: my_type + integer :: a + real :: b + contains + final :: finalize_my_type + procedure :: print_stuff + end type my_type + + type :: my_type2 + contains + procedure :: print_stuff => print_stuff2 + final :: finalize_my_type2 + end type my_type2 + +contains + + subroutine finalize_my_type(this) + type(my_type), intent(inout) :: this + print *, "Finalizing my_type" + end subroutine finalize_my_type + + subroutine finalize_my_type2(this) + type(my_type2), intent(inout) :: this + print *, "Finalizing my_type2" + end subroutine finalize_my_type2 + + subroutine print_stuff(this) + class(my_type), intent(in) :: this + print *, "stuff" + end subroutine print_stuff + + subroutine print_stuff2(this) + class(my_type2), intent(in) :: this + print *, "stuff" + end subroutine print_stuff2 +end module mod + +program main + use mod + + implicit none + + call func() + +contains + subroutine func() + class(*), allocatable :: obj + + ! allocate (obj, mold=my_type2()) + ! deallocate (obj) + ! allocate (my_type2 :: obj) + ! deallocate (obj) + ! allocate (obj, source=my_type2()) + + ! can be assigned with allocate, move_alloc, = operator and in function arguments + obj = my_type(123, 12) + + select type (obj) + type is (my_type) + call obj%print_stuff() + print *, 'Object is of type my_type2' + class default + print *, 'Object is of an unknown type' + end select + end subroutine func +end program main + diff --git a/cgfcollector/test/simple/use/main.f90 b/cgfcollector/test/simple/use/main.f90 new file mode 100644 index 00000000..0a298573 --- /dev/null +++ b/cgfcollector/test/simple/use/main.f90 @@ -0,0 +1,48 @@ +module mod + + implicit none + + type :: base + private + real ::var + contains + procedure :: set_var => set_var_base + end type base + + type, extends(base) :: derived + contains + procedure :: set_var => set_var_derived + end type derived + +contains + subroutine set_var_base(this, a) + class(base), intent(inout) :: this + real, intent(in) :: a + + print *, 'Setting var from base' + + this%var = a + end subroutine set_var_base + + subroutine set_var_derived(this, a) + class(derived), intent(inout) :: this + real, intent(in) :: a + + print *, 'Setting var from derived' + + this%var = a + end subroutine set_var_derived +end module mod + +program main + use mod, only: base_rename => base, derived_rename => derived + + implicit none + + type(base_rename), allocatable :: b + + allocate (base_rename :: b) + call b%set_var(3.14) + +end program main + diff --git a/cgfcollector/test/simple/use/output.json b/cgfcollector/test/simple/use/output.json new file mode 100644 index 00000000..90fa13f9 --- /dev/null +++ b/cgfcollector/test/simple/use/output.json @@ -0,0 +1,36 @@ +{ + "_CG": { + "meta": {}, + "nodes": { + "0": { + "callees": {}, + "functionName": "_QMmodPset_var_base", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "1": { + "callees": {}, + "functionName": "_QMmodPset_var_derived", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + }, + "2": { + "callees": { "0": {}, "1": {} }, + "functionName": "_QQmain", + "hasBody": true, + "meta": {}, + "origin": "main.f90" + } + } + }, + "_MetaCG": { + "generator": { + "name": "MetaCG", + "sha": "68fb73aebcc0af419653b36a6b5e3e9668408d10", + "version": "0.9" + }, + "version": "4.0" + } +} diff --git a/cgfcollector/tools/cgfcollector_comp_wrapper.sh.in b/cgfcollector/tools/cgfcollector_comp_wrapper.sh.in new file mode 100755 index 00000000..37384e13 --- /dev/null +++ b/cgfcollector/tools/cgfcollector_comp_wrapper.sh.in @@ -0,0 +1,67 @@ +#!/usr/bin/env bash + +# Wrapper script for running cgfcollector plugin with flang. +# This script acts as a drop-in replacement for the flang compiler +# while addtionally generating call graphs for each source file. +# +# Note: The plugin requires the `-fc1` flag to be passed to flang. +# However, flang invokations with and without `-fc1` accept different +# sets of options. This script filters the original compiler options, +# keeping only those compatible with `-fc1`, and invokes flang with +# the plugin to generate call graphs. Finally, it invokes flang again +# with the original arguments to perform the actual compilation. +# +# Usage: +# cgfcollector_comp_wrapper.sh [flang options and source files] + +flang_bin=${CGFCOLLECTOR_FLANG_BIN:-"flang-new"} +flang_fc1_bin=${CGFCOLLECTOR_FLANG_FC1_BIN:-"flang-new"} + +if ! command -v "$flang_bin" &>/dev/null; then + echo "Error: $flang_bin not found in PATH." + exit 1 +fi + +source_files=() +options=() +all_args=("$@") + +# If you're using the `mpif90` wrapper, we are extracting the underlying compiler arguments using `mpif90 --show`. +# +# Important: Ensure that `flang_fc1_bin` is set to the actual Flang binary (e.g. `flang-new`, which it is by default), +# not the `mpif90` wrapper itself. The wrapper adds MPI-specific flags that are incompatible with `-fc1`. +if [[ "$flang_bin" == *mpif90 ]]; then + read -r -a mpi_show_args <<<"$(mpif90 --show)" + all_args=("${mpi_show_args[@]}" "${all_args[@]}") +fi + +# Extract all flags that are compatible with `-fc1`. +option_o=false +for arg in "${all_args[@]}"; do + if [ "$option_o" = true ]; then + options+=("$arg") + option_o=false + continue + fi + + case "$arg" in + -fPIC) + # skip + ;; + -I* | -J* | -std=* | -O* | -D* | -f* | -cpp) + options+=("$arg") + ;; + -o) + options+=("$arg") + option_o=true + ;; + *.f90 | *.F90) + source_files+=("$arg") + ;; + esac +done + +if [ ${#source_files[@]} -gt 0 ]; then + $flang_fc1_bin -fc1 -load "@CGFCOLLECTOR_FILE_NAME@" -plugin "genCG" "${options[@]}" "${source_files[@]}" +fi +$flang_bin "$@" diff --git a/cgfcollector/tools/cgfcollector_wrapper.sh.in b/cgfcollector/tools/cgfcollector_wrapper.sh.in new file mode 100755 index 00000000..34fe5858 --- /dev/null +++ b/cgfcollector/tools/cgfcollector_wrapper.sh.in @@ -0,0 +1,34 @@ +#!/usr/bin/env bash + +# Wrapper script for running cgfcollector plugin with flang. +# +# Usage: +# cgfcollector_wrapper.sh [-dot|-norename] [flang options and source files] +# +# Options: +# -dot # Generate call graph with dot format +# -norename # Do not rename output files + +flang_bin=${CGFCOLLECTOR_FLANG_BIN:-"flang-new"} + +flang_args=("$@") +plugin_name="genCG" + +if [[ "$1" == "-dot" ]]; then + plugin_name="genCGwithDot" + shift + flang_args=("$@") +fi + +if [[ "$1" == "-norename" ]]; then + plugin_name="genCGNoRename" + shift + flang_args=("$@") +fi + +if ! command -v "$flang_bin" &>/dev/null; then + echo "Error: $flang_bin not found in PATH." + exit 1 +fi + +$flang_bin -fc1 -load "@CGFCOLLECTOR_FILE_NAME@" -plugin "$plugin_name" "${flang_args[@]}" diff --git a/cgfcollector/tools/test_runner.sh.in b/cgfcollector/tools/test_runner.sh.in new file mode 100755 index 00000000..217c2bc3 --- /dev/null +++ b/cgfcollector/tools/test_runner.sh.in @@ -0,0 +1,147 @@ +#!/usr/bin/env bash + +# Test runner for cgfcollector +# +# Usage: +# test_runner.sh # run all tests +# test_runner.sh [test_name] # run specific test cases + +test_case_dir="@CGFCOLLECTOR_TEST_CASES_DIR@" +scriptdir="$(cd "$(dirname "$0")" && pwd -P)" +out_dir="$scriptdir/out" + +mkdir -p "$out_dir" + +if ! [ -d "$test_case_dir" ]; then + echo "Error: Test case directory '$test_case_dir' does not exist." + exit 1 +fi + +function find_test_dir() +{ + local test_name="${1#*_}" + local test_category="${1%%_*}" + local test_dir="$test_case_dir/$test_category/$test_name" + + if [ -d "$test_dir" ] && [ -f "$test_dir/output.json" ]; then + echo "$test_dir" + return 0 + fi + return 1 +} + +function run_single_test() +{ + local test_dir="$1" + local test_name="$2" + local expected_output="$test_dir/output.json" + local actual_output="$out_dir/$test_name.json" + + if [ -f "$test_dir/CMakeLists.txt" ]; then + # cmake managed test + local tmp_dir="$(mktemp -d)" + trap 'rm -rf '"$tmp_dir"'' RETURN + + cmake -S "$test_dir" -B "$tmp_dir" || { + echo "Failed: cmake config failed" + return 1 + } + cmake --build "$tmp_dir" || { + echo "Failed: cmake build failed" + return 1 + } + find "$tmp_dir" -maxdepth 1 -name '*.json' -exec cp {} "$actual_output" \; || { + echo "Failed: could not generate CG" + return 1 + } + elif [ -f "$test_dir/Makefile" ]; then + # make managed with fortdepend test + local tmp_dir="$(mktemp -d)" + trap 'rm -rf '"$tmp_dir"'' RETURN + + make -C "$test_dir" BUILD_DIR="$tmp_dir" || { + echo "Failed: make build failed" + return 1 + } + find "$tmp_dir" -maxdepth 1 -name 'output.json' -exec cp {} "$actual_output" \; || { + echo "Failed: could not generate CG" + return 1 + } + else + # not make/cmake managed test + local input_files=("$test_dir"/*.f90) + if ! [ -f "${input_files[0]}" ]; then + echo "Failed: no .f90 files found" + return 1 + fi + + @CGFCOLLECTOR_WRAPPER@ -dot -o "$actual_output" "${input_files[@]}" || { + echo "Failed: could not generate CG" + return 1 + } + fi + + if @CGFCOLLECTOR_CGDIFF@ "$expected_output" "$actual_output"; then + echo "Passed" + return 0 + else + echo "Failed: Output mismatch" + return 1 + fi +} + +if [ $# -gt 0 ]; then + # specific test cases + test_cases=() + for test_name in "$@"; do + test_dir=$(find_test_dir "$test_name") + if [ -n "$test_dir" ]; then + test_cases+=("$test_dir:$test_name") + else + echo "Warning: Test '$test_name' not found" + fi + done +else + # all test cases + test_cases=() + while read -r output_file; do + test_dir="$(dirname "$output_file")" + test_name="$(basename "$(dirname "$test_dir")")_$(basename "$test_dir")" + test_cases+=("$test_dir:$test_name") + done < <(find "$test_case_dir" -mindepth 1 -type d -exec find {} -maxdepth 1 -name "output.json" \;) +fi + +total_tests=${#test_cases[@]} +passed=0 +failed=0 +failed_tests=() + +# run tests +for i in "${!test_cases[@]}"; do + IFS=':' read -r test_dir test_name <<<"${test_cases[i]}" + + printf "Test %d/%d %s\n" "$((i + 1))" "$total_tests" "$test_name" + + if run_single_test "$test_dir" "$test_name"; then + ((passed++)) + else + ((failed++)) + failed_tests+=("$test_name") + fi +done + +# summary +if [ "$total_tests" -gt 0 ]; then + printf "%d%% tests passed, %d tests failed out of %d\n" \ + "$((passed * 100 / total_tests))" "$failed" "$total_tests" +else + echo "No tests found" +fi + +if [ ${#failed_tests[@]} -gt 0 ]; then + echo "Failed tests:" + for test in "${failed_tests[@]}"; do + echo " $test" + done + exit 1 +fi diff --git a/cgfcollector/tools/visuel.cpp b/cgfcollector/tools/visuel.cpp new file mode 100644 index 00000000..01bc2c46 --- /dev/null +++ b/cgfcollector/tools/visuel.cpp @@ -0,0 +1,42 @@ +#include +#include +#include +#include +#include + +static auto console = metacg::MCGLogger::instance().getConsole(); +static auto errConsole = metacg::MCGLogger::instance().getErrConsole(); + +int main(int argc, char* argv[]) { + if (argc != 2) { + errConsole->error("Usage: visuel "); + return EXIT_FAILURE; + } + + metacg::io::FileSource fs1(argv[1]); + + auto mcgReader1 = metacg::io::createReader(fs1); + if (!mcgReader1) { + return EXIT_FAILURE; + } + + auto cg = mcgReader1->read(); + if (!cg) { + errConsole->error("Error reading call graphs."); + return EXIT_FAILURE; + } + + metacg::io::dot::DotGenerator dotGen(cg.get()); + dotGen.generate(); + + std::ofstream outFile("callgraph.dot"); + if (!outFile.is_open()) { + errConsole->error("Error opening output file for writing."); + return EXIT_FAILURE; + } + outFile << dotGen.getDotString(); + + outFile.close(); + + return EXIT_SUCCESS; +} diff --git a/cmake/FlangLLVM.cmake b/cmake/FlangLLVM.cmake new file mode 100644 index 00000000..59557789 --- /dev/null +++ b/cmake/FlangLLVM.cmake @@ -0,0 +1,35 @@ +find_package( + Clang + REQUIRED + CONFIG +) + +find_package( + MLIR + REQUIRED + CONFIG +) + +find_package( + Flang + REQUIRED + CONFIG +) + +message(STATUS "Found FlangConfig.cmake in: ${Flang_DIR}") +message(STATUS "Using Flang version: ${Flang_VERSION}") +message(STATUS "Found MLIRConfig.cmake in: ${MLIR_DIR}") +message(STATUS "Using MLIR version: ${MLIR_VERSION}") + +function(add_flang target) + target_compile_definitions(${target} PRIVATE FLANG_LITTLE_ENDIAN) + + target_include_directories(${target} SYSTEM PUBLIC ${FLANG_INCLUDE_DIRS}) + + find_library( + FLANG_FRONTEND_TOOL flangFrontendTool + PATHS ${LLVM_LIBRARY_DIR} + NO_DEFAULT_PATH + ) + target_link_libraries(${target} PUBLIC ${FLANG_FRONTEND_TOOL}) +endfunction() diff --git a/graph/include/LoggerUtil.h b/graph/include/LoggerUtil.h index 11d8dbda..2e1e24c0 100644 --- a/graph/include/LoggerUtil.h +++ b/graph/include/LoggerUtil.h @@ -254,6 +254,16 @@ class MCGLogger { metacg::MCGLogger::instance().warn(msg, std::forward(args)...); } + template + static void logDebug(const MSG_t msg, Args&&... args) { + metacg::MCGLogger::instance().debug(msg, std::forward(args)...); + } + + template + static void logDebugUnique(const MSG_t msg, Args&&... args) { + metacg::MCGLogger::instance().debug(msg, std::forward(args)...); + } + /** * Resets the uniqueness-property for all messages. * Any message that has been previously logged as unique can now appear again diff --git a/graph/src/Callgraph.cpp b/graph/src/Callgraph.cpp index 8dcd4ee1..1cbbe25a 100644 --- a/graph/src/Callgraph.cpp +++ b/graph/src/Callgraph.cpp @@ -33,7 +33,7 @@ CgNode* Callgraph::getMain(bool forceRecompute) const { // Otherwise, try to find by name. if ((mainNode = getFirstNode("main")) || (mainNode = getFirstNode("_Z4main")) || - (mainNode = getFirstNode("_ZSt4mainiPPc"))) { + (mainNode = getFirstNode("_ZSt4mainiPPc")) || (mainNode = getFirstNode("_QQmain"))) { return mainNode; } diff --git a/tools/cgcollector2/fileInfoDemoPlugin/FileInfoMetadataPlugin.cpp b/tools/cgcollector2/fileInfoDemoPlugin/FileInfoMetadataPlugin.cpp index 536aa561..61ee9d21 100644 --- a/tools/cgcollector2/fileInfoDemoPlugin/FileInfoMetadataPlugin.cpp +++ b/tools/cgcollector2/fileInfoDemoPlugin/FileInfoMetadataPlugin.cpp @@ -29,7 +29,7 @@ struct FileInfoMetadataPlugin : Plugin { #else const auto fileEntry = fullSrcLoc.getFileEntryRef(); #endif - + if (!fileEntry) { return result; }