pax_global_header00006660000000000000000000000064151470737370014530gustar00rootroot0000000000000052 comment=fd5b1fb059570ee9c49b2d2e4a580a25ad9b4613 fckit-0.14.2/000077500000000000000000000000001514707373700127145ustar00rootroot00000000000000fckit-0.14.2/.clang-format000066400000000000000000000057171514707373700153010ustar00rootroot00000000000000--- Language: Cpp AccessModifierOffset: -4 AlignAfterOpenBracket: Align AlignConsecutiveAssignments: true AlignConsecutiveDeclarations: false AlignEscapedNewlines: Left AlignOperands: true AlignTrailingComments: true AllowAllParametersOfDeclarationOnNextLine: true AllowShortBlocksOnASingleLine: true AllowShortCaseLabelsOnASingleLine: false AllowShortFunctionsOnASingleLine: Inline AllowShortIfStatementsOnASingleLine: false AllowShortLoopsOnASingleLine: false AlwaysBreakAfterDefinitionReturnType: None AlwaysBreakAfterReturnType: None AlwaysBreakBeforeMultilineStrings: true AlwaysBreakTemplateDeclarations: true BinPackArguments: true BinPackParameters: true BraceWrapping: AfterClass: false AfterControlStatement: false AfterEnum: true AfterFunction: false AfterNamespace: false AfterObjCDeclaration: false AfterStruct: false AfterUnion: false BeforeCatch: true BeforeElse: true IndentBraces: false SplitEmptyFunction: true SplitEmptyRecord: true SplitEmptyNamespace: true BreakBeforeBinaryOperators: None BreakBeforeBraces: Custom BreakBeforeInheritanceComma: false BreakBeforeTernaryOperators: true BreakConstructorInitializersBeforeComma: false BreakConstructorInitializers: AfterColon BreakAfterJavaFieldAnnotations: false BreakStringLiterals: true ColumnLimit: 120 CommentPragmas: '^ IWYU pragma:' CompactNamespaces: false ConstructorInitializerAllOnOneLineOrOnePerLine: true ConstructorInitializerIndentWidth: 4 ContinuationIndentWidth: 4 Cpp11BracedListStyle: true DerivePointerAlignment: false DisableFormat: false ExperimentalAutoDetectBinPacking: false FixNamespaceComments: true ForEachMacros: - foreach - Q_FOREACH - BOOST_FOREACH IncludeCategories: - Regex: '^<.*\.h>' Priority: 1 - Regex: '^<.*' Priority: 2 - Regex: '.*' Priority: 3 IncludeIsMainRegex: '([-_](test|unittest))?$' IndentCaseLabels: true IndentWidth: 4 IndentWrappedFunctionNames: false JavaScriptQuotes: Leave JavaScriptWrapImports: true KeepEmptyLinesAtTheStartOfBlocks: false MacroBlockBegin: '' MacroBlockEnd: '' MaxEmptyLinesToKeep: 2 NamespaceIndentation: None ObjCBlockIndentWidth: 2 ObjCSpaceAfterProperty: false ObjCSpaceBeforeProtocolList: false PenaltyBreakAssignment: 2 PenaltyBreakBeforeFirstCallParameter: 1 PenaltyBreakComment: 300 PenaltyBreakFirstLessLess: 120 PenaltyBreakString: 1000 PenaltyExcessCharacter: 1000000 PenaltyReturnTypeOnItsOwnLine: 200 PointerAlignment: Left ReflowComments: false SortIncludes: true SortUsingDeclarations: true SpaceAfterCStyleCast: false SpaceAfterTemplateKeyword: true SpaceBeforeAssignmentOperators: true SpaceBeforeParens: ControlStatements SpaceInEmptyParentheses: false SpacesBeforeTrailingComments: 2 SpacesInAngles: false SpacesInContainerLiterals: true SpacesInCStyleCastParentheses: false SpacesInParentheses: true SpacesInSquareBrackets: false Standard: Auto TabWidth: 4 UseTab: Never ... fckit-0.14.2/.github/000077500000000000000000000000001514707373700142545ustar00rootroot00000000000000fckit-0.14.2/.github/ci-config.yml000066400000000000000000000001371514707373700166360ustar00rootroot00000000000000dependencies: | ecmwf/ecbuild ecmwf/eckit dependency_branch: develop parallelism_factor: 8 fckit-0.14.2/.github/ci-hpc-config.yml000066400000000000000000000002061514707373700174030ustar00rootroot00000000000000build: modules: - ninja - python3/3.12 dependencies: - ecmwf/ecbuild@develop - ecmwf/eckit@develop parallel: 64 fckit-0.14.2/.github/workflows/000077500000000000000000000000001514707373700163115ustar00rootroot00000000000000fckit-0.14.2/.github/workflows/build-wheel-wrapper.yml000066400000000000000000000014031514707373700227110ustar00rootroot00000000000000# (C) Copyright 2024- ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation # nor does it submit to any jurisdiction. name: Build Python Wrapper Wheel on: # Trigger the workflow manually workflow_dispatch: ~ # Allow to be called from another workflow -- eg `cd.yml` workflow_call: ~ jobs: python-wrapper-wheel: name: Python Wrapper Wheel uses: ecmwf/reusable-workflows/.github/workflows/python-wrapper-wheel.yml@main with: wheel_directory: python/fckitlib secrets: inherit fckit-0.14.2/.github/workflows/cd.yml000066400000000000000000000003621514707373700174230ustar00rootroot00000000000000name: cd on: push: tags: - '**' jobs: deploy: uses: ecmwf/reusable-workflows/.github/workflows/create-package.yml@v2 secrets: inherit wheel: uses: ./.github/workflows/build-wheel-wrapper.yml secrets: inherit fckit-0.14.2/.github/workflows/ci.yml000066400000000000000000000064241514707373700174350ustar00rootroot00000000000000name: ci on: # Trigger the workflow on push to master or develop, except tag creation push: branches: - 'master' - 'develop' tags-ignore: - '**' # Trigger the workflow on pull request pull_request: ~ # Trigger the workflow manually workflow_dispatch: ~ # Trigger after public PR approved for CI pull_request_target: types: [labeled] jobs: # Run CI including downstream packages on self-hosted runners downstream-ci: name: downstream-ci if: ${{ !github.event.pull_request.head.repo.fork && github.event.action != 'labeled' || github.event.label.name == 'approved-for-ci' }} uses: ecmwf/downstream-ci/.github/workflows/downstream-ci.yml@main with: fckit: ecmwf/fckit@${{ github.event.pull_request.head.sha || github.sha }} codecov_upload: true secrets: inherit # Run CI of private downstream packages on self-hosted runners private-downstream-ci: name: private-downstream-ci needs: [downstream-ci] if: ${{ (success() || failure()) && (!github.event.pull_request.head.repo.fork && github.event.action != 'labeled' || github.event.label.name == 'approved-for-ci') }} runs-on: ubuntu-latest permissions: pull-requests: write steps: - name: Dispatch private downstream CI uses: ecmwf/dispatch-private-downstream-ci@v1 with: token: ${{ secrets.GH_REPO_READ_TOKEN }} owner: ecmwf repository: private-downstream-ci event_type: downstream-ci payload: '{"fckit": "ecmwf/fckit@${{ github.event.pull_request.head.sha || github.sha }}"}' # Build downstream packages on HPC downstream-ci-hpc: name: downstream-ci-hpc if: ${{ !github.event.pull_request.head.repo.fork && github.event.action != 'labeled' || github.event.label.name == 'approved-for-ci' }} uses: ecmwf/downstream-ci/.github/workflows/downstream-ci-hpc.yml@main with: fckit: ecmwf/fckit@${{ github.event.pull_request.head.sha || github.sha }} secrets: inherit # Run CI of private downstream packages on HPC private-downstream-ci-hpc: name: private-downstream-ci-hpc needs: [downstream-ci-hpc] if: ${{ (success() || failure()) && (!github.event.pull_request.head.repo.fork && github.event.action != 'labeled' || github.event.label.name == 'approved-for-ci') }} runs-on: ubuntu-latest permissions: pull-requests: write steps: - name: Dispatch private downstream CI uses: ecmwf/dispatch-private-downstream-ci@v1 with: token: ${{ secrets.GH_REPO_READ_TOKEN }} owner: ecmwf repository: private-downstream-ci event_type: downstream-ci-hpc payload: '{"fckit": "ecmwf/fckit@${{ github.event.pull_request.head.sha || github.sha }}"}' notify: runs-on: ubuntu-latest needs: - downstream-ci - private-downstream-ci - downstream-ci-hpc - private-downstream-ci-hpc if: ${{ always() && !github.event.pull_request.head.repo.fork && github.event.action != 'labeled' || github.event.label.name == 'approved-for-ci' }} steps: - name: Trigger Teams notification uses: ecmwf/notify-teams@v1 with: incoming_webhook: ${{ secrets.MS_TEAMS_INCOMING_WEBHOOK }} needs_context: ${{ toJSON(needs) }} fckit-0.14.2/.github/workflows/label-public-pr.yml000066400000000000000000000003431514707373700220060ustar00rootroot00000000000000# Manage labels of pull requests that originate from forks name: label-public-pr on: pull_request_target: types: [opened, synchronize] jobs: label: uses: ecmwf/reusable-workflows/.github/workflows/label-pr.yml@v2 fckit-0.14.2/.github/workflows/notify-new-issue.yml000066400000000000000000000004251514707373700222620ustar00rootroot00000000000000name: Notify new issue on: issues: types: - "opened" jobs: notify: runs-on: ubuntu-latest steps: - name: Notify new issue uses: ecmwf/notify-teams-issue@v1 with: incoming_webhook: ${{ secrets.MS_TEAMS_INCOMING_WEBHOOK }} fckit-0.14.2/.github/workflows/notify-new-pr.yml000066400000000000000000000005361514707373700215560ustar00rootroot00000000000000name: Notify new PR # Needs the worklow to be located in the branche the PR is merged to on: pull_request_target: types: - "opened" jobs: notify: runs-on: ubuntu-latest steps: - name: Notify new PR uses: ecmwf/notify-teams-pr@v1 with: incoming_webhook: ${{ secrets.MS_TEAMS_INCOMING_WEBHOOK }} fckit-0.14.2/.github/workflows/sync.yml000066400000000000000000000011501514707373700200050ustar00rootroot00000000000000name: sync # Controls when the workflow will run on: # Trigger the workflow on all pushes push: branches: - "**" tags: - "**" # Trigger the workflow when a branch or tag is deleted delete: ~ jobs: # Calls a reusable CI workflow to sync the current with a remote repository. # It will correctly handle addition of any new and removal of existing Git objects. sync: name: sync uses: ecmwf/reusable-workflows/.github/workflows/sync.yml@v2 secrets: target_repository: ecsdk/fckit target_username: ClonedDuck target_token: ${{ secrets.BITBUCKET_PAT }} fckit-0.14.2/.gitignore000066400000000000000000000001221514707373700146770ustar00rootroot00000000000000build artifacts install/* CMakeLists.txt.user **/*.egg-info/ .vscode __pycache__ fckit-0.14.2/.travis.yml000066400000000000000000000160211514707373700150250ustar00rootroot00000000000000sudo: false language: cpp # Workaround for https://github.com/travis-ci/travis-ci/issues/4681 matrix: - TRAVIS_EMPTY_JOB_WORKAROUND=true cache: directories: - ${HOME}/deps/cmake - ${HOME}/deps/openmpi - ${HOME}/deps/mpich - ${HOME}/deps/eckit matrix: exclude: - env: TRAVIS_EMPTY_JOB_WORKAROUND include: - os: linux compiler: clang env: - CACHE_NAME=linux-clang38-mpich - CXX_COMPILER='clang++-3.8' C_COMPILER='clang-3.8' Fortran_COMPILER='gfortran' - MPI='mpich' - FCKIT_CMAKE_OPTIONS="-DCMAKE_BUILD_TYPE=DEBUG" addons: apt: sources: ['llvm-toolchain-precise', 'ubuntu-toolchain-r-test'] packages: ['clang-3.8', 'gfortran'] - os: linux compiler: gcc env: - CACHE_NAME=linux-gcc5-openmpi - CXX_COMPILER='g++-5' C_COMPILER='gcc-5' Fortran_COMPILER='gfortran-5' - MPI='openmpi' - FCKIT_CMAKE_OPTIONS="-DCMAKE_BUILD_TYPE=DEBUG" addons: apt: sources: ['ubuntu-toolchain-r-test'] packages: ['g++-5', 'gcc-5', 'gfortran-5'] - os: linux compiler: gcc env: - CACHE_NAME=linux-gcc7-mpich - CXX_COMPILER='g++-7' C_COMPILER='gcc-7' Fortran_COMPILER='gfortran-7' - MPI='mpich' - FCKIT_CMAKE_OPTIONS='-DCMAKE_BUILD_TYPE=DEBUG -DENABLE_GPROF=ON' - COVERAGE=ON addons: apt: sources: ['ubuntu-toolchain-r-test'] packages: ['g++-7', 'gcc-7', 'gfortran-7', 'lcov'] - os: osx env: - CACHE_NAME=osx-clang-openmpi - CXX_COMPILER='clang++' C_COMPILER='clang' Fortran_COMPILER='gfortran' - MPI=openmpi - FCKIT_CMAKE_OPTIONS="-DCMAKE_BUILD_TYPE=DEBUG" osx_image: xcode10.1 addons: homebrew: packages: - openmpi ################################## # KNOWN TO FAIL, so comment ################################## # - os: osx # env: # - CACHE_NAME=osx-clang-mpich # - CXX_COMPILER='clang++' C_COMPILER='clang' Fortran_COMPILER='gfortran' # - MPI=mpich # osx_image: xcode9 # - os: linux # compiler: gcc # env: # - CACHE_NAME=linux-pgi-openmpi # - CXX_COMPILER='pgc++' C_COMPILER='pgcc' Fortran_COMPILER='pgfortran' # - MPI='openmpi' # - PGI_VERSION="CommunityEdition" # - ECKIT_CMAKE_OPTIONS="-DRT_LIB=/usr/lib/x86_64-linux-gnu/librt.so -DCURSES_LIBRARY=/usr/lib/x86_64-linux-gnu/libcurses.so" # - FCKIT_CMAKE_OPTIONS="-DCMAKE_BUILD_TYPE=DEBUG -DENABLE_FORTRAN=OFF" # Fortran tests known to be broken with pgi/17.10 before_install: ################################################################# # Set compilers ################################################################# - | ### Set compilers export CC=${C_COMPILER} export CXX=${CXX_COMPILER} export FC=${Fortran_COMPILER} - | ### Load scripts source ${TRAVIS_BUILD_DIR}/tools/source-me.sh install: ################################################################# # All dependencies are installed in ${TRAVIS_BUILD_DIR}/deps/ ################################################################# - DEPS_DIR=${HOME}/deps - mkdir -p ${DEPS_DIR} && cd ${DEPS_DIR} - | DEPS_BRANCH="master" if [[ "${TRAVIS_BRANCH}" != "master" ]]; then DEPS_BRANCH="develop" fi ################################################################# # Install Compilers ################################################################# - | ### Install gcc (homebrew) if [[ "${TRAVIS_OS_NAME}" == "osx" ]]; then export HOMEBREW_NO_AUTO_UPDATE=1 brew install gcc brew link gcc fi - | ### Install PGI community edition if [[ "${PGI_VERSION:-notset}" == "CommunityEdition" ]]; then install-pgi.sh --mpi --prefix ${DEPS_DIR}/pgi source ${DEPS_DIR}/pgi/env.sh fi ################################################################# # Install MPI ################################################################# - | ### Install MPI install-mpi.sh ${MPI} source ${DEPS_DIR}/${MPI}/env.sh echo "${MPI_HOME}" echo "${PATH}" ################################################################# # Install CMake ################################################################# - | ### Install CMake if [[ "${TRAVIS_OS_NAME}" == "linux" ]]; then if [[ -z "$(ls -A ${DEPS_DIR}/cmake)" ]]; then CMAKE_URL="https://cmake.org/files/v3.13/cmake-3.13.3-Linux-x86_64.tar.gz" mkdir -p ${DEPS_DIR}/cmake && travis_retry wget --no-check-certificate --quiet -O - ${CMAKE_URL} | tar --strip-components=1 -xz -C ${DEPS_DIR}/cmake fi export PATH=${DEPS_DIR}/cmake/bin:${PATH} fi cmake --version ################################################################# # Install ecbuild ################################################################# - | ### Install ecbuild git clone --depth 1 -b ${DEPS_BRANCH} https://github.com/ecmwf/ecbuild ${DEPS_DIR}/ecbuild export PATH=${DEPS_DIR}/ecbuild/bin:${PATH} export ECBUILD_MODULE_PATH=${DEPS_DIR}/ecbuild/cmake ecbuild --version ################################################################# # Install eckit ################################################################# - | ### Install eckit install-dep.sh --repo eckit --branch ${DEPS_BRANCH} --prefix ${DEPS_DIR}/eckit --cmake "-DENABLE_TESTS=OFF -DCMAKE_BUILD_TYPE=DEBUG ${ECKIT_CMAKE_OPTIONS}" - export ECKIT_PATH=${DEPS_DIR}/eckit - ${DEPS_DIR}/eckit/bin/eckit-version script: ################################################################# # Environment variables ################################################################# - echo ${CXX} - echo ${CC} - echo ${FC} - echo ${MPI_HOME} - echo ${PATH} - | FCKIT_SOURCE_DIR=${TRAVIS_BUILD_DIR} FCKIT_BUILD_DIR=${TRAVIS_BUILD_DIR}/builds/fckit ################################################################# # Build fckit ################################################################# - mkdir -p ${FCKIT_BUILD_DIR} && cd ${FCKIT_BUILD_DIR} - cmake -DCMAKE_MODULE_PATH=${ECBUILD_MODULE_PATH} ${FCKIT_CMAKE_OPTIONS} ${FCKIT_SOURCE_DIR} - make -j4 - bin/fckit --info ################################################################# # Test fckit ################################################################# - ctest after_success: - | if [[ "${COVERAGE}" == "ON" ]]; then # Creating report cd ${FCKIT_BUILD_DIR} lcov --directory . --capture --output-file coverage.info # capture coverage info lcov --remove coverage.info '/usr/*' --output-file coverage.info # filter out system lcov --list coverage.info #debug info # Uploading report to CodeCov bash <(curl -s https://codecov.io/bash) -t d604c898-35ae-4ce6-ad24-a4c0d56c2afc || echo "Codecov did not collect coverage reports" fi after_failure: - cd ${FCKIT_BUILD_DIR} - ctest -VV --rerun-failed - cat ecbuild.log fckit-0.14.2/CMakeLists.txt000077500000000000000000000170101514707373700154560ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. ############################################################################################ # FCKIT cmake_minimum_required( VERSION 3.17 FATAL_ERROR ) find_package( ecbuild 3.4 REQUIRED HINTS ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_SOURCE_DIR}/../ecbuild ) project( fckit LANGUAGES C CXX Fortran ) set(CMAKE_DIRECTORY_LABELS "fckit") set(CMAKE_CXX_STANDARD 17) set(CMAKE_CXX_STANDARD_REQUIRED ON) ################################################################################################ # options & dependencies ### Fortran ... ecbuild_enable_fortran( REQUIRED MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/module ) ecbuild_check_fortran( FEATURES finalization ) set( FEATURE_FINAL_DEFAULT ON ) set( PGIBUG_ATLAS_197 0 ) if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" ) if( ${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS 19.4 ) set( PGIBUG_ATLAS_197 1 ) endif() if( ${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS 19.10 ) # Compilation works, but runtime segmentation faults occur (tested with pgi/17.7) set( FEATURE_FINAL_DEFAULT OFF ) endif() endif() ecbuild_add_option( FEATURE FINAL DESCRIPTION "Enable automatic finalisation for derived types (destructors)" DEFAULT ${FEATURE_FINAL_DEFAULT} CONDITION EC_HAVE_Fortran_FINALIZATION ) if( fckit_HAVE_FINAL ) include( final-support ) check_final_support() ecbuild_info( "FCKIT_HAVE_FINAL [1]") ecbuild_info( " FCKIT_FINAL_FUNCTION_RESULT = ${FCKIT_FINAL_FUNCTION_RESULT}") ecbuild_info( " FCKIT_FINAL_UNINITIALIZED_LOCAL = ${FCKIT_FINAL_UNINITIALIZED_LOCAL}") ecbuild_info( " FCKIT_FINAL_UNINITIALIZED_INTENT_OUT = ${FCKIT_FINAL_UNINITIALIZED_INTENT_OUT}") ecbuild_info( " FCKIT_FINAL_UNINITIALIZED_INTENT_INOUT = ${FCKIT_FINAL_UNINITIALIZED_INTENT_INOUT}") ecbuild_info( " FCKIT_FINAL_NOT_PROPAGATING = ${FCKIT_FINAL_NOT_PROPAGATING}") ecbuild_info( " FCKIT_FINAL_NOT_INHERITING = ${FCKIT_FINAL_NOT_INHERITING}") ecbuild_info( " FCKIT_FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY = ${FCKIT_FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY}") ecbuild_info( " FCKIT_FINAL_BROKEN_FOR_AUTOMATIC_ARRAY = ${FCKIT_FINAL_BROKEN_FOR_AUTOMATIC_ARRAY}") ecbuild_info( " FCKIT_FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY = ${FCKIT_FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY}") ecbuild_info( " FCKIT_FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY = ${FCKIT_FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY}") if( FCKIT_FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY OR FCKIT_FINAL_BROKEN_FOR_AUTOMATIC_ARRAY OR FCKIT_FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY OR FCKIT_FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY) ecbuild_warn("Introspected compiler bugs w.r.t. using derived types with FINAL (destructors)") endif() endif() if( NOT fckit_HAVE_FINAL ) ecbuild_info( "fckit_HAVE_FINAL [0]") set( FCKIT_FINAL_FUNCTION_RESULT 0 ) set( FCKIT_FINAL_UNINITIALIZED_LOCAL 0 ) set( FCKIT_FINAL_UNINITIALIZED_INTENT_OUT 0 ) set( FCKIT_FINAL_UNINITIALIZED_INTENT_INOUT 0 ) set( FCKIT_FINAL_NOT_PROPAGATING 0 ) set( FCKIT_FINAL_NOT_INHERITING 0 ) set( FCKIT_FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY 0 ) set( FCKIT_FINAL_BROKEN_FOR_AUTOMATIC_ARRAY 0 ) endif() ecbuild_find_package( NAME eckit VERSION 1.14 QUIET ) ecbuild_add_option( FEATURE ECKIT DESCRIPTION "Wrap ecKit functionality" CONDITION eckit_FOUND ) if( NOT fckit_HAVE_ECKIT ) ecbuild_warn("ecKit could not be found. This disables various fckit features such as MPI, Configuration, Logging") endif() ## MPI set( fckit_HAVE_ECKIT_MPI_PARALLEL 0 ) if( fckit_HAVE_ECKIT ) if( eckit_HAVE_MPI OR ECKIT_HAVE_MPI ) set( fckit_HAVE_ECKIT_MPI_PARALLEL 1 ) set( HAVE_MPI 1 ) else() set( fckit_HAVE_ECKIT_MPI_PARALLEL 0 ) set( HAVE_MPI 0 ) endif() endif() set( fckit_HAVE_MPI ${HAVE_MPI} ) if( fckit_HAVE_ECKIT ) if( NOT fckit_HAVE_MPI ) ecbuild_warn("ecKit has been compiled without MPI. This causes fckit to not be able to run parallel executables.") else() ecbuild_info("ecKit has been compiled with MPI") endif() endif() ################################################################################################ # export package info set( FCKIT_LIBRARIES fckit ) ################################################################################################ # install python venv with rumael.yaml and fypp include( fckit_install_venv ) set( install_permissions OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE ) # Discover only system install Python 3 set( Python3_FIND_VIRTUALENV STANDARD ) find_package( Python3 COMPONENTS Interpreter ) ecbuild_add_option( FEATURE FCKIT_VENV DEFAULT OFF DESCRIPTION "Install Python virtual environment with fypp and a yaml parser" CONDITION Python3_VERSION VERSION_GREATER_EQUAL 3.8 ) ecbuild_add_option( FEATURE FCKIT_VENV_EDITABLE DEFAULT OFF DESCRIPTION "Install editable packages in fckit Python virtual environment" CONDITION HAVE_FCKIT_VENV ) ecbuild_add_option( FEATURE FCKIT_VENV_INSTALL DEFAULT OFF DESCRIPTION "CMake install Python virtual environment with fypp and a yaml parser" CONDITION HAVE_FCKIT_VENV ) if( HAVE_FCKIT_VENV ) fckit_install_venv() else() # install fypp runner script only set( FYPP ${CMAKE_CURRENT_SOURCE_DIR}/tools/fckit-eval.sh ${CMAKE_CURRENT_SOURCE_DIR}/contrib/fypp-3.2-b8dd58b-20230822/bin/fypp ) install( FILES contrib/fypp-3.2-b8dd58b-20230822/bin/fypp DESTINATION libexec RENAME fckit-fypp.py PERMISSIONS ${install_permissions} ) endif() ################################################################################################ # sources set( FCTEST_GENERATOR ${Python3_EXECUTABLE} ${CMAKE_CURRENT_SOURCE_DIR}/tools/fctest-generate-runner.py ) include( fckit_preprocess_fypp ) include( add_fctest ) add_subdirectory( src ) add_subdirectory( doc ) ################################################################################################ # finalize ecbuild_print_summary() ################################################################################################ if( ECBUILD_INSTALL_FORTRAN_MODULES ) install( DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/${CMAKE_CFG_INTDIR} DESTINATION module/fckit COMPONENT modules ) endif() if( NOT PROJECT_NAME STREQUAL CMAKE_PROJECT_NAME ) set( FCTEST_GENERATOR ${FCTEST_GENERATOR} PARENT_SCOPE ) set( FYPP ${FYPP} PARENT_SCOPE ) endif() file(READ ${CMAKE_CURRENT_SOURCE_DIR}/cmake/add_fctest.cmake ADD_FCTEST) file(READ ${CMAKE_CURRENT_SOURCE_DIR}/cmake/fckit_preprocess_fypp.cmake FCKIT_PREPROCESS_FYPP ) install( FILES tools/fctest-generate-runner.py DESTINATION libexec PERMISSIONS ${install_permissions} ) install( FILES tools/fckit-eval.sh DESTINATION libexec PERMISSIONS ${install_permissions} ) ecbuild_install_project( NAME fckit ) fckit-0.14.2/LICENSE000066400000000000000000000250031514707373700137210ustar00rootroot00000000000000 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS Copyright 1996-2012 ECMWF Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. fckit-0.14.2/README.md000066400000000000000000000054651514707373700142050ustar00rootroot00000000000000FCKit ===== [![fckit release version](https://img.shields.io/github/release/ecmwf/fckit.svg)](https://github.com/ecmwf/fckit/releases/latest) [![travis master](https://img.shields.io/travis/ecmwf/fckit/master.svg?label=master&logo=travis)](http://travis-ci.org/ecmwf/fckit "master") [![travis develop](https://img.shields.io/travis/ecmwf/fckit/develop.svg?label=develop&logo=travis)](http://travis-ci.org/ecmwf/fckit "develop") [![codecov](https://codecov.io/gh/ecmwf/fckit/branch/develop/graph/badge.svg)](https://codecov.io/gh/ecmwf/fckit) Fortran toolkit for interoperating Fortran with C/C++. In addition useful algorithms from ecKit are wrapped with Fortran. Project website and reference documentation on released versions: https://confluence.ecmwf.int/display/FCKIT ## fctest Unit Testing Framwork for Fortran, made easy. - C Preprocessor Macros are used to make writing tests extremely fast - Tests in one file are bundled in a Test Suite (Fortran Module) - Python script generates a main program for a Test Suite - Driven by CMake build system ( and ctest ) ### To use in your ecbuild project Simply add following line to your project's CMakeLists.txt ``` ecbuild_add_option( FEATURE FCTEST DEFAULT ${ENABLE_TESTS} DESCRIPTION "Fortran Unit Testing Framework" REQUIRED_PACKAGES "NAME fckit" ) ``` See src/examples folder how to add and create the unit-tests. ## fckit Various Fortran modules helpful to create mixed-language applications - MPI - Logging ### Offline build of fckit Python virtual environment An offline build/installation of the fckit Python virtual environment can be completed as follows: 1. Download all necessary Python dependencies of src/fckit/fckit_yaml_reader. `ruamel.yaml.clib` is not a pure Python package, so we have to ensure a wheel compatible with the target platform is downloaded. pip compatibility tags for any system can be displayed using `python3 -m pip debug --verbose`, and buit-distributions (i.e. wheels) for ruamel.yaml.clib can be found [here](https://pypi.org/project/ruamel.yaml.clib/#files). For a linux installation based on an x86 architecture using Python3.10, the following command can be used: ``` FCKIT_WHEEL_ARCH=manylinux_2_17_x86_64 FCKIT_WHEEL_PYTHON_VERSION=310 ./populate ``` This will download all the wheels to `/artifacts.` It should be noted that if `FCKIT_WHEEL_ARCH` and `FCKIT_WHEEL_PYTHON_VERSION` are not specified then the wheels are downloaded for the calling system's Python interpreter. 2. scp/rsync/copy the directory containing the dependencies to the offline system. 3. Add the path to the `artifacts` directory to the fckit CMake configuration step, i.e. `-DARTIFACTS_DIR=`. ### License Please read LICENSE. --------------------------------------------------------------------- ECMWF fckit-0.14.2/VERSION000066400000000000000000000000101514707373700137530ustar00rootroot000000000000000.14.2 fckit-0.14.2/bamboo/000077500000000000000000000000001514707373700141535ustar00rootroot00000000000000fckit-0.14.2/bamboo/CLANG-env.sh000066400000000000000000000011011514707373700161120ustar00rootroot00000000000000#!/bin/bash if [[ $(uname) == "Darwin" ]]; then # Up to date CMake version required export PATH=${HOME}/Applications/CMake.app/Contents/bin:${PATH} # No module environment on the Mac return fi # initialise module environment if it is not if [[ ! $(command -v module > /dev/null 2>&1) ]]; then . /usr/local/apps/module/init/bash fi module unload grib_api module unload eccodes module unload emos module unload fftw module unload libemos module unload metview module unload netcdf4 module load cmake/3.16.5 module load python3/3.8.8-01 module switch gnu clang fckit-0.14.2/bamboo/CMakeLists.txt000066400000000000000000000002541514707373700167140ustar00rootroot00000000000000file( GLOB_RECURSE bamboo_files RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} "*" ) ecbuild_add_resources( TARGET ${PROJECT_NAME}_bamboo SOURCES_DONT_PACK ${bamboo_files} ) fckit-0.14.2/bamboo/GCC-env.sh000066400000000000000000000006601514707373700156730ustar00rootroot00000000000000#!/bin/bash [[ $(uname) == "Darwin" ]] && return # no module environment on the Mac # initialise module environment if it is not if [[ ! $(command -v module > /dev/null 2>&1) ]]; then . /usr/local/apps/module/init/bash fi module unload grib_api module unload eccodes module unload emos module unload fftw module unload libemos module unload metview module unload netcdf4 module load cmake/3.16.5 module load python3/3.8.8-01 fckit-0.14.2/bamboo/INTEL-env.sh000066400000000000000000000007171514707373700161550ustar00rootroot00000000000000#!/bin/bash [[ $(uname) == "Darwin" ]] && return # no module environment on the Mac # initialise module environment if it is not if [[ ! $(command -v module > /dev/null 2>&1) ]]; then . /usr/local/apps/module/init/bash fi module unload grib_api module unload eccodes module unload emos module unload fftw module unload libemos module unload metview module unload netcdf4 module load cmake/3.16.5 module load python3/3.8.8-01 module switch gnu intel/17.0.3 fckit-0.14.2/bamboo/MACOSX-env.sh000066400000000000000000000000751514707373700162710ustar00rootroot00000000000000export PATH=$HOME/Applications/CMake.app/Contents/bin:$PATH fckit-0.14.2/bamboo/env.sh000066400000000000000000000000761514707373700153020ustar00rootroot00000000000000#!/usr/bin/env bash # export VAR=VALUE # ctest_parallel="no" fckit-0.14.2/bamboo/flags.cmake000066400000000000000000000001331514707373700162460ustar00rootroot00000000000000#set( ECBUILD_2_COMPAT OFF CACHE BOOL "Disable ecbuild 2 compat mode for bamboo testing" ) fckit-0.14.2/cmake/000077500000000000000000000000001514707373700137745ustar00rootroot00000000000000fckit-0.14.2/cmake/FindFORD.cmake000066400000000000000000000012431514707373700163310ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. ############################################################################### # find FORD Fortran documentation generator find_program( FORD_EXECUTABLE ford QUIET DOC "Fortran documentation generator" ) if( FORD_EXECUTABLE ) set( FORD_FOUND TRUE ) endif() mark_as_advanced(FORD_EXECUTABLE) fckit-0.14.2/cmake/add_fctest.cmake000066400000000000000000000104021514707373700170730ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. function( fctest_generate_runner ) set( options ) set( single_value_args OUTPUT FILENAME ) set( multi_value_args DEPENDS ) cmake_parse_arguments( _PAR "${options}" "${single_value_args}" "${multi_value_args}" ${_FIRST_ARG} ${ARGN} ) get_filename_component(base ${_PAR_FILENAME} NAME_WE) set(outfile ${CMAKE_CURRENT_BINARY_DIR}/${base}_main.F90) set(${_PAR_OUTPUT} ${outfile} PARENT_SCOPE) list( APPEND _depends ${_PAR_FILENAME} ${_PAR_DEPENDS} ) add_custom_command( OUTPUT ${outfile} COMMAND ${FCTEST_GENERATOR} -i ${_PAR_FILENAME} -o ${outfile} DEPENDS ${_depends} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} COMMENT "[fctest] Generating test driver ${base}_main.F90") set_source_files_properties(${outfile} PROPERTIES GENERATED TRUE) endfunction() function( add_fctest ) cmake_minimum_required( VERSION 3.12 ) cmake_policy( SET CMP0064 NEW ) # Recognize ``TEST`` as operator for the ``if()`` command. (introduced in CMake version 3.4) ecbuild_add_test( ${ARGV} ) set( options ) set( single_value_args TARGET ) set( multi_value_args ) cmake_parse_arguments( _PAR "${options}" "${single_value_args}" "${multi_value_args}" ${_FIRST_ARG} ${ARGN} ) if( TARGET ${_PAR_TARGET} ) get_target_property( test_sources ${_PAR_TARGET} SOURCES ) list( GET test_sources 0 TESTSUITE ) get_filename_component( extension ${TESTSUITE} EXT ) get_filename_component( base ${TESTSUITE} NAME_WE ) ### Preprocess files with extension ".fypp.F90" fckit_target_preprocess_fypp( ${_PAR_TARGET} ) ### Remove TESTSUITE from target get_target_property( test_sources ${_PAR_TARGET} SOURCES ) set( match_regex "${base}.F90") set( match_found FALSE ) foreach( source ${test_sources} ) if( ${source} MATCHES "${match_regex}" ) if( match_found ) message( FATAL_ERROR "Second match found for ${match_regex} in fctest ${_PAR_TARGET}" ) endif() set( match_found TRUE ) set( TESTSUITE ${source} ) list( FILTER test_sources EXCLUDE REGEX ${source} ) endif() endforeach() if( NOT match_found ) message( FATAL_ERROR "No match found for ${match_regex} in fctest ${_PAR_TARGET}" ) endif() set_property( TARGET ${_PAR_TARGET} PROPERTY SOURCES ${test_sources} ) ### Add TESTRUNNER generated from TESTSUITE fctest_generate_runner( OUTPUT TESTRUNNER FILENAME ${TESTSUITE} ) target_sources( ${_PAR_TARGET} PUBLIC ${TESTRUNNER} ) ### Add dependencies target_link_libraries( ${_PAR_TARGET} fckit ) if( TEST ${_PAR_TARGET} ) set_property( TEST ${_PAR_TARGET} APPEND PROPERTY LABELS "fortran" ) endif() ### Add compile flags list( APPEND _properties COMPILE_FLAGS COMPILE_DEFINITIONS ) foreach( _prop ${_properties} ) if( NOT ORIGINAL_TESTSUITE ) set( ORIGINAL_TESTSUITE ${TESTSUITE} ) endif() get_source_file_property( TESTSUITE_PROPERTY ${ORIGINAL_TESTSUITE} ${_prop} ) if( TESTSUITE_PROPERTY ) set_source_files_properties( ${TESTRUNNER} PROPERTIES ${_prop} ${TESTSUITE_PROPERTY} ) endif() endforeach() if(${CMAKE_Fortran_COMPILER_ID} MATCHES GNU) #Disable developer-only pre-processor warnings when not compiling for Debug configurations target_compile_options(${_PAR_TARGET} PRIVATE $<$>:-Wno-cpp>) endif() ### Workaround Flang issue, not able to include absolute path. Adding -I/ seems a workaround # but results in warning for other compilers (intel) if( ${CMAKE_Fortran_COMPILER_ID} MATCHES Flang ) target_include_directories( ${_PAR_TARGET} PUBLIC ${FCKIT_INCLUDE_DIRS} "/" ) endif() add_custom_target( ${_PAR_TARGET}_testsuite SOURCES ${TESTSUITE} ) endif() endfunction() fckit-0.14.2/cmake/fckit-import.cmake.in000066400000000000000000000034441514707373700200200ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. if( @PROJECT_NAME@_IS_BUILD_DIR_EXPORT ) set( FCTEST_GENERATOR @Python3_EXECUTABLE@ @CMAKE_CURRENT_SOURCE_DIR@/tools/fctest-generate-runner.py ) set( FYPP @FYPP@ ) if( @HAVE_FCKIT_VENV@ ) set( FCKIT_VENV_EXE @FCKIT_VENV_EXE@ ) endif() else() if( @HAVE_FCKIT_VENV@ AND NOT @ECBUILD_INSTALL_LIBRARY_HEADERS@ ) message( FATAL_ERROR "Installation of fckit python vritual environment was disabled" ) elseif( @HAVE_FCKIT_VENV@ ) set( _fckit_eval_script ${fckit_BASE_DIR}/libexec/fckit-eval.sh ) set( FCKIT_VENV_EXE ${fckit_BASE_DIR}/@rel_venv_exe_path@ ) set( FYPP ${_fckit_eval_script} ${FCKIT_VENV_EXE} -m fypp ) else() set( FYPP ${fckit_BASE_DIR}/libexec/fckit-eval.sh ${fckit_BASE_DIR}/libexec/fckit-fypp.py ) endif() set( FCTEST_GENERATOR @Python3_EXECUTABLE@ ${fckit_BASE_DIR}/libexec/fctest-generate-runner.py ) endif() @FCKIT_PREPROCESS_FYPP@ @ADD_FCTEST@ set( fckit_HAVE_ECKIT @fckit_HAVE_ECKIT@ ) set( fckit_ECKIT_FOUND 0 ) if( fckit_HAVE_ECKIT ) set( fckit_ECKIT_FOUND 1 ) # Following Required when "ECBUILD_2_COMPAT=OFF" and static linking is used include( CMakeFindDependencyMacro ) find_dependency( eckit HINTS ${CMAKE_CURRENT_LIST_DIR}/../eckit @eckit_DIR@ @eckit_BINARY_DIR@ ) endif() if( fckit_FIND_REQUIRED_ECKIT AND NOT fckit_ECKIT_FOUND ) message( FATAL_ERROR "fckit was not compiled with ECKIT enabled" ) endif() set( FCKIT_LIBRARIES @FCKIT_LIBRARIES@ ) fckit-0.14.2/cmake/fckit_download_python_wheels.cmake000066400000000000000000000137661514707373700227520ustar00rootroot00000000000000# (C) Copyright 2025 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. ############################################################################## #.rst: # # download_python_wheels # ====================== # # Download all dependencies for the given ``REQUIREMENT_SPEC`` and cache them in a # wheelhouse at ``WHEELS_DIR`` # # download_python_wheels( REQUIREMENT_SPEC [ WHEELS_DIR ] [ PYTHON_VERSION ] # [ WHEEL_ARCH ] [ WHEEL_PYTHON_VERSION ] ) # # Implementation note # ------------------- # # This function does intentionally not expose all PIP options directly because the PIP command line # interface allows to specify option values via environment variables. These can therefore be used # to further control the PIP behaviour, see https://pip.pypa.io/en/stable/cli/pip_download/ # # Because PIP does not provide a mechanism for downloading PEP 518 build dependencies, # this function builds the wheel also for the provided REQUIREMENT_SPEC instead of only downloading # the required dependencies. See https://github.com/pypa/pip/issues/7863 for details. # To provide a sane minimum, setuptools and wheel packages are always downloaded. # # The provided PYTHON_VERSION is used to discover a Python interpreter matching the version # specification when calling pip. To download wheels for specific platforms or Python versions, # use the PIP_PLATFORM, PIP_PYTHON_VERSION, PIP_IMPLEMENTATION, or PIP_ABI environment variables. # # It is safe to call this function during an offline build, as long as all wheels are already # available in the wheelhouse. A dry-run call to ``pip install`` is used to determine the need # for any wheel downloads before executing the ``pip download`` command. # # Options # ------- # # :REQUIREMENT_SPEC: The requirement spec as given to ``pip download`` and ``pip wheel`` # :WHEELS_DIR: The path of the wheelhouse directory to cache the wheels. Defaults to # ``${CMAKE_CURRENT_BINARY_DIR}/wheelhouse`` # :PYTHON_VERSION: Optional specification of permissible Python versions for find_package # :WHEEL_ARCH: Optional specification of architecture for which to download non-pure Python wheels # :WHEEL_PYTHON_VERSION: Optional specification of Python version for which to download wheels # ############################################################################## # We add this here to enforce the correct behaviour for find_package( Python3 ... ) cmake_minimum_required( VERSION 3.17 FATAL_ERROR ) function( download_python_wheels ) set( options "" ) set( oneValueArgs REQUIREMENT_SPEC WHEELS_DIR PYTHON_VERSION WHEEL_ARCH WHEEL_PYTHON_VERSION ) set( multiValueArgs "" ) cmake_parse_arguments( _PAR "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN} ) if( _PAR_UNPARSED_ARGUMENTS ) message( FATAL_ERROR "Unknown keywords given to download_python_wheels(): \"${_PAR_UNPARSED_ARGUMENTS}\"" ) endif() if( NOT _PAR_REQUIREMENT_SPEC ) message( FATAL_ERROR "No REQUIREMENT_SPEC provided to download_python_wheels()" ) endif() message( STATUS "Checking for cached wheels in ${WHEELS_DIR}" ) # Check for a suitable python interpreter find_package( Python3 ${_PAR_PYTHON_VERSION} COMPONENTS Interpreter REQUIRED QUIET ) # If no wheelhouse dir is given, create one in the current binary directory if( _PAR_WHEELS_DIR ) set( WHEELS_DIR "${_PAR_WHEELS_DIR}" ) else() set( WHEELS_DIR "${CMAKE_CURRENT_BINARY_DIR}/wheelhouse" ) endif() file( MAKE_DIRECTORY "${WHEELS_DIR}" ) unset( PIP_OPTIONS ) if( DEFINED _PAR_WHEEL_ARCH AND NOT _PAR_WHEEL_ARCH MATCHES None|NONE ) string(REPLACE "\"" "" _WHEEL_ARCH ${_PAR_WHEEL_ARCH}) list( APPEND PIP_OPTIONS "--platform=${_WHEEL_ARCH}" ) endif() if( DEFINED _PAR_WHEEL_PYTHON_VERSION AND NOT _PAR_WHEEL_PYTHON_VERSION MATCHES None|NONE ) string(REPLACE "\"" "" _PYTHON_VERSION ${_PAR_WHEEL_PYTHON_VERSION}) list( APPEND PIP_OPTIONS "--python-version=${_PYTHON_VERSION}" ) endif() # We use a dry-run installation to check if all dependencies have already been downloaded execute_process( COMMAND ${Python3_EXECUTABLE} -m pip install --dry-run --break-system-packages --no-index --find-links "${WHEELS_DIR}" --only-binary :all: ${PIP_OPTIONS} ${_PAR_REQUIREMENT_SPEC} OUTPUT_QUIET ERROR_QUIET RESULT_VARIABLE _RET_VAL ) if( "${_RET_VAL}" EQUAL "0" ) message( STATUS "All dependency wheels for ${_PAR_REQUIREMENT_SPEC} found in cache" ) else() message( STATUS "Downloading dependency wheels for ${_PAR_REQUIREMENT_SPEC} to ${WHEELS_DIR}" ) # Download typical build dependencies for wheels: setuptools and wheel execute_process( COMMAND ${Python3_EXECUTABLE} -m pip download --disable-pip-version-check --only-binary :all: --dest "${WHEELS_DIR}" ${PIP_OPTIONS} setuptools>=75.0.0 wheel OUTPUT_QUIET ) # Download dependencies for the specified REQUIREMENT_SPEC execute_process( COMMAND ${Python3_EXECUTABLE} -m pip download --disable-pip-version-check --only-binary :all: --dest "${WHEELS_DIR}" ${PIP_OPTIONS} ${_PAR_REQUIREMENT_SPEC} OUTPUT_QUIET ) endif() endfunction() download_python_wheels( REQUIREMENT_SPEC ${REQUIREMENT_SPEC} WHEELS_DIR ${WHEELS_DIR} WHEEL_ARCH ${FCKIT_WHEEL_ARCH} WHEEL_PYTHON_VERSION ${FCKIT_WHEEL_PYTHON_VERSION} ) fckit-0.14.2/cmake/fckit_install_venv.cmake000066400000000000000000000066061514707373700206720ustar00rootroot00000000000000# (C) Copyright 2024 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. macro( fckit_install_venv ) # Create a virtualenv set( VENV_PATH ${CMAKE_CURRENT_BINARY_DIR}/fckit_venv ) ecbuild_info( "Create Python virtual environment ${VENV_PATH}" ) execute_process( COMMAND ${Python3_EXECUTABLE} -m venv --copies "${VENV_PATH}" ) # Make the virtualenv portable by automatically deducing the VIRTUAL_ENV path from # the 'activate' script's location in the filesystem file(READ ${VENV_PATH}/bin/activate VENV_ACTIVATE_CONTENT) string(REPLACE "VIRTUAL_ENV=${VENV_PATH}" "VIRTUAL_ENV=\$(cd \$(dirname \$(dirname \${BASH_SOURCE[0]} ) ) && pwd )" VENV_ACTIVATE_CONTENT "${VENV_ACTIVATE_CONTENT}") file(WRITE ${VENV_PATH}/bin/activate ${VENV_ACTIVATE_CONTENT} ) # Change the context of the search to only find the venv set( Python3_FIND_VIRTUALENV ONLY ) set( Python3_EXECUTABLE_CACHE ${Python3_EXECUTABLE} ) # Unset Python3_EXECUTABLE because it is also an input variable # (see documentation, Artifacts Specification section) unset( Python3_EXECUTABLE ) # To allow cmake to discover the newly created venv if Python3_ROOT_DIR # was passed as an argument at build-time set( Python3_ROOT_DIR "${VENV_PATH}" ) # Find newly created python venv find_package( Python3 COMPONENTS Interpreter REQUIRED ) # Make sure the Python installation has (sufficiently recent) pip execute_process( COMMAND ${Python3_EXECUTABLE} -m ensurepip -U OUTPUT_QUIET ) if( Python3_VERSION VERSION_EQUAL 3.8 ) execute_process( COMMAND ${Python3_EXECUTABLE} -m pip --disable-pip-version-check install --upgrade pip OUTPUT_QUIET ERROR_QUIET ) endif() unset( PIP_OPTIONS ) # set pip options if( DEFINED ARTIFACTS_DIR ) list( APPEND PIP_OPTIONS "--no-index;--find-links=${ARTIFACTS_DIR}" ) else() list( APPEND PIP_OPTIONS "--disable-pip-version-check") endif() if( HAVE_FCKIT_VENV_EDITABLE ) # Use checked-out source instead of installing into venv list( APPEND PIP_OPTIONS "-e" ) endif() # install virtual environment from requirements, which includes fypp set( _pkg_name "fckit_yaml_reader") ecbuild_info( "Install fckit_yaml_reader and fypp in virtual environment ${VENV_PATH}" ) execute_process( COMMAND ${Python3_EXECUTABLE} -m pip install ${PIP_OPTIONS} ${CMAKE_CURRENT_SOURCE_DIR}/src/fckit/${_pkg_name} OUTPUT_QUIET ) if( HAVE_FCKIT_VENV_INSTALL ) install( DIRECTORY ${VENV_PATH} DESTINATION . PATTERN "bin/*" PERMISSIONS ${install_permissions} ) endif() # add python interpreter of venv as executable target set( FCKIT_VENV_EXE ${Python3_EXECUTABLE} ) # compute relative path to venv to aid with installation string(REPLACE "${CMAKE_CURRENT_BINARY_DIR}/" "" rel_venv_exe_path ${FCKIT_VENV_EXE}) set( FYPP ${CMAKE_CURRENT_SOURCE_DIR}/tools/fckit-eval.sh ${FCKIT_VENV_EXE} -m fypp ) # reset Python3_EXECUTABLE to the system install set( Python3_EXECUTABLE ${Python3_EXECUTABLE_CACHE} ) endmacro() fckit-0.14.2/cmake/fckit_preprocess_fypp.cmake000066400000000000000000000271361514707373700214120ustar00rootroot00000000000000 ############################################################################################## # fckit_target_append_fypp_args( output target ) # Purpose: # From a target, assemble arguments to pass to fypp. These arguments are # the include flags and compile definition flags. # Arguments: # output This argument will contain the flags as a list # target The name of the target to process function( fckit_target_append_fypp_args output target ) unset(_args) set( valid_target TRUE ) if( target MATCHES "/" ) set( valid_target FALSE ) endif() if( TARGET ${target} ) get_target_property(target_type ${target} TYPE) if( target_type STREQUAL "INTERFACE_LIBRARY") set( valid_target FALSE ) endif() endif() if( valid_target ) if( CMAKE_VERSION VERSION_LESS 3.12 ) # Hopefully we can remove this soon foreach( include_property INCLUDE_DIRECTORIES;INTERFACE_INCLUDE_DIRECTORIES ) set( prop "$" ) list( APPEND _args "$<$:-I $>" ) endforeach() foreach( definitions_property COMPILE_DEFINITIONS;INTERFACE_COMPILE_DEFINITIONS ) set( prop "$" ) list( APPEND _args "$<$:-D $>" ) endforeach() else() foreach( include_property INCLUDE_DIRECTORIES;INTERFACE_INCLUDE_DIRECTORIES ) set( prop "$<$:$>" ) list( APPEND _args "$<$:-I $>" ) endforeach() foreach( definitions_property COMPILE_DEFINITIONS;INTERFACE_COMPILE_DEFINITIONS ) set( prop "$<$:$>" ) list( APPEND _args "$<$:-D $>" ) endforeach() endif() endif() # Append to output and set in parent scope if( _args ) set(${output} ${${output}} ${_args} PARENT_SCOPE) endif() endfunction() ############################################################################################## # fckit_preprocess_fypp_sources( output # [SOURCES file1 [file2]... ] # [FYPP_ARGS arg1 [arg2]... ] # [FYPP_ARGS_EXCLUDE arg1 [arg2]... ] # [DEPENDS dep1 [dep2]... ] ) # Purpose: # Preprocess source files with fypp # # Arguments: # output Append preprocessed source files to this list # [SOURCES file1 [file2]... ] List of source files to append # [FYPP_ARGS arg1 [arg2]...] Arguments passed to fypp # [FYPP_ARGS_EXCLUDE arg1 [arg2]...] Arguments excluded from being passed to fypp; accepts bash-compatible regex # [DEPENDS dep1 [dep2]... ] Dependencies before processing files # # Notes: # The include flags and compile flags of targets with the DEPENDS argument # will be automatically deduced and added to the fypp command function( fckit_preprocess_fypp_sources output ) set( options NO_LINE_NUMBERING ) set( single_value_args "" ) set( multi_value_args SOURCES FYPP_ARGS FYPP_ARGS_EXCLUDE DEPENDS ) cmake_parse_arguments( _PAR "${options}" "${single_value_args}" "${multi_value_args}" ${_FIRST_ARG} ${ARGN} ) unset( outfiles ) list( APPEND _PAR_FYPP_ARGS_EXCLUDE ${FCKIT_FYPP_ARGS_EXCLUDE}) list( APPEND _PAR_FYPP_ARGS_EXCLUDE "-D[[:space:]]?.*=([0-9])+L" ) list( APPEND _PAR_FYPP_ARGS_EXCLUDE "-D[[:space:]]?__.*" ) list( JOIN _PAR_FYPP_ARGS_EXCLUDE "," _PAR_FYPP_ARGS_EXCLUDE ) foreach( filename ${_PAR_SOURCES} ) get_filename_component( dir ${filename} DIRECTORY ) get_filename_component( base ${filename} NAME_WE ) set( outfile ${CMAKE_CURRENT_BINARY_DIR} ) if( dir ) set( outfile "${outfile}/${dir}" ) endif() set( outfile "${outfile}/${base}.F90" ) list( APPEND outfiles ${outfile} ) unset(args) list( APPEND args -l 132 ) # Line length list( APPEND args -p ) # Create parent folder set( _enable_line_numbers TRUE ) if( _PAR_NO_LINE_NUMBERING OR FYPP_NO_LINE_NUMBERING ) set( _enable_line_numbers FALSE ) endif() if( CMAKE_Fortran_COMPILER_ID MATCHES "Cray" ) set( _enable_line_numbers FALSE ) # Compiler errors occur (tested with cce/8.7.5 ) endif() if( _enable_line_numbers ) list( APPEND args -n ) # Create line numbering for compile errors if( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) list( APPEND args --line-marker-format=gfortran5 ) endif() if( CMAKE_Fortran_COMPILER_ID MATCHES "NAG" ) # workaround for line markers in continuation lines ( see e.g. https://github.com/ecmwf/atlas/pull/193 ) list( APPEND args --line-numbering-mode=nocontlines ) endif() # list( APPEND args -N nocontlines ) # workaround for line numbers in continuation lines endif() if( _PAR_FYPP_ARGS ) set( args ${args} ${_PAR_FYPP_ARGS} ) endif() foreach( target ${_PAR_DEPENDS} ) fckit_target_append_fypp_args( args ${target} ) endforeach() if( dir ) set( short_outfile "${dir}/${base}.F90" ) else() set( short_outfile "${base}.F90") endif() get_source_file_property( _depends ${filename} OBJECT_DEPENDS ) unset( ${filename}_depends ) if( _depends ) set( ${filename}_depends ${_depends} ) endif() add_custom_command( OUTPUT ${outfile} COMMAND ${CMAKE_COMMAND} -E env FCKIT_EVAL_ARGS_EXCLUDE="${_PAR_FYPP_ARGS_EXCLUDE}" ${FYPP} ${args} ${CMAKE_CURRENT_SOURCE_DIR}/${filename} ${outfile} DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${filename} ${_PAR_DEPENDS} ${${filename}_depends} COMMENT "[fypp] Preprocessor generating ${short_outfile}" ) set_source_files_properties(${outfile} PROPERTIES GENERATED TRUE) ### Extra stuff required to add correct flags # ecbuild 3.2 compatible properties that need to be transferred from .fypp files to .F90 foreach( _prop COMPILE_FLAGS COMPILE_FLAGS_${CMAKE_BUILD_TYPE_CAPS} COMPILE_OPTIONS OVERRIDE_COMPILE_FLAGS OVERRIDE_COMPILE_FLAGS_${CMAKE_BUILD_TYPE_CAPS} ) get_source_file_property( ${filename}_${_prop} ${filename} ${_prop} ) if( ${filename}_${_prop} ) set_source_files_properties(${outfile} PROPERTIES ${_prop} ${${filename}_${_prop}} ) endif() endforeach() endforeach() # Append to output and set in parent scope set(${output} ${${output}} ${outfiles} PARENT_SCOPE) endfunction() ############################################################################################## ############################################################################################## # fckit_target_preprocess_fypp( target # [FYPP_ARGS arg1 [arg2]... ] # [FYPP_ARGS_EXCLUDE arg1 [arg2]... ] # [DEPENDS dep1 [dep2]... ] ) # Purpose: # Preprocess source files in the target with the extensions # {.fypp, .fypp.F90, .F90.fypp} # # Arguments: # target Preprocess all files from this target # [FYPP_ARGS arg1 [arg2]...] Arguments passed to fypp # [FYPP_ARGS_EXCLUDE arg1 [arg2]... ] Arguments excluded from being passed to fypp; accepts bash-compatible regex # [DEPENDS dep1 [dep2]... ] Dependencies before processing files # # Notes: # The include flags and compile flags of current target and targets # within the DEPENDS argument will be automatically deduced # and added to the fypp command function( fckit_target_preprocess_fypp _PAR_TARGET ) set( options NO_LINE_NUMBERING ) set( single_value_args "" ) set( multi_value_args FYPP_ARGS FYPP_ARGS_EXCLUDE DEPENDS ) cmake_parse_arguments( _PAR "${options}" "${single_value_args}" "${multi_value_args}" ${_FIRST_ARG} ${ARGN} ) if( TARGET ${_PAR_TARGET} ) get_target_property( _target_sources ${_PAR_TARGET} SOURCES ) unset( sources_to_be_preprocessed ) foreach( source ${_target_sources} ) if( source MATCHES ".fypp.F90" ) list( APPEND sources_to_be_preprocessed ${source} ) elseif( source MATCHES ".F90.fypp" ) list( APPEND sources_to_be_preprocessed ${source} ) elseif( source MATCHES ".fypp" ) list( APPEND sources_to_be_preprocessed ${source} ) endif() endforeach() foreach( source ${sources_to_be_preprocessed} ) set( source_files_properties ${source} PROPERTIES HEADER_FILE_ONLY TRUE ) endforeach() ### BUG WORKAROUND (tested upto CMake 3.13.2) # Even though source files to be preprocessed with final extension .F90 have just been # declared as HEADER_FILE_ONLY, CMake still tries to compile these files. # This does not happen for files ending with other extensions ( .fypp ) set( _create_fypp_target FALSE ) foreach( source ${sources_to_be_preprocessed} ) if( source MATCHES ".fypp.F90" ) set( _create_fypp_target TRUE ) list(FILTER _target_sources EXCLUDE REGEX ${source} ) endif() endforeach() if( NOT TARGET ${_PAR_TARGET}_fypp AND _create_fypp_target ) set_property( TARGET ${_PAR_TARGET} PROPERTY SOURCES ${_target_sources} ) add_custom_target( ${_PAR_TARGET}_fypp SOURCES ${sources_to_be_preprocessed} ) endif() ### END BUG WORKAROUND foreach( depends_property LINK_DEPENDS;MANUALLY_ADDED_DEPENDENCIES ) get_target_property( target_depends ${_PAR_TARGET} ${depends_property} ) if( target_depends ) set( preprocessed_depends ${preprocessed_depends} ${target_depends} ) endif() endforeach() fckit_target_append_fypp_args( args ${_PAR_TARGET} ) if( _PAR_NO_LINE_NUMBERING ) set( _NO_LINE_NUMBERING NO_LINE_NUMBERING ) endif() fckit_preprocess_fypp_sources( preprocessed_sources SOURCES ${sources_to_be_preprocessed} ${_NO_LINE_NUMBERING} FYPP_ARGS ${_PAR_FYPP_ARGS} ${args} FYPP_ARGS_EXCLUDE ${_PAR_FYPP_ARGS_EXCLUDE} DEPENDS ${preprocessed_depends} ${_PAR_DEPENDS} ) target_sources( ${_PAR_TARGET} PRIVATE ${preprocessed_sources} ) ### Extra stuff required to add correct flags if( COMMAND ecbuild_target_flags ) list( APPEND ${_PAR_TARGET}_fortran_srcs ${preprocessed_sources} ) list( APPEND ${_PAR_TARGET}_Fortran_srcs ${preprocessed_sources} ) ecbuild_target_flags( ${_PAR_TARGET} "" "" "") # Currently it is not possible to add flags that were added within # ecbuild_add_library( ... FFLAGS CXXFLAGS ) # until ecbuild exports these variables # Therefore 3 empty strings for these. # Luckily this is a very tiny use case endif() ### BUG WORKAROUND for CMake < 3.12 # CMake seems to not add the "-fPIC -h PIC" flags for the Cray compiler when the target # has the POSITION_INDEPENDENT_CODE property set, so add it manually if( CMAKE_VERSION VERSION_LESS 3.12 ) get_property( _target_pic TARGET ${_PAR_TARGET} PROPERTY POSITION_INDEPENDENT_CODE ) if( _target_pic ) if( CMAKE_Fortran_COMPILER_ID MATCHES "Cray" ) foreach( _src ${preprocessed_sources} ) set_source_files_properties( ${_src} COMPILE_FLAGS "-h PIC" ) endforeach() endif() endif() endif() endif() ### END BUG WORKAROUND endfunction() fckit-0.14.2/cmake/final-support.F90000066400000000000000000000327571514707373700170750ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. ! This file is used in conjunction with final-support.cmake to detect compiler behaviour ! for the finalisation of derived types #ifdef FINAL_FUNCTION_RESULT #define TEST 1 #endif #ifdef FINAL_UNINITIALIZED_LOCAL #define TEST 1 #endif #ifdef FINAL_UNINITIALIZED_INTENT_OUT #define TEST 2 #endif #ifdef FINAL_UNINITIALIZED_INTENT_INOUT #define TEST 3 #endif #ifdef FINAL_NOT_PROPAGATING #define TEST 6 #endif #ifdef FINAL_NOT_INHERITING #define TEST 7 #endif #ifdef FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY #define TEST 8 #endif #ifdef FINAL_BROKEN_FOR_AUTOMATIC_ARRAY #define TEST 9 #endif #ifdef FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY #define TEST 10 #endif #ifdef FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY #define TEST 11 #endif #ifndef TEST #define OUTPUT #endif module final_support_module implicit none public integer, parameter :: output_unit = 6 type :: Object logical, public :: return = .false. logical, public :: initialized = .false. logical, public :: finalized = .false. contains procedure, public :: copy => copy_f generic, public :: assignment(=) => copy final :: destructor endtype interface Object module procedure construct_Object end interface type, extends(Object) :: ObjectDerivedWithFinal contains final :: destructor_ObjectDerivedWithFinal endtype interface ObjectDerivedWithFinal module procedure construct_ObjectDerivedWithFinal end interface type, extends(Object) :: ObjectDerivedWithoutFinal contains endtype interface ObjectDerivedWithoutFinal module procedure construct_ObjectDerivedWithoutFinal end interface integer :: final_uninitialized = 0 integer :: final_return = 0 integer :: final_initialized = 0 integer :: final_base = 0 integer :: final_derived = 0 integer :: indent=0 contains subroutine reset() final_uninitialized = 0 final_return = 0 final_initialized = 0 final_base = 0 final_derived = 0 end subroutine subroutine write_indented( string ) character(len=*) :: string integer :: i #ifdef OUTPUT do i=1,indent write(0,'(A)',advance='no') ' ' enddo write(0,'(A)') string #endif end subroutine subroutine write_counters() #ifdef OUTPUT write(0,*) '' write(0,*) 'final_uninitialized: ',final_uninitialized write(0,*) 'final_initialized: ',final_initialized write(0,*) 'final_return: ',final_return write(0,*) 'final_base: ',final_base write(0,*) 'final_derived: ',final_derived #endif end subroutine function construct_Object() result(this) type(Object) :: this this%initialized = .true. this%return = .true. end function function construct_ObjectDerivedWithFinal() result(this) type(ObjectDerivedWithFinal) :: this this%initialized = .true. this%return = .true. end function function construct_ObjectDerivedWithoutFinal() result(this) type(ObjectDerivedWithoutFinal) :: this this%initialized = .true. this%return = .true. end function subroutine destructor_ObjectDerivedWithFinal(this) type(ObjectDerivedWithFinal) :: this call write_indented( 'final( derived )' ) final_derived = final_derived + 1 associate( unused => this ) end associate end subroutine subroutine copy_f(this,obj_in) class(Object), intent(inout) :: this class(Object), target, intent(in) :: obj_in #if 1 if( obj_in%return ) then if( .not. this%initialized ) then call write_indented( 'copy uninitialized from rvalue' ) else call write_indented( 'copy initialized from rvalue' ) endif else if ( obj_in%initialized ) then if( .not. this%initialized ) then call write_indented( 'copy uninitialized from already existing initialized' ) else call write_indented( 'copy initialized from already existing initialized' ) endif endif #endif this%initialized = obj_in%initialized this%return = .false. end subroutine impure elemental subroutine destructor(this) type(Object), intent(inout) :: this final_base = final_base + 1 if( .not. this%initialized ) then call write_indented( 'final( uninitialized )' ) final_uninitialized = final_uninitialized+1 else if( this%return ) then call write_indented( 'final( returned )' ) final_return = final_return+1 else call write_indented( 'final( initialized )' ) final_initialized = final_initialized+1 endif endif end subroutine subroutine create_obj_out(obj) implicit none type(Object), intent(out) :: obj call write_indented( 'obj = Object()' ) indent = indent+1 obj = Object() indent = indent-1 end subroutine subroutine create_obj_inout(obj) implicit none type(Object), intent(inout) :: obj call write_indented( 'obj = Object()' ) indent = indent+1 obj = Object() indent = indent-1 end subroutine subroutine test1 implicit none type(Object) :: obj call write_indented( 'obj = Object()' ) indent = indent+1 obj = Object() indent = indent-1 end subroutine subroutine test2 implicit none type(Object) :: obj call write_indented( 'subroutine create_obj_out(obj)' ) indent = indent+1 call create_obj_out(obj) indent = indent-1 call write_indented( 'end subroutine create_obj_out(obj)' ) end subroutine subroutine test3 implicit none type(Object) :: obj call write_indented( 'subroutine create_obj_inout(obj)' ) indent = indent+1 call create_obj_inout(obj) indent = indent-1 call write_indented( 'end subroutine create_obj_inout(obj)' ) end subroutine subroutine test4 implicit none type(Object) :: obj1, obj2 call write_indented( 'subroutine create_obj_inout(obj1)' ) indent = indent+1 call create_obj_inout(obj1) indent = indent-1 call write_indented( 'end subroutine create_obj_inout(obj)' ) call write_indented( 'obj2 = obj1' ) indent = indent+1 obj2 = obj1 indent = indent-1 end subroutine subroutine test5 implicit none type(Object) :: obj1, obj2 call write_indented( 'subroutine create_obj_inout(obj1)' ) indent = indent+1 call create_obj_inout(obj1) indent = indent-1 call write_indented( 'end subroutine create_obj_inout(obj)' ) call write_indented( 'obj2 = obj1' ) indent = indent+1 obj2 = obj1 indent = indent-1 call write_indented( 'obj2 = obj1' ) indent = indent+1 obj1 = obj2 indent = indent-1 end subroutine subroutine test6 implicit none type(ObjectDerivedWithFinal) :: obj indent = indent+1 obj = ObjectDerivedWithFinal() indent = indent-1 call write_indented('--- scope end ---') end subroutine subroutine test7 implicit none type(ObjectDerivedWithoutFinal) :: obj indent = indent+1 obj = ObjectDerivedWithoutFinal() indent = indent-1 call write_indented('--- scope end ---') end subroutine subroutine test8 implicit none type(Object), allocatable :: list(:) allocate( list(2) ) call write_indented('list(1) = Object()') indent=indent+1 list(1) = Object() indent=indent-1 call write_indented('list(2) = Object()') indent=indent+1 list(2) = Object() indent=indent-1 call write_indented('--- deallocate ---') deallocate( list ) call write_indented('--- scope end ---') end subroutine subroutine test9 implicit none type(Object) :: list(2) call write_indented('list(1) = Object()') indent=indent+1 list(1) = Object() indent=indent-1 call write_indented('list(2) = Object()') indent=indent+1 list(2) = Object() indent=indent-1 call write_indented('--- scope end ---') end subroutine subroutine test10 implicit none type(ObjectDerivedWithoutFinal), allocatable :: list(:) allocate(list(2)) call write_indented('list(1) = ObjectDerivedWithoutFinal()') indent=indent+1 list(1) = ObjectDerivedWithoutFinal() indent=indent-1 call write_indented('list(2) = ObjectDerivedWithoutFinal()') indent=indent+1 list(2) = ObjectDerivedWithoutFinal() indent=indent-1 call write_indented('--- scope end ---') end subroutine subroutine test11 implicit none type(ObjectDerivedWithoutFinal) :: list(2) call write_indented('list(1) = ObjectDerivedWithoutFinal()') indent=indent+1 list(1) = ObjectDerivedWithoutFinal() indent=indent-1 call write_indented('list(2) = ObjectDerivedWithoutFinal()') indent=indent+1 list(2) = ObjectDerivedWithoutFinal() indent=indent-1 call write_indented('--- scope end ---') end subroutine subroutine run_test(i) integer, intent(in) :: i character(len=2) :: test_number write(test_number,'(I0)') i #ifndef TEST #define COMPARE_TEST(x) (x == i) #else #define COMPARE_TEST(x) (x == TEST) #endif #ifdef OUTPUT write(0,'(A)') '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' #endif call write_indented( 'subroutine test'//trim(test_number) ) indent = indent+1 call reset if( COMPARE_TEST(1) ) call test1 if( COMPARE_TEST(2) ) call test2 if( COMPARE_TEST(3) ) call test3 if( COMPARE_TEST(4) ) call test4 if( COMPARE_TEST(5) ) call test5 if( COMPARE_TEST(6) ) call test6 if( COMPARE_TEST(7) ) call test7 if( COMPARE_TEST(8) ) call test8 if( COMPARE_TEST(9) ) call test9 if( COMPARE_TEST(10)) call test10 if( COMPARE_TEST(11)) call test11 indent = indent-1 call write_indented( 'end subroutine test'//trim(test_number) ) call write_counters() end subroutine end module program final_support use final_support_module implicit none call run_test(1) call write_indented( 'test1 summary:' ) if( final_return > 0 ) then call write_indented( 'rvalue Object() was finalised' ) endif if( final_uninitialized > 0 ) then call write_indented( 'Locally scoped object is finalised before assignment' ) endif if( final_return == 0 .and. final_uninitialized == 0 ) then call write_indented( 'Behaviour of GNU 6.3.0' ) endif if( final_return == 0 .and. final_uninitialized == 1 ) then call write_indented( 'Behaviour of PGI 17.10' ) endif if( final_return == 1 .and. final_uninitialized == 0 ) then call write_indented( 'Behaviour of Cray 8.6.2' ) call write_indented( 'Behaviour of Intel 17-18' ) endif #ifdef FINAL_FUNCTION_RESULT write(output_unit,'(I0)',advance='no') final_return #endif #ifdef FINAL_UNINITIALIZED_LOCAL write(output_unit,'(I0)',advance='no') final_uninitialized #endif call run_test(2) call write_indented( 'test2 summary:' ) if( final_uninitialized > 0 ) then call write_indented( 'object with intent OUT is finalised before assignment' ) endif if( final_uninitialized == 1 ) then call write_indented( 'Behaviour of GNU 6.3.0' ) call write_indented( 'Behaviour of Intel 17-18' ) endif if( final_uninitialized == 0 ) then call write_indented( 'Behaviour of Cray 8.6.2' ) call write_indented( 'Behaviour of PGI 17.10' ) endif #ifdef FINAL_UNINITIALIZED_INTENT_OUT write(output_unit,'(I0)',advance='no') final_uninitialized #endif call run_test(3) call write_indented( 'test3 summary:' ) if( final_uninitialized > 0 ) then call write_indented('object with intent INOUT is finalised before assignment') endif if( final_uninitialized == 0 ) then call write_indented( 'Behaviour of GNU 6.3.0' ) call write_indented( 'Behaviour of Cray 8.6.2' ) call write_indented( 'Behaviour of Intel 17-18' ) call write_indented( 'Behaviour of PGI 17.1' ) endif #ifdef FINAL_UNINITIALIZED_INTENT_INOUT write(output_unit,'(I0)',advance='no') final_uninitialized #endif call run_test(4) call write_indented( 'test4 summary:' ) if( final_uninitialized == 0 .and. final_initialized == 2 ) then call write_indented( 'Behaviour of GNU 6.3.0' ) endif call run_test(5) call write_indented( 'test5 summary:' ) if( final_uninitialized == 0 .and. final_initialized == 2 ) then call write_indented( 'Behaviour of GNU 6.3.0' ) endif call run_test(6) #ifdef FINAL_NOT_PROPAGATING if( final_derived > 0 .and. final_initialized == 0 ) then write(output_unit,'(I0)',advance='no') 1 else write(output_unit,'(I0)',advance='no') 0 endif #endif call run_test(7) #ifdef FINAL_NOT_INHERITING if( final_initialized == 0 ) then write(output_unit,'(I0)',advance='no') 1 else write(output_unit,'(I0)',advance='no') 0 endif #endif call run_test(8) #ifdef FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY if( final_initialized /= 0 ) then write(output_unit,'(I0)',advance='no') 1 else write(output_unit,'(I0)',advance='no') 0 endif #endif call run_test(9) #ifdef FINAL_BROKEN_FOR_AUTOMATIC_ARRAY if( final_initialized /= 2 ) then write(output_unit,'(I0)',advance='no') 1 else write(output_unit,'(I0)',advance='no') 0 endif #endif call run_test(10) call write_indented( 'test10 summary:' ) if (final_initialized < 2) then call write_indented( 'Array is not completely finalized') call write_indented( 'This is a bug in aocc 4.0.0' ) endif #ifdef FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY if( final_initialized /= 2 ) then write(output_unit,'(I0)',advance='no') 1 else write(output_unit,'(I0)',advance='no') 0 endif #endif call run_test(11) call write_indented( 'test11 summary:' ) if (final_initialized < 2) then call write_indented( 'Array is not completely finalized') call write_indented( 'This is a bug in aocc 4.0.0' ) endif #ifdef FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY if( final_initialized /= 2 ) then write(output_unit,'(I0)',advance='no') 1 else write(output_unit,'(I0)',advance='no') 0 endif #endif end program fckit-0.14.2/cmake/final-support.cmake000066400000000000000000000045741514707373700176130ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. # This macro provides compiler introspection of the behaviour of finalisation of derived types set( FINAL_SUPPORT_SOURCE ${CMAKE_CURRENT_LIST_DIR}/final-support.F90 ) macro( check_final_support ) set( DEBUG_FINAL_SUPPORT FALSE ) macro( debug_test case ) if( DEBUG_FINAL_SUPPORT ) ecbuild_add_executable( TARGET fckit-test-${case} SOURCES ${FINAL_SUPPORT_SOURCE} DEFINITIONS ${case} ) endif() endmacro() macro( check_final_support_case case ) if( NOT DEFINED FCKIT_${case} ) try_compile( ${case}_compiled ${CMAKE_CURRENT_BINARY_DIR} ${FINAL_SUPPORT_SOURCE} COMPILE_DEFINITIONS -D${case} LINK_LIBRARIES "${CMAKE_EXE_LINKER_FLAGS}" OUTPUT_VARIABLE FCKIT_${case}_compile_output COPY_FILE ${CMAKE_CURRENT_BINARY_DIR}/${case}.bin ) execute_process( COMMAND ${CMAKE_CURRENT_BINARY_DIR}/${case}.bin WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} RESULT_VARIABLE _run_res OUTPUT_VARIABLE FCKIT_${case} ERROR_VARIABLE _run_err ) string( STRIP ${FCKIT_${case}} FCKIT_${case} ) set( FCKIT_${case} ${FCKIT_${case}} CACHE STRING "" ) debug_test( ${case} ) endif() endmacro() list( APPEND cases FINAL_FUNCTION_RESULT FINAL_UNINITIALIZED_LOCAL FINAL_UNINITIALIZED_INTENT_OUT FINAL_UNINITIALIZED_INTENT_INOUT FINAL_NOT_PROPAGATING FINAL_NOT_INHERITING FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY FINAL_BROKEN_FOR_AUTOMATIC_ARRAY FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY ) foreach( case ${cases}) check_final_support_case( ${case} ) endforeach() ecbuild_add_executable( TARGET fckit-final-support SOURCES ${FINAL_SUPPORT_SOURCE} NOINSTALL ) endmacro() fckit-0.14.2/contrib/000077500000000000000000000000001514707373700143545ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/000077500000000000000000000000001514707373700176705ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/.readthedocs.yaml000066400000000000000000000010471514707373700231210ustar00rootroot00000000000000# Read the Docs configuration file # See https://docs.readthedocs.io/en/stable/config-file/v2.html for details # Required version: 2 # Set the version of Python and other tools you might need build: os: ubuntu-22.04 tools: python: "3.10" # Build documentation in the docs/ directory with Sphinx sphinx: configuration: docs/conf.py # We recommend specifying your dependencies to enable reproducible builds: # https://docs.readthedocs.io/en/stable/guides/reproducible-builds.html python: install: - requirements: docs/requirements.txt fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/.travis.yml000066400000000000000000000001601514707373700217760ustar00rootroot00000000000000language: python python: - "3.5" - "3.6" - "3.7" - "3.8" - "3.9" script: test/runtests.sh fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/CHANGELOG.rst000066400000000000000000000121371514707373700217150ustar00rootroot00000000000000========== Change Log ========== 3.2 === Added ----- * Option ``--file-var-root`` to render file variables (``_FILE_``, ``_THIS_FILE``) as relative paths with respect to a specified root. 3.1 === Added ----- * Global variables _SYSTEM_ and _MACHINE_ to query environment. * Emission of standard (#line pragma styled) line directives. * Factory method arguments in Fypp constructor: evaluator_factory, parser_factor, builder_factory and renderer_factory. Changed ------- * Support for Python 2.7, 3.3 and 3.4 dropped, support for Python 3.9 added. 3.0 === Added ----- * Implement variable keyword argument in macros. * Add block / contains / endblock construct as alternative for call / nextarg / endcall. * Escaping of preprocessor comments * Possibility of specifying character encoding for file I/O with UTF-8 as default. Changed ------- * Injecting local variables into macros by passing arbitrary (non-declared) keyword arguments is not possible any more. This feature made it impossible to detect typos in keyword argument names in macro calls. [Backwards incompatible] * Variable positional argument in a macro resolves to a list not to a tuple for more consistency with Python. Fixed ----- * Wrong command-line parser initialisation in waf frontend. * _LINE_ and _FILE_ were incorrect if the called macro contained a call directive with an evaluation in its argument. 2.1.1 ===== Fixed ----- * Wrong _LINE_ and _FILE_ values when calling a macro during evaluation of the arguments of a call directive. 2.1 === Fixed ----- * Variable definition without value. Changed ------- * Hosting site and branch names (develop -> master, master -> release). 2.0.1 ===== Fixed ----- * Missing files in Python source distribution package. 2.0 === Added ----- * Direct call format resembling ordinary function call. * Inline direct call directive. * Keyword arguments in direct call and call directive. * Generalized call directive with arbitrary argument types. * Macros with variable number of arguments. * Default values for macro arguments. * Allow names in enddef and endcall directives for better readability. * Del directive and delvar() function. * Assert directive. * Global directive and globalvar() function. * Python-like consistent global and local scopes and scope lookup rules. * Predefined variables _THIS_FILE_ and _THIS_LINE_. * Additional flags in line numbering directives when opening a file or returning to a previous file. * Additional testing with tox for developers. * Python 2.6, 3.0 and 3.1 compatibility. Changed ------- * Setvar directive not allowed as alternative to set any more. [Backwards incompatible] * Old direct call syntax (@:macro arg1) not supported any more [Backwards incompatible] * Inline form of def directive not allowed any more. [Backwards incompatible] * Execution of arbitrary Python script at startup (option -i) has been removed. [Backwards incompatible] * Minimal API change: process_* methods of Fypp do not accept the optional argument env any more. [Backwards incompatible] * Equal sign must be used as separator in set directive for better readability. [Backwards incompatible] * Function setvar() accepts arbitrary number of argument pairs. * Reverse order exception printing, exception first occurring printed as last. * Command line tool formats error messages in GNU-like format. * Make equal sign in set directive mandatory and in setvar directive forbidden. * Search paths for module imports behave more Python-like. * Removed builtins callable() and memoryview() from restricted environment as they are not available in all supported Python versions. Fixed ----- * Line numbering with flags fixes gfortrans confusion with line numbers. 1.2 === Added ----- * Allow (and promote) usage of set directive instead of setvar. * Implement stop request via stop directive. * Assignment to variable tuples. * Hierarchial exception testing. Fixed ----- * Wrong file name in error report, when exception occurs in a macro defined in an included file. 1.1 === Added ----- * Allow inline eval and control directives in direct macro call arguments. * Add waf integration modules. * Examples and build system intergration chapters in user guide. * Change log file. 1.0 === Added ----- * Optional suppression of line numbering in continuation lines. * Optional creation of parent folders for output file. Changed ------- * Class Fypp independent of ArgumentParser. Fixed ----- * Fix false error, when include was within a directive. * Wrong line number offset in eval directives. 0.12 ==== Added ----- * Implement direct call. Changed ------- * Remove paranthesis from direct call. 0.11 ==== Added ----- * Implement call directive. * More precise error messages. * Folding prevention for comment lines. * Smart line folding, fixed format line folding. * Python 2.7 compatibility. Changed ------- * Control directive prefix changed from ``@`` to ``#``. * Rename function `default()` into `getvar()`. Fixed ----- * Superfluous trailing newlines in macro calls. 0.9 === Added ----- * Basic functionality. fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/LICENSE.txt000066400000000000000000000024461514707373700215210ustar00rootroot00000000000000Copyright (c) 2016-2023 Bálint Aradi, Universität Bremen All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/MANIFEST.in000066400000000000000000000002111514707373700214200ustar00rootroot00000000000000include bin/fypp include LICENSE.txt include CHANGELOG.rst recursive-include test *.sh *.inc *.py global-exclude *.pyc global-exclude *~ fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/README.rst000066400000000000000000000156061514707373700213670ustar00rootroot00000000000000********************************************* Fypp — Python powered Fortran metaprogramming ********************************************* .. image:: https://travis-ci.org/aradi/fypp.svg?branch=develop :target: https://travis-ci.org/aradi/fypp Fypp is a Python powered preprocessor. It can be used for any programming languages but its primary aim is to offer a Fortran preprocessor, which helps to extend Fortran with condititional compiling and template metaprogramming capabilities. Instead of introducing its own expression syntax, it uses Python expressions in its preprocessor directives, offering the consistency and versatility of Python when formulating metaprogramming tasks. It puts strong emphasis on robustness and on neat integration into developing toolchains. The project is `hosted on github `_. `Detailed DOCUMENTATION `_ is available on `readthedocs.org `_. Fypp is released under the *BSD 2-clause license*. Main features ============= * Definition, evaluation and removal of variables:: #:if DEBUG > 0 print *, "Some debug information" #:endif #:set LOGLEVEL = 2 print *, "LOGLEVEL: ${LOGLEVEL}$" #:del LOGLEVEL * Macro definitions and macro calls:: #:def ASSERT(cond) #:if DEBUG > 0 if (.not. ${cond}$) then print *, "Assert failed in file ${_FILE_}$, line ${_LINE_}$" error stop end if #:endif #:enddef ASSERT ! Invoked via direct call (argument needs no quotation) @:ASSERT(size(myArray) > 0) ! Invoked as Python expression (argument needs quotation) $:ASSERT('size(myArray) > 0') * Conditional output:: program test #:if defined('WITH_MPI') use mpi #:elif defined('WITH_OPENMP') use openmp #:else use serial #:endif * Iterated output (e.g. for generating Fortran templates):: interface myfunc #:for dtype in ['real', 'dreal', 'complex', 'dcomplex'] module procedure myfunc_${dtype}$ #:endfor end interface myfunc * Inline directives:: logical, parameter :: hasMpi = #{if defined('MPI')}# .true. #{else}# .false. #{endif}# * Insertion of arbitrary Python expressions:: character(*), parameter :: comp_date = "${time.strftime('%Y-%m-%d')}$" * Inclusion of files during preprocessing:: #:include "macrodefs.fypp" * Using Fortran-style continutation lines in preprocessor directives:: #:if var1 > var2 & & or var2 > var4 print *, "Doing something here" #:endif * Passing (unquoted) multiline string arguments to callables:: #! Callable needs only string argument #:def DEBUG_CODE(code) #:if DEBUG > 0 $:code #:endif #:enddef DEBUG_CODE #! Pass code block as first positional argument #:block DEBUG_CODE if (size(array) > 100) then print *, "DEBUG: spuriously large array" end if #:endblock DEBUG_CODE #! Callable needs also non-string argument types #:def REPEAT_CODE(code, repeat) #:for ind in range(repeat) $:code #:endfor #:enddef REPEAT_CODE #! Pass code block as positional argument and 3 as keyword argument "repeat" #:block REPEAT_CODE(repeat=3) this will be repeated 3 times #:endblock REPEAT_CODE * Preprocessor comments:: #! This will not show up in the output #! Also the newline characters at the end of the lines will be suppressed * Suppressing the preprocessor output in selected regions:: #! Definitions are read, but no output (e.g. newlines) will be produced #:mute #:include "macrodefs.fypp" #:endmute * Explicit request for stopping the preprocessor:: #:if DEBUGLEVEL < 0 #:stop 'Negative debug level not allowed!' #:endif * Easy check for macro parameter sanity:: #:def mymacro(RANK) #! Macro only works for RANK 1 and above #:assert RANK > 0 : #:enddef mymacro * Line numbering directives in output:: program test #:if defined('MPI') use mpi #:endif : transformed to :: # 1 "test.fypp" 1 program test # 3 "test.fypp" use mpi # 5 "test.fypp" : when variable ``MPI`` is defined and Fypp was instructed to generate line markers. * Automatic folding of generated lines exceeding line length limit Installing ========== Fypp needs a working Python 3 interpreter (Python 3.5 or above). When you install Fypp, you obtain the command line tool ``fypp`` and the Python module ``fypp.py``. Latter you can import if you want to access the functionality of Fypp directly from within your Python scripts. Installing via conda -------------------- The last stable release of Fypp can be easily installed as conda package by issuing :: conda install -c conda-forge fypp Installing via pip ------------------ You can also use Pythons command line installer ``pip`` in order to download the stable release from the `Fypp page on PyPI `_ and install it on your system. If you want to install Fypp into the module system of the active Python 3 interpreter (typically the case when you are using a Python virtual environment), issue :: pip3 install fypp Alternatively, you can install Fypp into the user space (under `~/.local`) with :: pip3 install --user fypp Installing via MSYS2 pacman --------------------------- On Windows you can use the `MSYS2 toolchain `_ to install Fypp in a MinGW terminal. To install Fypp use:: pacman -S mingw-w64-x86_64-python-fypp Make sure the selected architecture is matching your current MinGW terminal. For all supporting MinGW architectures visit check the package index `here `_. Manual install -------------- For a manual install, you can download the source code of the **stable** releases from the `Fypp project website `_. If you wish to obtain the latest **development** version, clone the projects repository:: git clone https://github.com/aradi/fypp.git and check out the `master` branch. The command line tool is a single stand-alone script. You can run it directly from the source folder :: FYPP_SOURCE_FOLDER/bin/fypp or after copying it from the `bin` folder to any location listed in your `PATH` environment variable, by just issuing :: fypp The python module ``fypp.py`` can be found in ``FYP_SOURCE_FOLDER/src``. Running ======= The Fypp command line tool reads a file, preprocesses it and writes it to another file, so you would typically invoke it like:: fypp source.fpp source.f90 which would process `source.fpp` and write the result to `source.f90`. If input and output files are not specified, information is read from stdin and written to stdout. The behavior of Fypp can be influenced with various command line options. A summary of all command line options can be obtained by:: fypp -h fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/bin/000077500000000000000000000000001514707373700204405ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/bin/fypp000077500000000000000000003422331514707373700213530ustar00rootroot00000000000000#!/usr/bin/env python3 # -*- coding: utf-8 -*- ################################################################################ # # fypp -- Python powered Fortran preprocessor # # Copyright (c) 2016-2023 Bálint Aradi, Universität Bremen # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, this # list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright notice, # this list of conditions and the following disclaimer in the documentation # and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 'AS IS' # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # ################################################################################ '''For using the functionality of the Fypp preprocessor from within Python, one usually interacts with the following two classes: * `Fypp`_: The actual Fypp preprocessor. It returns for a given input the preprocessed output. * `FyppOptions`_: Contains customizable settings controlling the behaviour of `Fypp`_. Alternatively, the function `get_option_parser()`_ can be used to obtain an option parser, which can create settings based on command line arguments. If processing stops prematurely, an instance of one of the following subclasses of `FyppError`_ is raised: * FyppFatalError: Unexpected error (e.g. bad input, missing files, etc.) * FyppStopRequest: Stop was triggered by an explicit request in the input (by a stop- or an assert-directive). ''' import pathlib import sys import types import inspect import re import os import errno import time import optparse import io import platform import builtins # Prevent cluttering user directory with Python bytecode sys.dont_write_bytecode = True VERSION = '3.2' STDIN = '' FILEOBJ = '' STRING = '' ERROR_EXIT_CODE = 1 USER_ERROR_EXIT_CODE = 2 _ALL_DIRECTIVES_PATTERN = r''' # comment block (?:^[ \t]*\#!.*\n)+ | # line directive (with optional continuation lines) ^[ \t]*(?P[\#\$@]):[ \t]* (?P.+?(?:&[ \t]*\n(?:[ \t]*&)?.*?)*)?[ \t]*\n | # inline eval directive (?P[$\#@])\{[ \t]*(?P.+?)?[ \t]*\}(?P=idirtype) ''' _ALL_DIRECTIVES_REGEXP = re.compile( _ALL_DIRECTIVES_PATTERN, re.VERBOSE | re.MULTILINE) _CONTROL_DIR_REGEXP = re.compile( r'(?P[a-zA-Z_]\w*)[ \t]*(?:[ \t]+(?P[^ \t].*))?$') _DIRECT_CALL_REGEXP = re.compile( r'(?P[a-zA-Z_][\w.]*)[ \t]*\((?P.+?)?\)$') _DIRECT_CALL_KWARG_REGEXP = re.compile( r'(?:(?P[a-zA-Z_]\w*)\s*=(?=[^=]|$))?') _DEF_PARAM_REGEXP = re.compile( r'^(?P[a-zA-Z_]\w*)[ \t]*\(\s*(?P.+)?\s*\)$') _SIMPLE_CALLABLE_REGEXP = re.compile( r'^(?P[a-zA-Z_][\w.]*)[ \t]*(?:\([ \t]*(?P.*)[ \t]*\))?$') _IDENTIFIER_NAME_REGEXP = re.compile(r'^(?P[a-zA-Z_]\w*)$') _PREFIXED_IDENTIFIER_NAME_REGEXP = re.compile(r'^(?P[a-zA-Z_][\w.]*)$') _SET_PARAM_REGEXP = re.compile( r'^(?P(?:[(]\s*)?[a-zA-Z_]\w*(?:\s*,\s*[a-zA-Z_]\w*)*(?:\s*[)])?)\s*'\ r'(?:=\s*(?P.*))?$') _DEL_PARAM_REGEXP = re.compile( r'^(?:[(]\s*)?[a-zA-Z_]\w*(?:\s*,\s*[a-zA-Z_]\w*)*(?:\s*[)])?$') _FOR_PARAM_REGEXP = re.compile( r'^(?P[a-zA-Z_]\w*(\s*,\s*[a-zA-Z_]\w*)*)\s+in\s+(?P.+)$') _INCLUDE_PARAM_REGEXP = re.compile(r'^(\'|")(?P.*?)\1$') _COMMENTLINE_REGEXP = re.compile(r'^[ \t]*!.*$') _CONTLINE_REGEXP = re.compile(r'&[ \t]*\n(?:[ \t]*&)?') _UNESCAPE_TEXT_REGEXP1 = re.compile(r'([$#@])\\(\\*)([{:])') _UNESCAPE_TEXT_REGEXP2 = re.compile(r'#\\(\\*)([!])') _UNESCAPE_TEXT_REGEXP3 = re.compile(r'(\})\\(\\*)([$#@])') _INLINE_EVAL_REGION_REGEXP = re.compile(r'\${.*?}\$') _RESERVED_PREFIX = '__' _RESERVED_NAMES = set(['defined', 'setvar', 'getvar', 'delvar', 'globalvar', '_LINE_', '_FILE_', '_THIS_FILE_', '_THIS_LINE_', '_TIME_', '_DATE_', '_SYSTEM_', '_MACHINE_']) _LINENUM_NEW_FILE = 1 _LINENUM_RETURN_TO_FILE = 2 _QUOTES_FORTRAN = '\'"' _OPENING_BRACKETS_FORTRAN = '{([' _CLOSING_BRACKETS_FORTRAN = '})]' _ARGUMENT_SPLIT_CHAR_FORTRAN = ',' class FyppError(Exception): '''Signalizes error occurring during preprocessing. Args: msg (str): Error message. fname (str): File name. None (default) if file name is not available. span (tuple of int): Beginning and end line of the region where error occurred or None if not available. If fname was not None, span must not be None. Attributes: msg (str): Error message. fname (str or None): File name or None if not available. span (tuple of int or None): Beginning and end line of the region where error occurred or None if not available. Line numbers start from zero. For directives, which do not consume end of the line, start and end lines are identical. ''' def __init__(self, msg, fname=None, span=None): super().__init__() self.msg = msg self.fname = fname self.span = span def __str__(self): msg = [self.__class__.__name__, ': '] if self.fname is not None: msg.append("file '" + self.fname + "'") if self.span[1] > self.span[0] + 1: msg.append(', lines {0}-{1}'.format( self.span[0] + 1, self.span[1])) else: msg.append(', line {0}'.format(self.span[0] + 1)) msg.append('\n') if self.msg: msg.append(self.msg) if self.__cause__ is not None: msg.append('\n' + str(self.__cause__)) return ''.join(msg) class FyppFatalError(FyppError): '''Signalizes an unexpected error during processing.''' class FyppStopRequest(FyppError): '''Signalizes an explicitely triggered stop (e.g. via stop directive)''' class Parser: '''Parses a text and generates events when encountering Fypp constructs. Args: includedirs (list): List of directories, in which include files should be searched for, when they are not found at the default location. encoding (str): Encoding to use when reading the file (default: utf-8) ''' def __init__(self, includedirs=None, encoding='utf-8'): # Directories to search for include files if includedirs is None: self._includedirs = [] else: self._includedirs = includedirs # Encoding self._encoding = encoding # Name of current file self._curfile = None # Directory of current file self._curdir = None def parsefile(self, fobj): '''Parses file or a file like object. Args: fobj (str or file): Name of a file or a file like object. ''' if isinstance(fobj, str): if fobj == STDIN: self._includefile(None, sys.stdin, STDIN, os.getcwd()) else: inpfp = _open_input_file(fobj, self._encoding) self._includefile(None, inpfp, fobj, os.path.dirname(fobj)) inpfp.close() else: self._includefile(None, fobj, FILEOBJ, os.getcwd()) def _includefile(self, span, fobj, fname, curdir): oldfile = self._curfile olddir = self._curdir self._curfile = fname self._curdir = curdir self._parse_txt(span, fname, fobj.read()) self._curfile = oldfile self._curdir = olddir def parse(self, txt): '''Parses string. Args: txt (str): Text to parse. ''' self._curfile = STRING self._curdir = '' self._parse_txt(None, self._curfile, txt) def handle_include(self, span, fname): '''Called when parser starts to process a new file. It is a dummy methond and should be overridden for actual use. Args: span (tuple of int): Start and end line of the include directive or None if called the first time for the main input. fname (str): Name of the file. ''' self._log_event('include', span, filename=fname) def handle_endinclude(self, span, fname): '''Called when parser finished processing a file. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the include directive or None if called the first time for the main input. fname (str): Name of the file. ''' self._log_event('endinclude', span, filename=fname) def handle_set(self, span, name, expr): '''Called when parser encounters a set directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the variable. expr (str): String representation of the expression to be assigned to the variable. ''' self._log_event('set', span, name=name, expression=expr) def handle_def(self, span, name, args): '''Called when parser encounters a def directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the macro to be defined. argexpr (str): String with argument definition (or None) ''' self._log_event('def', span, name=name, arguments=args) def handle_enddef(self, span, name): '''Called when parser encounters an enddef directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str): Name found after the enddef directive. ''' self._log_event('enddef', span, name=name) def handle_del(self, span, name): '''Called when parser encounters a del directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the variable to delete. ''' self._log_event('del', span, name=name) def handle_if(self, span, cond): '''Called when parser encounters an if directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. cond (str): String representation of the branching condition. ''' self._log_event('if', span, condition=cond) def handle_elif(self, span, cond): '''Called when parser encounters an elif directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. cond (str): String representation of the branching condition. ''' self._log_event('elif', span, condition=cond) def handle_else(self, span): '''Called when parser encounters an else directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. ''' self._log_event('else', span) def handle_endif(self, span): '''Called when parser encounters an endif directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. ''' self._log_event('endif', span) def handle_for(self, span, varexpr, iterator): '''Called when parser encounters a for directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. varexpr (str): String representation of the loop variable expression. iterator (str): String representation of the iterable. ''' self._log_event('for', span, variable=varexpr, iterable=iterator) def handle_endfor(self, span): '''Called when parser encounters an endfor directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. ''' self._log_event('endfor', span) def handle_call(self, span, name, argexpr, blockcall): '''Called when parser encounters a call directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the callable to call argexpr (str or None): Argument expression containing additional arguments for the call. blockcall (bool): Whether the alternative "block / contains / endblock" calling directive has been used. ''' self._log_event('call', span, name=name, argexpr=argexpr, blockcall=blockcall) def handle_nextarg(self, span, name, blockcall): '''Called when parser encounters a nextarg directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str or None): Name of the argument following next or None if it should be the next positional argument. blockcall (bool): Whether the alternative "block / contains / endblock" calling directive has been used. ''' self._log_event('nextarg', span, name=name, blockcall=blockcall) def handle_endcall(self, span, name, blockcall): '''Called when parser encounters an endcall directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str): Name found after the endcall directive. blockcall (bool): Whether the alternative "block / contains / endblock" calling directive has been used. ''' self._log_event('endcall', span, name=name, blockcall=blockcall) def handle_eval(self, span, expr): '''Called when parser encounters an eval directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. expr (str): String representation of the Python expression to be evaluated. ''' self._log_event('eval', span, expression=expr) def handle_global(self, span, name): '''Called when parser encounters a global directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the variable which should be made global. ''' self._log_event('global', span, name=name) def handle_text(self, span, txt): '''Called when parser finds text which must left unaltered. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. txt (str): Text. ''' self._log_event('text', span, content=txt) def handle_comment(self, span): '''Called when parser finds a preprocessor comment. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. ''' self._log_event('comment', span) def handle_mute(self, span): '''Called when parser finds a mute directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. ''' self._log_event('mute', span) def handle_endmute(self, span): '''Called when parser finds an endmute directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. ''' self._log_event('endmute', span) def handle_stop(self, span, msg): '''Called when parser finds an stop directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. msg (str): Stop message. ''' self._log_event('stop', span, msg=msg) def handle_assert(self, span): '''Called when parser finds an assert directive. It is a dummy method and should be overridden for actual use. Args: span (tuple of int): Start and end line of the directive. ''' self._log_event('assert', span) @staticmethod def _log_event(event, span=(-1, -1), **params): print('{0}: {1} --> {2}'.format(event, span[0], span[1])) for parname, parvalue in params.items(): print(' {0}: ->|{1}|<-'.format(parname, parvalue)) print() def _parse_txt(self, includespan, fname, txt): self.handle_include(includespan, fname) self._parse(txt) self.handle_endinclude(includespan, fname) def _parse(self, txt, linenr=0, directcall=False): pos = 0 for match in _ALL_DIRECTIVES_REGEXP.finditer(txt): start, end = match.span() if start > pos: endlinenr = linenr + txt.count('\n', pos, start) self._process_text(txt[pos:start], (linenr, endlinenr)) linenr = endlinenr endlinenr = linenr + txt.count('\n', start, end) span = (linenr, endlinenr) ldirtype, ldir, idirtype, idir = match.groups() if directcall and (idirtype is None or idirtype != '$'): msg = 'only inline eval directives allowed in direct calls' raise FyppFatalError(msg, self._curfile, span) elif idirtype is not None: if idir is None: msg = 'missing inline directive content' raise FyppFatalError(msg, self._curfile, span) dirtype = idirtype content = idir elif ldirtype is not None: if ldir is None: msg = 'missing line directive content' raise FyppFatalError(msg, self._curfile, span) dirtype = ldirtype content = _CONTLINE_REGEXP.sub('', ldir) else: # Comment directive dirtype = None if dirtype == '$': self.handle_eval(span, content) elif dirtype == '#': self._process_control_dir(content, span) elif dirtype == '@': self._process_direct_call(content, span) else: self.handle_comment(span) pos = end linenr = endlinenr if pos < len(txt): endlinenr = linenr + txt.count('\n', pos) self._process_text(txt[pos:], (linenr, endlinenr)) def _process_text(self, txt, span): escaped_txt = self._unescape(txt) self.handle_text(span, escaped_txt) def _process_control_dir(self, content, span): match = _CONTROL_DIR_REGEXP.match(content) if not match: msg = "invalid control directive content '{0}'".format(content) raise FyppFatalError(msg, self._curfile, span) directive, param = match.groups() if directive == 'if': self._check_param_presence(True, 'if', param, span) self.handle_if(span, param) elif directive == 'else': self._check_param_presence(False, 'else', param, span) self.handle_else(span) elif directive == 'elif': self._check_param_presence(True, 'elif', param, span) self.handle_elif(span, param) elif directive == 'endif': self._check_param_presence(False, 'endif', param, span) self.handle_endif(span) elif directive == 'def': self._check_param_presence(True, 'def', param, span) self._check_not_inline_directive('def', span) self._process_def(param, span) elif directive == 'enddef': self._process_enddef(param, span) elif directive == 'set': self._check_param_presence(True, 'set', param, span) self._process_set(param, span) elif directive == 'del': self._check_param_presence(True, 'del', param, span) self._process_del(param, span) elif directive == 'for': self._check_param_presence(True, 'for', param, span) self._process_for(param, span) elif directive == 'endfor': self._check_param_presence(False, 'endfor', param, span) self.handle_endfor(span) elif directive == 'call' or directive == 'block': self._check_param_presence(True, directive, param, span) self._process_call(param, span, directive == 'block') elif directive == 'nextarg' or directive == 'contains': self._process_nextarg(param, span, directive == 'contains') elif directive == 'endcall' or directive == 'endblock': self._process_endcall(param, span, directive == 'endblock') elif directive == 'include': self._check_param_presence(True, 'include', param, span) self._check_not_inline_directive('include', span) self._process_include(param, span) elif directive == 'mute': self._check_param_presence(False, 'mute', param, span) self._check_not_inline_directive('mute', span) self.handle_mute(span) elif directive == 'endmute': self._check_param_presence(False, 'endmute', param, span) self._check_not_inline_directive('endmute', span) self.handle_endmute(span) elif directive == 'stop': self._check_param_presence(True, 'stop', param, span) self._check_not_inline_directive('stop', span) self.handle_stop(span, param) elif directive == 'assert': self._check_param_presence(True, 'assert', param, span) self._check_not_inline_directive('assert', span) self.handle_assert(span, param) elif directive == 'global': self._check_param_presence(True, 'global', param, span) self._process_global(param, span) else: msg = "unknown directive '{0}'".format(directive) raise FyppFatalError(msg, self._curfile, span) def _process_direct_call(self, callexpr, span): match = _DIRECT_CALL_REGEXP.match(callexpr) if not match: msg = "invalid direct call expression" raise FyppFatalError(msg, self._curfile, span) callname = match.group('callname') self.handle_call(span, callname, None, False) callparams = match.group('callparams') if callparams is None or not callparams.strip(): args = [] else: try: args = [arg.strip() for arg in _argsplit_fortran(callparams)] except Exception as exc: msg = 'unable to parse direct call argument' raise FyppFatalError(msg, self._curfile, span) from exc for arg in args: match = _DIRECT_CALL_KWARG_REGEXP.match(arg) argval = arg[match.end():].strip() # Remove enclosing braces if present if argval.startswith('{'): argval = argval[1:-1] keyword = match.group('kwname') self.handle_nextarg(span, keyword, False) self._parse(argval, linenr=span[0], directcall=True) self.handle_endcall(span, callname, False) def _process_def(self, param, span): match = _DEF_PARAM_REGEXP.match(param) if not match: msg = "invalid macro definition '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) name = match.group('name') argexpr = match.group('args') self.handle_def(span, name, argexpr) def _process_enddef(self, param, span): if param is not None: match = _IDENTIFIER_NAME_REGEXP.match(param) if not match: msg = "invalid enddef parameter '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) param = match.group('name') self.handle_enddef(span, param) def _process_set(self, param, span): match = _SET_PARAM_REGEXP.match(param) if not match: msg = "invalid variable assignment '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) self.handle_set(span, match.group('name'), match.group('expr')) def _process_global(self, param, span): match = _DEL_PARAM_REGEXP.match(param) if not match: msg = "invalid variable specification '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) self.handle_global(span, param) def _process_del(self, param, span): match = _DEL_PARAM_REGEXP.match(param) if not match: msg = "invalid variable specification '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) self.handle_del(span, param) def _process_for(self, param, span): match = _FOR_PARAM_REGEXP.match(param) if not match: msg = "invalid for loop declaration '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) loopexpr = match.group('loopexpr') loopvars = [s.strip() for s in loopexpr.split(',')] self.handle_for(span, loopvars, match.group('iter')) def _process_call(self, param, span, blockcall): match = _SIMPLE_CALLABLE_REGEXP.match(param) if not match: msg = "invalid callable expression '{}'".format(param) raise FyppFatalError(msg, self._curfile, span) name, args = match.groups() self.handle_call(span, name, args, blockcall) def _process_nextarg(self, param, span, blockcall): if param is not None: match = _IDENTIFIER_NAME_REGEXP.match(param) if not match: msg = "invalid nextarg parameter '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) param = match.group('name') self.handle_nextarg(span, param, blockcall) def _process_endcall(self, param, span, blockcall): if param is not None: match = _PREFIXED_IDENTIFIER_NAME_REGEXP.match(param) if not match: msg = "invalid endcall parameter '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) param = match.group('name') self.handle_endcall(span, param, blockcall) def _process_include(self, param, span): match = _INCLUDE_PARAM_REGEXP.match(param) if not match: msg = "invalid include file declaration '{0}'".format(param) raise FyppFatalError(msg, self._curfile, span) fname = match.group('fname') for incdir in [self._curdir] + self._includedirs: fpath = os.path.join(incdir, fname) if os.path.exists(fpath): break else: msg = "include file '{0}' not found".format(fname) raise FyppFatalError(msg, self._curfile, span) inpfp = _open_input_file(fpath, self._encoding) self._includefile(span, inpfp, fpath, os.path.dirname(fpath)) inpfp.close() def _process_mute(self, span): if span[0] == span[1]: msg = 'Inline form of mute directive not allowed' raise FyppFatalError(msg, self._curfile, span) self.handle_mute(span) def _process_endmute(self, span): if span[0] == span[1]: msg = 'Inline form of endmute directive not allowed' raise FyppFatalError(msg, self._curfile, span) self.handle_endmute(span) def _check_param_presence(self, presence, directive, param, span): if (param is not None) != presence: if presence: msg = 'missing data in {0} directive'.format(directive) else: msg = 'forbidden data in {0} directive'.format(directive) raise FyppFatalError(msg, self._curfile, span) def _check_not_inline_directive(self, directive, span): if span[0] == span[1]: msg = 'Inline form of {0} directive not allowed'.format(directive) raise FyppFatalError(msg, self._curfile, span) @staticmethod def _unescape(txt): txt = _UNESCAPE_TEXT_REGEXP1.sub(r'\1\2\3', txt) txt = _UNESCAPE_TEXT_REGEXP2.sub(r'#\1\2', txt) txt = _UNESCAPE_TEXT_REGEXP3.sub(r'\1\2\3', txt) return txt class Builder: '''Builds a tree representing a text with preprocessor directives. ''' def __init__(self): # The tree, which should be built. self._tree = [] # List of all open constructs self._open_blocks = [] # Nodes to which the open blocks have to be appended when closed self._path = [] # Nr. of open blocks when file was opened. Used for checking whether all # blocks have been closed, when file processing finishes. self._nr_prev_blocks = [] # Current node, to which content should be added self._curnode = self._tree # Current file self._curfile = None def reset(self): '''Resets the builder so that it starts to build a new tree.''' self._tree = [] self._open_blocks = [] self._path = [] self._nr_prev_blocks = [] self._curnode = self._tree self._curfile = None def handle_include(self, span, fname): '''Should be called to signalize change to new file. Args: span (tuple of int): Start and end line of the include directive or None if called the first time for the main input. fname (str): Name of the file to be included. ''' self._path.append(self._curnode) self._curnode = [] self._open_blocks.append( ('include', self._curfile, [span], fname, None)) self._curfile = fname self._nr_prev_blocks.append(len(self._open_blocks)) def handle_endinclude(self, span, fname): '''Should be called when processing of a file finished. Args: span (tuple of int): Start and end line of the include directive or None if called the first time for the main input. fname (str): Name of the file which has been included. ''' nprev_blocks = self._nr_prev_blocks.pop(-1) if len(self._open_blocks) > nprev_blocks: directive, fname, spans = self._open_blocks[-1][0:3] msg = '{0} directive still unclosed when reaching end of file'\ .format(directive) raise FyppFatalError(msg, self._curfile, spans[0]) block = self._open_blocks.pop(-1) directive, blockfname, spans = block[0:3] if directive != 'include': msg = 'internal error: last open block is not \'include\' when '\ 'closing file \'{0}\''.format(fname) raise FyppFatalError(msg) if span != spans[0]: msg = 'internal error: span for include and endinclude differ ('\ '{0} vs {1}'.format(span, spans[0]) raise FyppFatalError(msg) oldfname, _ = block[3:5] if fname != oldfname: msg = 'internal error: mismatching file name in close_file event'\ " (expected: '{0}', got: '{1}')".format(oldfname, fname) raise FyppFatalError(msg, fname) block = directive, blockfname, spans, fname, self._curnode self._curnode = self._path.pop(-1) self._curnode.append(block) self._curfile = blockfname def handle_if(self, span, cond): '''Should be called to signalize an if directive. Args: span (tuple of int): Start and end line of the directive. param (str): String representation of the branching condition. ''' self._path.append(self._curnode) self._curnode = [] self._open_blocks.append(('if', self._curfile, [span], [cond], [])) def handle_elif(self, span, cond): '''Should be called to signalize an elif directive. Args: span (tuple of int): Start and end line of the directive. cond (str): String representation of the branching condition. ''' self._check_for_open_block(span, 'elif') block = self._open_blocks[-1] directive, _, spans = block[0:3] self._check_if_matches_last(directive, 'if', spans[-1], span, 'elif') conds, contents = block[3:5] conds.append(cond) contents.append(self._curnode) spans.append(span) self._curnode = [] def handle_else(self, span): '''Should be called to signalize an else directive. Args: span (tuple of int): Start and end line of the directive. ''' self._check_for_open_block(span, 'else') block = self._open_blocks[-1] directive, _, spans = block[0:3] self._check_if_matches_last(directive, 'if', spans[-1], span, 'else') conds, contents = block[3:5] conds.append('True') contents.append(self._curnode) spans.append(span) self._curnode = [] def handle_endif(self, span): '''Should be called to signalize an endif directive. Args: span (tuple of int): Start and end line of the directive. ''' self._check_for_open_block(span, 'endif') block = self._open_blocks.pop(-1) directive, _, spans = block[0:3] self._check_if_matches_last(directive, 'if', spans[-1], span, 'endif') _, contents = block[3:5] contents.append(self._curnode) spans.append(span) self._curnode = self._path.pop(-1) self._curnode.append(block) def handle_for(self, span, loopvar, iterator): '''Should be called to signalize a for directive. Args: span (tuple of int): Start and end line of the directive. varexpr (str): String representation of the loop variable expression. iterator (str): String representation of the iterable. ''' self._path.append(self._curnode) self._curnode = [] self._open_blocks.append(('for', self._curfile, [span], loopvar, iterator, None)) def handle_endfor(self, span): '''Should be called to signalize an endfor directive. Args: span (tuple of int): Start and end line of the directive. ''' self._check_for_open_block(span, 'endfor') block = self._open_blocks.pop(-1) directive, fname, spans = block[0:3] self._check_if_matches_last(directive, 'for', spans[-1], span, 'endfor') loopvar, iterator, dummy = block[3:6] spans.append(span) block = (directive, fname, spans, loopvar, iterator, self._curnode) self._curnode = self._path.pop(-1) self._curnode.append(block) def handle_def(self, span, name, argexpr): '''Should be called to signalize a def directive. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the macro to be defined. argexpr (str): Macro argument definition or None ''' self._path.append(self._curnode) self._curnode = [] defblock = ('def', self._curfile, [span], name, argexpr, None) self._open_blocks.append(defblock) def handle_enddef(self, span, name): '''Should be called to signalize an enddef directive. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the enddef statement. Could be None, if enddef was specified without name. ''' self._check_for_open_block(span, 'enddef') block = self._open_blocks.pop(-1) directive, fname, spans = block[0:3] self._check_if_matches_last(directive, 'def', spans[-1], span, 'enddef') defname, argexpr, dummy = block[3:6] if name is not None and name != defname: msg = "wrong name in enddef directive "\ "(expected '{0}', got '{1}')".format(defname, name) raise FyppFatalError(msg, fname, span) spans.append(span) block = (directive, fname, spans, defname, argexpr, self._curnode) self._curnode = self._path.pop(-1) self._curnode.append(block) def handle_call(self, span, name, argexpr, blockcall): '''Should be called to signalize a call directive. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the callable to call argexpr (str or None): Argument expression containing additional arguments for the call. blockcall (bool): Whether the alternative "block / contains / endblock" calling directive has been used. ''' self._path.append(self._curnode) self._curnode = [] directive = 'block' if blockcall else 'call' self._open_blocks.append( (directive, self._curfile, [span, span], name, argexpr, [], [])) def handle_nextarg(self, span, name, blockcall): '''Should be called to signalize a nextarg directive. Args: span (tuple of int): Start and end line of the directive. name (str or None): Name of the argument following next or None if it should be the next positional argument. blockcall (bool): Whether the alternative "block / contains / endblock" calling directive has been used. ''' self._check_for_open_block(span, 'nextarg') block = self._open_blocks[-1] directive, fname, spans = block[0:3] if blockcall: opened, current = 'block', 'contains' else: opened, current = 'call', 'nextarg' self._check_if_matches_last(directive, opened, spans[-1], span, current) args, argnames = block[5:7] args.append(self._curnode) spans.append(span) if name is not None: argnames.append(name) elif argnames: msg = 'non-keyword argument following keyword argument' raise FyppFatalError(msg, fname, span) self._curnode = [] def handle_endcall(self, span, name, blockcall): '''Should be called to signalize an endcall directive. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the endcall statement. Could be None, if endcall was specified without name. blockcall (bool): Whether the alternative "block / contains / endblock" calling directive has been used. ''' self._check_for_open_block(span, 'endcall') block = self._open_blocks.pop(-1) directive, fname, spans = block[0:3] callname, callargexpr, args, argnames = block[3:7] if blockcall: opened, current = 'block', 'endblock' else: opened, current = 'call', 'endcall' self._check_if_matches_last(directive, opened, spans[0], span, current) if name is not None and name != callname: msg = "wrong name in {0} directive "\ "(expected '{1}', got '{2}')".format(current, callname, name) raise FyppFatalError(msg, fname, span) args.append(self._curnode) # If nextarg or endcall immediately followed call, then first argument # is empty and should be removed (to allow for calls without arguments # and named first argument in calls) if args and not args[0]: if len(argnames) == len(args): del argnames[0] del args[0] del spans[1] spans.append(span) block = (directive, fname, spans, callname, callargexpr, args, argnames) self._curnode = self._path.pop(-1) self._curnode.append(block) def handle_set(self, span, name, expr): '''Should be called to signalize a set directive. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the variable. expr (str): String representation of the expression to be assigned to the variable. ''' self._curnode.append(('set', self._curfile, span, name, expr)) def handle_global(self, span, name): '''Should be called to signalize a global directive. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the variable(s) to make global. ''' self._curnode.append(('global', self._curfile, span, name)) def handle_del(self, span, name): '''Should be called to signalize a del directive. Args: span (tuple of int): Start and end line of the directive. name (str): Name of the variable(s) to delete. ''' self._curnode.append(('del', self._curfile, span, name)) def handle_eval(self, span, expr): '''Should be called to signalize an eval directive. Args: span (tuple of int): Start and end line of the directive. expr (str): String representation of the Python expression to be evaluated. ''' self._curnode.append(('eval', self._curfile, span, expr)) def handle_comment(self, span): '''Should be called to signalize a comment directive. The content of the comment is not needed by the builder, but it needs the span of the comment to generate proper line numbers if needed. Args: span (tuple of int): Start and end line of the directive. ''' self._curnode.append(('comment', self._curfile, span)) def handle_text(self, span, txt): '''Should be called to pass text which goes to output unaltered. Args: span (tuple of int): Start and end line of the text. txt (str): Text. ''' self._curnode.append(('txt', self._curfile, span, txt)) def handle_mute(self, span): '''Should be called to signalize a mute directive. Args: span (tuple of int): Start and end line of the directive. ''' self._path.append(self._curnode) self._curnode = [] self._open_blocks.append(('mute', self._curfile, [span], None)) def handle_endmute(self, span): '''Should be called to signalize an endmute directive. Args: span (tuple of int): Start and end line of the directive. ''' self._check_for_open_block(span, 'endmute') block = self._open_blocks.pop(-1) directive, fname, spans = block[0:3] self._check_if_matches_last(directive, 'mute', spans[-1], span, 'endmute') spans.append(span) block = (directive, fname, spans, self._curnode) self._curnode = self._path.pop(-1) self._curnode.append(block) def handle_stop(self, span, msg): '''Should be called to signalize a stop directive. Args: span (tuple of int): Start and end line of the directive. ''' self._curnode.append(('stop', self._curfile, span, msg)) def handle_assert(self, span, cond): '''Should be called to signalize an assert directive. Args: span (tuple of int): Start and end line of the directive. ''' self._curnode.append(('assert', self._curfile, span, cond)) @property def tree(self): '''Returns the tree built by the Builder.''' return self._tree def _check_for_open_block(self, span, directive): if len(self._open_blocks) <= self._nr_prev_blocks[-1]: msg = 'unexpected {0} directive'.format(directive) raise FyppFatalError(msg, self._curfile, span) def _check_if_matches_last(self, lastdir, curdir, lastspan, curspan, directive): if curdir != lastdir: msg = "mismatching '{0}' directive (last block opened was '{1}')"\ .format(directive, lastdir) raise FyppFatalError(msg, self._curfile, curspan) inline_last = lastspan[0] == lastspan[1] inline_cur = curspan[0] == curspan[1] if inline_last != inline_cur: if inline_cur: msg = 'expecting line form of directive {0}'.format(directive) else: msg = 'expecting inline form of directive {0}'.format(directive) raise FyppFatalError(msg, self._curfile, curspan) elif inline_cur and curspan[0] != lastspan[0]: msg = 'inline directives of the same construct must be in the '\ 'same row' raise FyppFatalError(msg, self._curfile, curspan) class Renderer: ''''Renders a tree. Args: evaluator (Evaluator, optional): Evaluator to use when rendering eval directives. If None (default), Evaluator() is used. linenums (bool, optional): Whether linenums should be generated, defaults to False. contlinenums (bool, optional): Whether linenums for continuation should be generated, defaults to False. linenumformat (str, optional): 'std', 'cpp' or 'gfortran5' depending what kind of line directives should be created. Default: 'cpp'. Format 'std' emits #line pragmas, 'cpp' resembles GNU cpps special format, and 'gfortran5' adds to cpp a workaround for a bug introduced in GFortran 5. linefolder (callable): Callable to use when folding a line. filevarroot (str, optional): render _FILE_ and _THIS_FILE_ as paths relative to this root directory (default: paths are not converted explicitely to relative paths) ''' def __init__(self, evaluator=None, linenums=False, contlinenums=False, linenumformat=None, linefolder=None, filevarroot=None): # Evaluator to use for Python expressions self._evaluator = Evaluator() if evaluator is None else evaluator self._evaluator.updateglobals(_SYSTEM_=platform.system(), _MACHINE_=platform.machine()) # Whether rendered output is diverted and will be processed # further before output (if True: no line numbering and post processing) self._diverted = False # Whether file name and line numbers should be kept fixed and # not updated (typically when rendering macro content) self._fixedposition = False # Whether line numbering directives should be emitted self._linenums = linenums # Whether line numbering directives in continuation lines are needed. self._contlinenums = contlinenums # Line number formatter function and whether gfortran5 fix is needed if linenumformat is None or linenumformat in ('cpp', 'gfortran5'): self._linenumdir = linenumdir_cpp self._linenum_gfortran5 = linenumformat == 'gfortran5' else: self._linenumdir = linenumdir_std self._linenum_gfortran5 = False # Callable to be used for folding lines if linefolder is None: self._linefolder = lambda line: [line] else: self._linefolder = linefolder if filevarroot is None: self._convert_file_path = lambda path: path else: self._convert_file_path = ( lambda path: pathlib.Path(path).relative_to(filevarroot) ) def render(self, tree, divert=False, fixposition=False): '''Renders a tree. Args: tree (fypp-tree): Tree to render. divert (bool): Whether output will be diverted and sent for further processing, so that no line numbering directives and postprocessing are needed at this stage. (Default: False) fixposition (bool): Whether file name and line position (variables _FILE_ and _LINE_) should be kept at their current values or should be updated continuously. (Default: False). Returns: str: Rendered string. ''' diverted = self._diverted self._diverted = divert fixedposition_old = self._fixedposition self._fixedposition = self._fixedposition or fixposition output, eval_inds, eval_pos = self._render(tree) if not self._diverted and eval_inds: self._postprocess_eval_lines(output, eval_inds, eval_pos) self._diverted = diverted self._fixedposition = fixedposition_old txt = ''.join(output) return txt def _render(self, tree): output = [] eval_inds = [] eval_pos = [] for node in tree: cmd = node[0] if cmd == 'txt': output.append(node[3]) elif cmd == 'if': out, ieval, peval = self._get_conditional_content(*node[1:5]) eval_inds += _shiftinds(ieval, len(output)) eval_pos += peval output += out elif cmd == 'eval': out, ieval, peval = self._get_eval(*node[1:4]) eval_inds += _shiftinds(ieval, len(output)) eval_pos += peval output += out elif cmd == 'def': result = self._define_macro(*node[1:6]) output.append(result) elif cmd == 'set': result = self._define_variable(*node[1:5]) output.append(result) elif cmd == 'del': self._delete_variable(*node[1:4]) elif cmd == 'for': out, ieval, peval = self._get_iterated_content(*node[1:6]) eval_inds += _shiftinds(ieval, len(output)) eval_pos += peval output += out elif cmd == 'call' or cmd == 'block': out, ieval, peval = self._get_called_content(*node[1:7]) eval_inds += _shiftinds(ieval, len(output)) eval_pos += peval output += out elif cmd == 'include': out, ieval, peval = self._get_included_content(*node[1:5]) eval_inds += _shiftinds(ieval, len(output)) eval_pos += peval output += out elif cmd == 'comment': output.append(self._get_comment(*node[1:3])) elif cmd == 'mute': output.append(self._get_muted_content(*node[1:4])) elif cmd == 'stop': self._handle_stop(*node[1:4]) elif cmd == 'assert': result = self._handle_assert(*node[1:4]) output.append(result) elif cmd == 'global': self._add_global(*node[1:4]) else: msg = "internal error: unknown command '{0}'".format(cmd) raise FyppFatalError(msg) return output, eval_inds, eval_pos def _get_eval(self, fname, span, expr): try: result = self._evaluate(expr, fname, span[0]) except Exception as exc: msg = "exception occurred when evaluating '{0}'".format(expr) raise FyppFatalError(msg, fname, span) from exc out = [] ieval = [] peval = [] if result is not None: out.append(str(result)) if not self._diverted: ieval.append(0) peval.append((span, fname)) if span[0] != span[1]: out.append('\n') return out, ieval, peval def _get_conditional_content(self, fname, spans, conditions, contents): out = [] ieval = [] peval = [] multiline = (spans[0][0] != spans[-1][1]) for condition, content, span in zip(conditions, contents, spans): try: cond = bool(self._evaluate(condition, fname, span[0])) except Exception as exc: msg = "exception occurred when evaluating '{0}'"\ .format(condition) raise FyppFatalError(msg, fname, span) from exc if cond: if self._linenums and not self._diverted and multiline: out.append(self._linenumdir(span[1], fname)) outcont, ievalcont, pevalcont = self._render(content) ieval += _shiftinds(ievalcont, len(out)) peval += pevalcont out += outcont break if self._linenums and not self._diverted and multiline: out.append(self._linenumdir(spans[-1][1], fname)) return out, ieval, peval def _get_iterated_content(self, fname, spans, loopvars, loopiter, content): out = [] ieval = [] peval = [] try: iterobj = iter(self._evaluate(loopiter, fname, spans[0][0])) except Exception as exc: msg = "exception occurred when evaluating '{0}'"\ .format(loopiter) raise FyppFatalError(msg, fname, spans[0]) from exc multiline = (spans[0][0] != spans[-1][1]) for var in iterobj: if len(loopvars) == 1: self._define(loopvars[0], var) else: for varname, value in zip(loopvars, var): self._define(varname, value) if self._linenums and not self._diverted and multiline: out.append(self._linenumdir(spans[0][1], fname)) outcont, ievalcont, pevalcont = self._render(content) ieval += _shiftinds(ievalcont, len(out)) peval += pevalcont out += outcont if self._linenums and not self._diverted and multiline: out.append(self._linenumdir(spans[1][1], fname)) return out, ieval, peval def _get_called_content(self, fname, spans, name, argexpr, contents, argnames): posargs, kwargs = self._get_call_arguments(fname, spans, argexpr, contents, argnames) try: callobj = self._evaluate(name, fname, spans[0][0]) result = callobj(*posargs, **kwargs) except Exception as exc: msg = "exception occurred when calling '{0}'".format(name) raise FyppFatalError(msg, fname, spans[0]) from exc self._update_predef_globals(fname, spans[0][0]) span = (spans[0][0], spans[-1][1]) out = [] ieval = [] peval = [] if result is not None: out = [str(result)] if not self._diverted: ieval = [0] peval = [(span, fname)] if span[0] != span[1]: out.append('\n') return out, ieval, peval def _get_call_arguments(self, fname, spans, argexpr, contents, argnames): if argexpr is None: posargs = [] kwargs = {} else: # Parse and evaluate arguments passed in call header self._evaluator.openscope() try: posargs, kwargs = self._evaluate( '__getargvalues(' + argexpr + ')', fname, spans[0][0]) except Exception as exc: msg = "unable to parse argument expression '{0}'"\ .format(argexpr) raise FyppFatalError(msg, fname, spans[0]) from exc self._evaluator.closescope() # Render arguments passed in call body args = [] for content in contents: self._evaluator.openscope() rendered = self.render(content, divert=True) self._evaluator.closescope() if rendered.endswith('\n'): rendered = rendered[:-1] args.append(rendered) # Separate arguments in call body into positional and keyword ones: if argnames: posargs += args[:len(args) - len(argnames)] offset = len(args) - len(argnames) for iargname, argname in enumerate(argnames): ind = offset + iargname if argname in kwargs: msg = "keyword argument '{0}' already defined"\ .format(argname) raise FyppFatalError(msg, fname, spans[ind + 1]) kwargs[argname] = args[ind] else: posargs += args return posargs, kwargs def _get_included_content(self, fname, spans, includefname, content): includefile = spans[0] is not None out = [] if self._linenums and not self._diverted: if includefile or self._linenum_gfortran5: out += self._linenumdir(0, includefname, _LINENUM_NEW_FILE) else: out += self._linenumdir(0, includefname) outcont, ieval, peval = self._render(content) ieval = _shiftinds(ieval, len(out)) out += outcont if self._linenums and not self._diverted and includefile: out += self._linenumdir(spans[0][1], fname, _LINENUM_RETURN_TO_FILE) return out, ieval, peval def _define_macro(self, fname, spans, name, argexpr, content): if argexpr is None: args = [] defaults = {} varpos = None varkw = None else: # Try to create a lambda function with the argument expression self._evaluator.openscope() lambdaexpr = 'lambda ' + argexpr + ': None' try: func = self._evaluate(lambdaexpr, fname, spans[0][0]) except Exception as exc: msg = "exception occurred when evaluating argument expression "\ "'{0}'".format(argexpr) raise FyppFatalError(msg, fname, spans[0]) from exc self._evaluator.closescope() try: args, defaults, varpos, varkw = _get_callable_argspec(func) except Exception as exc: msg = "invalid argument expression '{0}'".format(argexpr) raise FyppFatalError(msg, fname, spans[0]) from exc named_args = args if varpos is None else args + [varpos] named_args = named_args if varkw is None else named_args + [varkw] for arg in named_args: if arg in _RESERVED_NAMES or arg.startswith(_RESERVED_PREFIX): msg = "invalid argument name '{0}'".format(arg) raise FyppFatalError(msg, fname, spans[0]) result = '' try: macro = _Macro( name, fname, spans, args, defaults, varpos, varkw, content, self, self._evaluator, self._evaluator.localscope) self._define(name, macro) except Exception as exc: msg = "exception occurred when defining macro '{0}'"\ .format(name) raise FyppFatalError(msg, fname, spans[0]) from exc if self._linenums and not self._diverted: result = self._linenumdir(spans[1][1], fname) return result def _define_variable(self, fname, span, name, valstr): result = '' try: if valstr is None: expr = None else: expr = self._evaluate(valstr, fname, span[0]) self._define(name, expr) except Exception as exc: msg = "exception occurred when setting variable(s) '{0}' to '{1}'"\ .format(name, valstr) raise FyppFatalError(msg, fname, span) from exc multiline = (span[0] != span[1]) if self._linenums and not self._diverted and multiline: result = self._linenumdir(span[1], fname) return result def _delete_variable(self, fname, span, name): result = '' try: self._evaluator.undefine(name) except Exception as exc: msg = "exception occurred when deleting variable(s) '{0}'"\ .format(name) raise FyppFatalError(msg, fname, span) from exc multiline = (span[0] != span[1]) if self._linenums and not self._diverted and multiline: result = self._linenumdir(span[1], fname) return result def _add_global(self, fname, span, name): result = '' try: self._evaluator.addglobal(name) except Exception as exc: msg = "exception occurred when making variable(s) '{0}' global"\ .format(name) raise FyppFatalError(msg, fname, span) from exc multiline = (span[0] != span[1]) if self._linenums and not self._diverted and multiline: result = self._linenumdir(span[1], fname) return result def _get_comment(self, fname, span): if self._linenums and not self._diverted: return self._linenumdir(span[1], fname) return '' def _get_muted_content(self, fname, spans, content): self._render(content) if self._linenums and not self._diverted: return self._linenumdir(spans[-1][1], fname) return '' def _handle_stop(self, fname, span, msgstr): try: msg = str(self._evaluate(msgstr, fname, span[0])) except Exception as exc: msg = "exception occurred when evaluating stop message '{0}'"\ .format(msgstr) raise FyppFatalError(msg, fname, span) from exc raise FyppStopRequest(msg, fname, span) def _handle_assert(self, fname, span, expr): result = '' try: cond = bool(self._evaluate(expr, fname, span[0])) except Exception as exc: msg = "exception occurred when evaluating assert condition '{0}'"\ .format(expr) raise FyppFatalError(msg, fname, span) from exc if not cond: msg = "Assertion failed ('{0}')".format(expr) raise FyppStopRequest(msg, fname, span) if self._linenums and not self._diverted: result = self._linenumdir(span[1], fname) return result def _evaluate(self, expr, fname, linenr): self._update_predef_globals(fname, linenr) result = self._evaluator.evaluate(expr) self._update_predef_globals(fname, linenr) return result def _update_predef_globals(self, fname, linenr): fname = self._convert_file_path(fname) self._evaluator.updatelocals( _DATE_=time.strftime('%Y-%m-%d'), _TIME_=time.strftime('%H:%M:%S'), _THIS_FILE_=fname, _THIS_LINE_=linenr + 1) if not self._fixedposition: self._evaluator.updateglobals(_FILE_=fname, _LINE_=linenr + 1) def _define(self, var, value): self._evaluator.define(var, value) def _postprocess_eval_lines(self, output, eval_inds, eval_pos): ilastproc = -1 for ieval, ind in enumerate(eval_inds): span, fname = eval_pos[ieval] if ind <= ilastproc: continue iprev, eolprev = self._find_last_eol(output, ind) inext, eolnext = self._find_next_eol(output, ind) curline = self._glue_line(output, ind, iprev, eolprev, inext, eolnext) output[iprev + 1:inext] = [''] * (inext - iprev - 1) output[ind] = self._postprocess_eval_line(curline, fname, span) ilastproc = inext @staticmethod def _find_last_eol(output, ind): 'Find last newline before current position.' iprev = ind - 1 while iprev >= 0: eolprev = output[iprev].rfind('\n') if eolprev != -1: break iprev -= 1 else: iprev = 0 eolprev = -1 return iprev, eolprev @staticmethod def _find_next_eol(output, ind): 'Find last newline before current position.' # find first eol after expr. evaluation inext = ind + 1 while inext < len(output): eolnext = output[inext].find('\n') if eolnext != -1: break inext += 1 else: inext = len(output) - 1 eolnext = len(output[-1]) - 1 return inext, eolnext @staticmethod def _glue_line(output, ind, iprev, eolprev, inext, eolnext): 'Create line from parts between specified boundaries.' curline_parts = [] if iprev != ind: curline_parts = [output[iprev][eolprev + 1:]] output[iprev] = output[iprev][:eolprev + 1] curline_parts.extend(output[iprev + 1:ind]) curline_parts.extend(output[ind]) curline_parts.extend(output[ind + 1:inext]) if inext != ind: curline_parts.append(output[inext][:eolnext + 1]) output[inext] = output[inext][eolnext + 1:] return ''.join(curline_parts) def _postprocess_eval_line(self, evalline, fname, span): lines = evalline.split('\n') # If line ended on '\n', last element is ''. We remove it and # add the trailing newline later manually. trailing_newline = (lines[-1] == '') if trailing_newline: del lines[-1] lnum = self._linenumdir(span[0], fname) if self._linenums else '' clnum = lnum if self._contlinenums else '' linenumsep = '\n' + lnum clinenumsep = '\n' + clnum foldedlines = [self._foldline(line) for line in lines] outlines = [clinenumsep.join(lines) for lines in foldedlines] result = linenumsep.join(outlines) # Add missing trailing newline if trailing_newline: trailing = '\n' if self._linenums: # Last line was folded, but no linenums were generated for # the continuation lines -> current line position is not # in sync with the one calculated from the last line number unsync = ( len(foldedlines) and len(foldedlines[-1]) > 1 and not self._contlinenums) # Eval directive in source consists of more than one line multiline = span[1] - span[0] > 1 if unsync or multiline: # For inline eval directives span[0] == span[1] # -> next line is span[0] + 1 and not span[1] as for # line eval directives nextline = max(span[1], span[0] + 1) trailing += self._linenumdir(nextline, fname) else: trailing = '' return result + trailing def _foldline(self, line): if _COMMENTLINE_REGEXP.match(line) is None: return self._linefolder(line) return [line] class Evaluator: '''Provides an isolated environment for evaluating Python expressions. It restricts the builtins which can be used within this environment to a (hopefully safe) subset. Additionally it defines the functions which are provided by the preprocessor for the eval directives. Args: env (dict, optional): Initial definitions for the environment, defaults to None. ''' # Restricted builtins working in all supported Python verions. Version # specific ones are added dynamically in _get_restricted_builtins(). _RESTRICTED_BUILTINS = { 'abs': builtins.abs, 'all': builtins.all, 'any': builtins.any, 'bin': builtins.bin, 'bool': builtins.bool, 'bytearray': builtins.bytearray, 'bytes': builtins.bytes, 'chr': builtins.chr, 'classmethod': builtins.classmethod, 'complex': builtins.complex, 'delattr': builtins.delattr, 'dict': builtins.dict, 'dir': builtins.dir, 'divmod': builtins.divmod, 'enumerate': builtins.enumerate, 'filter': builtins.filter, 'float': builtins.float, 'format': builtins.format, 'frozenset': builtins.frozenset, 'getattr': builtins.getattr, 'globals': builtins.globals, 'hasattr': builtins.hasattr, 'hash': builtins.hash, 'hex': builtins.hex, 'id': builtins.id, 'int': builtins.int, 'isinstance': builtins.isinstance, 'issubclass': builtins.issubclass, 'iter': builtins.iter, 'len': builtins.len, 'list': builtins.list, 'locals': builtins.locals, 'map': builtins.map, 'max': builtins.max, 'min': builtins.min, 'next': builtins.next, 'object': builtins.object, 'oct': builtins.oct, 'ord': builtins.ord, 'pow': builtins.pow, 'property': builtins.property, 'range': builtins.range, 'repr': builtins.repr, 'reversed': builtins.reversed, 'round': builtins.round, 'set': builtins.set, 'setattr': builtins.setattr, 'slice': builtins.slice, 'sorted': builtins.sorted, 'staticmethod': builtins.staticmethod, 'str': builtins.str, 'sum': builtins.sum, 'super': builtins.super, 'tuple': builtins.tuple, 'type': builtins.type, 'vars': builtins.vars, 'zip': builtins.zip, } def __init__(self, env=None): # Global scope self._globals = env if env is not None else {} # Local scope(s) self._locals = None self._locals_stack = [] # Variables which are references to entries in global scope self._globalrefs = None self._globalrefs_stack = [] # Current scope (globals + locals in all embedding and in current scope) self._scope = self._globals # Turn on restricted mode self._restrict_builtins() def evaluate(self, expr): '''Evaluate a Python expression using the `eval()` builtin. Args: expr (str): String represantion of the expression. Return: Python object: Result of the expression evaluation. ''' result = eval(expr, self._scope) return result def import_module(self, module): '''Import a module into the evaluator. Note: Import only trustworthy modules! Module imports are global, therefore, importing a malicious module which manipulates other global modules could affect code behaviour outside of the Evaluator as well. Args: module (str): Python module to import. Raises: FyppFatalError: If module could not be imported. ''' rootmod = module.split('.', 1)[0] try: imported = __import__(module, self._scope) self.define(rootmod, imported) except Exception as exc: msg = "failed to import module '{0}'".format(module) raise FyppFatalError(msg) from exc def define(self, name, value): '''Define a Python entity. Args: name (str): Name of the entity. value (Python object): Value of the entity. Raises: FyppFatalError: If name starts with the reserved prefix or if it is a reserved name. ''' varnames = self._get_variable_names(name) if len(varnames) == 1: value = (value,) elif len(varnames) != len(value): msg = 'value for tuple assignment has incompatible length' raise FyppFatalError(msg) for varname, varvalue in zip(varnames, value): self._check_variable_name(varname) if self._locals is None: self._globals[varname] = varvalue else: if varname in self._globalrefs: self._globals[varname] = varvalue else: self._locals[varname] = varvalue self._scope[varname] = varvalue def undefine(self, name): '''Undefine a Python entity. Args: name (str): Name of the entity to undefine. Raises: FyppFatalError: If name starts with the reserved prefix or if it is a reserved name. ''' varnames = self._get_variable_names(name) for varname in varnames: self._check_variable_name(varname) deleted = False if self._locals is None: if varname in self._globals: del self._globals[varname] deleted = True else: if varname in self._locals: del self._locals[varname] del self._scope[varname] deleted = True elif varname in self._globalrefs and varname in self._globals: del self._globals[varname] del self._scope[varname] deleted = True if not deleted: msg = "lookup for an erasable instance of '{0}' failed"\ .format(varname) raise FyppFatalError(msg) def addglobal(self, name): '''Define a given entity as global. Args: name (str): Name of the entity to make global. Raises: FyppFatalError: If entity name is invalid or if the current scope is a local scope and entity is already defined in it. ''' varnames = self._get_variable_names(name) for varname in varnames: self._check_variable_name(varname) if self._locals is not None: if varname in self._locals: msg = "variable '{0}' already defined in local scope"\ .format(varname) raise FyppFatalError(msg) self._globalrefs.add(varname) def updateglobals(self, **vardict): '''Update variables in the global scope. This is a shortcut function to inject protected variables in the global scope without extensive checks (as in define()). Vardict must not contain any global entries which can be shadowed in local scopes (e.g. should only contain variables with forbidden prefix). Args: **vardict: variable definitions. ''' self._scope.update(vardict) if self._locals is not None: self._globals.update(vardict) def updatelocals(self, **vardict): '''Update variables in the local scope. This is a shortcut function to inject variables in the local scope without extensive checks (as in define()). Vardict must not contain any entries which have been made global via addglobal() before. In order to ensure this, updatelocals() should be called immediately after openscope(), or with variable names, which are warrantedly not globals (e.g variables starting with forbidden prefix) Args: **vardict: variable definitions. ''' self._scope.update(vardict) if self._locals is not None: self._locals.update(vardict) def openscope(self, customlocals=None): '''Opens a new (embedded) scope. Args: customlocals (dict): By default, the locals of the embedding scope are visible in the new one. When this is not the desired behaviour a dictionary of customized locals can be passed, and those locals will become the only visible ones. ''' self._locals_stack.append(self._locals) self._globalrefs_stack.append(self._globalrefs) if customlocals is not None: self._locals = customlocals.copy() elif self._locals is not None: self._locals = self._locals.copy() else: self._locals = {} self._globalrefs = set() self._scope = self._globals.copy() self._scope.update(self._locals) def closescope(self): '''Close scope and restore embedding scope.''' self._locals = self._locals_stack.pop(-1) self._globalrefs = self._globalrefs_stack.pop(-1) if self._locals is not None: self._scope = self._globals.copy() self._scope.update(self._locals) else: self._scope = self._globals @property def globalscope(self): 'Dictionary of the global scope.' return self._globals @property def localscope(self): 'Dictionary of the current local scope.' return self._locals def _restrict_builtins(self): builtindict = self._get_restricted_builtins() builtindict['__import__'] = self._func_import builtindict['defined'] = self._func_defined builtindict['setvar'] = self._func_setvar builtindict['getvar'] = self._func_getvar builtindict['delvar'] = self._func_delvar builtindict['globalvar'] = self._func_globalvar builtindict['__getargvalues'] = self._func_getargvalues self._globals['__builtins__'] = builtindict @classmethod def _get_restricted_builtins(cls): bidict = dict(cls._RESTRICTED_BUILTINS) return bidict @staticmethod def _get_variable_names(varexpr): lpar = varexpr.startswith('(') rpar = varexpr.endswith(')') if lpar != rpar: msg = "unbalanced parenthesis around variable varexpr(s) in '{0}'"\ .format(varexpr) raise FyppFatalError(msg, None, None) if lpar: varexpr = varexpr[1:-1] varnames = [s.strip() for s in varexpr.split(',')] return varnames @staticmethod def _check_variable_name(varname): if varname.startswith(_RESERVED_PREFIX): msg = "Name '{0}' starts with reserved prefix '{1}'"\ .format(varname, _RESERVED_PREFIX) raise FyppFatalError(msg, None, None) if varname in _RESERVED_NAMES: msg = "Name '{0}' is reserved and can not be redefined"\ .format(varname) raise FyppFatalError(msg, None, None) def _func_defined(self, var): defined = var in self._scope return defined def _func_import(self, name, *_, **__): module = self._scope.get(name, None) if module is not None and isinstance(module, types.ModuleType): return module msg = "Import of module '{0}' via '__import__' not allowed".format(name) raise ImportError(msg) def _func_setvar(self, *namesvalues): if len(namesvalues) % 2: msg = 'setvar function needs an even number of arguments' raise FyppFatalError(msg) for ind in range(0, len(namesvalues), 2): self.define(namesvalues[ind], namesvalues[ind + 1]) def _func_getvar(self, name, defvalue=None): if name in self._scope: return self._scope[name] return defvalue def _func_delvar(self, *names): for name in names: self.undefine(name) def _func_globalvar(self, *names): for name in names: self.addglobal(name) @staticmethod def _func_getargvalues(*args, **kwargs): return list(args), kwargs class _Macro: '''Represents a user defined macro. This object should only be initiatied by a Renderer instance, as it needs access to Renderers internal variables and methods. Args: name (str): Name of the macro. fname (str): The file where the macro was defined. spans (str): Line spans of macro definition. argnames (list of str): Macro dummy arguments. varpos (str): Name of variable positional argument or None. varkw (str): Name of variable keyword argument or None. content (list): Content of the macro as tree. renderer (Renderer): Renderer to use for evaluating macro content. localscope (dict): Dictionary with local variables, which should be used the local scope, when the macro is called. Default: None (empty local scope). ''' def __init__(self, name, fname, spans, argnames, defaults, varpos, varkw, content, renderer, evaluator, localscope=None): self._name = name self._fname = fname self._spans = spans self._argnames = argnames self._defaults = defaults self._varpos = varpos self._varkw = varkw self._content = content self._renderer = renderer self._evaluator = evaluator self._localscope = localscope if localscope is not None else {} def __call__(self, *args, **keywords): argdict = self._process_arguments(args, keywords) self._evaluator.openscope(customlocals=self._localscope) self._evaluator.updatelocals(**argdict) output = self._renderer.render(self._content, divert=True, fixposition=True) self._evaluator.closescope() if output.endswith('\n'): return output[:-1] return output def _process_arguments(self, args, keywords): kwdict = dict(keywords) argdict = {} nargs = min(len(args), len(self._argnames)) for iarg in range(nargs): argdict[self._argnames[iarg]] = args[iarg] if nargs < len(args): if self._varpos is None: msg = "macro '{0}' called with too many positional arguments "\ "(expected: {1}, received: {2})"\ .format(self._name, len(self._argnames), len(args)) raise FyppFatalError(msg, self._fname, self._spans[0]) else: argdict[self._varpos] = list(args[nargs:]) elif self._varpos is not None: argdict[self._varpos] = [] for argname in self._argnames[:nargs]: if argname in kwdict: msg = "got multiple values for argument '{0}'".format(argname) raise FyppFatalError(msg, self._fname, self._spans[0]) if nargs < len(self._argnames): for argname in self._argnames[nargs:]: if argname in kwdict: argdict[argname] = kwdict.pop(argname) elif argname in self._defaults: argdict[argname] = self._defaults[argname] else: msg = "macro '{0}' called without mandatory positional "\ "argument '{1}'".format(self._name, argname) raise FyppFatalError(msg, self._fname, self._spans[0]) if kwdict and self._varkw is None: kwstr = "', '".join(kwdict.keys()) msg = "macro '{0}' called with unknown keyword argument(s) '{1}'"\ .format(self._name, kwstr) raise FyppFatalError(msg, self._fname, self._spans[0]) if self._varkw is not None: argdict[self._varkw] = kwdict return argdict class Processor: '''Connects various objects with each other to create a processor. Args: parser (Parser, optional): Parser to use for parsing text. If None (default), `Parser()` is used. builder (Builder, optional): Builder to use for building the tree representation of the text. If None (default), `Builder()` is used. renderer (Renderer, optional): Renderer to use for rendering the output. If None (default), `Renderer()` is used with a default Evaluator(). evaluator (Evaluator, optional): Evaluator to use for evaluating Python expressions. If None (default), `Evaluator()` is used. ''' def __init__(self, parser=None, builder=None, renderer=None, evaluator=None): self._parser = Parser() if parser is None else parser self._builder = Builder() if builder is None else builder if renderer is None: evaluator = Evaluator() if evaluator is None else evaluator self._renderer = Renderer(evaluator) else: self._renderer = renderer self._parser.handle_include = self._builder.handle_include self._parser.handle_endinclude = self._builder.handle_endinclude self._parser.handle_if = self._builder.handle_if self._parser.handle_else = self._builder.handle_else self._parser.handle_elif = self._builder.handle_elif self._parser.handle_endif = self._builder.handle_endif self._parser.handle_eval = self._builder.handle_eval self._parser.handle_text = self._builder.handle_text self._parser.handle_def = self._builder.handle_def self._parser.handle_enddef = self._builder.handle_enddef self._parser.handle_set = self._builder.handle_set self._parser.handle_del = self._builder.handle_del self._parser.handle_global = self._builder.handle_global self._parser.handle_for = self._builder.handle_for self._parser.handle_endfor = self._builder.handle_endfor self._parser.handle_call = self._builder.handle_call self._parser.handle_nextarg = self._builder.handle_nextarg self._parser.handle_endcall = self._builder.handle_endcall self._parser.handle_comment = self._builder.handle_comment self._parser.handle_mute = self._builder.handle_mute self._parser.handle_endmute = self._builder.handle_endmute self._parser.handle_stop = self._builder.handle_stop self._parser.handle_assert = self._builder.handle_assert def process_file(self, fname): '''Processeses a file. Args: fname (str): Name of the file to process. Returns: str: Processed content. ''' self._parser.parsefile(fname) return self._render() def process_text(self, txt): '''Processes a string. Args: txt (str): Text to process. Returns: str: Processed content. ''' self._parser.parse(txt) return self._render() def _render(self): output = self._renderer.render(self._builder.tree) self._builder.reset() return ''.join(output) class Fypp: '''Fypp preprocessor. You can invoke it like :: tool = fypp.Fypp() tool.process_file('file.in', 'file.out') to initialize Fypp with default options, process `file.in` and write the result to `file.out`. If the input should be read from a string, the ``process_text()`` method can be used:: tool = fypp.Fypp() output = tool.process_text('#:if DEBUG > 0\\nprint *, "DEBUG"\\n#:endif\\n') If you want to fine tune Fypps behaviour, pass a customized `FyppOptions`_ instance at initialization:: options = fypp.FyppOptions() options.fixed_format = True tool = fypp.Fypp(options) Alternatively, you can use the command line parser ``optparse.OptionParser`` to set options for Fypp. The function ``get_option_parser()`` returns you a default option parser. You can then use its ``parse_args()`` method to obtain settings by reading the command line arguments:: optparser = fypp.get_option_parser() options, leftover = optparser.parse_args() tool = fypp.Fypp(options) The command line options can also be passed directly as a list when calling ``parse_args()``:: args = ['-DDEBUG=0', 'input.fpp', 'output.f90'] optparser = fypp.get_option_parser() options, leftover = optparser.parse_args(args=args) tool = fypp.Fypp(options) For even more fine-grained control over how Fypp works, you can pass in custom factory methods that handle construction of the evaluator, parser, builder and renderer components. These factory methods must have the same signature as the corresponding component's constructor. As an example of using a builder that's customized by subclassing:: class MyBuilder(fypp.Builder): def __init__(self): super().__init__() ...additional initialization... tool = fypp.Fypp(options, builder_factory=MyBuilder) Args: options (object): Object containing the settings for Fypp. You typically would pass a customized `FyppOptions`_ instance or an ``optparse.Values`` object as returned by the option parser. If not present, the default settings in `FyppOptions`_ are used. evaluator_factory (function): Factory function that returns an Evaluator object. Its call signature must match that of the Evaluator constructor. If not present, ``Evaluator`` is used. parser_factory (function): Factory function that returns a Parser object. Its call signature must match that of the Parser constructor. If not present, ``Parser`` is used. builder_factory (function): Factory function that returns a Builder object. Its call signature must match that of the Builder constructor. If not present, ``Builder`` is used. renderer_factory (function): Factory function that returns a Renderer object. Its call signature must match that of the Renderer constructor. If not present, ``Renderer`` is used. ''' def __init__(self, options=None, evaluator_factory=Evaluator, parser_factory=Parser, builder_factory=Builder, renderer_factory=Renderer): syspath = self._get_syspath_without_scriptdir() self._adjust_syspath(syspath) if options is None: options = FyppOptions() if inspect.signature(evaluator_factory) == inspect.signature(Evaluator): evaluator = evaluator_factory() else: raise FyppFatalError('evaluator_factory has incorrect signature') self._encoding = options.encoding if options.modules: self._import_modules(options.modules, evaluator, syspath, options.moduledirs) if options.defines: self._apply_definitions(options.defines, evaluator) if inspect.signature(parser_factory) == inspect.signature(Parser): parser = parser_factory(includedirs=options.includes, encoding=self._encoding) else: raise FyppFatalError('parser_factory has incorrect signature') if inspect.signature(builder_factory) == inspect.signature(Builder): builder = builder_factory() else: raise FyppFatalError('builder_factory has incorrect signature') fixed_format = options.fixed_format linefolding = not options.no_folding if linefolding: folding = 'brute' if fixed_format else options.folding_mode linelength = 72 if fixed_format else options.line_length indentation = 5 if fixed_format else options.indentation prefix = '&' suffix = '' if fixed_format else '&' linefolder = FortranLineFolder(linelength, indentation, folding, prefix, suffix) else: linefolder = DummyLineFolder() linenums = options.line_numbering contlinenums = (options.line_numbering_mode != 'nocontlines') self._create_parent_folder = options.create_parent_folder if inspect.signature(renderer_factory) == inspect.signature(Renderer): renderer = renderer_factory( evaluator, linenums=linenums, contlinenums=contlinenums, linenumformat=options.line_marker_format, linefolder=linefolder, filevarroot=options.file_var_root) else: raise FyppFatalError('renderer_factory has incorrect signature') self._preprocessor = Processor(parser, builder, renderer) def process_file(self, infile, outfile=None): '''Processes input file and writes result to output file. Args: infile (str): Name of the file to read and process. If its value is '-', input is read from stdin. outfile (str, optional): Name of the file to write the result to. If its value is '-', result is written to stdout. If not present, result will be returned as string. env (dict, optional): Additional definitions for the evaluator. Returns: str: Result of processed input, if no outfile was specified. ''' infile = STDIN if infile == '-' else infile output = self._preprocessor.process_file(infile) if outfile is None: return output if outfile == '-': outfile = sys.stdout else: outfile = _open_output_file(outfile, self._encoding, self._create_parent_folder) outfile.write(output) if outfile != sys.stdout: outfile.close() return None def process_text(self, txt): '''Processes a string. Args: txt (str): String to process. env (dict, optional): Additional definitions for the evaluator. Returns: str: Processed content. ''' return self._preprocessor.process_text(txt) @staticmethod def _apply_definitions(defines, evaluator): for define in defines: words = define.split('=', 1) name = words[0] value = None if len(words) > 1: try: value = evaluator.evaluate(words[1]) except Exception as exc: msg = "exception at evaluating '{0}' in definition for " \ "'{1}'".format(words[1], name) raise FyppFatalError(msg) from exc evaluator.define(name, value) def _import_modules(self, modules, evaluator, syspath, moduledirs): lookuppath = [] if moduledirs is not None: lookuppath += [os.path.abspath(moddir) for moddir in moduledirs] lookuppath.append(os.path.abspath('.')) lookuppath += syspath self._adjust_syspath(lookuppath) for module in modules: evaluator.import_module(module) self._adjust_syspath(syspath) @staticmethod def _get_syspath_without_scriptdir(): '''Remove the folder of the fypp binary from the search path''' syspath = list(sys.path) scriptdir = os.path.abspath(os.path.dirname(sys.argv[0])) if os.path.abspath(syspath[0]) == scriptdir: del syspath[0] return syspath @staticmethod def _adjust_syspath(syspath): sys.path = syspath class FyppOptions(optparse.Values): '''Container for Fypp options with default values. Attributes: defines (list of str): List of variable definitions in the form of 'VARNAME=VALUE'. Default: [] includes (list of str): List of paths to search when looking for include files. Default: [] line_numbering (bool): Whether line numbering directives should appear in the output. Default: False line_numbering_mode (str): Line numbering mode 'full' or 'nocontlines'. Default: 'full'. line_marker_format (str): Line marker format. Currently 'std', 'cpp' and 'gfortran5' are supported, where 'std' emits ``#line`` pragmas similar to standard tools, 'cpp' produces line directives as emitted by GNU cpp, and 'gfortran5' cpp line directives with a workaround for a bug introduced in GFortran 5. Default: 'cpp'. line_length (int): Length of output lines. Default: 132. folding_mode (str): Folding mode 'smart', 'simple' or 'brute'. Default: 'smart'. no_folding (bool): Whether folding should be suppressed. Default: False. indentation (int): Indentation in continuation lines. Default: 4. modules (list of str): Modules to import at initialization. Default: []. moduledirs (list of str): Module lookup directories for importing user specified modules. The specified paths are looked up *before* the standard module locations in sys.path. fixed_format (bool): Whether input file is in fixed format. Default: False. encoding (str): Character encoding for reading/writing files. Allowed values are Pythons codec identifiers, e.g. 'ascii', 'utf-8', etc. Default: 'utf-8'. Reading from stdin and writing to stdout is always encoded according to the current locale and is not affected by this setting. create_parent_folder (bool): Whether the parent folder for the output file should be created if it does not exist. Default: False. ''' def __init__(self): optparse.Values.__init__(self) self.defines = [] self.includes = [] self.line_numbering = False self.line_numbering_mode = 'full' self.line_marker_format = 'cpp' self.line_length = 132 self.folding_mode = 'smart' self.no_folding = False self.indentation = 4 self.modules = [] self.moduledirs = [] self.fixed_format = False self.encoding = 'utf-8' self.create_parent_folder = False self.file_var_root = None class FortranLineFolder: '''Implements line folding with Fortran continuation lines. Args: maxlen (int, optional): Maximal line length (default: 132). indent (int, optional): Indentation for continuation lines (default: 4). method (str, optional): Folding method with following options: * ``brute``: folding with maximal length of continuation lines, * ``simple``: indents with respect of indentation of first line, * ``smart``: like ``simple``, but tries to fold at whitespaces. prefix (str, optional): String to use at the beginning of a continuation line (default: '&'). suffix (str, optional): String to use at the end of the line preceding a continuation line (default: '&') ''' def __init__(self, maxlen=132, indent=4, method='smart', prefix='&', suffix='&'): # Line length should be long enough that contintuation lines can host at # east one character apart of indentation and two continuation signs minmaxlen = indent + len(prefix) + len(suffix) + 1 if maxlen < minmaxlen: msg = 'Maximal line length less than {0} when using an indentation'\ ' of {1}'.format(minmaxlen, indent) raise FyppFatalError(msg) self._maxlen = maxlen self._indent = indent self._prefix = ' ' * self._indent + prefix self._suffix = suffix if method not in ['brute', 'smart', 'simple']: raise FyppFatalError('invalid folding type') if method == 'brute': self._inherit_indent = False self._fold_position_finder = self._get_maximal_fold_pos elif method == 'simple': self._inherit_indent = True self._fold_position_finder = self._get_maximal_fold_pos elif method == 'smart': self._inherit_indent = True self._fold_position_finder = self._get_smart_fold_pos def __call__(self, line): '''Folds a line. Can be directly called to return the list of folded lines:: linefolder = FortranLineFolder(maxlen=10) linefolder(' print *, "some Fortran line"') Args: line (str): Line to fold. Returns: list of str: Components of folded line. They should be assembled via ``\\n.join()`` to obtain the string representation. ''' if self._maxlen < 0 or len(line) <= self._maxlen: return [line] if self._inherit_indent: indent = len(line) - len(line.lstrip()) prefix = ' ' * indent + self._prefix else: indent = 0 prefix = self._prefix suffix = self._suffix return self._split_line(line, self._maxlen, prefix, suffix, self._fold_position_finder) @staticmethod def _split_line(line, maxlen, prefix, suffix, fold_position_finder): # length of continuation lines with 1 or two continuation chars. maxlen1 = maxlen - len(prefix) maxlen2 = maxlen1 - len(suffix) start = 0 end = fold_position_finder(line, start, maxlen - len(suffix)) result = [line[start:end] + suffix] while end < len(line) - maxlen1: start = end end = fold_position_finder(line, start, start + maxlen2) result.append(prefix + line[start:end] + suffix) result.append(prefix + line[end:]) return result @staticmethod def _get_maximal_fold_pos(_, __, end): return end @staticmethod def _get_smart_fold_pos(line, start, end): linelen = end - start ispace = line.rfind(' ', start, end) # The space we waste for smart folding should be max. 1/3rd of the line if ispace != -1 and ispace >= start + (2 * linelen) // 3: return ispace return end class DummyLineFolder: '''Implements a dummy line folder returning the line unaltered.''' def __call__(self, line): '''Returns the entire line without any folding. Returns: list of str: Components of folded line. They should be assembled via ``\\n.join()`` to obtain the string representation. ''' return [line] def get_option_parser(): '''Returns an option parser for the Fypp command line tool. Returns: OptionParser: Parser which can create an optparse.Values object with Fypp settings based on command line arguments. ''' defs = FyppOptions() fypp_name = 'fypp' fypp_desc = 'Preprocesses source code with Fypp directives. The input is '\ 'read from INFILE (default: \'-\', stdin) and written to '\ 'OUTFILE (default: \'-\', stdout).' fypp_version = fypp_name + ' ' + VERSION usage = '%prog [options] [INFILE] [OUTFILE]' parser = optparse.OptionParser(prog=fypp_name, description=fypp_desc, version=fypp_version, usage=usage) msg = 'define variable, value is interpreted as ' \ 'Python expression (e.g \'-DDEBUG=1\' sets DEBUG to the ' \ 'integer 1) or set to None if omitted' parser.add_option('-D', '--define', action='append', dest='defines', metavar='VAR[=VALUE]', default=defs.defines, help=msg) msg = 'add directory to the search paths for include files' parser.add_option('-I', '--include', action='append', dest='includes', metavar='INCDIR', default=defs.includes, help=msg) msg = 'import a python module at startup (import only trustworthy modules '\ 'as they have access to an **unrestricted** Python environment!)' parser.add_option('-m', '--module', action='append', dest='modules', metavar='MOD', default=defs.modules, help=msg) msg = 'directory to be searched for user imported modules before '\ 'looking up standard locations in sys.path' parser.add_option('-M', '--module-dir', action='append', dest='moduledirs', metavar='MODDIR', default=defs.moduledirs, help=msg) msg = 'emit line numbering markers' parser.add_option('-n', '--line-numbering', action='store_true', dest='line_numbering', default=defs.line_numbering, help=msg) msg = 'line numbering mode, \'full\' (default): line numbering '\ 'markers generated whenever source and output lines are out '\ 'of sync, \'nocontlines\': line numbering markers omitted '\ 'for continuation lines' parser.add_option('-N', '--line-numbering-mode', metavar='MODE', choices=['full', 'nocontlines'], default=defs.line_numbering_mode, dest='line_numbering_mode', help=msg) msg = 'line numbering marker format, currently \'std\', \'cpp\' and '\ '\'gfortran5\' are supported, where \'std\' emits #line pragmas '\ 'similar to standard tools, \'cpp\' produces line directives as '\ 'emitted by GNU cpp, and \'gfortran5\' cpp line directives with a '\ 'workaround for a bug introduced in GFortran 5. Default: \'cpp\'.' parser.add_option('--line-marker-format', metavar='FMT', choices=['cpp', 'gfortran5', 'std'], dest='line_marker_format', default=defs.line_marker_format, help=msg) msg = 'maximal line length (default: 132), lines modified by the '\ 'preprocessor are folded if becoming longer' parser.add_option('-l', '--line-length', type=int, metavar='LEN', dest='line_length', default=defs.line_length, help=msg) msg = 'line folding mode, \'smart\' (default): indentation context '\ 'and whitespace aware, \'simple\': indentation context aware, '\ '\'brute\': mechnical folding' parser.add_option('-f', '--folding-mode', metavar='MODE', choices=['smart', 'simple', 'brute'], dest='folding_mode', default=defs.folding_mode, help=msg) msg = 'suppress line folding' parser.add_option('-F', '--no-folding', action='store_true', dest='no_folding', default=defs.no_folding, help=msg) msg = 'indentation to use for continuation lines (default 4)' parser.add_option('--indentation', type=int, metavar='IND', dest='indentation', default=defs.indentation, help=msg) msg = 'produce fixed format output (any settings for options '\ '--line-length, --folding-method and --indentation are ignored)' parser.add_option('--fixed-format', action='store_true', dest='fixed_format', default=defs.fixed_format, help=msg) msg = 'character encoding for reading/writing files. Default: \'utf-8\'. '\ 'Note: reading from stdin and writing to stdout is encoded '\ 'according to the current locale and is not affected by this setting.' parser.add_option('--encoding', metavar='ENC', default=defs.encoding, help=msg) msg = 'create parent folders of the output file if they do not exist' parser.add_option('-p', '--create-parents', action='store_true', dest='create_parent_folder', default=defs.create_parent_folder, help=msg) msg = 'in variables _FILE_ and _THIS_FILE_, use relative paths with DIR '\ 'as root directory. Note: the input file and all included files '\ 'must be in DIR or in a directory below.' parser.add_option('--file-var-root', metavar='DIR', dest='file_var_root', default=defs.file_var_root, help=msg) return parser def run_fypp(): '''Run the Fypp command line tool.''' options = FyppOptions() optparser = get_option_parser() opts, leftover = optparser.parse_args(values=options) infile = leftover[0] if len(leftover) > 0 else '-' outfile = leftover[1] if len(leftover) > 1 else '-' try: tool = Fypp(opts) tool.process_file(infile, outfile) except FyppStopRequest as exc: sys.stderr.write(_formatted_exception(exc)) sys.exit(USER_ERROR_EXIT_CODE) except FyppFatalError as exc: sys.stderr.write(_formatted_exception(exc)) sys.exit(ERROR_EXIT_CODE) def linenumdir_cpp(linenr, fname, flag=None): """Returns a GNU cpp style line directive. Args: linenr (int): Line nr (starting with zero). fname (str): File name. flag (str): Optional flag to print after the directive Returns: Line number directive as string. """ if flag is None: return '# {0} "{1}"\n'.format(linenr + 1, fname) return '# {0} "{1}" {2}\n'.format(linenr + 1, fname, flag) def linenumdir_std(linenr, fname, flag=None): """Returns standard #line pragma styled line directive. Args: linenr (int): Line nr (starting with zero). fname (str): File name. flag (str): Optional flag to print after the directive. Note, this option is only there to be API compatible with linenumdir_cpp(), but is ignored otherwise, since #line pragmas do not allow for extra file opening/closing flags. Returns: Line number directive as string. """ return "#line {0} \"{1}\"\n".format(linenr + 1, fname) def _shiftinds(inds, shift): return [ind + shift for ind in inds] def _open_input_file(inpfile, encoding=None): try: inpfp = io.open(inpfile, 'r', encoding=encoding) except IOError as exc: msg = "Failed to open file '{0}' for read".format(inpfile) raise FyppFatalError(msg) from exc return inpfp def _open_output_file(outfile, encoding=None, create_parents=False): if create_parents: parentdir = os.path.abspath(os.path.dirname(outfile)) if not os.path.exists(parentdir): try: os.makedirs(parentdir) except OSError as exc: if exc.errno != errno.EEXIST: msg = "Folder '{0}' can not be created"\ .format(parentdir) raise FyppFatalError(msg) from exc try: outfp = io.open(outfile, 'w', encoding=encoding) except IOError as exc: msg = "Failed to open file '{0}' for write".format(outfile) raise FyppFatalError(msg) from exc return outfp # Signature objects are available from Python 3.3 (and deprecated from 3.5) def _get_callable_argspec(func): sig = inspect.signature(func) args = [] defaults = {} varpos = None varkw = None for param in sig.parameters.values(): if param.kind == param.POSITIONAL_OR_KEYWORD: args.append(param.name) if param.default != param.empty: defaults[param.name] = param.default elif param.kind == param.VAR_POSITIONAL: varpos = param.name elif param.kind == param.VAR_KEYWORD: varkw = param.name else: msg = "argument '{0}' has invalid argument type".format(param.name) raise FyppFatalError(msg) return args, defaults, varpos, varkw def _blank_match(match): size = match.end() - match.start() return " " * size def _argsplit_fortran(argtxt): txt = _INLINE_EVAL_REGION_REGEXP.sub(_blank_match, argtxt) splitpos = [-1] quote = None closing_brace_stack = [] closing_brace = None for ind, char in enumerate(txt): if quote: if char == quote: quote = None continue if char in _QUOTES_FORTRAN: quote = char continue if char in _OPENING_BRACKETS_FORTRAN: closing_brace_stack.append(closing_brace) ind = _OPENING_BRACKETS_FORTRAN.index(char) closing_brace = _CLOSING_BRACKETS_FORTRAN[ind] continue if char in _CLOSING_BRACKETS_FORTRAN: if char == closing_brace: closing_brace = closing_brace_stack.pop(-1) continue else: msg = "unexpected closing delimiter '{0}' in expression '{1}' "\ "at position {2}".format(char, argtxt, ind + 1) raise FyppFatalError(msg) if not closing_brace and char == _ARGUMENT_SPLIT_CHAR_FORTRAN: splitpos.append(ind) if quote or closing_brace: msg = "open quotes or brackets in expression '{0}'".format(argtxt) raise FyppFatalError(msg) splitpos.append(len(txt)) fragments = [argtxt[start + 1 : end] for start, end in zip(splitpos, splitpos[1:])] return fragments def _formatted_exception(exc): error_header_formstr = '{file}:{line}: ' error_body_formstr = 'error: {errormsg} [{errorclass}]' if not isinstance(exc, FyppError): return error_body_formstr.format( errormsg=str(exc), errorclass=exc.__class__.__name__) out = [] if exc.fname is not None: if exc.span[1] > exc.span[0] + 1: line = '{0}-{1}'.format(exc.span[0] + 1, exc.span[1]) else: line = '{0}'.format(exc.span[0] + 1) out.append(error_header_formstr.format(file=exc.fname, line=line)) out.append(error_body_formstr.format(errormsg=exc.msg, errorclass=exc.__class__.__name__)) if exc.__cause__ is not None: out.append('\n' + _formatted_exception(exc.__cause__)) out.append('\n') return ''.join(out) if __name__ == '__main__': run_fypp() fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/docs/000077500000000000000000000000001514707373700206205ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/docs/Makefile000066400000000000000000000011361514707373700222610ustar00rootroot00000000000000# Minimal makefile for Sphinx documentation # # You can set these variables from the command line. SPHINXOPTS = SPHINXBUILD = python3 -msphinx SPHINXPROJ = Fypp SOURCEDIR = . BUILDDIR = _build # Put it first so that "make" without argument is like "make help". help: @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) .PHONY: help Makefile # Catch-all target: route all unknown targets to Sphinx using the new # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). %: Makefile @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/docs/conf.py000066400000000000000000000121171514707373700221210ustar00rootroot00000000000000#!/usr/bin/env python3 # -*- coding: utf-8 -*- # # Fypp documentation build configuration file, created by # sphinx-quickstart on Tue Sep 12 17:02:09 2017. # # This file is execfile()d with the current directory set to its # containing dir. # # Note that not all possible configuration values are present in this # autogenerated file. # # All configuration values have a default; values that are commented out # serve to show the default. # If extensions (or modules to document with autodoc) are in another directory, # add these directories to sys.path here. If the directory is relative to the # documentation root, use os.path.abspath to make it absolute, like shown here. # import os import sys sys.path.insert(0, os.path.abspath('../src')) # -- General configuration ------------------------------------------------ # If your documentation needs a minimal Sphinx version, state it here. # # needs_sphinx = '1.0' # Add any Sphinx extension module names here, as strings. They can be # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom # ones. extensions = ['sphinx.ext.autodoc', 'sphinx.ext.napoleon'] # Add any paths that contain templates here, relative to this directory. templates_path = ['_templates'] # The suffix(es) of source filenames. # You can specify multiple suffix as a list of string: # # source_suffix = ['.rst', '.md'] source_suffix = '.rst' # The master toctree document. master_doc = 'index' # General information about the project. project = 'Fypp' copyright = '2016-2023, Bálint Aradi' author = 'Bálint Aradi' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the # built documents. # # The short X.Y version. version = '3.2' # The full version, including alpha/beta/rc tags. release = '3.2' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. # # This is also used if you do content translation via gettext catalogs. # Usually you set "language" from the command line for these cases. language = "en" # List of patterns, relative to source directory, that match files and # directories to ignore when looking for source files. # This patterns also effect to html_static_path and html_extra_path exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] # The name of the Pygments (syntax highlighting) style to use. pygments_style = 'sphinx' # If true, `todo` and `todoList` produce output, else they produce nothing. todo_include_todos = False # -- Options for HTML output ---------------------------------------------- # The theme to use for HTML and HTML Help pages. See the documentation for # a list of builtin themes. # #html_theme = 'alabaster' html_theme = 'sphinx_rtd_theme' # Theme options are theme-specific and customize the look and feel of a theme # further. For a list of options available for each theme, see the # documentation. # # html_theme_options = {} # Add any paths that contain custom static files (such as style sheets) here, # relative to this directory. They are copied after the builtin static files, # so a file named "default.css" will overwrite the builtin "default.css". html_static_path = ['_static'] # Custom sidebar templates, must be a dictionary that maps document names # to template names. # # This is required for the alabaster theme # refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars html_sidebars = { '**': [ 'about.html', 'navigation.html', 'relations.html', # needs 'show_related': True theme option to display 'searchbox.html', 'donate.html', ] } # -- Options for HTMLHelp output ------------------------------------------ # Output file base name for HTML help builder. htmlhelp_basename = 'Fyppdoc' # -- Options for LaTeX output --------------------------------------------- latex_elements = { # The paper size ('letterpaper' or 'a4paper'). # # 'papersize': 'letterpaper', # The font size ('10pt', '11pt' or '12pt'). # # 'pointsize': '10pt', # Additional stuff for the LaTeX preamble. # # 'preamble': '', # Latex figure (float) alignment # # 'figure_align': 'htbp', } # Grouping the document tree into LaTeX files. List of tuples # (source start file, target name, title, # author, documentclass [howto, manual, or own class]). latex_documents = [ (master_doc, 'Fypp.tex', 'Fypp Documentation', 'Bálint Aradi', 'manual'), ] # -- Options for manual page output --------------------------------------- # One entry per manual page. List of tuples # (source start file, name, description, authors, manual section). man_pages = [ (master_doc, 'fypp', 'Fypp Documentation', [author], 1) ] # -- Options for Texinfo output ------------------------------------------- # Grouping the document tree into Texinfo files. List of tuples # (source start file, target name, title, author, # dir menu entry, description, category) texinfo_documents = [ (master_doc, 'Fypp', 'Fypp Documentation', author, 'Fypp', 'One line description of project.', 'Miscellaneous'), ] fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/docs/fypp.rst000066400000000000000000001762331514707373700223440ustar00rootroot00000000000000.. highlight:: none ************ Introduction ************ Fypp is a Python powered preprocessor. It can be used for any programming languages but its primary aim is to offer a Fortran preprocessor, which helps to extend Fortran with condititional compiling and template metaprogramming capabilities. Instead of introducing its own expression syntax, it uses Python expressions in its preprocessor directives, offering the consistency and versatility of Python when formulating metaprogramming tasks. It puts strong emphasis on robustness and on neat integration into developing toolchains. Fypp was inspired by the `pyratemp `_ templating engine [1]_. Although it shares many concepts with pyratemp, it was written from scratch focusing on the special needs when preprocessing source code. Fypp natively supports the output of line numbering markers, which are used by many compilers to generate compiler messages with correct line numbers. Unlike most cpp/fpp-like preprocessors or the coco preprocessor, Fypp also supports iterations, multiline macros, continuation lines in preprocessor directives and automatic line folding. It generally tries to extend the modern Fortran language with metaprogramming capabilities without tempting you to use it for tasks which could/should be done in Fortran itself. The project is `hosted on github `_ with documentation available on `readthedocs.org `_. Fypp is released under the *BSD 2-clause license*. This document describes Fypp Version 3.2. Features ======== Below you find a summary over Fypps main features. Each of them is described more in detail in the individual sections further down. * Definition, evaluation and removal of variables:: #:if DEBUG > 0 print *, "Some debug information" #:endif #:set LOGLEVEL = 2 print *, "LOGLEVEL: ${LOGLEVEL}$" #:del LOGLEVEL * Macro definitions and macro calls:: #:def ASSERT(cond) #:if DEBUG > 0 if (.not. ${cond}$) then print *, "Assert failed in file ${_FILE_}$, line ${_LINE_}$" error stop end if #:endif #:enddef ASSERT ! Invoked via direct call (argument needs no quotation) @:ASSERT(size(myArray) > 0) ! Invoked as Python expression (argument needs quotation) $:ASSERT('size(myArray) > 0') * Conditional output:: program test #:if defined('WITH_MPI') use mpi #:elif defined('WITH_OPENMP') use openmp #:else use serial #:endif * Iterated output (e.g. for generating Fortran templates):: interface myfunc #:for dtype in ['real', 'dreal', 'complex', 'dcomplex'] module procedure myfunc_${dtype}$ #:endfor end interface myfunc * Inline directives:: logical, parameter :: hasMpi = #{if defined('MPI')}# .true. #{else}# .false. #{endif}# * Insertion of arbitrary Python expressions:: character(*), parameter :: comp_date = "${time.strftime('%Y-%m-%d')}$" * Inclusion of files during preprocessing:: #:include "macrodefs.fypp" * Using Fortran-style continutation lines in preprocessor directives:: #:if var1 > var2 & & or var2 > var4 print *, "Doing something here" #:endif * Passing (unquoted) multiline string arguments to callables:: #! Callable needs only string argument #:def DEBUG_CODE(code) #:if DEBUG > 0 $:code #:endif #:enddef DEBUG_CODE #! Pass code block as first positional argument #:block DEBUG_CODE if (size(array) > 100) then print *, "DEBUG: spuriously large array" end if #:endblock DEBUG_CODE #! Callable needs also non-string argument types #:def REPEAT_CODE(code, repeat) #:for ind in range(repeat) $:code #:endfor #:enddef REPEAT_CODE #! Pass code block as positional argument and 3 as keyword argument "repeat" #:block REPEAT_CODE(repeat=3) this will be repeated 3 times #:endblock REPEAT_CODE * Preprocessor comments:: #! This will not show up in the output #! Also the newline characters at the end of the lines will be suppressed * Suppressing the preprocessor output in selected regions:: #! Definitions are read, but no output (e.g. newlines) will be produced #:mute #:include "macrodefs.fypp" #:endmute * Explicit request for stopping the preprocessor:: #:if DEBUGLEVEL < 0 #:stop 'Negative debug level not allowed!' #:endif * Easy check for macro parameter sanity:: #:def mymacro(RANK) #! Macro only works for RANK 1 and above #:assert RANK > 0 : #:enddef mymacro * Line numbering markers in output:: program test #:if defined('MPI') use mpi #:endif : transformed to :: # 1 "test.fypp" 1 program test # 3 "test.fypp" use mpi # 5 "test.fypp" : when variable ``MPI`` is defined and Fypp was instructed to generate line markers. * Automatic folding of generated lines exceeding line length limit *************** Getting started *************** Installing ========== Fypp needs a working Python 3 interpreter (Python 3.5 or above). When you install Fypp, you obtain the command line tool ``fypp`` and the Python module ``fypp.py``. Latter you can import if you want to access the functionality of Fypp directly from within your Python scripts. Installing via conda -------------------- The last stable release of Fypp can be easily installed as conda package by issuing :: conda install -c conda-forge fypp Installing via pip ------------------ You can also use Pythons command line installer ``pip`` in order to download the stable release from the `Fypp page on PyPI `_ and install it on your system. If you want to install Fypp into the module system of the active Python 3 interpreter (typically the case when you are using a Python virtual environment), issue :: pip3 install fypp Alternatively, you can install Fypp into the user space (under `~/.local`) with :: pip3 install --user fypp Manual install -------------- For a manual install, you can download the source code of the latest **stable** release from the `Fypp project website `_. If you wish to obtain the latest **development** version, clone the projects repository:: git clone https://github.com/aradi/fypp.git and check out the `master` branch. The command line tool is a single stand-alone script. You can run it directly from the source folder :: FYPP_SOURCE_FOLDER/bin/fypp or after copying it from the `bin` folder to any location listed in your `PATH` environment variable, by just issuing :: fypp The python module ``fypp.py`` can be found in ``FYP_SOURCE_FOLDER/src``. Testing ======= Simple manual testing can be done by issuing the command :: ./test/runtests.sh from the root of the Fypp source tree. This executes the unit tests shipped with Fypp with the default Python interpreter in your path. If you wish to use a specific interpreter, you can pass it as argument to the script:: ./test/runtests.sh python3 You can also pass multiple interpreters as separate arguments. In that case the testing will be carried out for each of them. Testing for developers ---------------------- If you wish to contribute to Fypp, you should have `tox` installed on your system, so that you can test the packaged project in isolated environments before issuing a pull request. In order to execute the unit tests with `tox`, run :: tox from the root folder of the source tree. This tries to test Fypp with various different python interpreters. If you want to limit testing to selected interpeters only, select the environment with the appropriate command line switch, e.g. :: tox -e py34 Running ======= The Fypp command line tool reads a file, preprocesses it and writes it to another file, so you would typically invoke it like:: fypp source.fpp source.f90 which would process `source.fpp` and write the result to `source.f90`. If input and output files are not specified, information is read from stdin and written to stdout. The behavior of Fypp can be influenced with various command line options. A summary of all command line options can be obtained by:: fypp -h ********************* Preprocessor language ********************* General syntax ============== Fypp has three types of preprocessor directives, all of them having a line and an inline form: * Control directives * Line form, starting with ``#:`` (hashmark colon):: #:if 1 > 2 Some code #:endif * Inline form, enclosed between ``#{`` and ``}#``:: #{if 1 > 2}#Some code#{endif}# * Eval directives * Line form, starting with ``$:`` (dollar colon):: $:time.strftime('%Y-%m-%d') * Inline form, enclosed between ``${`` and ``}$``:: print *, "Compilation date: ${time.strftime('%Y-%m-%d')}$" * Direct call directive * Line form, starting with ``@:`` (at colon):: @:mymacro(a < b) * Inline form, enclosed between ``@{`` and ``}@``:: print *, @{mymacro(a < b)}@ The line form must always start at the beginning of a line (preceded by optional whitespace characters only) and it ends at the end of the line. The inline form can appear anywhere, but if the construct consists of several directives (e.g. ``#{if ...}#`` and ``#{endif}#``), all of them must appear on the same line. While both forms can be used at the same time, they must be consistent for a particular construct, e.g. a directive opened as line directive can not be closed by an inline directive and vica versa. Whitespaces in preprocessor commands are ignored if they appear after the opening colon or curly brace or before the closing curly brace. So the following examples are pairwise equivalent:: #:if 1 > 2 #: if 1 > 2 #{if 1 > 2}# #{ if 1 > 2 }# $:time.strftime('%Y-%m-%d') $: time.strftime('%Y-%m-%d') ${time.strftime('%Y-%m-%d')}$ ${ time.strftime('%Y-%m-%d') }$ Starting whitespaces before line directives are ignored, enabling you to choose any indentation strategy you like for the directives:: program test : do ii = 1, nn print *, ii #:if DEBUG > 0 print *, "Some debug info about iteration ${ii}$" #:endif print *, "Normal code" end do : end program test Preprocessor directives can be arbitrarily nested:: #:if DEBUG > 0 #:if DO_LOGGING ... #:endif #:endif Every open directive must be closed before the end of the file is reached. In all control directives, the whitespace separating the name of the directive from the following parameter is obligatory. Therefore, the following example is syntactically incorrect:: #! Incorrect due to missing whitespace after 'if' #:if(1 > 2) Expression evaluation ===================== Python expressions can occur either as part of control directives, like :: #:if DEBUG > 0 #:for dtype in ['real(dp)', 'integer', 'logical'] or directly inserted into the code using eval directives. :: $:time.strftime('%Y-%m-%d') print *, "${time.strftime('%Y-%m-%d')}$" Expressions are always evaluated by using Pythons ``eval()`` builtin and must be, therefore, syntactically and semantically correct Python expressions. Although, this may require some additional quotations as compared to other preprocessor languages :: #:if defined('DEBUG') #! The Python function defined() expects a string argument #:for dtype in ['real(dp)', 'integer', 'logical'] #! dtype runs over strings it enables consistent expressions with (hopefully) least surprises (once you know, how to formulate the expression in Python, you exactly know, how to write it for Fypp). Also, note, that variable names, macros etc. are for Python (and therefore also for Fypp) case sensitive. When you access a variable in an expression, it must have been already defined before, either via command line options or via preprocessor directives. For example the directive :: #:if DEBUG > 0 can only be evaluated, if the variable `DEBUG` had been already defined before. Python sandbox ============== Python expressions are evaluated in an isolated Python environment, which contains a restricted set of Python built-in functions and a few predefined variables and functions (see below). There are no modules loaded by default, and for safety reasons, no modules can be loaded once the preprocessing has started, but can be loaded at startup if needed. Predefined variables -------------------- The isolated Python environment for the expression evaluation contains following predefined global variables: * ``_THIS_LINE_``: number of current line * ``_THIS_FILE_``: name of current file * ``_LINE_``: number of current line in the processed input file * ``_FILE_``: name of processed input file :: print *, "This is line nr. ${_LINE_}$ in file '${_FILE_}$'" * ``_DATE_``: current date in ISO format * ``_TIME_``: current time:: print *, "Rendering started ${_DATE_}$ ${_TIME_}$" * ``_SYSTEM_``: Name of the system Fypp runs on, as returned by Pythons ``platform.system()`` function (e.g. ``Linux``, ``Windows``, ``Darwin``, etc.) * ``_MACHINE_``: Name of the current machine Fypp runs on, as returned by Pythons ``platform.machine()`` function (e.g. ``x86_64``) The predefined variables ``_FILE_`` and ``_LINE_`` differ from their counterparts ``_THIS_FILE_`` and ``_THIS_LINE_`` only within macros. When a macro is executed, the variables ``_THIS_FILE_`` and ``_THIS_LINE_`` specify the position, where the expression containing these variables is located, while the variables ``_FILE_`` and ``_LINE_`` refer to the position in the processed file, from where the macro was called (and where the result of the evaluation will be inserted later). For example, the input :: #:def macro() IN MACRO: _THIS_LINE_=${_THIS_LINE_}$, _LINE_=${_LINE_}$ #:enddef macro GLOBAL: _THIS_LINE_=${_THIS_LINE_}$, _LINE_=${_LINE_}$ | ${macro()}$ yields after being processed by Fypp:: GLOBAL: _THIS_LINE_=5, _LINE_=5 | IN MACRO: _THIS_LINE_=2, _LINE_=5 If from within a macro an other macro is called, the variables ``_FILE_`` and ``_LINE_`` will keep their original values, while ``_THIS_FILE_`` and ``_THIS_LINE_`` will be continuously updated within the nested macro as well. Predefined functions -------------------- Following predefined functions are available: * ``defined(VARNAME)``: Returns ``True`` if a variable with a given name has been already defined. The variable name must be provided as string:: #:if defined('WITH_MPI') * ``getvar(VARNAME, DEFAULTVALUE)``: Returns the value of a variable or a default value if the variable is not defined. The variable name must be provided as string:: #:if getvar('DEBUG', 0) * ``setvar(VARNAME, VALUE)``: Sets a variable to given value. It is identical to the `set directive`_. The variable name expression has the same format as in the ``#:set`` directive, but must be quoted:: $:setvar('i', 12) print *, "VAR I: ${i}$" Multiple assignments may be specified as subsequent argument pairs:: $:setvar('i', 1, 'j', 2) print *, "VAR I: ${i}$, VAR J: ${j}$" * ``delvar(VARNAME)``: Removes a variable or a macro definition from the local scope. It is identical to the `del directive`_. The variable name expression must be provided as in the ``#:del`` directive, but must be quoted:: $:delvar('i') Additional variable name expressions may be specified as subsequent arguments:: $:delvar('i', 'j') * ``globalvar(VARNAME)``: Adds a given variable as global variable to the current scope. It is identical to the `global directive`_. The variable name expression must be provided as in the ``#:global`` directive, but must be quoted:: $:globalvar('i') Multiple variable name expressions may be specified as subsequent arguments. Initializing variables ---------------------- Initial values for preprocessor variables can be set via the command line option (``-D``) at startup:: fypp -DDEBUG=0 -DWITH_MPI The assigned value for a given variable is evaluated in Python. If no value is provided, `None` is assigned. Importing modules at startup ---------------------------- .. warning:: Modules imported at startup have access to the full **unrestricted** Python environment and can execute any Python code. Import only trustworthy modules! If a Python module is required for the preprocessing, it can be imported before the preprocessing starts via the command line option (``-m``):: fypp -m time The example above would allow to process the line:: character(*), parameter :: comp_date = "${time.strftime('%Y-%m-%d')}$" If more than one module is needed, each of them can imported with an individual ``-m`` option:: fypp -m time -m math When importing modules with the ``-m`` option, the module search path consists of the current directory, the directories in the `PYTHONPATH` environment variable and the standard Python module paths. Further lookup paths can be specified using the option ``-M``:: fypp -M mymoddir1 -M mymoddir2 -m mymodule -m mymodule2 The module directories are looked up in the order they are specified *before* searching at the default locations. Modules are imported also in the order of their specification at the command line. Each module imported at startup has its own name space. Entities in the imported modules can be accessed during the preprocessing in the usual pythonic way. After importing the module ``mymodule`` as in the example above, entities in the module could be accessed as:: ${mymodule.SOME_CONSTANT}$ $:mymodule.SOME_CONSTANT $:mymodule.some_function() @:mymodule.some_function() #:call mymodule.some_function #:endcall mymodule.some_function #:block mymodule.some_function #:endblock mymodule.some_function Eval directive ============== A result of a Python expression can be inserted into the code by using eval directives ``$:`` (line form) or ``${`` and ``}$`` (inline form). The expression is evaluated using Python's built-in function `eval()`. If it evaluates to `None`, no output is produced. Otherwise the result is converted to a string and written to the output. The eval directive has both, a line and an inline variant:: $:somePythonFunction() print *, "DEBUG LEVEL: ${DEBUG}$" .. warning:: Lines containing eval directive(s) will be folded using Fortran continuation lines when getting longer than a specified maximum. They must, therefore, not contain anything which could lead to invalid source code, when being folded at an arbitrary position (e.g. Fortran comments). `set` directive ================== The value of a variable can be set during the preprocessing via the `set` directive. (Otherwise, variables can be also declared and defined via command line options.) The first argument is the name of the variable (unquoted), followed by an optional Python expression. If the Python expression is present, it must be separated by an equal sign from the variable name. If the Python expression and the equal sign are not present, the variable is set to `None`:: #:set DEBUG #:set LOG = 1 #:set LOGLEVEL = LOGLEVEL + 1 Note, that in the last example the variable `LOGLEVEL` must have been already defined in advance. The `set` directive also accepts assignments to variable tuples, provided the right hand side of the assignment is compatible with the variable tuple:: #:set VAR1, VAR2 = 1, 2 #:set (VAR1, VAR2) = 1, 2 The parantheses around the variable list (second example) are optional. The `set` directive can be also used in the inline form:: #{set X = 2}#print *, ${X}$ Similar to the line form, the separating equal sign is optional here as well. `del` directive =============== A variable (or macro) definition can be removed from the current scope by the `del` directive:: #:set X = 12 #! X available, with value 12 : #:del X #! X not available any more The variable name expression syntax is identical to the one used for the `set` directive, so that also variable tuples can be deleted:: #! Removes the variables X and Y from local scope #:del X, Y The variable passed to the ``del`` directive must exist and be erasable. So the example above would trigger an error, if the variables ``X`` and ``Y`` were not defined before. The `del` directive can also be used to delete macro definitions:: #:def echo(TXT) ${TXT}$ #:enddef @:echo(HELLO) #:del echo #! Following line throws an error as macro echo is not available any more @:echo(HELLO) The `del` directive can be also used in the inline form:: #{del X}# `if` directive ============== Conditional output can be generated using the `if` directive. The condition must be a Python expression, which can be converted to a `bool`. If the condition evaluates to `True`, the enclosed code is written to the output, otherwise it is ignored. :: print *, "Before" #:if DEBUG > 0 print *, "Debug code" #:endif print *, "After" would result in :: print *, "Before" print *, "Debug code" print *, "After" if the Python expression ``DEBUG > 0`` evaluates to `True`, otherwise in :: print *, "Before" print *, "After" For more complex scenarios ``elif`` and ``else`` branches can be used as well:: #:if DEBUG >= 2 print *, "Very detailed debug info" #:elif DEBUG >= 1 print *, "Less detailed debug info" #:else print *, "No debug info" #:endif The `if` directive is also available as inline directive:: print *, "COMPILATION MODE: #{if DEBUG > 0}#DEBUG#{else}#PRODUCTION#{endif}#" `for` directive =============== Fortran templates can be easily created by using the `for` directive. The following example creates a function for calculating the sine square for both single and double precision reals:: #:set real_kinds = ['sp', 'dp'] interface sin2 #:for rkind in real_kinds module procedure sin2_${rkind}$ #:endfor end interface sin2 #:for rkind in real_kinds function sin2_${rkind}$(xx) result(res) real(${rkind}$), intent(in) :: xx real(${rkind}$) :: res res = sin(xx) * sin(xx) end function sin2_${rkind}$ #:endfor The `for` directive expects a loop variable expression and an iterable separated by the ``in`` keyword. The code within the `for` directive is outputed for every iteration with the current value of the loop variable, which can be inserted using eval directives. The loop variable expression must be either a name or a list of names joined by comma (``,``). In the latter case, the iterable must consist of iterable items (e.g. tuples), which will be then unpacked into the loop variables. (The number of the loop variables and the number of the components of each iterated item must be identical.):: #:set kinds = ['sp', 'dp'] #:set names = ['real', 'dreal'] #! create kinds_names as [('sp', 'real'), ('dp', 'dreal')] #:set kinds_names = list(zip(kinds, names)) #! Access by indexing interface sin2 #:for kind_name in kinds_names module procedure sin2_${kind_name[1]}$ #:endfor end interface sin2 #! Unpacking in the loop header #:for kind, name in kinds_names function sin2_${name}$(xx) result(res) real(${kind}$), intent(in) :: xx real(${kind}$) :: res res = sin(xx) * sin(xx) end function sin2_${name}$ #:endfor The `for` directive can be used also in its inline form:: print *, "Numbers: #{for i in range(5)}#${i}$#{endfor}#" `def` directive =============== Parametrized macros can be defined with the `def` directive. This defines a regular callable in Python, which returns the rendered content of the macro body when called. The macro arguments are converted to local variables containing the actual arguments as values. The macro can be called from within an eval-directive, via the `call` and `block` control directives and via their abreviated form, the direct call. Given the macro definition :: #:def ASSERT(cond) #:if DEBUG > 0 if (.not. (${cond}$)) then print *, "Assert failed!" error stop end if #:endif #:enddef the following three calls :: #! call macro by evaluating a Python expression $:ASSERT('x > y') #! call macro by using the call directive (see below) #:call ASSERT x > y #:endcall ASSERT #! call macro by using the block directive (see below) #:block ASSERT x > y #:endblock ASSERT #! call macro by using the direct call directive (see below) @:ASSERT(x > y) would all yield :: if (.not. (x > y)) then print *, "Assert failed!" error stop end if if the variable `DEBUG` had a value greater than zero or an empty string otherwise. It is possible to declare default values for the positional arguments of a macro. If for a given positional argument such a value is provided, then default values must be provided for all following arguments as well. When the macro is called, missing positional arguments will be replaced by their default value:: #:def macro(X, Y=2, Z=3) X=${X}$, Y=${Y}$, Z=${Z}$ #:enddef macro $:macro(1) #! Returns "X=1, Y=2, Z=3" Similar to Python, it is also possible to define macros with a variable number of positional or keyword arguments (variadic macros) using the ``*`` and ``**`` argument prefixes. The corresponding arguments will contain the unprocessed positional and keywords arguments as a list and a dictionary, respectively:: #:def macro(X, *VARPOS, **VARKW) pos: ${X}$ varpos: #{for ARG in VARPOS}#${ARG}$, #{endfor}# varkw: #{for KEYWORD in VARKW}#${KEYWORD}$->${VARKW[KEYWORD]}$, #{endfor}# #:enddef macro Calling the example macro above with :: $:macro(1, 2, 3, kw1=4, kw2=5) yields:: pos: 1 varpos: 2, 3, varkw: kw1->4, kw2->5, Macros can be invoked recursively. Together with the variadic arguments, this enables the realization of variadic templates (similar to C++) [2]_:: #:def horner(x, a, b, *args) #:set res = "({} * {} + ({}))".format(a, x, b) #:if len(args) > 0 #:set res = horner(x, res, args[0], *args[1:]) #:endif $:res #:enddef Calling the ``horner`` macro with :: poly = @{horner(x, 2, -3, 4, -5, 6)}@ would result in the Horner scheme with the specified coefficients:: poly = ((((2 * x + (-3)) * x + (4)) * x + (-5)) * x + (6)) Scopes ------ Scopes in general follow the Python convention: Within the macro, all variables from the encompassing scope are available (as `DEBUG` in the example above), and additionally those which were passed as arguments. If a variable is defined within the macro, it will be only accessible within the macro. If a variable with the same name already exists in the encompassing scope, it will be shadowed by it for the time of the macro substitution. For example preprocessing the code snippet :: #:def macro(x) print *, "Local XY: ${x}$ ${y}$" #:set y = -2 print *, "Local XY: ${x}$ ${y}$" #:enddef #:set x = 1 #:set y = 2 print *, "Global XY: ${x}$ ${y}$" $:macro(-1) print *, "Global XY: ${x}$ ${y}$" would result in :: print *, "Global XY: 1 2" print *, "Local XY: -1 2" print *, "Local XY: -1 -2" print *, "Global XY: 1 2" For better readability, you can repeat the name of the macro (but not its argument list) at the corresponding enddef directive:: #:def ASSERT(cond) #:if DEBUG > 0 if (.not. (${cond}$)) then print *, "Assert failed!" error stop end if #:endif #:enddef ASSERT The `def` directive has no inline form. .. warning:: The content of macros is usually inserted via an eval directive and is accordingly subject to eventual line folding. Macros should, therefore, not contain any inline Fortran comments. (Comments starting at the beginning of the line preceded by optional whitespaces only are OK, though). Use preprocessor comments (``#!``) instead. `block` and `call` directives ============================= When a Python callable (regular Python function, macro etc.) needs a string argument of larger size (e.g. source code), it can be called using the `call` or the `block` directives to avoid extra quoting of the text argument and to enable passing of multiline arguments in a comfortable way:: #:def DEBUG_CODE(code) #:if DEBUG > 0 $:code #:endif #:enddef DEBUG_CODE #:block DEBUG_CODE if (a < b) then print *, "DEBUG: a is less than b" end if #:endblock DEBUG_CODE #:call DEBUG_CODE if (a < b) then print *, "DEBUG: a is less than b" end if #:endcall DEBUG_CODE The `block` and the `call` directives are equivalent. The two alternative forms exists in order to allow for more readable meta-code depending on the context. The `block` and `call` directives take the name of the callable as argument. The lines between the opening and closing directives will be rendered and then passed as positional *string* arguments to the callable. The name of the callable can be repeated in the `endblock` and `endcall` directives for enhanced readability:: #! This form is probably somewhat more natural to read #:block DEBUG_CODE if (a < b) then print *, "DEBUG: a (${a}$) is less than b (${b}$)" end if #:endblock DEBUG_CODE #:call DEBUG_CODE if (a < b) then print *, "DEBUG: a (${a}$) is less than b (${b}$)" end if #:endcall DEBUG_CODE If the callable needs more than one string arguments, the `contains` directive (for `block`) or the `nextarg` directive (for `call`) can be used to separate the arguments from each other:: #:def CHOOSE_CODE(debug_code, nondebug_code) #:if DEBUG > 0 $:debug_code #:else $:nondebug_code #:endif #:enddef CHOOSE_CODE #:block CHOOSE_CODE if (a < b) then print *, "DEBUG: a is less than b" end if #:contains print *, "No debugging" #:endcall CHOOSE_CODE #! This form is probably somewhat more natural to read #:call CHOOSE_CODE if (a < b) then print *, "DEBUG: a is less than b" end if #:nextarg print *, "No debugging" #:endcall CHOOSE_CODE The lines in the body of the `block` and `call` directives may contain directives themselves. However, any variable defined within the body of the `block` and `call` directives will be a local variable existing only during the evaluation of that branch of the directive (and not being available when the callable is called with the evaluated string as argument). The `contains` and `nextarg` directives may be followed by an optional argument name. In that case the text following will be passed as keyword argument to the callable. If the first argument should be also passed as keyword argument, it should be also preceded by a named `contains` or `nextarg` directive declared in the line immediately following the `block` or `call` directive. If an argument is passed as a keyword argument, all following arguments must be passed as keyword arguments as well:: #:block CHOOSE_CODE #:contains nondebug_code print *, "No debugging" #:contains debug_code if (a < b) then print *, "DEBUG: a is less than b" end if #:endblock CHOOSE_CODE #:call CHOOSE_CODE #:nextarg nondebug_code print *, "No debugging" #:nextarg debug_code if (a < b) then print *, "DEBUG: a is less than b" end if #:endcall CHOOSE_CODE Additional to passing the content of the `block` or `call` directives body as string argument, further arguments of arbitrary type can be passed by specifying them directly in the header of the directive. Among others, this can be very comfortable when the callable needs also non-string type of arguments:: #! Argument 'repeat' should be an integer, not string #:def REPEAT_CODE(code, repeat) #:for ind in range(repeat) $:code #:endfor #:enddef REPEAT_CODE #! Code block as positional argument and 3 as keyword argument "repeat" #:block REPEAT_CODE(repeat=3) this will be repeated 3 times #:block REPEAT_CODE #! Code block as positional argument and 3 as keyword argument "repeat" #:call REPEAT_CODE(repeat=3) this will be repeated 3 times #:endcall REPEAT_CODE The arguments must be specified between parantheses and are evaluated as Python expressions. The arguments specified in the directive (both, in the header and in the body) are passed to the callable in the following order: #. positional arguments in the header #. positional arguments in the body #. keyword arguments in the header #. keyword arguments in the body Callables without arguments can also be called with the `block` and `call` directives, provided the `endblock` and `endcall` directives immediately follows the opening directive. If there are empty lines between the opening and the closing directives, they will be interpreted as a positional argument:: #:def macro_noarg() NOARGS #:enddef macro_noarg #:def macro_arg1(arg1) ARG1:${arg1}$ #:enddef macro_arg1 #! Calling macro without arguments #:block macro_noarg #:endblock macro_noarg #! Calling macro without arguments #:call macro_noarg #:endcall macro_noarg #! Calling macro with one positional (empty) argument #! Note the empty line between block and endblock #:block macro_arg1 #:endblock macro_arg1 #! Calling macro with one positional (empty) argument #! Note the empty line between call and endcall #:call macro_arg1 #:endcall macro_arg1 The `block` and `call` directives can also be used in their inline form. As this easily leads to code being hard to read, it should be usually avoided:: ! Rather ugly print *, #{block CHOOSE_CODE}# a(:) #{contains}# size(a) #{endblock}# ! Rather ugly as well print *, #{call CHOOSE_CODE}# a(:) #{nextarg}# size(a) #{endcall}# ! This form is more readable print *, ${CHOOSE_CODE('a(:)', 'size(a)')}$ ! Alternatively, you may use a direct call (see next section) print *, @{CHOOSE_CODE(a(:), size(a))}@ If the callable only requires short text arguments, the more compact direct call directive should be used as an alternative (see next section). Direct call directive ===================== In order to enable compact (single line) calls while still maintaining code readability, the `block` and `call` directives have an alternative form, the direct call directive:: #:def ASSERT(cond) #:if DEBUG > 0 if (.not. (${cond}$)) then print *, "Assert failed!" error stop end if #:endif #:enddef ASSERT @:ASSERT(size(aa) >= size(bb)) The direct call directive starts with ``@:`` followed by the name of a Python callable and an opening parenthesis (``(``). Everything after that up to the closing parenthesis (``)``) is passed as *string argument* to the callable. The closing parenthesis may only be followed by whitespace characters. When the callable needs more than one argument, the arguments must be separated by a comma (``,``):: #:def ASSERT_EQUAL(received, expected) if (${received}$ /= ${expected}$) then print *, "ASSERT_EQUAL failed (${received}$ /= ${expected}$)!" error stop end if #:enddef ASSERT_EQUAL @:ASSERT_EQUAL(size(coords, dim=2), size(atomtypes)) .. note:: In order to be able to split the argument string of a direct call correctly, Fypp assumes that all provided arguments represent valid Fortran expressions with balanced quotes (``'`` or ``"``) and balanced brackets (``()``, ``[]`` and ``{}``) outside of quoted regions. The argument string is only split around commas which are outside of any quoted or bracketed regions. Arguments can be optionally enclosed within curly braces in order to avoid argument splitting at unwanted places or to improve readability. The outermost curly braces will be removed from the arguments before they are passed to the callable:: #! Passes "a**2 + b**2" and "c**2" as string arguments to ASSERT_EQUAL @:ASSERT_EQUAL({a**2 + b**2}, c**2) Keywords arguments can be passed by prefixing them with the keyword name and an equal sign:: @:ASSERT_EQUAL(expected=size(atomtypes), received=size(coords, dim=2)) @:ASSERT_EQUAL(expected=c**2, received={a**2 + b**2}) If the equal sign is followed immediately by an other equal sign, the argument will be recognized as positional and not as keyword argument. This exception allows for passing valid Fortran code containing the comparison operator (``==``) without the need for special bracketing. In other cases, however, bracketing may be needed to avoid recognition as keyword argument:: #! Passes string "a == b" as first positional argument @:ASSERT(a == b) #! Passes string "=b" as keyword argument "a" @:ASSERT(a={=b}) #! Passes string "b" as keyword argument "a" @:someMacro(a = b) #! Passes "a = b" as positional argument @:someMacro({a = b}) The direct call directive may contain continuation lines:: @:ASSERT_EQUAL(size(coords, dim=2), & & size(atomtypes)) The arguments are parsed for further inline eval directives (but not for any inline control or direct call directives), making variable substitutions in the arguments possible:: #:set MYSIZE = 2 @:ASSERT_EQUAL(size(coords, dim=2), ${MYSIZE}$) Whitespaces around the arguments of the direct call are stripped, but not the whitespaces within the optional curly braces around the argument:: #! Calls a macro without arguments @:macro_without_args() #! Calls a macro with no arguments (whitespace between () is stripped): @:macro_without_args( ) #! Calls a macro with empty string as argument @:macro_with_one_arg({}) #! Calls a macro with one space as argument @:macro_with_one_arg({ }) The direct call directive can also be used in its inline form:: #! Using CHOOSE_CODE() macro defined in previous section print *, @{CHOOSE_CODE(a(:), size(a))}@ `global` directive ================== Global variables are by default read-only in local scopes (e.g. within macros). This can be changed for selected variables by using the `global` directive:: #:def set_debug(value) #:global DEBUG #:set DEBUG = value #:enddef set_debug #:set DEBUG = 1 $:DEBUG $:set_debug(2) $:DEBUG In the example above, without the `global` directive, the `set` directive would have created a local variable within the macro, which had shadowed the global variable and was destroyed at the end of the macro execution. With the `global` directive the `set` refers to the variable in the global scope. The variable in the global scope does not need to exist yet, when the `global` directive is executed. It will be then created at the first `set` directive, or remain non-existing if no assignment is made in the current scope. A variable can only made global, if it was not created in the local scope yet. Therefore, the following code would throw an exception:: #:def set_debug(value) #! DEBUG variable created in local scope #:set DEBUG = value #! Invalid: variable DEBUG already exists in local scope #:global DEBUG #:enddef set_debug # Throws exception $:set_debug(2) `include` directive =================== The `include` directive allows you to collect your preprocessor macros and variable definitions in separate files and include them whenever needed. The include directive expects a quoted string with a file name:: #:include 'mydefs.fypp' If the file name is relative, it is interpreted relative to the folder where the processed file is located (or to the current folder, if Fypp reads from stdin). Further lookup paths can be added with the ``-I`` command line option. The `include` directive does not have an inline form. `mute` directive ================ Empty lines between Fypp definitions makes the code easier to read. However, being outside of Fypp-directives, those empty lines will be written unaltered to the output. This can be especially disturbing if various macro definition files are included, as the resulting output would eventually contain a lot of empty lines. With the `mute` directive, the output can be suspended. While everything is still processed as normal, no output is written for the code within the `mute` directive:: #:mute #:include "mydefs1.fypp" #:include "mydefs2.fypp" #:def test(x) print *, "TEST: ${x}$" #:enddef test #:endmute $:test('me') The example above would only produce :: print *, "TEST: me" as output without any newlines. The `mute` directive does not have an inline form. `stop` directive ================ The `stop` directive can be used to report an error and stop the preprocessor before all input has been consumed. This can be useful in cases, where some external conditions (e.g. user defined variables) do not meet certain criteria. The directive expects a Python expression, which will be converted to string and written to standard error. After writing the error message Fypp exits immediately with a non-zero exit code (see `Exit Codes`_):: #! Stop the code if DEBUGLEVEL is not positive #:if DEBUGLEVEL < 0 #:stop 'Wrong debug level {}!'.format(DEBUGLEVEL) #:endif There is no inline form of the `stop` directive. `assert` directive ================== The `assert` directive is a short form for the combination of an `if` and a `stop` directive. It evaluates a given expression and stops the code if the boolean value of the result is `False`. This can be very convenient, if you want to write robust macros containing sanity checks for their arguments:: #:def mymacro(RANK) #! Macro only works for RANK 1 and above #:assert RANK > 0 : #:enddef mymacro Given the macro definition above, the macro call :: $:mymacro(1) would pass the `assert` directive in the third line, while the call :: $:mymacro(0) would cause Fypp to stop at it. When the expression in an `assert` directive evaluates to `False`, Fypp reports the failed assertion (the condition, the file name and the line number) on standard error and terminates immediately with a non-zero exit code (see `Exit Codes`_). There is no inline form of the `assert` directive. Comment directive ================= Comment lines can be added by using the ``#!`` preprocessor directive. The comment line (including the newlines at their end) will be ignored by the prepropessor and will not appear in the output:: #! This will not show up in the output There is no inline form of the comment directive. **************** Various features **************** Multiline directives ==================== The line form of the control and eval directives can span arbitrary number of lines, if Fortran-style continuation characters are used:: #:if a > b & & or b > c & & or c > d $:somePythonFunction(param1, & ¶m2) The line break at the first line must be in the expression, not in the opening delimiter characters or in the directive name. Similar to Fortran, the continuation character at the beginning of each continuation line may be left away, but then all whitespaces at the beginning of the respective continuation line will be part of the expression. Inline directives must not contain any continuation lines. Line folding ============ The Fortran standard only allows source lines up to 132 characters. In order to emit standard conforming code, Fypp folds all lines in the output which it had manipulated before (all lines containing eval directives). Lines which were just copied to the output are left unaltered. The maximal line length can be chosen by the ``-l`` command line option. The indentation of the continuation lines can be tuned with the ``--indentation`` option, and the folding strategy can be selected by the ``-f`` option with following possibilities: * ``brute``: Continuation lines are indented relative to the beginning of the line, and each line is folded at the maximal line position. * ``simple``: Like ``brute``, but continuation lines are indented with respect of the indentation of the original line. * ``smart``: Like ``simple``, but Fypp tries to fold the line at a whitespace character in order to prevent split tokens. To prevent continuation lines becoming too short, it defaults to ``simple`` if no whitespace occurs in the last third of the line. The ``-F`` option can be used to turn off line folding. .. warning:: Fypp is not aware of the Fortran semantics of the lines it folds. Fypp applies the line folding mechanically (only considering the position of the whitespace characters). Lines containing eval directives and lines within macro definitions should, therefore, not contain any Fortran style comments (started by ``!``) *within* the line, as folding within the comment would result in invalid Fortran code. For comments within such lines, Fypps comment directive (``#!``) can be used instead:: #:def macro() print *, "DO NOT DO THIS!" ! Warning: Line may be folded within the comment print *, "This is OK." #! Preprocessor comment is safe as it will be stripped For comments starting at the beginning of the line (preceded by optional whitespace characters only) the folding is suppressed, though. This enables you to define macros with non-negligible comment lines (e.g. with source code documentation or OpenMP directives):: #:def macro(DTYPE) !> This functions calculates something (version ${DTYPE}$) !! \param xx Ingoing value !! \return Some calculated value. ${DTYPE}$ function calcSomething(xx) : end function calcSomething #:enddef macro Escaping ======== If you want to prevent Fypp to interpret something as a directive, put a backslash (``\``) between the first and second delimiter character. In case of inline directives, do it for both, the opening and the closing delimiter:: $\: 1 + 2 #\{if 1 > 2}\# @\:myMacro arg1 Fypp will not recognize the escaped strings as directives, but will remove the backslash between the delimiter characters in the output. If you put more than one backslash between the delimiters, only one will be removed. Line numbering markers ====================== In order to support compilers in emitting messages with correct line numbers with respect to the original source file, Fypp can put line number directives (a.k.a. line markers) in its output. This can be enabled by using the command line option ``-n``. Given a file ``test.fpp`` with the content :: program test #:if defined('MPI') use mpi #:else use openmpi #:endif : end program test the command :: fypp -n -DMPI test.fpp produces the output :: # 1 "test.fpp" 1 program test # 3 "test.fpp" use mpi # 7 "test.fpp" : end program test If during compilation of this output an error occurred in the line ``use mpi`` (e.g. the mpi module can not be found), the compiler would know that this line corresponds to line number 3 in the original file ``test.fpp`` and could emit an according error message. The line numbering directives can be fine tuned with the ``-N`` option, which accepts following mode arguments: * ``full``: Line numbering directives are emitted whenever lines are removed from the original source file or extra lines are added to it. * ``nocontlines``: Same as full, but line numbering directives are omitted before continuation lines. (Some compilers, like the NAG Fortran compiler, have difficulties with line numbering directives before continuation lines). Note: Due to a bug introduced in GFortran 5 (being also present in major versions 6), a workaround is needed for obtaining correct error messages when compiling preprocessed files with those compilers. Please use the command line option ``--line-marker-format 'gfortran5'`` in those cases. Scopes ====== Fypp uses a scope concept very similar to Pythons one. There is one global scope (like in Python modules), and temporary local scopes may be created in special cases (e.g. during macro calls). The global scope is the one, which Fypp normaly uses for defining objects. All imports specified on the command line are carried out in this scope And all definitions made by the `set` and `def` directives in the processed source file defines entities in that scope, unless they appear within a `block`, a `call` or a `def` directive. Addtional temporary local scopes are opened, whenever * a macro defined by the `def` directive is called, or * the body of the `block` or `call` directive is evaluated in order to render the text, which will be passed to the callable as argument. Any entity defined in a local scope is only visible within that scope and is unaccessible once the scope has been closed. For example the code snippet:: #:set toupper = lambda s: s.upper() #:call toupper #:set NUMBER = 9 here is the number ${NUMBER}$ #:endcall toupper $:defined('NUMBER') results after preprocessing in :: HERE IS THE NUMBER 9 False as the variable ``NUMBER`` defined in the local scope is destroyed, when the scope is closed (the `endcall` directive has been reached). Lookup rules ------------ When Fypp tries to resolve a name, the lookup rules depend on the scope, in which the query appears: * global scope (outside of any `def` or `call` directives): only the global scope is searched. * local scope (within the body of a `call` or `def` directive): first, the active local scope is searched. Then the scope embedding it (the scope which contains the directive) is searched. Then further embedding scopes are searched until finally also the global scope has been checked. The search is immediately terminated, if the name has been found in a scope. Note, that all variables outside of the active scope are read-only. If a variable with the same name is created in the active scope, it will shadow the original definition. Once the scope is closed, the variable regains it original value. For example:: #:set toupper = lambda s: s.upper() #:set X = 1 #:call toupper #:set X = 2 value ${X}$ #:endcall toupper value ${X}$ results in :: VALUE 2 value 1 Also note, that if a name can not be resolved in the active scope during a macro evaluation, the relevant embedding scope for the next lookup is the scope, where the macro has been defined (where the `def` directive occurs), and *not* the scope, from which the macro is being called. The following snippet demonstrates this:: #! GLOBAL SCOPE #:set toupper = lambda s: s.upper() #:call toupper #! LOCAL SCOPE 1 #:def macro1() #! LOCAL SCOPE 2A value of x: ${X}$ #:enddef macro1 #! LOCAL SCOPE 1 #:def macro2() #! LOCAL SCOPE 2B #:set X = 2 $:macro1() #:enddef macro2 #! LOCAL SCOPE 1 #:set X = 1 $:macro2() #:endcall #! GLOBAL SCOPE After processing the code above one obtains ``VALUE OF X: 1``. Although in the local scope 2B, from where the macro ``macro1()`` is called, the value of X is defined to be ``2``, the relevant scopes for the lookup of X during the macro evaluation are the local scope 2A of ``macro1()`` (where the eval-directive for X is located), the local scope 1 (where the `def` directive for ``macro1()`` occurs) and the global scope (which embeds local scope 1). Therefore, at the macro evaluation the value ``1`` will be substituted as this is the value of X in scope 1, and scope 1 is the first scope in the lookup order, which provides a value for X. Rendering file names as relative paths ====================================== When the input file is specified as an absolute path (e.g. during an out-of-source build), the variables ``_FILE_`` and ``_THIS_FILE_`` will also contain absolute paths. This might result in file names, which are unnecessary long and might reveal unwanted information about the directory structure on the building host. The ``--file-var-root`` option converts the paths in ``_FILE_`` and ``_THIS_FILE_`` to relative paths with respect to a specified root folder. Given the file `source.fpp`:: [...] call fatal_error("Error in ${_FILE_}$:${_LINE_}$") invoking with Fypp with :: fypp /home/user/projectdir/src/source.fpp results in :: [...] call fatal_error("Error in /home/user/projectdir/src/source.fpp:2") while using the ``--file-var-root`` option :: fypp --file-var-root=/home/user/projectdir /home/user/projectdir/src/source.fpp yields :: [...] call fatal_error("Error in src/source.fpp:2") Exit codes ========== When run as a standalone application, Fypp returns one of the following exit codes to the calling environment: * 0: Preprocessing finished successfully. * 1: Stopped due to an unexpected error. * 2: Explicitely requested stop encountered (`stop directive`_ or `assert directive`_). ******** Examples ******** Asserts and debug code ====================== In this example a simple "assert"-mechanism (as can be found in many programming languages) should be implemented, where run-time checks can be included or excluded depending on preprocessor variable definitions. Apart of single assert-like queries, we also want to include larger debug code pieces, which can be removed in the production code. First, we create an include file (``checks.fypp``) with the appropriate macros:: #:mute #! Enable debug feature if the preprocessor variable DEBUG has been defined #:set DEBUG = defined('DEBUG') #! Stops the code, if the condition passed to it is not fulfilled #! Only included in debug mode. #:def ASSERT(cond, msg=None) #:if DEBUG if (.not. (${cond}$)) then write(*,*) 'Run-time check failed' write(*,*) 'Condition: ${cond.replace("'", "''")}$' #:if msg is not None write(*,*) 'Message: ', ${msg}$ #:endif write(*,*) 'File: ${_FILE_}$' write(*,*) 'Line: ', ${_LINE_}$ stop end if #:endif #:enddef ASSERT #! Includes code if in debug mode. #:def DEBUG_CODE(code) #:if DEBUG $:code #:endif #:enddef DEBUG_CODE #:endmute Remarks: * All macro definitions are within a ``#:mute`` -- ``#:endmute`` pair in order to prevent the appearance of disturbing empty lines (the lines between the macro definitions) in the file which includes ``checks.fypp``. * The preprocessor variable ``DEBUG`` will determine, whether the checks and the debug code is left in the preprocessed code or not. * The content of both macros, ``ASSERT`` and ``DEBUG_CODE``, are only included if the variable ``DEBUG`` has been defined. * We also want to print out the failed condition for more verbose output. As the condition may contains apostrophes, we use Python's string replacement method to escape them. With the definitions above, we can use the functionality in any Fortran source after including ``checks.fypp``:: #:include 'checks.fypp' module testmod implicit none contains subroutine someFunction(ind, uplo) integer, intent(in) :: ind character, intent(in) :: uplo @:ASSERT(ind > 0, msg="Index must be positive") @:ASSERT(uplo == 'U' .or. uplo == 'L') ! Do something useful here ! : #:block DEBUG_CODE print *, 'We are in debug mode' print *, 'The value of ind is', ind #:endblock DEBUG_CODE end subroutine someFunction end module testmod Now, the file ``testmod.fpp`` can be preprocessed with Fypp. When the variable ``DEBUG`` is not set:: fypp testmod.fpp testmod.f90 the resulting routine will not contain the conditional code:: subroutine someFunction(ind, uplo) integer, intent(in) :: ind character, intent(in) :: uplo ! Do something useful here ! : end subroutine someFunction On the other hand, if the ``DEBUG`` variable is set:: fypp -DDEBUG testmod.fpp testmod.f90 the run-time checks and the debug code will be there:: subroutine someFunction(ind, uplo) integer, intent(in) :: ind character, intent(in) :: uplo if (.not. (ind > 0)) then write(*,*) 'Run-time check failed' write(*,*) 'Condition: ind > 0' write(*,*) 'Message: ', "Index must be positive" write(*,*) 'File: testmod.fpp' write(*,*) 'Line: ', 12 stop end if if (.not. (uplo == 'U' .or. uplo == 'L')) then write(*,*) 'Run-time check failed' write(*,*) 'Condition: uplo == ''U'' .or. uplo == ''L''' write(*,*) 'File: testmod.fpp' write(*,*) 'Line: ', 13 stop end if ! Do something useful here ! : print *, 'We are in debug mode' print *, 'The value of ind is', ind end subroutine someFunction Generic programming =================== The example below shows how to create a generic function ``maxRelError()``, which gives the maximal elementwise relative error for any pair of arrays with ranks from 0 (scalar) to 7 in single or double precision. The Fortran module (file ``errorcalc.fpp``) contains the interface ``maxRelError`` which maps to all the realizations with the different array ranks and precisions:: #:def ranksuffix(RANK) $:'' if RANK == 0 else '(' + ':' + ',:' * (RANK - 1) + ')' #:enddef ranksuffix #:set PRECISIONS = ['sp', 'dp'] #:set RANKS = range(0, 8) module errorcalc implicit none integer, parameter :: sp = kind(1.0) integer, parameter :: dp = kind(1.0d0) interface maxRelError #:for PREC in PRECISIONS #:for RANK in RANKS module procedure maxRelError_${RANK}$_${PREC}$ #:endfor #:endfor end interface maxRelError contains #:for PREC in PRECISIONS #:for RANK in RANKS function maxRelError_${RANK}$_${PREC}$(obtained, reference) result(res) real(${PREC}$), intent(in) :: obtained${ranksuffix(RANK)}$ real(${PREC}$), intent(in) :: reference${ranksuffix(RANK)}$ real(${PREC}$) :: res #:if RANK == 0 res = abs((obtained - reference) / reference) #:else res = maxval(abs((obtained - reference) / reference)) #:endif end function maxRelError_${RANK}$_${PREC}$ #:endfor #:endfor end module errorcalc The macro ``ranksuffix()`` defined at the beginning receives a rank as argument and returns a string, which is either the empty string (rank 0) or the appropriate number of dimension placeholder separated by commas and within parantheses (e.g. ``(:,:)`` for rank 2). The string expression is calculated as a Python expression, so that we can make use of the powerful string manipulation routines in Python and write it as a one-line routine. If we preprocess the Fortran source file ``errorcalc.fpp`` with Fypp:: fypp errorcalc.fpp errorcalc.f90 the resulting file ``errorcalc.f90`` will contain a module with the generic interface ``maxRelError()``:: interface maxRelError module procedure maxRelError_0_sp module procedure maxRelError_1_sp module procedure maxRelError_2_sp module procedure maxRelError_3_sp module procedure maxRelError_4_sp module procedure maxRelError_5_sp module procedure maxRelError_6_sp module procedure maxRelError_7_sp module procedure maxRelError_0_dp module procedure maxRelError_1_dp module procedure maxRelError_2_dp module procedure maxRelError_3_dp module procedure maxRelError_4_dp module procedure maxRelError_5_dp module procedure maxRelError_6_dp module procedure maxRelError_7_dp end interface maxRelError The interface maps to the appropriate functions:: function maxRelError_0_sp(obtained, reference) result(res) real(sp), intent(in) :: obtained real(sp), intent(in) :: reference real(sp) :: res res = abs((obtained - reference) / reference) end function maxRelError_0_sp function maxRelError_1_sp(obtained, reference) result(res) real(sp), intent(in) :: obtained(:) real(sp), intent(in) :: reference(:) real(sp) :: res res = maxval(abs((obtained - reference) / reference)) end function maxRelError_1_sp function maxRelError_2_sp(obtained, reference) result(res) real(sp), intent(in) :: obtained(:,:) real(sp), intent(in) :: reference(:,:) real(sp) :: res res = maxval(abs((obtained - reference) / reference)) end function maxRelError_2_sp : The function ``maxRelError()`` can be, therefore, invoked with a pair of arrays with various ranks or with a pair of scalars, both in single and in double precision, as required. If you prefer not to have preprocessor loops around long code blocks, the example above can be also written by defining a macro first and then calling the macro within the loop. The function definition would then look as follows:: contains #:def maxRelError_template(RANK, PREC) function maxRelError_${RANK}$_${PREC}$(obtained, reference) result(res) real(${PREC}$), intent(in) :: obtained${ranksuffix(RANK)}$ real(${PREC}$), intent(in) :: reference${ranksuffix(RANK)}$ real(${PREC}$) :: res #:if RANK == 0 res = abs((obtained - reference) / reference) #:else res = maxval(abs((obtained - reference) / reference)) #:endif end function maxRelError_${RANK}$_${PREC}$ #:enddef maxRelError_template #:for PREC in PRECISIONS #:for RANK in RANKS $:maxRelError_template(RANK, PREC) #:endfor #:endfor end module errorcalc *********************************** Integration into build environments *********************************** Fypp can be integrated into build environments like any other preprocessor. If your build environment is Python-based, you may consider to access its functionality directly via its API instead of calling it as an external script (see the `API documentation`_). Make ==== In traditional make based system you can define an appropriate preprocessor rule in your ``Makefile``:: .fpp.f90: fypp $(FYPPFLAGS) $< $@ or for GNU make:: %.f90: %.fpp fypp $(FYPPFLAGS) $< $@ Waf === For the `waf` build system the Fypp source tree contains extension modules in the folder ``tools/waf``. They use Fypps Python API, therefore, the ``fypp`` module must be accessible from Python. Using those waf modules, you can formulate a Fypp preprocessed Fortran build like the example below:: def options(opt): opt.load('compiler_fc') opt.load('fortran_fypp') def configure(conf): conf.load('compiler_fc') conf.load('fortran_fypp') def build(bld): sources = bld.path.ant_glob('*.fpp') bld( features='fypp fc fcprogram', source=sources, target='myprog' ) Check the documentation in the corresponding waf modules for further details. CMake ===== One possible way of invoking the Fypp preprocessor within the CMake build framework is demonstrated below (thanks to Jacopo Chevallard for providing the very first version of this example):: ### Pre-process: .fpp -> .f90 via Fypp # Create a list of the files to be preprocessed set(fppFiles file1.fpp file2.fpp file3.fpp) # Pre-process foreach(infileName IN LISTS fppFiles) # Generate output file name string(REGEX REPLACE ".fpp\$" ".f90" outfileName "${infileName}") # Create the full path for the new file set(outfile "${CMAKE_CURRENT_BINARY_DIR}/${outfileName}") # Generate input file name set(infile "${CMAKE_CURRENT_SOURCE_DIR}/${infileName}") # Custom command to do the processing add_custom-command( OUTPUT "${outfile}" COMMAND fypp "${infile}" "${outfile}" MAIN_DEPENDENCY "${infile}" VERBATIM) # Finally add output file to a list set(outFiles ${outFiles} "${outfile}") endforeach(infileName) ***************** API documentation ***************** Additional to its usage as a command line tool, Fypp can also be operated directly from Python. This can be especially practical, when Fypp is used in a Python driven build environment (e.g. waf, Scons). Below you find the detailed documentation of the API Fypp offers. fypp module =========== .. automodule:: fypp Fypp ==== .. autoclass:: Fypp :members: FyppOptions =========== .. autoclass:: FyppOptions :members: get_option_parser() =================== .. autofunction:: get_option_parser() FyppError ========= .. autoclass:: FyppError :members: ***** Notes ***** .. [1] I am indebted to pyratemps author Roland Koebler for some helpful discussions. .. [2] Many thanks to Ivan Pribec for pointing out the similarity to C++ variadic templates and bringing up the Horner scheme as example. fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/docs/index.rst000066400000000000000000000001471514707373700224630ustar00rootroot00000000000000################## Fypp documentation ################## .. toctree:: :maxdepth: 2 fypp fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/docs/requirements.in000066400000000000000000000000371514707373700236730ustar00rootroot00000000000000sphinx==6.2.1 sphinx-rtd-theme fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/docs/requirements.txt000066400000000000000000000021701514707373700241040ustar00rootroot00000000000000# # This file is autogenerated by pip-compile with Python 3.10 # by the following command: # # pip-compile requirements.in # alabaster==0.7.13 # via sphinx babel==2.12.1 # via sphinx certifi==2023.7.22 # via requests charset-normalizer==3.2.0 # via requests docutils==0.18.1 # via # sphinx # sphinx-rtd-theme idna==3.4 # via requests imagesize==1.4.1 # via sphinx jinja2==3.1.2 # via sphinx markupsafe==2.1.3 # via jinja2 packaging==23.1 # via sphinx pygments==2.15.1 # via sphinx requests==2.31.0 # via sphinx snowballstemmer==2.2.0 # via sphinx sphinx==6.2.1 # via # -r requirements.in # sphinx-rtd-theme # sphinxcontrib-jquery sphinx-rtd-theme==1.2.2 # via -r requirements.in sphinxcontrib-applehelp==1.0.4 # via sphinx sphinxcontrib-devhelp==1.0.2 # via sphinx sphinxcontrib-htmlhelp==2.0.1 # via sphinx sphinxcontrib-jquery==4.1 # via sphinx-rtd-theme sphinxcontrib-jsmath==1.0.1 # via sphinx sphinxcontrib-qthelp==1.0.3 # via sphinx sphinxcontrib-serializinghtml==1.1.5 # via sphinx urllib3==2.0.4 # via requests fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/setup.py000066400000000000000000000025211514707373700214020ustar00rootroot00000000000000# -*- coding: utf-8 -*- from setuptools import setup from codecs import open from os import path here = path.abspath(path.dirname(__file__)) with open(path.join(here, 'README.rst'), encoding='utf-8') as f: long_description = f.read() setup( name='fypp', version='3.2', description='Python powered Fortran preprocessor', long_description=long_description, url='https://github.com/aradi/fypp', author='Bálint Aradi', author_email='aradi@uni-bremen.de', license='BSD', classifiers=[ 'Development Status :: 5 - Production/Stable', 'Intended Audience :: Developers', 'Intended Audience :: Science/Research', 'Topic :: Software Development :: Code Generators', 'Topic :: Software Development :: Pre-processors', 'License :: OSI Approved :: BSD License', 'Programming Language :: Python :: 3', 'Programming Language :: Python :: 3.5', 'Programming Language :: Python :: 3.6', 'Programming Language :: Python :: 3.7', 'Programming Language :: Python :: 3.8', 'Programming Language :: Python :: 3.9', ], keywords='fortran metaprogramming pre-processor', package_dir={'': 'src'}, py_modules=['fypp'], entry_points={ 'console_scripts': [ 'fypp=fypp:run_fypp', ], }, ) fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/src/000077500000000000000000000000001514707373700204575ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/src/fypp.py000077700000000000000000000000001514707373700236662../bin/fyppustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/000077500000000000000000000000001514707373700206475ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/000077500000000000000000000000001514707373700222725ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/assert.inc000066400000000000000000000002331514707373700242640ustar00rootroot00000000000000#:mute #:def ASSERT_CODE(code) $:code #:enddef ASSERT_CODE #:def ASSERT() ${_THIS_FILE_}$:${_THIS_LINE_}$|${_FILE_}$:${_LINE_}$ #:enddef ASSERT #:endmute fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/failingmacro.inc000066400000000000000000000001061514707373700254150ustar00rootroot00000000000000#:def failingmacro() before $:UNDEFINED_VARIABLE after #:enddef fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/fypp1.inc000066400000000000000000000000671514707373700240270ustar00rootroot00000000000000INCL1 #:def incmacro(x) INCMACRO(${x}$) #:enddef INCL5 fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/inimod2.py000066400000000000000000000000401514707373700241770ustar00rootroot00000000000000def get_version(): return 2 fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/subfolder/000077500000000000000000000000001514707373700242575ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/subfolder/fypp2.inc000066400000000000000000000000061514707373700260060ustar00rootroot00000000000000FYPP2 fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/subfolder/include_fypp1.inc000066400000000000000000000000261514707373700275120ustar00rootroot00000000000000#:include 'fypp1.inc' fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/include/subfolder/include_fypp2.inc000066400000000000000000000000261514707373700275130ustar00rootroot00000000000000#:include 'fypp2.inc' fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/inimod.py000066400000000000000000000000401514707373700224720ustar00rootroot00000000000000def get_version(): return 1 fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/inimod2.py000066400000000000000000000000401514707373700225540ustar00rootroot00000000000000def get_version(): return 1 fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/input/000077500000000000000000000000001514707373700220065ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/input/filevarroot.fypp000066400000000000000000000001611514707373700252400ustar00rootroot00000000000000FILE: ${_FILE_}$:${_LINE_}$ THIS_FILE: ${_THIS_FILE_}$:${_THIS_LINE_}$ --- #:include "filevarroot.inc" $:macro() fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/input/filevarroot.inc000066400000000000000000000001361514707373700250350ustar00rootroot00000000000000#:def macro() FILE: ${_FILE_}$:${_LINE_}$ THIS_FILE: ${_THIS_FILE_}$:${_THIS_LINE_}$ #:enddef fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/runtests.sh000077500000000000000000000014071514707373700230770ustar00rootroot00000000000000#!/bin/bash testdir="$(dirname $0)" if [ $# -gt 0 ]; then pythons=$* else pythons="python3" fi root=".." if [ -z "$PYTHONPATH" ]; then export PYTHONPATH="$root/src" else export PYTHONPATH="$root/src:$PYTHONPATH" fi cd $testdir failed="0" failing_pythons="" for python in $pythons; do echo "Testing with interpreter '$python'" $python test_fypp.py exitcode=$? if [ $exitcode != 0 ]; then failed="$(($failed + 1))" if [ -z "$failing_pythons" ]; then failing_pythons=$python else failing_pythons="$failing_pythons, $python" fi fi done echo if [ $failed -gt 0 ]; then echo "Failing test runs: $failed" >&2 echo "Failing interpreter(s): $failing_pythons" >&2 exit 1 else echo "All test runs finished successfully" exit 0 fi fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/test/test_fypp.py000066400000000000000000002345231514707373700232470ustar00rootroot00000000000000'''Unit tests for testing Fypp.''' from pathlib import Path import platform import unittest import fypp def _linenum(linenr, fname=None, flag=None): if fname is None: fname = fypp.STRING return fypp.linenumdir_cpp(linenr, fname, flag) def _defvar(var, val): return '-D{0}={1}'.format(var, val) def _incdir(path): return '-I{0}'.format(path) def _linelen(linelen): return '-l{0}'.format(linelen) def _indentation(ind): return '--indentation={0}'.format(ind) def _folding(fold): return '-f{0}'.format(fold) def _moddir(path): return '-M{0}'.format(path) def _linenumbering(nummode): return '-N{0}'.format(nummode) def _linenum_gfortran5(): return '--line-marker-format=gfortran5' def _linenum_std(): return '--line-marker-format=std' def _importmodule(module): return '-m{0}'.format(module) _LINENUM_FLAG = '-n' _FIXED_FORMAT_FLAG = '--fixed-format' _NO_FOLDING_FLAG = '-F' _NEW_FILE = 1 _RETURN_TO_FILE = 2 # Various basic tests # # Each test consists of a tuple containing the test name and a tuple with the # arguments of the get_test_output_method() routine. # SIMPLE_TESTS = [ ('if_true', ([_defvar('TESTVAR', 1)], '#:if TESTVAR > 0\nTrue\n#:endif\n', 'True\n' ) ), ('if_false', ([_defvar('TESTVAR', 0)], '#:if TESTVAR > 0\nTrue\n#:endif\n', '' ) ), ('if_else_true', ([_defvar('TESTVAR', 1)], '#:if TESTVAR > 0\nTrue\n#:else\nFalse\n#:endif\n', 'True\n' ) ), ('if_else_false', ([_defvar('TESTVAR', 0)], '#:if TESTVAR > 0\nTrue\n#:else\nFalse\n#:endif\n', 'False\n' ) ), ('if_elif_true1', ([_defvar('TESTVAR', 1)], '#:if TESTVAR == 1\nTrue1\n#:elif TESTVAR == 2\nTrue2\n#:endif\n', 'True1\n' ) ), ('if_elif_true2', ([_defvar('TESTVAR', 2)], '#:if TESTVAR == 1\nTrue1\n#:elif TESTVAR == 2\nTrue2\n#:endif\n', 'True2\n' ) ), ('if_elif_false', ([_defvar('TESTVAR', 0)], '#:if TESTVAR == 1\nTrue1\n#:elif TESTVAR == 2\nTrue2\n#:endif\n', '' ) ), ('if_elif_else_true1', ([_defvar('TESTVAR', 1)], '#:if TESTVAR == 1\nTrue1\n#:elif TESTVAR == 2\nTrue2\n' '#:else\nFalse\n#:endif\n', 'True1\n' ) ), ('if_elif_else_true2', ([_defvar('TESTVAR', 2)], '#:if TESTVAR == 1\nTrue1\n#:elif TESTVAR == 2\nTrue2\n' '#:else\nFalse\n#:endif\n', 'True2\n' ) ), ('if_elif_else_false', ([_defvar('TESTVAR', 0)], '#:if TESTVAR == 1\nTrue1\n#:elif TESTVAR == 2\nTrue2\n' '#:else\nFalse\n#:endif\n', 'False\n' ) ), ('inline_if_true', ([_defvar('TESTVAR', 1)], '#{if TESTVAR > 0}#True#{endif}#Done', 'TrueDone' ) ), ('inline_if_false', ([_defvar('TESTVAR', 0)], '#{if TESTVAR > 0}#True#{endif}#Done', 'Done' ) ), ('inline_if_else_true', ([_defvar('TESTVAR', 1)], '#{if TESTVAR > 0}#True#{else}#False#{endif}#Done', 'TrueDone' ) ), ('inline_if_else_false', ([_defvar('TESTVAR', 0)], '#{if TESTVAR > 0}#True#{else}#False#{endif}#Done', 'FalseDone' ) ), ('inline_if_elif_true1', ([_defvar('TESTVAR', 1)], '#{if TESTVAR == 1}#True1#{elif TESTVAR == 2}#True2#{endif}#Done', 'True1Done' ) ), ('inline_if_elif_true2', ([_defvar('TESTVAR', 2)], '#{if TESTVAR == 1}#True1#{elif TESTVAR == 2}#True2#{endif}#Done', 'True2Done' ) ), ('inline_if_elif_false', ([_defvar('TESTVAR', 0)], '#{if TESTVAR == 1}#True1#{elif TESTVAR == 2}#True2#{endif}#Done', 'Done' ) ), ('inline_if_elif_else_true1', ([_defvar('TESTVAR', 1)], '#{if TESTVAR == 1}#True1#{elif TESTVAR == 2}#True2#{else}#False#{endif}#' 'Done', 'True1Done' ) ), ('inline_if_elif_else_true2', ([_defvar('TESTVAR', 2)], '#{if TESTVAR == 1}#True1#{elif TESTVAR == 2}#True2#{else}#False#{endif}#' 'Done', 'True2Done' ) ), ('inline_if_elif_else_false', ([_defvar('TESTVAR', 0)], '#{if TESTVAR == 1}#True1#{elif TESTVAR == 2}#True2#{else}#False#{endif}#' 'Done', 'FalseDone' ) ), ('linesub_eol', ([_defvar('TESTVAR', 1)], 'A\n$: TESTVAR + 1\nB\n', 'A\n2\nB\n' ) ), ('linesub_contlines', ([_defvar('TESTVAR', 1)], '$: TESTVAR & \n & + 1\n', '2\n' ) ), ('linesub_contlines2', ([_defvar('TESTVAR', 1)], '$: TEST& \n &VAR & \n & + 1\n', '2\n' ) ), ('linesub_contlines_contchar1', ([], '$: \'hello&\n world\'\n', 'hello world\n' ) ), ('linesub_contlines2_contchar1', ([], '$: \'hello&\n world&\n !\'\n', 'hello world !\n' ) ), ('exprsub', ([_defvar('TESTVAR', 1)], 'A${TESTVAR}$B${TESTVAR + 1}$C', 'A1B2C' ) ), ('exprsub_ignored_contlines', ([_defvar('TESTVAR', 1)], 'A${TEST&\n &VAR}$B${TESTVAR + 1}$C', 'A${TEST&\n &VAR}$B2C' ) ), ('macrosubs', ([], '#:def macro(var)\nMACRO|${var}$|\n#:enddef\n${macro(1)}$', 'MACRO|1|' ) ), ('macrosubs_named_enddef', ([], '#:def macro(var)\nMACRO|${var}$|\n#:enddef macro\n${macro(1)}$', 'MACRO|1|' ) ), ('macrodef_whitespace', ([], '#:def macro (var)\nMACRO|${var}$|\n#:enddef macro\n${macro(1)}$', 'MACRO|1|' ) ), ('macro_noargs', ([], '#:def macro()\nMACRO\n#:enddef\n${macro()}$', 'MACRO' ) ), ('recursive_macrosubs', ([], '#:def macro(var)\nMACRO|${var}$|\n#:enddef\n${macro(macro(1))}$', 'MACRO|MACRO|1||' ) ), ('macrosubs_extvarsubs', ([_defvar('TESTVAR', 1)], '#:def macro(var)\nMACRO|${var}$-${TESTVAR}$|\n#:enddef\n${macro(2)}$', 'MACRO|2-1|' ) ), ('macro_trailing_newlines', ([], '#:def macro()\nL1\n\n#:enddef\n$: macro()\n', 'L1\n\n', ) ), ('macro_trailing_newlines_inline', ([], '#:def macro()\nL1\n\n#:enddef\n|${macro()}$|', '|L1\n|', ) ), ('macro_call_named_arguments', ([], '#:def mymacro(A, B)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '$:mymacro(B=1, A=2)\n', 'A=2,B=1\n' ) ), ('macro_call_positional_and_named_arguments', ([], '#:def mymacro(A, B, C)\nA=${A}$,B=${B}$,C=${C}$\n#:enddef mymacro\n'\ '$:mymacro(1, C=3, B=2)\n', 'A=1,B=2,C=3\n' ) ), ('optarg_macro_call_all_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '#:call mymacro\n1\n#:nextarg\n2\n#:endcall\n', 'A=1,B=2\n' ) ), ('optarg_macro_block_all_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '#:block mymacro\n1\n#:contains\n2\n#:endblock\n', 'A=1,B=2\n' ) ), ('optarg_macro_call_missing_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '#:call mymacro\n1\n#:endcall\n', 'A=1,B=2\n' ) ), ('optarg_macro_block_missing_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '#:block mymacro\n1\n#:endblock\n', 'A=1,B=2\n' ) ), ('optarg_macro_eval_call_all_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '$:mymacro(1, 2)\n', 'A=1,B=2\n' ) ), ('optarg_macro_eval_call_missing_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '$:mymacro(1)\n', 'A=1,B=2\n' ) ), ('optarg_macro_direct_call_all_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '@:mymacro(1, 2)\n', 'A=1,B=2\n' ) ), ('optarg_macro_direct_call_all_args_inline', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '@{mymacro(1, 2)}@', 'A=1,B=2' ) ), ('optarg_macro_direct_call_missing_args', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '@:mymacro(1)\n', 'A=1,B=2\n' ) ), ('optarg_macro_direct_call_missing_args_inline', ([], '#:def mymacro(A, B=2)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '|@{mymacro(1)}@|', '|A=1,B=2|' ) ), ('optarg_macro_tuple_as_default', ([], '#:def macro(X, Y=2, Z=(1,2==3))\nX=${X}$,Y=${Y}$,Z=${Z[0]}$,${Z[1]}$\n'\ '#:enddef\n@:macro(1)\n', 'X=1,Y=2,Z=1,False\n' ) ), ('macro_vararg_no_varargs', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '$:macro(1, 2)\n', '|12[]|\n' ) ), ('macro_vararg_one_vararg', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '$:macro(1, 2, 3)\n', '|12[3]|\n' ) ), ('macro_vararg_two_varargs', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '$:macro(1, 2, 3, 4)\n', '|12[3, 4]|\n' ) ), ('macro_vararg_named_arguments_eval', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '$:macro(y=2, x=1)\n', '|12[]|\n' ) ), ('macro_vararg_named_arguments_directcall', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '@:macro(y=2, x=1)\n', '|12[]|\n' ) ), ('macro_vararg_named_arguments_call', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '#:call macro\n#:nextarg y\n2\n#:nextarg x\n1\n#:endcall\n', '|12[]|\n' ) ), ('macro_vararg_named_arguments_block', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '#:block macro\n#:contains y\n2\n#:contains x\n1\n#:endblock\n', '|12[]|\n' ) ), ('macro_vararg_named_arguments_inline_call', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '#{call macro}##{nextarg y}#2#{nextarg x}#1#{endcall}#', '|12[]|' ) ), ('macro_vararg_named_arguments_inline_block', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '#{block macro}##{contains y}#2#{contains x}#1#{endblock}#', '|12[]|' ) ), ('macro_vararg_mixed_arguments_eval', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '$:macro(1, z=3, y=2)\n', '|123[]|\n' ) ), ('macro_vararg_mixed_arguments_directcall', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '@:macro(1, z=3, y=2)\n', '|123[]|\n' ) ), ('macro_vararg_mixed_arguments_call', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#:call macro\n1\n#:nextarg z\n3\n#:nextarg y\n2\n#:endcall\n', '|123[]|\n' ) ), ('macro_vararg_mixed_arguments_block', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#:block macro\n1\n#:contains z\n3\n#:contains y\n2\n#:endblock\n', '|123[]|\n' ) ), ('macro_vararg_mixed_arguments_call2', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#:call macro\n#:nextarg\n1\n#:nextarg z\n3\n#:nextarg y\n2\n#:endcall\n', '|123[]|\n' ) ), ('macro_vararg_mixed_arguments_block2', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#:block macro\n'\ '#:contains\n1\n'\ '#:contains z\n3\n'\ '#:contains y\n'\ '2\n'\ '#:endblock\n', '|123[]|\n' ) ), ('macro_vararg_mixed_arguments_inline_call', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#{call macro}#1#{nextarg z}#3#{nextarg y}#2#{endcall}#', '|123[]|' ) ), ('macro_vararg_mixed_arguments_inline_block', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#{block macro}#1#{contains z}#3#{contains y}#2#{endblock}#', '|123[]|' ) ), ('macro_vararg_mixed_arguments_inline_call2', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#{call macro}##{nextarg}#1#{nextarg z}#3#{nextarg y}#2#{endcall}#', '|123[]|' ) ), ('macro_vararg_mixed_arguments_inline_block2', ([], '#:def macro(x, y, z, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '#{block macro}##{contains}#1#{contains z}#3#{contains y}#2#{endblock}#', '|123[]|' ) ), ('macro_varpos_varkw_with_keyword_arguments', ([], '#:def macro(x, y, *vararg, **varkw)\n'\ '|${x}$${y}$${varkw["z"]}$${vararg}$|\n'\ '#:enddef\n'\ '$:macro(1, 2, z=3)\n', '|123[]|\n' ) ), ('macro_varpos_varkw_with_pos_arguments', ([], '#:def macro(x, y, *vararg, **varkw)\n'\ '|${x}$${y}$${vararg}$|\n'\ '#:enddef\n'\ '$:macro(1, 2, 4, 5)\n', '|12[4, 5]|\n' ) ), ('macro_varpos_varkw_with_pos_and_kw_arguments', ([], '#:def macro(x, y, *vararg, **varkw)\n'\ '|${x}$${y}$${varkw["z"]}$${vararg}$|\n'\ '#:enddef\n'\ '$:macro(1, 2, 4, 5, z=3)\n', '|123[4, 5]|\n' ) ), ('for', ([], '#:for i in (1, 2, 3)\n${i}$\n#:endfor\n', '1\n2\n3\n' ) ), ('for_macro', ([], '#:def mymacro(val)\nVAL:${val}$\n#:enddef\n' '#:for i in (1, 2, 3)\n$: mymacro(i)\n#:endfor\n', 'VAL:1\nVAL:2\nVAL:3\n' ) ), ('inline_for', ([], '#{for i in (1, 2, 3)}#${i}$#{endfor}#Done\n', '123Done\n' ) ), ('inline_for_macro', ([], '#:def mymacro(val)\nVAL:${val}$\n#:enddef\n' '#{for i in (1, 2, 3)}#${mymacro(i)}$#{endfor}#Done\n', 'VAL:1VAL:2VAL:3Done\n' ) ), ('call_directive', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:call mymacro\nL1\nL2\nL3\n#:endcall\n', '|L1\nL2\nL3|\n', ) ), ('block_directive', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:block mymacro\nL1\nL2\nL3\n#:endblock\n', '|L1\nL2\nL3|\n', ) ), ('call_directive_named_endcall', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:call mymacro\nL1\nL2\nL3\n#:endcall mymacro\n', '|L1\nL2\nL3|\n', ) ), ('block_directive_named_endblock', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:block mymacro\nL1\nL2\nL3\n#:endblock mymacro\n', '|L1\nL2\nL3|\n', ) ), ('inine_call_directive_named_endcall', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#{call mymacro}#L1 L2 L3#{endcall mymacro}#', '|L1 L2 L3|', ) ), ('inine_block_directive_named_endblock', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#{block mymacro}#L1 L2 L3#{endblock mymacro}#', '|L1 L2 L3|', ) ), ('call_directive_quotation', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:call mymacro\n"""L1"""\nL2\nL3\n#:endcall\n', '|"""L1"""\nL2\nL3|\n', ) ), ('block_directive_quotation', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:block mymacro\n"""L1"""\nL2\nL3\n#:endblock\n', '|"""L1"""\nL2\nL3|\n', ) ), ('call_directive_backslash_escape1', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:call mymacro\nL1\\n\nL2\nL3\n#:endcall\n', '|L1\\n\nL2\nL3|\n', ) ), ('block_directive_backslash_escape1', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:block mymacro\nL1\\n\nL2\nL3\n#:endblock\n', '|L1\\n\nL2\nL3|\n', ) ), ('call_directive_backslash_escape2', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:call mymacro\nL1\\"a\\"\\n\nL2\nL3\n#:endcall\n', '|L1\\"a\\"\\n\nL2\nL3|\n', ) ), ('block_directive_backslash_escape2', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '#:block mymacro\nL1\\"a\\"\\n\nL2\nL3\n#:endblock\n', '|L1\\"a\\"\\n\nL2\nL3|\n', ) ), ('call_directive_2_args', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '#:call mymacro\n"""L1"""\nL2\n#:nextarg\nL3\n#:endcall\n', '|"""L1"""\nL2|L3|\n', ) ), ('block_directive_2_args', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '#:block mymacro\n"""L1"""\nL2\n#:contains\nL3\n#:endblock\n', '|"""L1"""\nL2|L3|\n', ) ), ('call_directive_2_args_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '#{call mymacro}#A1#{nextarg}#A2#{endcall}#', '|A1|A2|', ) ), ('block_directive_2_args_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '#{block mymacro}#A1#{contains}#A2#{endblock}#', '|A1|A2|', ) ), ('call_lambda_func', ([], '#:set convert = lambda s: s.lower()\n'\ '#:call convert\nHELLO\n#:endcall\n', 'hello\n', ) ), ('call_no_header_arg_no_body_arg', ([], '#:def macro0()\nNOARG\n#:enddef\n'\ '#:call macro0()\n#:endcall\n', 'NOARG\n', ) ), ('block_no_header_arg_no_body_arg', ([], '#:def macro0()\nNOARG\n#:enddef\n'\ '#:block macro0()\n#:endblock\n', 'NOARG\n', ) ), ('call_header_pos_arg_no_body_arg', ([], '#:def macro(arg)\n|${arg}$|\n#:enddef\n'\ '#:call macro("h1")\n#:endcall\n', '|h1|\n', ) ), ('block_header_pos_arg_no_body_arg', ([], '#:def macro(arg)\n|${arg}$|\n#:enddef\n'\ '#:block macro("h1")\n#:endblock\n', '|h1|\n', ) ), ('call_header_kwarg_no_body_arg', ([], '#:def macro(arg)\n|${arg}$|\n#:enddef\n'\ '#:call macro(arg="h1")\n#:endcall\n', '|h1|\n', ) ), ('block_header_kwarg_no_body_arg', ([], '#:def macro(arg)\n|${arg}$|\n#:enddef\n'\ '#:block macro(arg="h1")\n#:endblock\n', '|h1|\n', ) ), ('call_header_mixed_args_no_body_arg', ([], '#:def macro(arg, arg2)\n|${arg}$|${arg2}$|\n#:enddef\n'\ '#:call macro("h1", arg2="h2")\n#:endcall\n', '|h1|h2|\n', ) ), ('block_header_mixed_args_no_body_arg', ([], '#:def macro(arg, arg2)\n|${arg}$|${arg2}$|\n#:enddef\n'\ '#:block macro("h1", arg2="h2")\n#:endblock\n', '|h1|h2|\n', ) ), ('call_header_mixed_args_body_pos_arg', ([], '#:def macro(arg, arg2, arg3)\n|${arg}$|${arg2}$|${arg3}$|\n#:enddef\n'\ '#:call macro("h1", arg3="h3")\nB1\n#:endcall\n', '|h1|B1|h3|\n', ) ), ('block_header_mixed_args_body_pos_arg', ([], '#:def macro(arg, arg2, arg3)\n|${arg}$|${arg2}$|${arg3}$|\n#:enddef\n'\ '#:block macro("h1", arg3="h3")\nB1\n#:endblock\n', '|h1|B1|h3|\n', ) ), ('call_header_kwargs_body_pos_arg', ([], '#:def macro(arg, arg2, arg3)\n|${arg}$|${arg2}$|${arg3}$|\n#:enddef\n'\ '#:call macro(arg3="h3", arg2="h2")\nB1\n#:endcall\n', '|B1|h2|h3|\n', ) ), ('block_header_kwargs_body_pos_arg', ([], '#:def macro(arg, arg2, arg3)\n|${arg}$|${arg2}$|${arg3}$|\n#:enddef\n'\ '#:block macro(arg3="h3", arg2="h2")\nB1\n#:endblock\n', '|B1|h2|h3|\n', ) ), ('call_header_kwargs_body_kwarg', ([], '#:def macro(arg1, arg2, arg3)\n|${arg1}$|${arg2}$|${arg3}$|\n#:enddef\n'\ '#:call macro(arg1="h1", arg3="h3")\n#:nextarg arg2\nB1\n#:endcall\n', '|h1|B1|h3|\n', ) ), ('block_header_kwargs_body_kwarg', ([], '#:def macro(arg1, arg2, arg3)\n|${arg1}$|${arg2}$|${arg3}$|\n#:enddef\n'\ '#:block macro(arg1="h1", arg3="h3")\n#:contains arg2\nB1\n#:endblock\n', '|h1|B1|h3|\n', ) ), ('direct_call', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro(a < b)\n', '|a < b|\n', ) ), ('direct_call_whitespace', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro (a < b)\n', '|a < b|\n', ) ), ('direct_call_inline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@{mymacro(a < b)}@', '|a < b|', ) ), ('direct_call2', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro(a < b )\n', '|a < b|\n', ) ), ('direct_call2_inline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@{mymacro(a < b )}@', '|a < b|', ) ), ('direct_call3', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro( a < b)\n', '|a < b|\n', ) ), ('direct_call3_inline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@{mymacro( a < b)}@', '|a < b|', ) ), ('direct_call4', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro(a < b)\n', '|a < b|\n', ) ), ('direct_call4_inline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@{mymacro(a < b)}@', '|a < b|', ) ), ('direct_call_contline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro(a &\n &< b&\n &)\n', '|a < b|\n', ) ), ('direct_call_quotation', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro( """L1""" )\n', '|"""L1"""|\n', ) ), ('direct_call_quotation_inline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@{mymacro( """L1""" )}@', '|"""L1"""|', ) ), ('direct_call_backslash_escape1', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro(L1\\n)\n', '|L1\\n|\n', ) ), ('direct_call_backslash_escape1_inline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@{mymacro(L1\\n)}@', '|L1\\n|', ) ), ('direct_call_backslash_escape2', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro(L1\\"a\\"\\n)\n', '|L1\\"a\\"\\n|\n', ) ), ('direct_call_backslash_escape2_inline', ([], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@{mymacro(L1\\"a\\"\\n)}@', '|L1\\"a\\"\\n|', ) ), ('direct_call_2_args', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro("""L1""", L2)\n', '|"""L1"""|L2|\n', ) ), ('direct_call_2_args_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro("""L1""", L2)}@', '|"""L1"""|L2|', ) ), ('direct_call_2_args_escape1', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro("""L1"""","L2, L3)\n', '|"""L1"""","L2|L3|\n', ) ), ('direct_call_2_args_escape1_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro("""L1"""","L2, L3)}@', '|"""L1"""","L2|L3|', ) ), ('direct_call_2_args_escape2', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro((L1, L2), L3)\n', '|(L1, L2)|L3|\n', ) ), ('direct_call_2_args_escape2_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro((L1, L2), L3)}@', '|(L1, L2)|L3|', ) ), ('direct_call_2_args_escape3', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro({L1, L2}, L3)\n', '|L1, L2|L3|\n', ) ), ('direct_call_2_args_escape3_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro({L1, L2}, L3)}@', '|L1, L2|L3|', ) ), ('direct_call_2_args_escape4', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro([L1, L2], L3)\n', '|[L1, L2]|L3|\n', ) ), ('direct_call_2_args_escape4_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro([L1, L2], L3)}@', '|[L1, L2]|L3|', ) ), ('direct_call_2_args_escape5', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro("L1, L2", L3)\n', '|"L1, L2"|L3|\n', ) ), ('direct_call_2_args_escape5_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro("L1, L2", L3)}@', '|"L1, L2"|L3|', ) ), ('direct_call_2_args_escape6', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro(\'L1, L2\', L3)\n', '|\'L1, L2\'|L3|\n', ) ), ('direct_call_2_args_escape6_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro(\'L1, L2\', L3)}@', '|\'L1, L2\'|L3|', ) ), ('direct_call_2_args_escape7', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro(L1 ${2, 2}$, L3)\n', '|L1 (2, 2)|L3|\n', ) ), ('direct_call_2_args_escape7_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro(L1 ${2, 2}$, L3)}@', '|L1 (2, 2)|L3|', ) ), ('direct_call_2_args_escape8', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro({{L1, L2}}, L3)\n', '|{L1, L2}|L3|\n', ) ), ('direct_call_2_args_escape8_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro({{L1, L2}}, L3)}@', '|{L1, L2}|L3|', ) ), ('direct_call_kwarg', ([], '#:def mymacro(a)\n|${a}$|\n#:enddef\n'\ '@:mymacro(a = b)\n', '|b|\n', ) ), ('direct_call_kwarg_eq_operator', ([], '#:def mymacro(a)\n|${a}$|\n#:enddef\n'\ '@:mymacro(a == b)\n', '|a == b|\n', ) ), ('direct_call_kwarg_ptr_assignment', ([], '#:def mymacro(a)\n|${a}$|\n#:enddef\n'\ '@:mymacro(a => b)\n', '|> b|\n', ) ), ('direct_call_kwarg_escape', ([], '#:def mymacro(val1)\n|${val1}$|\n#:enddef\n'\ '@:mymacro({a = b})\n', '|a = b|\n', ) ), ('direct_call_varsubs', ([], '#:def mymacro(val1)\n|${val1}$|\n#:enddef\n'\ '@:mymacro(2x2=${2*2}$)\n', '|2x2=4|\n', ) ), ('direct_call_varsubs_inline', ([], '#:def mymacro(val1)\n|${val1}$|\n#:enddef\n'\ '@{mymacro(2x2=${2*2}$)}@', '|2x2=4|', ) ), ('direct_call_varsubs_2_args', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro(${2*1}$, ${2*2}$)\n', '|2|4|\n', ) ), ('direct_call_varsubs_2_args_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro(${2*1}$, ${2*2}$)}@', '|2|4|', ) ), ('direct_call_varsubs_2_args_escape', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro((${2*1}$, ${2*2}$), ${2*3}$)\n', '|(2, 4)|6|\n', ) ), ('direct_call_varsubs_2_args_escape_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro((${2*1}$, ${2*2}$), ${2*3}$)}@', '|(2, 4)|6|', ) ), ('direct_call_no_param', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '@:mymacro()\n', '||\n' ) ), ('direct_call_no_param_inline', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '@{mymacro()}@', '||' ) ), ('direct_call_no_param2', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '@:mymacro( )\n', '||\n' ) ), ('direct_call_no_param2_inline', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '@{mymacro( )}@', '||' ) ), ('call_no_param_inline', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '#{call mymacro}##{endcall}#\n', '||\n' ) ), ('block_no_param_inline', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '#{block mymacro}##{endblock}#\n', '||\n' ) ), ('call_no_param', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '#:call mymacro\n#:endcall\n', '||\n' ) ), ('block_no_param', ([], '#:def mymacro()\n||\n#:enddef mymacro\n'\ '#:block mymacro\n#:endblock\n', '||\n' ) ), ('call_empty_param_inline', ([], '#:def mymacro(txt)\n|${txt}$|\n#:enddef mymacro\n'\ '#{call mymacro}# #{endcall}#\n', '| |\n' ) ), ('block_empty_param_inline', ([], '#:def mymacro(txt)\n|${txt}$|\n#:enddef mymacro\n'\ '#{block mymacro}# #{endblock}#\n', '| |\n' ) ), ('call_empty_param', ([], '#:def mymacro(txt)\n|${txt}$|\n#:enddef mymacro\n'\ '#:call mymacro\n\n#:endcall\n', '||\n' ) ), ('block_empty_param', ([], '#:def mymacro(txt)\n|${txt}$|\n#:enddef mymacro\n'\ '#:block mymacro\n\n#:endblock\n', '||\n' ) ), ('call_empty_param_directcall', ([], '#:def mymacro(txt)\n|${txt}$|\n#:enddef mymacro\n'\ '@:mymacro({})\n', '||\n' ) ), ('call_whitespace_param_directcall', ([], '#:def mymacro(txt)\n|${txt}$|\n#:enddef mymacro\n'\ '@:mymacro({ })\n', '| |\n' ) ), ('comment_single', ([], ' #! Comment here\nDone\n', 'Done\n', ) ), ('comment_multiple', ([], ' #! Comment1\n#! Comment2\nDone\n', 'Done\n', ) ), ('set', ([], '#:set x = 2\n$: x\n', '2\n', ) ), ('set_no_rhs', ([], '#:set x\n$:x\n', '\n', ) ), ('set_equal_sign_nospace', ([], '#:set x=2\n$: x\n', '2\n', ) ), ('set_equal_sign_withspace', ([], '#:set x = 2\n$: x\n', '2\n', ) ), ('inline_set_equal_withspace', ([], '#{set x = 2}#${x}$Done\n', '2Done\n', ) ), ('inline_set_equal_nospace', ([], '#{set x=2}#${x}$Done\n', '2Done\n', ) ), ('set_function', ([], '$:setvar("x", 2)\n${x}$\nDone\n', "\n2\nDone\n", ) ), ('set_function_tuple', ([], '$:setvar("x, y", (2, 3))\n${x}$${y}$\nDone\n', "\n23\nDone\n", ) ), ('set_function_tuple2', ([], '$:setvar("(x, y)", (2, 3))\n${x}$${y}$\nDone\n', "\n23\nDone\n", ) ), ('set_function_multiple_args', ([], '$:setvar("x", 2, "y", 3)\n${x}$${y}$\nDone\n', "\n23\nDone\n", ) ), ('getvar_existing_value', ([_defvar('VAR', '\"VAL\"')], '$:getvar("VAR", "DEFAULT")\n', 'VAL\n', ) ), ('getvar_default_value', ([], '$:getvar("VAR", "DEFAULT")\n', 'DEFAULT\n', ) ), ('getvar_local_scope', ([], '#:set X = 1\n'\ '#:def test()\n$:getvar("X")\n#:set X = 2\n$:getvar("X")\n#:enddef\n'\ '$:test()\n', '1\n2\n', ) ), ('del_existing_variable', ([], '#:set X = 12\n$:defined("X")\n#:del X\n$:defined("X")\n', 'True\nFalse\n', ) ), ('del_variable_tuple', ([], '#:set X = 1\n#:set Y = 2\n${defined("X")}$${defined("Y")}$\n'\ '#:del X, Y\n${defined("X")}$${defined("Y")}$\n', 'TrueTrue\nFalseFalse\n', ) ), ('del_variable_local_scope', ([], '#:set echo = lambda s: s\n#:set X = 1\n'\ '#:call echo\n$:X\n#:set X = 2\n$:X\n$:defined("X")\n'\ '#:del X\n$:defined("X")\n#:endcall\n$:X\n', '1\n2\nTrue\nFalse\n1\n', ) ), ('del_macro', ([], '#:def mymacro(txt)\n|${txt}$|\n#:enddef mymacro\n$:defined("mymacro")\n'\ '$:mymacro("A")\n#:del mymacro\n$:defined("mymacro")\n', 'True\n|A|\nFalse\n', ) ), ('del_inline', ([], '#:set X = 12\n$:defined("X")\n#{del X}#${defined("X")}$\n', 'True\nFalse\n', ) ), ('del_inline_tuple', ([], '#:set X = 1\n#:set Y = 2\n${defined("X")}$${defined("Y")}$\n'\ '#{del X, Y}#${defined("X")}$${defined("Y")}$\n', 'TrueTrue\nFalseFalse\n', ) ), ('delvar_function', ([], '#:set X = 12\n$:defined("X")\n$:delvar("X")\n$:defined("X")\n', 'True\n\nFalse\n', ) ), ('delvar_function_tuple', ([], '#:set X = 1\n#:set Y = 2\n${defined("X")}$${defined("Y")}$\n'\ '$:delvar("X, Y")\n${defined("X")}$${defined("Y")}$\n', 'TrueTrue\n\nFalseFalse\n', ) ), ('delvar_function_multiple_args', ([], '#:set X = 1\n#:set Y = 2\n${defined("X")}$${defined("Y")}$\n'\ '$:delvar("X", "Y")\n${defined("X")}$${defined("Y")}$\n', 'TrueTrue\n\nFalseFalse\n', ) ), ('mute', ([], 'A\n#:mute\nB\n#:set VAR = 2\n#:endmute\nVAR=${VAR}$\n', 'A\nVAR=2\n' ) ), ('builtin_var_line', ([], '${_LINE_}$', '1' ) ), ('builtin_var_file', ([], '${_FILE_}$', fypp.STRING ) ), ('builtin_var_line_in_lineeval', ([], '$:_LINE_\n', '1\n' ) ), ('builtin_var_system', ([], '${_SYSTEM_}$', platform.system() ) ), ('builtin_var_machine', ([], '${_MACHINE_}$', platform.machine() ) ), ('escaped_control_inline', ([], r'A#\{if False}\#B#\{endif}\#', 'A#{if False}#B#{endif}#' ) ), ('escaped_control_line', ([], '#\\:if False\n', '#:if False\n' ) ), ('escaped_eval_inline', ([], r'A$\{1 + 1}\$', 'A${1 + 1}$' ) ), ('escaped_eval_line', ([], '$\\: 1 + 1\n', '$: 1 + 1\n' ) ), ('multi_escape', ([], r'$\\\{1 + 1}\\$', r'$\\{1 + 1}\$' ) ), ('escape_direct_call', ([], '@\\:assertTrue(x > y)\n', '@:assertTrue(x > y)\n' ) ), ('escape_direct_call_inline', ([], '@\\{assertTrue(x > y)}@', '@{assertTrue(x > y)}@' ) ), ('escape_comment', ([], 'A\n #\! Comment\n', 'A\n #! Comment\n', ) ), ('fold_lines', ([_linelen(10), _indentation(2), _folding('simple')], 'This line is not folded\nThis line ${1 + 1}$ is folded\n', 'This line is not folded\nThis line&\n & 2 is &\n &folded\n' ) ), ('prevent_comment_folding', ([_linelen(10), _indentation(2), _folding('simple')], '#:def macro()\n ! Should be not folded\nShould be folded\n#:enddef\n' '$:macro()\n', ' ! Should be not folded\nShould be&\n & folded\n' ) ), ('no_folding', ([_linelen(15), _indentation(4), _NO_FOLDING_FLAG], ' ${3}$456 89 123456 8', ' 3456 89 123456 8', ) ), ('brute_folding', ([_linelen(15), _indentation(4), _folding('brute')], ' ${3}$456 89 123456 8', ' 3456 89 1234&\n &56 8', ) ), ('simple_folding', ([_linelen(15), _indentation(4), _folding('simple')], ' ${3}$456 89 123456 8', ' 3456 89 1234&\n &56 8', ) ), ('smart_folding', ([_linelen(15), _indentation(4), _folding('smart')], ' ${3}$456 89 123456 8', ' 3456 89&\n & 123456&\n & 8', ) ), ('fixed_format_folding', ([_FIXED_FORMAT_FLAG], ' print *, ${\'aa\'}$, bb, cc, dd, ee, ff, gg, hh, ii, jj, kk, ll, ' 'mm, nn, oo, pp, qq, rr, ss, tt\n', ' print *, aa, bb, cc, dd, ee, ff, gg, hh, ii, jj, kk, ll, mm, nn, ' 'o\n &o, pp, qq, rr, ss, tt\n', ) ), ('tuple_assignment', ([], '#:set mytuple = (1, 2, 3)\n#:set a, b, c = mytuple\n${a}$${b}$${c}$\n', '123\n' ) ), ('tuple_assignment2', ([], '#:set a, b, c = (1, 2, 3)\n${a}$${b}$${c}$\n', '123\n' ) ), ('tuple_assignment3', ([], '#:set a, b, c = 1, 2, 3\n${a}$${b}$${c}$\n', '123\n' ) ), ('tuple_assignment_nospace', ([], '#:set a,b,c = (1, 2, 3)\n${a}$${b}$${c}$\n', '123\n' ) ), ('tuple_assignment_vartuple', ([], '#:set (a, b, c) = (1, 2, 3)\n${a}$${b}$${c}$\n', '123\n' ) ), ('tuple_assignment_vartuple2', ([], '#:set ( a, b, c ) = (1, 2, 3)\n${a}$${b}$${c}$\n', '123\n' ) ), ('inline_tuple_assignment', ([], '#{set a, b, c = 1, 2, 3}#${a}$${b}$${c}$\n', '123\n' ) ), ('inline_tuple_assignment_vartuple', ([], '#{set (a, b, c) = 1, 2, 3}#${a}$${b}$${c}$\n', '123\n' ) ), ('whitespace_but_no_param', ([], '#:if True\nOK\n#:endif \n', 'OK\n' ) ), ('whitespace_but_no_param2', ([], '#:if True\nOK\n#:endif \n \n', 'OK\n \n' ) ), ('whitespace_but_no_param_inline', ([], '#{if True}#OK#{endif }#', 'OK' ) ), ('for_loop_scope', ([], '#{for i in range(4)}##{set X = i}##{endfor}#${X}$${i}$\n', '33\n' ) ), ('macro_scope', ([], '#:set X = 3\n#:def setx()\n#:set X = -5\n#:enddef\n$:setx()\n$:X\n', '\n3\n' ) ), ('local_macro_local_scope', ([], '#:set echo = lambda s: s\n'\ '#:set X = 3\n#:call echo\n'\ '#:def mymacro()\nX:${X}$\n#:enddef\n'\ '#:set X = 2\n$:mymacro()\n#:endcall\n', 'X:2\n', ) ), ('local_macro_global_scope', ([], '#:set echo = lambda s: s\n'\ '#:set X = 3\n#:call echo\n' '#:def mymacro()\nX:${X}$\n#:enddef\n'\ '$:mymacro()\n#:endcall\n', 'X:3\n', ) ), ('scope_global_macro_called_from_local_scope', ([], '#:set echo = lambda s: s\n'\ '#:def printX()\nX:${X}$\n#:enddef\n#:set X = 1\n'\ '#:call echo\n#:set X = 2\n'\ '#:call echo\n#:set X = 3\n$:printX()\n'\ '#:endcall\n#:endcall\nX:${X}$\n', 'X:1\nX:1\n', ) ), ('scope_macro_lookup_locals_in_definition_scope', ([], '#:set X = 0\n'\ '#:def macro1()\n#:set X = 1\n'\ '#:def macro2()\n'\ '#:def macro3a()\nX3a:${X}$\n#:enddef macro3a\n'\ '#:def macro3b()\n#:set X = 3\n$:macro3a()\n#:enddef macro3b\n'\ '#:set X = 2\n$:macro3b()\nX2:${X}$\n'\ '#:enddef macro2\n$:macro2()\nX1:${X}$\n'\ '#:enddef macro1\n$:macro1()\nX0:${X}$\n', 'X3a:2\nX2:2\nX1:1\nX0:0\n', ) ), ('scope_macro_lookup_locals_above_definition_scope', ([], '#:set X = 0\n'\ '#:def macro1()\n#:set X = 1\n'\ '#:def macro2()\n'\ '#:def macro3a()\nX3a:${X}$\n#:enddef macro3a\n'\ '#:def macro3b()\n#:set X = 3\n$:macro3a()\n#:enddef macro3b\n'\ '$:macro3b()\nX2:${X}$\n'\ '#:enddef macro2\n$:macro2()\nX1:${X}$\n'\ '#:enddef macro1\n$:macro1()\nX0:${X}$\n', 'X3a:1\nX2:1\nX1:1\nX0:0\n', ) ), ('scope_macro_lookup_locals_global_scope', ([], '#:set X = 0\n'\ '#:def macro1()\n'\ '#:def macro2()\n'\ '#:def macro3a()\nX3a:${X}$\n#:enddef macro3a\n'\ '#:def macro3b()\n#:set X = 3\n$:macro3a()\n#:enddef macro3b\n'\ '$:macro3b()\nX2:${X}$\n'\ '#:enddef macro2\n$:macro2()\nX1:${X}$\n'\ '#:enddef macro1\n$:macro1()\nX0:${X}$\n', 'X3a:0\nX2:0\nX1:0\nX0:0\n', ) ), ('scope_generator_within_macro', ([], '#:def foo()\n#:set b = 21\n$:sum([b for i in range(2)])\n#:enddef\n'\ '$:foo()\n', '42\n' ) ), ('correct_predefined_var_injection', ([], '#:def ASSERT(cond)\n"${cond}$", ${_FILE_}$, ${_LINE_}$\n#:enddef\n'\ '@:ASSERT(2 < 3)\n', '"2 < 3", ' + fypp.STRING + ', 4\n' ) ), ('correct_line_numbering_in_if', ([], '#:if _LINE_ == 1\nOK\n#:endif\n', 'OK\n' ) ), ('correct_line_numbering_in_for', ([], '#:for line in [_LINE_]\n${line}$ - ${_LINE_}$\n#:endfor\n', '1 - 2\n' ) ), ('line_numbering_macro', ([], '#:def macro()\n${_THIS_LINE_}$,${_LINE_}$\n#:enddef macro\n'\ '${_THIS_LINE_}$,${_LINE_}$|${macro()}$\n', '4,4|2,4\n' ) ), ('line_numbering_argeval', ([], "#:set func = lambda s: str(_THIS_LINE_) + ',' + str(_LINE_) + '|' + s\n"\ "#:call func\n${_THIS_LINE_}$,${_LINE_}$\n#:endcall\n", '2,2|3,3\n' ) ), ('line_numbering_argeval_macrocall', ([_incdir('include')], "#:include 'assert.inc'\n"\ "#:call ASSERT_CODE\n@:ASSERT()\n#:endcall ASSERT_CODE\n", 'include/assert.inc:7|:3\n' ) ), ('line_numbering_eval_within_macro', ([], '#:def m1(A)\n${_LINE_}$\n#:enddef\n'\ '#:def m2(A)\n#:call m1\n${A}$\n#:endcall\n#:enddef\n'\ '$:m2(1)\n', '9\n' ) ), ('global_existing', ([], '#:set A = 1\n#:def macro()\n#:global A\n#:set A = 2\n#:enddef macro\n'\ '$:macro()\n$:A\n', '\n2\n' ) ), ('global_non_existing', ([], '#:def macro()\n#:global A\n#:set A = 2\n#:enddef macro\n'\ '$:defined("A")\n$:macro()\n$:A\n', 'False\n\n2\n' ) ), ('global_non_existing_evaldir', ([], '#:def macro()\n$:globalvar("A")\n#:set A = 2\n#:enddef macro\n'\ '$:defined("A")\n$:macro()\n$:A\n', 'False\n\n2\n' ) ), ('global_non_existing_evaldir_tuple', ([], '#:def macro()\n$:globalvar("A, B")\n#:set A = 2\n#:set B = 3\n'\ '#:enddef macro\n'\ '$:defined("A")\n$:defined("B")\n$:macro()\n$:A\n$:B\n', 'False\nFalse\n\n2\n3\n' ) ), ('global_non_existing_evaldir_arglist', ([], '#:def macro()\n$:globalvar("A", "B")\n#:set A = 2\n#:set B = 3\n'\ '#:enddef macro\n'\ '$:defined("A")\n$:defined("B")\n$:macro()\n$:A\n$:B\n', 'False\nFalse\n\n2\n3\n' ) ), ('global_in_global_scope', ([], '#:set A = 1\n#:global A\n$:A\n', '1\n' ) ), ('global_without_assignment', ([], '#:def macro()\n#:global A\n#:enddef macro\n'\ '$:defined("A")\n$:macro()\n$:defined("A")\n', 'False\n\nFalse\n' ) ), ('define_with_equal_sign', ([_defvar("A", "'a=b'")], '${A}$', 'a=b' ) ), ] # Tests with line enumerations # # Each test consists of a tuple containing the test name and a tuple with the # arguments of the get_test_output_method() routine. # LINENUM_TESTS = [ # Explicit test for line number marker format ('explicit_str_linenum_test', ([_LINENUM_FLAG], '', '# 1 ""\n', ) ), # Explicit test for line number marker format (GFortran5 compatibility) ('explicit_str_linenum_test_gfortran5', ([_LINENUM_FLAG, _linenum_gfortran5()], '', '# 1 "" 1\n', ) ), # Explicit test for standard line number marker format ('explicit_str_linenum_test_standard', ([_LINENUM_FLAG, _linenum_std()], '', '#line 1 ""\n', ) ), ('trivial', ([_LINENUM_FLAG], 'Test\n', _linenum(0) + 'Test\n' ) ), ('if_true', ([_LINENUM_FLAG], '#:if 1 < 2\nTrue\n#:endif\nDone\n', _linenum(0) + _linenum(1) + 'True\n' + _linenum(3) + 'Done\n' ) ), ('if_false', ([_LINENUM_FLAG], '#:if 1 > 2\nTrue\n#:endif\nDone\n', _linenum(0) + _linenum(3) + 'Done\n' ) ), ('if_else_true', ([_LINENUM_FLAG], '#:if 1 < 2\nTrue\n#:else\nFalse\n#:endif\nDone\n', _linenum(0) + _linenum(1) + 'True\n' + _linenum(5) + 'Done\n' ) ), ('if_else_false', ([_LINENUM_FLAG], '#:if 1 > 2\nTrue\n#:else\nFalse\n#:endif\nDone\n', _linenum(0) + _linenum(3) + 'False\n' + _linenum(5) + 'Done\n' ) ), ('if_elif_true1', ([_LINENUM_FLAG], '#:if 1 == 1\nTrue1\n#:elif 1 == 2\nTrue2\n#:endif\nDone\n', _linenum(0) + _linenum(1) + 'True1\n' + _linenum(5) + 'Done\n' ) ), ('if_elif_true2', ([_LINENUM_FLAG], '#:if 2 == 1\nTrue1\n#:elif 2 == 2\nTrue2\n#:endif\nDone\n', _linenum(0) + _linenum(3) + 'True2\n' + _linenum(5) + 'Done\n' ) ), ('if_elif_false', ([_LINENUM_FLAG], '#:if 0 == 1\nTrue1\n#:elif 0 == 2\nTrue2\n#:endif\nDone\n', _linenum(0) + _linenum(5) + 'Done\n' ) ), ('if_elif_else_true1', ([_LINENUM_FLAG], '#:if 1 == 1\nTrue1\n#:elif 1 == 2\nTrue2\n' '#:else\nFalse\n#:endif\nDone\n', _linenum(0) + _linenum(1) + 'True1\n' + _linenum(7) + 'Done\n' ) ), ('if_elif_else_true2', ([_LINENUM_FLAG], '#:if 2 == 1\nTrue1\n#:elif 2 == 2\nTrue2\n' '#:else\nFalse\n#:endif\nDone\n', _linenum(0) + _linenum(3) + 'True2\n' + _linenum(7) + 'Done\n' ) ), ('if_elif_else_false', ([_LINENUM_FLAG], '#:if 0 == 1\nTrue1\n#:elif 0 == 2\nTrue2\n' '#:else\nFalse\n#:endif\nDone\n', _linenum(0) + _linenum(5) + 'False\n' + _linenum(7) + 'Done\n' ) ), ('inline_if_true', ([_LINENUM_FLAG], '#{if 1 < 2}#True#{endif}#Done\n', _linenum(0) + 'TrueDone\n' ) ), ('inline_if_false', ([_LINENUM_FLAG], '#{if 1 > 2}#True#{endif}#Done\n', _linenum(0) + 'Done\n' ) ), ('inline_if_else_true', ([_LINENUM_FLAG], '#{if 1 < 2}#True#{else}#False#{endif}#Done\n', _linenum(0) + 'TrueDone\n' ) ), ('inline_if_else_false', ([_LINENUM_FLAG], '#{if 1 > 2}#True#{else}#False#{endif}#Done\n', _linenum(0) + 'FalseDone\n' ) ), ('inline_if_elif_true1', ([_LINENUM_FLAG], '#{if 1 == 1}#True1#{elif 1 == 2}#True2#{endif}#Done\n', _linenum(0) + 'True1Done\n' ) ), ('inline_if_elif_true2', ([_LINENUM_FLAG], '#{if 2 == 1}#True1#{elif 2 == 2}#True2#{endif}#Done\n', _linenum(0) + 'True2Done\n' ) ), ('inline_if_elif_false', ([_LINENUM_FLAG], '#{if 0 == 1}#True1#{elif 0 == 2}#True2#{endif}#Done\n', _linenum(0) + 'Done\n' ) ), ('inline_if_elif_else_true1', ([_LINENUM_FLAG], '#{if 1 == 1}#True1#{elif 1 == 2}#True2#{else}#False#{endif}#Done\n', _linenum(0) + 'True1Done\n' ) ), ('inline_if_elif_else_true2', ([_LINENUM_FLAG], '#{if 2 == 1}#True1#{elif 2 == 2}#True2#{else}#False#{endif}#Done\n', _linenum(0) + 'True2Done\n' ) ), ('inline_if_elif_else_false', ([_LINENUM_FLAG], '#{if 0 == 1}#True1#{elif 0 == 2}#True2#{else}#False#{endif}#Done\n', _linenum(0) + 'FalseDone\n' ) ), ('linesub_oneline', ([_LINENUM_FLAG], 'A\n$: 1 + 1\nB\n', _linenum(0) + 'A\n2\nB\n' ) ), ('linesub_contlines', ([_LINENUM_FLAG, _defvar('TESTVAR', 1)], '$: TESTVAR & \n & + 1\nDone\n', _linenum(0) + '2\n' + _linenum(2) + 'Done\n' ) ), ('linesub_contlines2', ([_LINENUM_FLAG, _defvar('TESTVAR', 1)], '$: TEST& \n &VAR & \n & + 1\nDone\n', _linenum(0) + '2\n' + _linenum(3) + 'Done\n' ) ), ('exprsub_single_line', ([_LINENUM_FLAG, _defvar('TESTVAR', 1)], 'A${TESTVAR}$B${TESTVAR + 1}$C', _linenum(0) + 'A1B2C' ) ), ('exprsub_multi_line', ([_LINENUM_FLAG], '${"line1\\nline2"}$\nDone\n', _linenum(0) + 'line1\n' + _linenum(0) + 'line2\nDone\n' ) ), ('macrosubs', ([_LINENUM_FLAG], '#:def macro(var)\nMACRO|${var}$|\n#:enddef\n${macro(1)}$', _linenum(0) + _linenum(3) + 'MACRO|1|' ) ), ('recursive_macrosubs', ([_LINENUM_FLAG], '#:def macro(var)\nMACRO|${var}$|\n#:enddef\n${macro(macro(1))}$', _linenum(0) + _linenum(3) + 'MACRO|MACRO|1||' ) ), ('macrosubs_multiline', ([_LINENUM_FLAG], '#:def macro(c)\nMACRO1|${c}$|\nMACRO2|${c}$|\n#:enddef\n${macro(\'A\')}$' '\n', _linenum(0) + _linenum(4) + 'MACRO1|A|\n' + _linenum(4) + 'MACRO2|A|\n' ) ), ('recursive_macrosubs_multiline', ([_LINENUM_FLAG], '#:def f(c)\nLINE1|${c}$|\nLINE2|${c}$|\n#:enddef\n$: f(f("A"))\n', (_linenum(0) + _linenum(4) + 'LINE1|LINE1|A|\n' + _linenum(4) + 'LINE2|A||\n' + _linenum(4) + 'LINE2|LINE1|A|\n' + _linenum(4) + 'LINE2|A||\n') ) ), ('multiline_macrocall', ([_LINENUM_FLAG], '#:def macro(c)\nMACRO|${c}$|\n#:enddef\n$: mac& \n &ro(\'A\')\nDone\n', _linenum(0) + _linenum(3) + 'MACRO|A|\n' + _linenum(5) + 'Done\n' ) ), ('call_directive_2_args', ([_LINENUM_FLAG], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '#:call mymacro\nL1\nL2\n#:nextarg\nL3\n#:endcall\n', _linenum(0) + _linenum(3) + '|L1\n' + _linenum(3) + 'L2|L3|\n' + _linenum(9), ) ), ('for', ([_LINENUM_FLAG], '#:for i in (1, 2)\n${i}$\n#:endfor\nDone\n', (_linenum(0) + _linenum(1) + '1\n' + _linenum(1) + '2\n' + _linenum(3) + 'Done\n') ) ), ('inline_for', ([_LINENUM_FLAG], '#{for i in (1, 2)}#${i}$#{endfor}#Done\n', _linenum(0) + '12Done\n' ) ), ('set', ([_LINENUM_FLAG], '#:set x = 2\n$: x\n', _linenum(0) + _linenum(1) + '2\n', ) ), ('inline_set', ([_LINENUM_FLAG], '#{set x = 2}#${x}$Done\n', _linenum(0) + '2Done\n', ) ), ('comment_single', ([_LINENUM_FLAG], ' #! Comment here\nDone\n', _linenum(0) + _linenum(1) + 'Done\n' ) ), ('comment_multiple', ([_LINENUM_FLAG], ' #! Comment1\n#! Comment2\nDone\n', _linenum(0) + _linenum(2) + 'Done\n', ) ), ('mute', ([_LINENUM_FLAG], 'A\n#:mute\nB\n#:set VAR = 2\n#:endmute\nVAR=${VAR}$\n', _linenum(0) + 'A\n' + _linenum(5) + 'VAR=2\n' ) ), ('direct_call', ([_LINENUM_FLAG], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro( a < b )\n', _linenum(0) + _linenum(3) + '|a < b|\n', ) ), ('direct_call_contline', ([_LINENUM_FLAG], '#:def mymacro(val)\n|${val}$|\n#:enddef\n'\ '@:mymacro(a &\n &< b&\n &)\nDone\n', _linenum(0) + _linenum(3) + '|a < b|\n' + _linenum(6) + 'Done\n', ) ), ('assert_directive', ([_LINENUM_FLAG], '#:assert 1 < 2\nDone\n', _linenum(0) + _linenum(1) + 'Done\n', ) ), ('assert_directive_contline', ([_LINENUM_FLAG], '#:assert 1&\n& < 2\nDone\n', _linenum(0) + _linenum(2) + 'Done\n', ) ), ('smart_folding', ([_LINENUM_FLAG, _linelen(15), _indentation(4), _folding('smart')], ' ${3}$456 89 123456 8\nDone\n', _linenum(0) + ' 3456 89&\n' + _linenum(0) + ' & 123456&\n' + _linenum(0) + ' & 8\n' + 'Done\n' ) ), ('smart_folding_nocontlines', ([_LINENUM_FLAG, _linenumbering('nocontlines'), _linelen(15), _indentation(4), _folding('smart')], ' ${3}$456 89 123456 8\nDone\n', _linenum(0) + ' 3456 89&\n' + ' & 123456&\n' \ + ' & 8\n' + _linenum(1) + 'Done\n' ) ), ] # Tests with include files # # Each test consists of a tuple containing the test name and a tuple with the # arguments of the get_test_output_method() routine. # INCLUDE_TESTS = [ ('explicit_include', ([], '#:include "include/fypp1.inc"\n', 'INCL1\nINCL5\n' ) ), ('search_include', ([_incdir('include')], '#:include "fypp1.inc"\n', 'INCL1\nINCL5\n' ) ), ('nested_include_in_incpath', ([_incdir('include')], '#:include "subfolder/include_fypp1.inc"\n', 'INCL1\nINCL5\n' ) ), ('nested_include_in_folder_of_incfile', ([_incdir('include')], '#:include "subfolder/include_fypp2.inc"\n', 'FYPP2\n' ) ), ('search_include_linenum', ([_LINENUM_FLAG, _incdir('include')], '#:include "fypp1.inc"\n$: incmacro(1)\n', (_linenum(0) + _linenum(0, 'include/fypp1.inc', flag=_NEW_FILE) + 'INCL1\n' + _linenum(4, 'include/fypp1.inc') + 'INCL5\n' + _linenum(1, flag=_RETURN_TO_FILE) + 'INCMACRO(1)\n') ) ), ('nested_include_in_incpath_linenum', ([_LINENUM_FLAG, _incdir('include')], '#:include "subfolder/include_fypp1.inc"\n', (_linenum(0) + _linenum(0, 'include/subfolder/include_fypp1.inc', flag=_NEW_FILE) + _linenum(0, 'include/fypp1.inc', flag=_NEW_FILE) + 'INCL1\n' + _linenum(4, 'include/fypp1.inc') + 'INCL5\n' + _linenum(1, 'include/subfolder/include_fypp1.inc', flag=_RETURN_TO_FILE) + _linenum(1, flag=_RETURN_TO_FILE)) ) ), ('nested_include_in_folder_of_incfile2', ([_LINENUM_FLAG, _incdir('include')], '#:include "subfolder/include_fypp2.inc"\n', (_linenum(0) + _linenum(0, 'include/subfolder/include_fypp2.inc', flag=_NEW_FILE) + _linenum(0, 'include/subfolder/fypp2.inc', flag=_NEW_FILE) + 'FYPP2\n' + _linenum(1, 'include/subfolder/include_fypp2.inc', flag=_RETURN_TO_FILE) + _linenum(1, flag=_RETURN_TO_FILE)) ) ), ('muted_include', ([_incdir('include')], 'START\n#:mute\n#:include \'fypp1.inc\'\n#:endmute\nDONE\n', 'START\nDONE\n' ) ), ('muted_include_linenum', ([_LINENUM_FLAG, _incdir('include')], 'START\n#:mute\n#:include \'fypp1.inc\'\n#:endmute\nDONE\n', _linenum(0) + 'START\n' + _linenum(4) + 'DONE\n' ) ), ] # Tests which needs actual files as input # # Each test consists of a tuple containing the test name and a tuple with the # arguments of the get_test_output_from_file_input_method() routine. # INPUT_FILE_TESTS = [ ('file_var_substitution', ([], "input/filevarroot.fypp", 'FILE: input/filevarroot.fypp:1\n' 'THIS_FILE: input/filevarroot.fypp:2\n' '---\n' 'FILE: input/filevarroot.fypp:5\n' 'THIS_FILE: input/filevarroot.inc:3\n' ) ), ('file_var_root_rel', (["--file-var-root=input"], "input/filevarroot.fypp", 'FILE: filevarroot.fypp:1\n' 'THIS_FILE: filevarroot.fypp:2\n' '---\n' 'FILE: filevarroot.fypp:5\n' 'THIS_FILE: filevarroot.inc:3\n' ) ), ('file_var_root_abs', ([f"--file-var-root={Path.cwd()}"], f"{Path.cwd() / 'input/filevarroot.fypp'}", 'FILE: input/filevarroot.fypp:1\n' 'THIS_FILE: input/filevarroot.fypp:2\n' '---\n' 'FILE: input/filevarroot.fypp:5\n' 'THIS_FILE: input/filevarroot.inc:3\n' ) ), ] # Tests triggering exceptions # # Each test consists of a tuple containing the test name and a tuple with the # arguments of the get_test_exception_method() routine. # EXCEPTION_TESTS = [ # # Parser errors # ('invalid_directive', ([], '#:invalid\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_macrodef', ([], '#:def alma[x]\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_for_decl', ([], '#:for i = 1, 2\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_include', ([], '#:include \n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('inline_include', ([], '#{include "test.h"}#\n', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('wrong_include_file', ([], '#:include "testfkjsdlfkjslf.h"\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_else', ([], '#:if 1 > 2\nA\n#:else True\nB\n#:endif\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('invalid_endif', ([], '#:if 1 > 2\nA\n#:else\nB\n#:endif INV\n', [(fypp.FyppFatalError, fypp.STRING, (4, 5))] ) ), ('invalid_endfor', ([], '#:for i in range(5)\n${i}$\n#:endfor INV\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('invalid_variable_assign', ([], '#:set A=\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_mute', ([], '#:mute TEST\n#:endmute\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_endmute', ([], '#:mute\n#:endmute INVALID\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('inline_mute', ([], '#{mute}#test#{endmute}#\n', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('inline_endmute', ([], '#:mute\ntest#{endmute}#\n', [(fypp.FyppFatalError, fypp.STRING, (1, 1))] ) ), ('setvar_with_equal', ([], '#:setvar x = 2\n$: x\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('inline_set_without_equal', ([], '#{set x 2}#${x}$Done\n', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('missing_del_name', ([], '#:del\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_del_name', ([], '#:del [a, b]\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('inline_def', ([], '#{def macro()}#TEST#{enddef}#', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('invalid_direct_call_expr', ([], '#:def macro()\n#:enddef\n@:macro{}\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('invalid_direct_call_expr_inline', ([], '#:def macro()\n#:enddef\n@{macro{}}@\n', [(fypp.FyppFatalError, fypp.STRING, (2, 2))] ) ), ('invalid_direct_call_expr2', ([], '#:def macro()\n#:enddef\n@:macro(\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('invalid_direct_call_expr2_inline', ([], '#:def macro()\n#:enddef\n@{macro(}@\n', [(fypp.FyppFatalError, fypp.STRING, (2, 2))] ) ), ('direct_call_non_eval_dir', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@:mymacro(L1 #{if True}#2, 2#{endif}#)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 3))] ) ), ('direct_call_non_eval_dir_inline', ([], '#:def mymacro(val1, val2)\n|${val1}$|${val2}$|\n#:enddef\n'\ '@{mymacro(L1 #{if True}#2, 2#{endif}#)}@', [(fypp.FyppFatalError, fypp.STRING, (3, 3))] ) ), ('direct_call_unclosed quote', ([], '#:def mymacro(arg1)\n|${arg1}$|\n#:enddef\n'\ '@:mymacro("something)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, None, None)] ) ), ('direct_call_unclosed bracket', ([], '#:def mymacro(arg1)\n|${arg1}$|\n#:enddef\n'\ '@:mymacro({something)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, None, None)] ) ), ('direct_call_unbalanced bracket', ([], '#:def mymacro(arg1)\n|${arg1}$|\n#:enddef\n'\ '@:mymacro({(})\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, None, None)] ) ), ('missing_line_dir_content', ([], '#:\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('missing_line_dir_content2', ([], '#: \n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('missing_inline_dir_content', ([], '#{}#', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('missing_inline_dir_content2', ([], '#{ }#', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('set_setvar', ([], '#:setvar x 2\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('inline_setvar', ([], '#{setvar x 2}#', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), # # Builder errors # ('line_if_inline_endif', ([], '#:if 1 < 2\nTrue\n#{endif}#\n', [(fypp.FyppFatalError, fypp.STRING, (2, 2))] ) ), ('inline_if_line_endif', ([], '#{if 1 < 2}#True\n#:endif\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('line_if_inline_elif', ([], '#:if 1 < 2\nTrue\n#{elif 2 > 3}#\n', [(fypp.FyppFatalError, fypp.STRING, (2, 2))] ) ), ('inline_if_line_elif', ([], '#{if 1 < 2}#True\n#:elif 2 > 3\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('line_if_inline_else', ([], '#:if 1 < 2\nTrue\n#{else}#\n', [(fypp.FyppFatalError, fypp.STRING, (2, 2))] ) ), ('inline_if_line_else', ([], '#{if 1 < 2}#True\n#:else\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('loose_else', ([], 'A\n#:else\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('loose_inline_else', ([], 'A\n#{else}#\n', [(fypp.FyppFatalError, fypp.STRING, (1, 1))] ) ), ('loose_elif', ([], 'A\n#:elif 1 > 2\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('loose_inline_elif', ([], 'A\n#{elif 1 > 2}#\n', [(fypp.FyppFatalError, fypp.STRING, (1, 1))] ) ), ('loose_endif', ([], 'A\n#:endif\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('loose_inline_endif', ([], 'A\n#{endif}#\n', [(fypp.FyppFatalError, fypp.STRING, (1, 1))] ) ), ('mismatching_else', ([], '#:if 1 < 2\n#:for i in range(3)\n#:else\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('mismatching_elif', ([], '#:if 1 < 2\n#:for i in range(3)\n#:elif 1 > 2\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('mismatching_endif', ([], '#:if 1 < 2\n#:for i in range(3)\n#:endif\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('line_def_inline_enddef', ([], '#:def alma(x)\n#{enddef}#\n', [(fypp.FyppFatalError, fypp.STRING, (1, 1))] ) ), ('loose_enddef', ([], '#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('loose_inline_enddef', ([], '#{enddef}#\n', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('mismatching_enddef', ([], '#:def test(x)\n#{if 1 < 2}#\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('enddef_name_mismatch', ([], '#:def macro(var)\nMACRO|${var}$|\n#:enddef nonsense\n${macro(1)}$', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('endcall_name_mismatch', ([], '#:def macro(var)\nMACRO|${var}$|\n#:enddef\n'\ '#:call macro\n1\n#:endcall nonsense\n', [(fypp.FyppFatalError, fypp.STRING, (5, 6))] ) ), ('inline_endcall_name_mismatch', ([], '#:def macro(var)\nMACRO|${var}$|\n#:enddef\n'\ '#{call macro}#1#{endcall nonsense}#', [(fypp.FyppFatalError, fypp.STRING, (3, 3))] ) ), ('line_for_inline_endfor', ([], '#:for i in range(3)\nA\n#{endfor}#\n', [(fypp.FyppFatalError, fypp.STRING, (2, 2))] ) ), ('inline_for_line_endfor', ([], '#{for i in range(3)}#Empty\n#:endfor\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2))] ) ), ('loose_endfor', ([], '#:endfor\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('loose_inline_endfor', ([], '#{endfor}#', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('mismatching_endfor', ([], '#:for i in range(3)\n#{if 1 < 2}#\n#:endfor\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('loose_endmute', ([], '#:endmute\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('mismatching_endmute', ([], '#:mute\n#{if 1 < 2}#\n#:endmute\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('unclosed_directive', ([], '#:if 1 > 2\nA\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('missing_space_after_directive', ([], '#:if(1 > 2)\nA\n#:endif', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('missing_space_after_inline_directive', ([], '#{if(1 > 2)}#A#{endif}#', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('mixing_block_and_endcall', ([], '#:def test(x)\n#:enddef\n#:block test\n1\n#:endcall\n', [(fypp.FyppFatalError, fypp.STRING, (4, 5))] ) ), ('mixing_call_and_endblock', ([], '#:def test(x)\n#:enddef\n#:call test\n1\n#:endblock\n', [(fypp.FyppFatalError, fypp.STRING, (4, 5))] ) ), ('mixing_call_and_contains', ([], '#:def test(x,y)\n#:enddef\n#:call test\n1\n#:contains\n2\n#:endcall\n', [(fypp.FyppFatalError, fypp.STRING, (4, 5))] ) ), ('mixing_block_and_nextarg', ([], '#:def test(x,y)\n#:enddef\n#:block test\n1\n#:nextarg\n2\n#:endblock\n', [(fypp.FyppFatalError, fypp.STRING, (4, 5))] ) ), # # Renderer errors # ('invalid_expression', ([], '${i}$', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('invalid_variable', ([], '#:set i 1.2.3\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_condition', ([], '#{if i >>> 3}##{endif}#', [(fypp.FyppFatalError, fypp.STRING, (0, 0))] ) ), ('invalid_iterator', ([], '#:for i in 1.2.3\nDummy\n#:endfor\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_macro_argument_expression', ([], '#:def alma(x))\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('tuple_macro_argument', ([], '#:def alma((x, y))\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))], ), ), ('repeated_keyword_argument', ([], '#:def mymacro(A, B)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '$:mymacro(A=1, A=2, B=3)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4))] ) ), ('pos_arg_after_keyword_arg', ([], '#:def mymacro(A, B)\nA=${A}$,B=${B}$\n#:enddef mymacro\n'\ '$:mymacro(B=4, 2)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4))] ) ), ('macrodef_pos_arg_after_keyword_arg', ([], '#:def mymacro(A, B=2, C)\nA=${A}$,B=${B},C=${C}$$\n#:enddef mymacro\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('macrodef_pos_arg_after_var_arg', ([], '#:def mymacro(A, *B, C)\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ), ), ('macrodef_pos_arg_after_var_kwarg', ([], '#:def mymacro(A, **B, C)\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_macro_prefix', ([], '#:def __test(x)\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('reserved_macro_name', ([], '#:def defined(x)\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('macro_double_defined_arg', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${vararg}$|\n#:enddef\n'\ '$:macro(1, 2, x=1)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('macro_invalid_argument_name', ([], '#:def macro(x, __y, *vararg)\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('macro_invalid_varargument_name', ([], '#:def macro(x, y, *__vararg)\n#:enddef\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_variable_prefix', ([], '#:set __test = 2\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('reserved_variable_name', ([], '#:set _LINE_ = 2\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('macro_call_more_args', ([], '#:def test(x)\n${x}$\n#:enddef\n$: test(\'A\', 1)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('macro_call_less_args', ([], '#:def test(x)\n${x}$\n#:enddef\n$: test()\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('macro_invalid_keyword_arguments', ([], '#:def macro(x, y)\n|${x}$${y}$|\n#:enddef\n'\ '$:macro(1, 2, z=3)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('macro_vararg_invalid_keyword_arguments', ([], '#:def macro(x, y, *vararg)\n|${x}$${y}$${z}$${vararg}$|\n#:enddef\n'\ '$:macro(1, 2, z=3)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('macro_kwarg_invalid_posarg', ([], '#:def macro(x, y, **varkw)\n|${x}$${y}$${varkw}$|\n#:enddef\n'\ '$:macro(1, 2, 3, z=3)\n', [(fypp.FyppFatalError, fypp.STRING, (3, 4)), (fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('short_line_length', ([_linelen(4)], '', [(fypp.FyppFatalError, None, None)] ) ), ('failing_macro_in_include', ([], '#:include "include/failingmacro.inc"\n$:failingmacro()\n', [(fypp.FyppFatalError, fypp.STRING, (1, 2)), (fypp.FyppFatalError, 'include/failingmacro.inc', (2, 3))] ) ), ('incompatible_tuple_assignment1', ([], '#:set a,b,c = (1, 2)\n${a}$${b}$${c}$\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('incompatible_tuple_assignment2', ([], '#:set a,b,c = (1, 2, 3, 4)\n${a}$${b}$${c}$\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('invalid_lhs_tuple1', ([], '#:set (a, b = (1, 2)\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('invalid_lhs_tuple2', ([], '#:set a, b) = (1, 2)\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('invalid_del_tuple1', ([], '#:del (a, b\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('invalid_del_tuple2', ([], '#:del a, b)\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('del_nonexisting_variable', ([], '#:del X\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ('local_macro_visibility', ([], '#:set echo = lambda s: s\n'\ '#:call echo\n' '#:def mymacro()\nX\n#:enddef\n'\ '#:endcall\n$:mymacro()\n', [(fypp.FyppFatalError, fypp.STRING, (6, 7))] ) ), # # Command line errors # ('def_error', (['-DVAR=1.2.2'], '', [(fypp.FyppFatalError, None, None)] ) ), ('missing_module', (['-mWhateverDummyKJFDKf'], '', [(fypp.FyppFatalError, None, None)] ) ), # # User requested stop # ('userstop', ([], '#:set A = 12\n#:if A > 10\n#:stop "Wrong A: {0}".format(A)\n#:endif\n', [(fypp.FyppStopRequest, fypp.STRING, (2, 3))] ) ), ('invalid_userstop_expr', ([], '#:set A = 12\n#:if A > 10\n#:stop "Wrong A: {0}".format(BA)\n#:endif\n', [(fypp.FyppFatalError, fypp.STRING, (2, 3))] ) ), ('invalid_inline_stop', ([], '#:set A = 1\n#:if A > 10\n#{stop "Wrong A: {0}".format(BA)}#\n#:endif\n', [(fypp.FyppFatalError, fypp.STRING, (2, 2))] ) ), ('assert', ([], '#:set A = 12\n#:assert A < 10\n', [(fypp.FyppStopRequest, fypp.STRING, (1, 2))] ) ), ('invalid_assert_expr', ([], '#:assert A < 10\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1))] ) ), ('invalid_inline_assert', ([], '#:set A = 12\n#{assert A < 10}#\n', [(fypp.FyppFatalError, fypp.STRING, (1, 1))] ) ), ('global_existing_in_local_scope', ([], '#:def macro()\n#:set A = 12\n#:global A\n#:enddef\n$:macro()\n', [(fypp.FyppFatalError, fypp.STRING, (4, 5)), (fypp.FyppFatalError, fypp.STRING, (2, 3)), (fypp.FyppFatalError, None, None)] ) ), ('setvar_func_odd_arguments', ([], '$:setvar("i", 1, "j")\n', [(fypp.FyppFatalError, fypp.STRING, (0, 1)), (fypp.FyppFatalError, None, None)] ) ), ] # Tests with module imports # # Each test consists of a tuple containing the test name and a tuple with the # arguments of the get_test_output_method() routine. # # NOTE: imports are global in Python, so all instances of Fypp following after # the tests below will see the imported modules Therefore, this tests should be # executed as last to minimize unwanted interactions between unit tests. Also, # no tests before these should import any modules. # IMPORT_TESTS = [ ('import_module', ([_importmodule('math')], '$:int(math.sqrt(4))\n', '2\n' ) ), ('import_module_current_dir', ([_importmodule('inimod')], '${inimod.get_version()}$', '1' ) ), ('import_module_modified_lookupdir', ([_moddir('include'), _importmodule('inimod2')], '${inimod2.get_version()}$', '2' ) ), ('import_subpackage', ([_importmodule('os.path')], '${os.path.isabs("a")}$', 'False' ) ), ] def _get_test_output_method(args, inp, out): '''Returns a test method for checking correctness of Fypp output. Args: args (list of str): Command-line arguments to pass to Fypp. inp (str): Input with Fypp directives. out (str): Expected output. Returns: method: Method to test equality of output with result delivered by Fypp. ''' def test_output(self): '''Tests whether Fypp result matches expected output.''' optparser = fypp.get_option_parser() options, leftover = optparser.parse_args(args) self.assertEqual(len(leftover), 0) tool = fypp.Fypp(options) result = tool.process_text(inp) self.assertEqual(out, result) return test_output def _get_test_output_from_file_input_method(args, inputfile, out): '''Returns a test method for checking correctness of Fypp output. Args: args (list of str): Command-line arguments to pass to Fypp. inputfile (str): Input file with Fypp directives. out (str): Expected output. Returns: method: Method to test equality of output with result delivered by Fypp. ''' def test_output_from_file_input(self): '''Tests whether Fypp result matches expected output when input is in a file.''' optparser = fypp.get_option_parser() options, leftover = optparser.parse_args(args) self.assertEqual(len(leftover), 0) tool = fypp.Fypp(options) result = tool.process_file(inputfile) self.assertEqual(out, result) return test_output_from_file_input def _get_test_exception_method(args, inp, exceptions): '''Returns a test method for checking correctness of thrown exception. Args: args (list of str): Command-line arguments to pass to Fypp. inp (str): Input with Fypp directives. exceptions (list of tuples): Each tuple contains an exception, a file name and a span (tuple or int). The tuples should be in reverse order (latest raised exception first). Returns: method: Method to test, whether Fypp throws the correct exception. ''' def test_exception(self): '''Tests whether Fypp throws the correct exception.''' optparser = fypp.get_option_parser() options, leftover = optparser.parse_args(args) self.assertEqual(len(leftover), 0) try: tool = fypp.Fypp(options) _ = tool.process_text(inp) except Exception as e: raised = e else: self.fail('No exception was raised') for exc, fname, span in exceptions: self.assertTrue(isinstance(raised, exc)) if fname is None: self.assertTrue(raised.fname is None) else: self.assertEqual(fname, raised.fname) if span is None: self.assertTrue(raised.span is None) else: self.assertEqual(span, raised.span) raised = raised.__cause__ self.assertTrue(not isinstance(raised, fypp.FyppError)) return test_exception def _test_needed(flag): return True class _TestContainer(unittest.TestCase): '''General test container class.''' @classmethod def add_test_methods(cls, tests, methodfactory): '''Adds tests to a test case. Args: tests (list of tuples): Tests to attach. testcase (TestCase): Class which the tests should be attached to. methodfactory (function): Functions which turns the tuples in tests into methods, which can be then attached to the test case. ''' already_added = set() for itest, test in enumerate(tests): name = test[0] if name in already_added: msg = "multiple occurrence of test name '{0}'".format(name) raise ValueError(msg) already_added.add(name) testargs = test[1] methodname = 'test_' + name if len(test) < 3: addtest = True else: addtest = _test_needed(test[2]) if addtest: setattr(cls, methodname, methodfactory(*testargs)) class SimpleTest(_TestContainer): pass SimpleTest.add_test_methods(SIMPLE_TESTS, _get_test_output_method) class LineNumberingTest(_TestContainer): pass LineNumberingTest.add_test_methods(LINENUM_TESTS, _get_test_output_method) class IncludeTest(_TestContainer): pass IncludeTest.add_test_methods(INCLUDE_TESTS, _get_test_output_method) class InputFileTest(_TestContainer): pass InputFileTest.add_test_methods( INPUT_FILE_TESTS, _get_test_output_from_file_input_method ) class ExceptionTest(_TestContainer): pass ExceptionTest.add_test_methods(EXCEPTION_TESTS, _get_test_exception_method) class ImportTest(_TestContainer): pass ImportTest.add_test_methods(IMPORT_TESTS, _get_test_output_method) if __name__ == '__main__': unittest.main() fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/tools/000077500000000000000000000000001514707373700210305ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/tools/waf/000077500000000000000000000000001514707373700216055ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/tools/waf/fypp_fortran.py000066400000000000000000000030731514707373700246730ustar00rootroot00000000000000#!/usr/bin/env python3 # encoding: utf-8 # Bálint Aradi, 2016-2021 '''Uses Fypp as Fortran preprocessor (.fpp -> .f90). Use this one (instead of fypp_preprocessor) if you want to preprocess Fortran sources with Fypp. You typically trigger the preprocessing via the 'fypp' feature:: def options(opt): opt.load('compiler_c') opt.load('compiler_fc') opt.load('fypp_fortran') def configure(conf): conf.load('compiler_c') conf.load('compiler_fc') conf.load('fypp_fortran') def build(bld): sources = bld.path.ant_glob('*.fpp') bld( features='fypp fc fcprogram', source=sources, target='myprog' ) Please check the documentation in the fypp_preprocessor module for the description of the uselib variables which may be passed to the task generator. ''' from waflib import TaskGen import fypp_preprocessor ################################################################################ # Configure ################################################################################ def configure(conf): fypp_preprocessor.configure(conf) ################################################################################ # Build ################################################################################ class fypp_fortran(fypp_preprocessor.fypp_preprocessor): ext_in = [ '.fpp' ] ext_out = [ '.f90' ] @TaskGen.extension('.fpp') def fypp_preprocess_fpp(self, node): 'Preprocess the .fpp files with Fypp.' f90node = node.change_ext('.f90') self.create_task('fypp_fortran', node, [ f90node ]) if 'fc' in self.features: self.source.append(f90node) fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/tools/waf/fypp_preprocessor.py000066400000000000000000000144521514707373700257510ustar00rootroot00000000000000#!/usr/bin/env python3 # encoding: utf-8 # Bálint Aradi, 2016-2021 '''General module for using Fypp as preprocessor. This module implements the general framework for the Fypp preprocessor, but does not bind it to any task generator. If you want to use it to preprocessor Fortran source files (.fpp -> .f90), use the fypp_fortran module instead. Otherwise, you can generate your own binding as ususal:: def build(bld): bld(features='fypp', source=['test.fypp']) from waflib import TaskGen @TaskGen.extension('.fypp') def process(self, node): tsk = self.create_task('fypp_preprocessor', [node], node.change_ext('.out')) The preprocessor understands the following uselib attributes: * ``includes``: Directory/directories to search for include files * ``modules``: Python module(s) to import before preprocessing starts * ``defines``: Definition(s) to apply before preprocessing starts * ``inifiles``: Python file(s) to execute before preprosessing starts The example below demonstrates this:: def build(bld): bld(features='fypp', source=['trash.fypp'], includes='include', modules=['myfypp1', 'myfypp2'], defines='TEST=1 QUIET', inifiles='fyppini.py') ''' import re import os.path from waflib import Configure, Logs, Task, TaskGen, Tools, Errors try: import fypp except ImportError: fypp = None Tools.ccroot.USELIB_VARS['fypp'] = set([ 'DEFINES', 'INCLUDES', 'MODULES', 'INIFILES' ]) FYPP_INCPATH_ST = '-I%s' FYPP_DEFINES_ST = '-D%s' FYPP_LINENUM_FLAG = '-n' FYPP_MODULES_ST = '-m%s' FYPP_INIFILES_ST = '-i%s' class FyppPreprocError(Errors.WafError): pass ################################################################################ # Configure ################################################################################ def configure(conf): fypp_check(conf) fypp_add_user_flags(conf) @Configure.conf def fypp_add_user_flags(conf): '''Import user settings for Fypp.''' conf.add_os_flags('FYPP_FLAGS', dup=False) @Configure.conf def fypp_check(conf): '''Check for Fypp.''' conf.start_msg('Checking for fypp module') if fypp is None: conf.fatal('Python module \'fypp\' could not be imported.') version = fypp.VERSION version_regexp = re.compile(r'^(?P\d+)\.(?P\d+)'\ '(?:\.(?P\d+))?$') match = version_regexp.search(version) if not match: conf.fatal('cannot parse fypp version string') version = (match.group('major'), match.group('minor')) conf.env['FYPP_VERSION'] = version conf.end_msg('found (version %s.%s)' % version) ################################################################################ # Build ################################################################################ class fypp_preprocessor(Task.Task): def keyword(self): return 'Preprocessing' def run(self): argparser = fypp.get_option_parser() args = [FYPP_LINENUM_FLAG] args += self.env.FYPP_FLAGS args += [FYPP_DEFINES_ST % ss for ss in self.env['DEFINES']] args += [FYPP_INCPATH_ST % ss for ss in self.env['INCLUDES']] args += [FYPP_INIFILES_ST % ss for ss in self.env['INIFILES']] args += [FYPP_MODULES_ST % ss for ss in self.env['MODULES']] opts, leftover = argparser.parse_args(args) infile = self.inputs[0].abspath() outfile = self.outputs[0].abspath() if Logs.verbose: Logs.debug('runner: fypp.Fypp %r %r %r' % (args, infile, outfile)) tool = fypp.Fypp(opts) try: tool.process_file(infile, outfile) except fypp.FyppError as err: msg = ("%s [%s:%d]" % (err.msg, err.fname, err.span[0] + 1)) raise FyppPreprocError(msg) return 0 def scan(self): parser = FyppIncludeParser(self.generator.includes_nodes) nodes, names = parser.parse(self.inputs[0]) if Logs.verbose: Logs.debug('deps: deps for %r: %r; unresolved: %r' % (self.inputs, nodes, names)) return (nodes, names) TaskGen.feature('fypp')(Tools.ccroot.propagate_uselib_vars) TaskGen.feature('fypp')(Tools.ccroot.apply_incpaths) ################################################################################ # Helper routines ################################################################################ class FyppIncludeParser(object): '''Parser for include directives in files preprocessed by Fypp. It can not handle conditional includes. ''' # Include file pattern, opening and closing quoute must be replaced inside. INCLUDE_PATTERN = re.compile(r'^\s*#:include\s*(["\'])(?P.+?)\1', re.MULTILINE) def __init__(self, incpaths): '''Initializes the parser. :param quotes: Tuple containing the opening and closing quote sign. :type quotes: tuple ''' # Nodes still to be processed self._waiting = [] # Files we have already processed self._processed = set() # List of dependent nodes self._dependencies = [] # List of unresolved dependencies self._unresolved = set() # Paths to consider when checking for includes self._incpaths = incpaths def parse(self, node): '''Parser the includes in a given node. :return: Tuple with two elements: list of dependent nodes and list of unresolved depencies. ''' self._waiting = [ node, ] # self._waiting is eventually extended during _process() -> iterate while self._waiting: curnode = self._waiting.pop(0) self._process(curnode) return (self._dependencies, list(self._unresolved)) def _process(self, node): incfiles = self._get_include_files(node) for incfile in incfiles: if incfile in self._processed: continue self._processed.add(incfile) incnode = self._find_include_node(node, incfile) if incnode: self._dependencies.append(incnode) self._waiting.append(incnode) else: self._unresolved.add(incfile) def _get_include_files(self, node): txt = node.read() matches = self.INCLUDE_PATTERN.finditer(txt) incs = [ match.group('incfile') for match in matches ] return incs def _find_include_node(self, node, filename): for incpath in self._incpaths: incnode = incpath.find_resource(filename) if incnode: break else: incnode = node.parent.find_resource(filename) return incnode fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/tox.ini000066400000000000000000000002711514707373700212030ustar00rootroot00000000000000[tox] envlist = py34, py35, py36, py37, py38, py39 [testenv] skip_missing_interpreters = true setenv = PYTHONPATH = {toxinidir}/src changedir=test commands=python test_fypp.py fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/utils/000077500000000000000000000000001514707373700210305ustar00rootroot00000000000000fckit-0.14.2/contrib/fypp-3.2-b8dd58b-20230822/utils/bump-version.py000077500000000000000000000040241514707373700240330ustar00rootroot00000000000000#!/usr/bin/env python3 import sys import re import os VERSION_PATTERN = r'\d+\.\d+(?:\.\d+)?(?:-\w+)?' FILES_PATTERNS = [ ('bin/fypp', r'^VERSION\s*=\s*([\'"]){}\1'.format(VERSION_PATTERN), "VERSION = '{version}'"), ('docs/fypp.rst', r'Fypp Version[ ]*{}.'.format(VERSION_PATTERN), 'Fypp Version {shortversion}.'), ('setup.py', r'version\s*=\s*([\'"]){}\1'.format(VERSION_PATTERN), "version='{version}'"), ('docs/conf.py', r'version\s*=\s*([\'"]){}\1'.format(VERSION_PATTERN), "version = '{shortversion}'"), ('docs/conf.py', r'release\s*=\s*([\'"]){}\1'.format(VERSION_PATTERN), "release = '{version}'"), ] if len(sys.argv) < 2: print("Missing version string") sys.exit(1) version = sys.argv[1] shortversion = '.'.join(version.split('.')[0:2]) match = re.match(VERSION_PATTERN, version) if match is None: print("Invalid version string") sys.exit(1) rootdir = os.path.join(os.path.dirname(sys.argv[0]), '..') for fname, regexp, repl in FILES_PATTERNS: fname = os.path.join(rootdir, fname) print("Replacments in '{}': ".format(fname), end='') fp = open(fname, 'r') txt = fp.read() fp.close() replacement = repl.format(version=version, shortversion=shortversion) newtxt, nsub = re.subn(regexp, replacement, txt, flags=re.MULTILINE) print(nsub) fp = open(fname, 'w') fp.write(newtxt) fp.close() # Replace version number in Change Log and adapt decoration below fname = os.path.join(rootdir, 'CHANGELOG.rst') print("Replacments in '{}': ".format(fname), end='') fp = open(fname, 'r') txt = fp.read() fp.close() decoration = '=' * len(version) newtxt, nsub = re.subn( '^Unreleased\s*\n=+', version + '\n' + decoration, txt, count=1, flags=re.MULTILINE) print(nsub) fp = open(fname, 'w') fp.write(newtxt) fp.close() fckit-0.14.2/doc/000077500000000000000000000000001514707373700134615ustar00rootroot00000000000000fckit-0.14.2/doc/CMakeLists.txt000066400000000000000000000031101514707373700162140ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. find_package(FORD QUIET) ecbuild_add_option( FEATURE DOCS DESCRIPTION "Generate reference documentation" CONDITION FORD_FOUND ) if( HAVE_DOCS ) set( FCKIT_DOC fckit_doc ) if( PROJECT_NAME STREQUAL CMAKE_PROJECT_NAME ) set( FCKIT_DOC doc ) endif() set( FORDFILE ford.md CACHE INTERNAL "FORD project filename" ) set( FORDPREPROCESSOR ford-preprocessor ) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/${FORDFILE}.in "${CMAKE_CURRENT_BINARY_DIR}/${FORDFILE}" @ONLY ) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/${FORDPREPROCESSOR}.in "${CMAKE_CURRENT_BINARY_DIR}/${FORDPREPROCESSOR}" @ONLY ) file( GLOB_RECURSE FORD_DEPENDS ${PROJECT_SOURCE_DIR}/src/fckit/* ) list( APPEND FORD_DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${FORDFILE}.in ${CMAKE_CURRENT_SOURCE_DIR}/${FORDPREPROCESSOR}.in ) add_custom_command(OUTPUT "ford/index.html" COMMAND ${FORD_EXECUTABLE} --debug "${CMAKE_CURRENT_BINARY_DIR}/${FORDFILE}" WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" DEPENDS ${FORD_DEPENDS} COMMENT "Building HTML documentation for ${CMAKE_PROJECT_NAME} using FORD (${CMAKE_CURRENT_BINARY_DIR}/ford/index.html)" ) add_custom_target( ${FCKIT_DOC} DEPENDS "ford/index.html" ${FORD_DEPENDS} ) endif() fckit-0.14.2/doc/fctest_examples/000077500000000000000000000000001514707373700166475ustar00rootroot00000000000000fckit-0.14.2/doc/fctest_examples/CMakeLists.txt000066400000000000000000000020661514707373700214130ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. cmake_minimum_required( VERSION 3.12 FATAL_ERROR ) find_package( ecbuild 3.4 REQUIRED ) project( fctest_examples VERSION 0.0.0 LANGUAGES Fortran ) ecbuild_enable_fortran( REQUIRED MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/module ) find_package( fckit REQUIRED ) ecbuild_add_library( TARGET fctest_example_lib SOURCES fctest_example_lib.F90 NOINSTALL ) add_fctest( TARGET fctest_example_simple LINKER_LANGUAGE Fortran SOURCES fctest_example_simple.F90 LIBS fctest_example_lib ) add_fctest( TARGET fctest_example_with_fixture LINKER_LANGUAGE Fortran SOURCES fctest_example_with_fixture.F90 ) fckit-0.14.2/doc/fctest_examples/fctest_example_lib.F90000066400000000000000000000011011514707373700227510ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. module example_module implicit none private public :: example_function contains function example_function() result(j) integer :: j write(0,*) "example_function()" j = 1 end function end module fckit-0.14.2/doc/fctest_examples/fctest_example_simple.F90000066400000000000000000000024511514707373700235050ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fctest.h" TESTSUITE( fctest_example_simple ) TEST( test1 ) write(0,*) "test1" CHECK_EQUAL( 1, 1 ) ! description here CHECK( 1==1 ) ! description here CHECK_CLOSE( 0., 1.e-8, 1.e-5 ) ! description here CHECK_EQUAL( (/1,2/), (/2,3/) ) CHECK_EQUAL( (/1._sp,2._sp/), (/1._sp,2._sp,3._sp/) ) CHECK_CLOSE( (/1._dp,2.01_dp/), (/1._dp,2._dp/), 0.001_dp ) END_TEST TEST( test2 ) write(0,*) "test2" CHECK_EQUAL( 1, 2 ) ! description here CHECK( 1==2 ) ! description here CHECK_CLOSE( 0., 1.e-4, 1.e-5 ) ! description here CHECK_EQUAL( (/1._sp,2._sp/), (/1._sp,2._sp/) ) CHECK_CLOSE( (/1._dp,2.0001_dp/), (/1._dp,2._dp/), 0.001_dp ) END_TEST TEST( test3 ) use example_module, only: example_function write(0,*) "test3" CHECK_EQUAL( example_function(), 1 ) END_TEST TESTSUITE_FINALIZE ! Mark test as passed, as it was supposed to fail otherwise exit_status = 0 END_TESTSUITE_FINALIZE END_TESTSUITE fckit-0.14.2/doc/fctest_examples/fctest_example_with_fixture.F90000066400000000000000000000020371514707373700247350ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fctest.h" module fctest_TestFixture implicit none integer, allocatable :: array(:) end module TESTSUITE_WITH_FIXTURE( fctest_example_with_fixture, fctest_TestFixture ) TESTSUITE_INIT write(0,*) "initializing testsuite" allocate( array(4) ) END_TESTSUITE_INIT TESTSUITE_FINALIZE write(0,*) "finalizing testsuite" deallocate( array ) ! Mark test as passed, as it was supposed to fail otherwise exit_status = 0 END_TESTSUITE_FINALIZE TEST( test1 ) write(0,*) "test1" CHECK_EQUAL( size(array), 4 ) ! description here END_TEST TEST( test2 ) write(0,*) "test2" CHECK_EQUAL( size(array), 2 ) ! description here END_TEST END_TESTSUITE fckit-0.14.2/doc/ford-preprocessor.in000077500000000000000000000005431514707373700174740ustar00rootroot00000000000000#!/usr/bin/env bash length=$(($#-1)) args_except_file=${@:1:$length} file=${@: -1} if [ ${file: -5} == ".fypp" ]; then mkdir -p ford_tmp fypp_outfile=ford_tmp/$(basename "$file" .fypp).F90 @CMAKE_CURRENT_SOURCE_DIR@/../tools/fckit-fypp.py $@ $fypp_outfile gfortran -E $args_except_file $fypp_outfile rm -rf ford_tmp else gfortran -E $@ fi fckit-0.14.2/doc/ford.md.in000066400000000000000000000045021514707373700153430ustar00rootroot00000000000000project: fcKit project_website: https://software.ecmwf.int/wiki/display/FCKIT project_github: https://github.com/ecmwf/fckit version: @fckit_VERSION@ summary: Fortran support library author: ECMWF author_website: www.ecmwf.int src_dir: @CMAKE_CURRENT_SOURCE_DIR@/../src/fckit output_dir: @CMAKE_CURRENT_BINARY_DIR@/ford predocmark: > docmark_alt: # predocmark_alt: < display: public protected source: true graph: true search: false macro: FORD extra_filetypes: sh # exclude: Log.F90 include: @CMAKE_CURRENT_BINARY_DIR@/../src extensions: F90 fypp fpp_extensions: F90 fypp preprocessor: @CMAKE_CURRENT_BINARY_DIR@/ford-preprocessor ## Capabilities: #### Logging - Configure ecKit loggers to e.g. direct output to Fortran units - Multiple log channels ( info, debug, warning, error ) - Each log channel may be configured with multiple destinations ( Fortran unit, file, none ) #### MPI - Wraping of MPI functions (allreduce, broadcast, alltoall, allgather, ...) - Depending on environment variables set by mpirun, aprun, srun, the real MPI or a serial MPI implementation is selected at runtime, so that no ```mpi_serial``` dummy library is required for serial jobs. #### Exception handling - C++ exceptions are handled by a custom terminate function - This terminate function calls a configurable routine to abort the program #### Configuration - Configuration can be read from a YAML or JSON file - Access configuration by key-value with key being a string - Compatible with ecKit configuration (can be passed as argument) #### C/Fortran interoperability - Helper functions to convert strings, arrays ## fctest Unit Testing Framwork for Fortran, made easy. - C Preprocessor Macros are used to make writing tests extremely fast - Tests in one file are bundled in a Test Suite (Fortran Module) - Python script generates a main program for a Test Suite - Driven by CMake build system ( and ctest ) #### To use fctest in your ecbuild project Simply add following line to your project's CMakeLists.txt ``` ecbuild_add_option( FEATURE FCTEST DEFAULT ${ENABLE_TESTS} DESCRIPTION "Fortran Unit Testing Framework" REQUIRED_PACKAGES "NAME fckit" ) ``` See src/examples folder how to add and create the unit-tests. --------------------------------------------------------------------- fckit-0.14.2/populate000077500000000000000000000015651514707373700145020ustar00rootroot00000000000000#!/usr/bin/env bash # (C) Copyright 2024- ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation # nor does it submit to any jurisdiction. if [[ $BASH_SOURCE = */* ]]; then SOURCE_DIR=${BASH_SOURCE%/*} else SOURCE_DIR=. fi ARTIFACTS_DIR=${ARTIFACTS_DIR:-"${SOURCE_DIR}/artifacts"} # Download dependencies for Python package in this repository cmake \ -DWHEELS_DIR=${ARTIFACTS_DIR} -DREQUIREMENT_SPEC=${SOURCE_DIR}/src/fckit/fckit_yaml_reader \ -DFCKIT_WHEEL_ARCH=${FCKIT_WHEEL_ARCH} -DFCKIT_WHEEL_PYTHON_VERSION=${FCKIT_WHEEL_PYTHON_VERSION} \ -P ${SOURCE_DIR}/cmake/fckit_download_python_wheels.cmake fckit-0.14.2/python/000077500000000000000000000000001514707373700142355ustar00rootroot00000000000000fckit-0.14.2/python/fckitlib/000077500000000000000000000000001514707373700160245ustar00rootroot00000000000000fckit-0.14.2/python/fckitlib/buildconfig000066400000000000000000000014571514707373700202430ustar00rootroot00000000000000# (C) Copyright 2025- ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation # nor does it submit to any jurisdiction. # to be source'd by wheelmaker's compile.sh *and* wheel-linux.sh # NOTE replace the whole thing with pyproject.toml? Less powerful, and quaint to use for sourcing ecbuild invocation # TODO we duplicate information -- pyproject.toml's `name` and `packages` are derivable from $NAME and must stay consistent NAME="fckit" CMAKE_PARAMS="-Deckit_ROOT=/tmp/fckit/prereqs/eckitlib" PYPROJECT_DIR="python/fckitlib" DEPENDENCIES='["eckitlib"]' fckit-0.14.2/python/fckitlib/pre-compile.sh000077500000000000000000000035661514707373700206110ustar00rootroot00000000000000#!/bin/bash # NOTE we dont use auditwheel because we dont want eckit and its deps to end up # here. We could use --exclude, but thats more work than what we have, and we'd # additionally need to not have names mangled set -euo pipefail source_target=python/fckitlib/src/copying mkdir -p $source_target mkdir -p /tmp/fckit/target/fckit/lib64/ # NOTE we hardcode lib list here, but note it may change with compiler version # in that case rerun: # `auditwheel lddtree /tmp/fckit/build/lib/libfckit.so 2>&1 | grep realpath | grep intel` # or refactor to do this in post-compile/post-build step (but thats more work) if [ -d /opt/intel/oneapi ] ; then libs="libifport.so.5 libimf.so libintlc.so.5 libifcoremt.so.5 libsvml.so libirc.so" echo "bundling in libs $libs" root="/opt/intel/oneapi/compiler/latest/lib/" for lib in $libs ; do cp $root/$lib /tmp/fckit/target/fckit/lib64/ patchelf --add-rpath '$ORIGIN' /tmp/fckit/target/fckit/lib64/$lib done # a bug in the intel libraries themselves -- dependency not declared but actually there patchelf --add-needed libifcoremt.so.5 /tmp/fckit/target/fckit/lib64/libifport.so.5 cp /opt/intel/oneapi/compiler/latest/share/doc/compiler/licensing/fortran/LICENSE $source_target/intel.LICENSE cp /opt/intel/oneapi/compiler/latest/share/doc/compiler/licensing/fortran/third-party-programs.txt $source_target/intel.third-party-programs.txt echo "{\"$(echo $libs | tr ' ' ',')\": {\"home\": \"https://www.intel.com/content/www/us/en/developer/articles/license/end-user-license-agreement.html\", \"path\": \"copying/intel*\"}}" > $source_target/list.json intel_version=$(ls /opt/intel/oneapi/compiler/ | grep -v latest | sort -r | head -n 1) echo "intel: $intel_version" >> $source_target/../versions.txt else # TODO macos support ??? # TODO nvidia fortran on arm ??? echo "no external bundle" fi fckit-0.14.2/python/fckitlib/setup.cfg000066400000000000000000000002141514707373700176420ustar00rootroot00000000000000[metadata] description = "fckitlib" long_description = file: README.md long_description_content_type = text/markdown author = file: AUTHORS fckit-0.14.2/python/fckitlib/setup.py000066400000000000000000000000621514707373700175340ustar00rootroot00000000000000from setup_utils import plain_setup plain_setup() fckit-0.14.2/src/000077500000000000000000000000001514707373700135035ustar00rootroot00000000000000fckit-0.14.2/src/CMakeLists.txt000066400000000000000000000012211514707373700162370ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. set(FCKIT_HAVE_ECKIT_TENSOR 0) if( HAVE_ECKIT ) if(eckit_VERSION VERSION_GREATER_EQUAL 1.23.0) set(FCKIT_HAVE_ECKIT_TENSOR 1) endif() endif() add_subdirectory(fckit) add_subdirectory(apps) add_subdirectory(tests) if ( HAVE_SANDBOX ) add_subdirectory(sandbox) endif() fckit-0.14.2/src/apps/000077500000000000000000000000001514707373700144465ustar00rootroot00000000000000fckit-0.14.2/src/apps/CMakeLists.txt000066400000000000000000000012341514707373700172060ustar00rootroot00000000000000get_property( langs GLOBAL PROPERTY ENABLED_LANGUAGES ) foreach( lang ${langs} ) set( EC_${lang}_FLAGS "${CMAKE_${lang}_FLAGS} ${CMAKE_${lang}_FLAGS_${CMAKE_BUILD_TYPE_CAPS}}" ) endforeach() configure_file( fckit.in ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/fckit ) file(COPY ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/fckit DESTINATION ${CMAKE_BINARY_DIR}/bin FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE) install( FILES ${CMAKE_BINARY_DIR}/bin/fckit DESTINATION ${INSTALL_BIN_DIR} PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE ) fckit-0.14.2/src/apps/fckit.in000077500000000000000000000051501514707373700161020ustar00rootroot00000000000000#!/usr/bin/env bash FCKIT_VERSION_STR="@fckit_VERSION_STR@" FCKIT_VERSION="@fckit_VERSION@" FCKIT_MAJOR_VERSION=@fckit_VERSION_MAJOR@ FCKIT_MINOR_VERSION=@fckit_VERSION_MINOR@ FCKIT_PATCH_VERSION=@fckit_VERSION_PATCH@ FCKIT_GIT_SHA1="@fckit_GIT_SHA1@" ################################################################# # Commands ################################################################# usage() { echo "Usage: fckit [--version] [--info] [--git]" exit $1 } version() { echo "${fckit_VERSION}" } print_feature() { if [ -z "$1" ]; then echo "OFF" elif [[ $1 =~ (true|TRUE|ON|1) ]]; then echo "ON" else echo "OFF" fi } info() { echo "fckit version (${fckit_VERSION}), git-sha1 ${fckit_GIT_SHA1}" echo "" echo "Build:" echo " build type : @CMAKE_BUILD_TYPE@" echo " timestamp : @EC_BUILD_TIMESTAMP@" echo " op. system : @CMAKE_SYSTEM@ (@EC_OS_NAME@.@EC_OS_BITS@)" echo " processor : @CMAKE_SYSTEM_PROCESSOR@" echo " sources : @PROJECT_SOURCE_DIR@" echo " c++ compiler : @CMAKE_CXX_COMPILER_ID@ @CMAKE_CXX_COMPILER_VERSION@" echo " flags : @EC_CXX_FLAGS@" echo " fortran compiler: @CMAKE_Fortran_COMPILER_ID@ @CMAKE_Fortran_COMPILER_VERSION@" echo " flags : @EC_Fortran_FLAGS@" echo "" echo "Features:" echo " MPI : $(print_feature @eckit_HAVE_MPI@)" echo " final : $(print_feature @fckit_HAVE_FINAL@)" echo " eckit : $(print_feature @fckit_HAVE_ECKIT@)" echo "" echo "Dependencies: " if [ -n "@fckit_HAVE_ECKIT@" ]; then echo " eckit version (@eckit_VERSION@), git-sha1 $(short_gitsha1 @eckit_GIT_SHA1@)" else echo " None" fi } gitsha1() { echo "${fckit_GIT_SHA1}" } short_gitsha1() { if [ -z "$1" ]; then echo "unknown" else echo $1 | head -c 13 fi } ################################################################# # Parse command-line ################################################################# if test $# -eq 0; then usage 1 fi while test $# -gt 0; do # Split --option=value in $opt="--option" and $val="value" opt="" val="" case "$1" in --*=*) opt=`echo "$1" | sed 's/=.*//'` val=`echo "$1" | sed 's/--[_a-zA-Z0-9]*=//'` ;; --*) opt=$1 ;; *) break ;; esac # Parse options case "$opt" in --version) version ;; --git) gitsha1 ;; --info) info ;; --) shift break ;; *) echo "unknown option: $opt" usage 1 ;; esac shift done fckit-0.14.2/src/fckit/000077500000000000000000000000001514707373700146035ustar00rootroot00000000000000fckit-0.14.2/src/fckit/CMakeLists.txt000066400000000000000000000066741514707373700173600ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. if( HAVE_ECKIT ) list( APPEND eckit_required_src module/fckit.F90 module/fckit_pathname.F90 module/fckit_configuration.F90 module/fckit_configuration.cc module/fckit_mpi.cc module/fckit_mpi.fypp module/fckit_main.cc module/fckit_main.F90 module/fckit_exception.F90 module/fckit_signal.F90 module/fckit_resource.cc module/fckit_resource.F90 module/fckit_log.cc module/fckit_log.F90 module/fckit_buffer.cc module/fckit_buffer.F90 module/fckit_owned.cc module/fckit_owned_object.F90 module/fckit_map.cc module/fckit_map.F90 Libfckit.h Libfckit.cc Main.h Main.cc Log.h Log.cc ) if( FCKIT_HAVE_ECKIT_TENSOR ) list( APPEND eckit_required_src module/fckit_tensor.cc module/fckit_tensor.F90 ) endif() set( eckit_required_libs eckit eckit_mpi ) endif() configure_file(fckit.h.in fckit.h) install( FILES ${CMAKE_CURRENT_BINARY_DIR}/fckit.h DESTINATION include/fckit ) set( source_files_properties fckit.h.in PROPERTIES HEADER_FILE_ONLY TRUE ) if( BUILD_SHARED_LIBS ) set( fckit_type SHARED ) else() set( fckit_type STATIC ) endif() if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" ) # Bug tested with pgi/17.7 (fixed pgi/19.4) requires fckit to be compiled statically if( ${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS 18.7 ) ecbuild_warn( "Bug in pgi < 19.4 requires fckit to be compiled statically" ) set( fckit_type STATIC ) endif() # Turn off all compiler warnings for reason : # PGF90-W-0435-Array declared with zero size # (/tmp/nawd/atlas-bundle/source/fckit/src/fckit/module/fckit_array.F90: 25) set_source_files_properties( module/fckit_array.F90 PROPERTIES COMPILE_FLAGS "-w" ) endif() ecbuild_add_library( TARGET fckit LINKER_LANGUAGE CXX # We need the C++ linker for the error handling to work # Otherwise death by recursion in function "fckit_terminate" # when uncaught exceptions are encountered SOURCES fctest.h fctest.F90 Log.F90 module/fckit_array.F90 module/fckit_C_interop.cc module/fckit_C_interop.F90 module/fckit_object.F90 module/fckit_final.F90 module/fckit_refcount.F90 module/fckit_shared_ptr.F90 module/fckit_shared_object.F90 ${eckit_required_src} PRIVATE_INCLUDES ${ECKIT_INCLUDE_DIRS} ${CMAKE_CURRENT_BINARY_DIR} INSTALL_HEADERS_LIST fctest.h Log.h Main.h HEADER_DESTINATION include/fckit PUBLIC_INCLUDES $ $ $ $ $ PRIVATE_LIBS ${eckit_required_libs} TYPE ${fckit_type} ) fckit_target_preprocess_fypp( fckit ) fckit-0.14.2/src/fckit/Libfckit.cc000066400000000000000000000025771514707373700166540ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #include #include #include "fckit/Libfckit.h" #include "fckit/fckit.h" namespace fckit { //---------------------------------------------------------------------------------------------------------------------- // eckit 0.16.5 improved library registration using REGISTER_LIBRARY macro REGISTER_LIBRARY( Libfckit ); Libfckit::Libfckit() : eckit::system::Library( "fckit" ) {} const Libfckit& Libfckit::instance() { static Libfckit library; return library; } const void* Libfckit::addr() const { return this; } std::string Libfckit::version() const { return FCKIT_VERSION; } std::string Libfckit::gitsha1( unsigned int count ) const { static std::string sha1( FCKIT_GIT_SHA1 ); if ( sha1.empty() ) { return "not available"; } sha1 = sha1.substr( 0, std::min( count, 40u ) ); return sha1.c_str(); } //---------------------------------------------------------------------------------------------------------------------- } // namespace fckit fckit-0.14.2/src/fckit/Libfckit.h000066400000000000000000000020121514707373700164760ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #ifndef fckit_Libfckit_h #define fckit_Libfckit_h #include "eckit/system/Library.h" namespace fckit { //---------------------------------------------------------------------------------------------------------------------- class Libfckit : public eckit::system::Library { public: Libfckit(); static const Libfckit& instance(); protected: const void* addr() const; virtual std::string version() const; virtual std::string gitsha1( unsigned int count ) const; }; //---------------------------------------------------------------------------------------------------------------------- } // namespace fckit #endif fckit-0.14.2/src/fckit/Log.F90000066400000000000000000000025221514707373700156050ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. ! Callback function, used from C++ side subroutine fckit_write_to_fortran_unit(unit,msg_cptr) bind(C) use, intrinsic :: iso_c_binding, only: c_int32_t, c_ptr, c_char, c_associated use fckit_c_interop_module, only : copy_c_ptr_to_string integer(c_int32_t), value, intent(in) :: unit type(c_ptr), value, intent(in) :: msg_cptr character(kind=c_char,len=:), allocatable :: msg if( c_associated(msg_cptr) ) then call copy_c_ptr_to_string( msg_cptr, msg ) write(unit,'(A)') msg endif end subroutine function fckit_fortranunit_stdout() result(stdout) bind(C) use, intrinsic :: iso_c_binding, only : c_int32_t use, intrinsic :: iso_fortran_env, only : output_unit integer(c_int32_t) :: stdout stdout = output_unit end function function fckit_fortranunit_stderr() result(stderr) bind(C) use, intrinsic :: iso_c_binding, only : c_int32_t use, intrinsic :: iso_fortran_env, only : error_unit integer(c_int32_t) :: stderr stderr = error_unit end function fckit-0.14.2/src/fckit/Log.cc000066400000000000000000000144551514707373700156440ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #include "fckit/Log.h" #include #include "eckit/exception/Exceptions.h" #include "eckit/log/CallbackTarget.h" #include "eckit/log/FileTarget.h" #include "eckit/log/OStreamTarget.h" #include "eckit/log/PrefixTarget.h" #include "eckit/log/TimeStampTarget.h" #include "eckit/runtime/Main.h" #include "eckit/system/Library.h" #include "eckit/system/LibraryManager.h" #include "fckit/Libfckit.h" using eckit::Channel; using eckit::LogTarget; using eckit::Main; using eckit::PrefixTarget; using eckit::system::Library; using eckit::system::LibraryManager; using fckit::Log; extern "C" { void fckit_write_to_fortran_unit( int unit, const char* msg ); int fckit_fortranunit_stdout(); int fckit_fortranunit_stderr(); } namespace { static void write_to_fortran_unit( void* ctxt, const char* msg ) { fckit_write_to_fortran_unit( *static_cast( ctxt ), msg ); } static std::string debug_prefix( const std::string& libname ) { std::string s = libname; std::transform( s.begin(), s.end(), s.begin(), ::toupper ); s += "_DEBUG"; return s; } void libs_debug_addTarget( LogTarget* target ) { for ( std::string libname : LibraryManager::list() ) { const Library& lib = LibraryManager::lookup( libname ); if ( lib.debug() ) { lib.debugChannel().addTarget( new PrefixTarget( debug_prefix( libname ), target ) ); } } } void libs_debug_setTarget( LogTarget* target ) { for ( std::string libname : LibraryManager::list() ) { const Library& lib = LibraryManager::lookup( libname ); if ( lib.debug() ) { lib.debugChannel().setTarget( new PrefixTarget( debug_prefix( libname ), target ) ); } } } } // namespace namespace fckit { class FortranUnitTarget : public eckit::CallbackTarget { public: FortranUnitTarget( int unit ); private: int unit_; }; FortranUnitTarget::FortranUnitTarget( int unit ) : eckit::CallbackTarget( &write_to_fortran_unit, &unit_ ), unit_( unit ) {} LogTarget* createStyleTarget( LogTarget* target, Log::Style style, const char* prefix ) { if ( style == Log::SIMPLE ) return target; if ( style == Log::PREFIX ) return new eckit::PrefixTarget( prefix, target ); if ( style == Log::TIMESTAMP ) return new eckit::TimeStampTarget( prefix, target ); NOTIMP; } void Log::addFortranUnit( int unit, Style style, const char* ) { LogTarget* funit = new FortranUnitTarget( unit ); info().addTarget( createStyleTarget( funit, style, "(I)" ) ); warning().addTarget( createStyleTarget( funit, style, "(W)" ) ); error().addTarget( createStyleTarget( funit, style, "(E)" ) ); if ( Main::instance().debug() ) debug().addTarget( createStyleTarget( funit, style, "(D)" ) ); libs_debug_addTarget( funit ); } void Log::setFortranUnit( int unit, Style style, const char* ) { LogTarget* funit = new FortranUnitTarget( unit ); info().setTarget( createStyleTarget( funit, style, "(I)" ) ); warning().setTarget( createStyleTarget( funit, style, "(W)" ) ); error().setTarget( createStyleTarget( funit, style, "(E)" ) ); if ( Main::instance().debug() ) debug().setTarget( createStyleTarget( funit, style, "(D)" ) ); libs_debug_setTarget( funit ); } void Log::addFile( const char* path, Style style, const char* ) { LogTarget* file = new eckit::FileTarget( path ); info().addTarget( createStyleTarget( file, style, "(I)" ) ); warning().addTarget( createStyleTarget( file, style, "(W)" ) ); error().addTarget( createStyleTarget( file, style, "(E)" ) ); if ( Main::instance().debug() ) debug().addTarget( createStyleTarget( file, style, "(D)" ) ); libs_debug_addTarget( file ); } void Log::setFile( const char* path, Style style, const char* ) { LogTarget* file = new eckit::FileTarget( path ); info().setTarget( createStyleTarget( file, style, "(I)" ) ); warning().setTarget( createStyleTarget( file, style, "(W)" ) ); error().setTarget( createStyleTarget( file, style, "(E)" ) ); if ( Main::instance().debug() ) debug().setTarget( createStyleTarget( file, style, "(D)" ) ); libs_debug_setTarget( file ); } void Log::addFile( const std::string& path, Style style, const std::string& prefix ) { return addFile( path.c_str(), style, prefix.c_str() ); } void Log::setFile( const std::string& path, Style style, const std::string& prefix ) { return setFile( path.c_str(), style, prefix.c_str() ); } void Log::addStdOut( Style style, const char* ) { LogTarget* stdout = new eckit::OStreamTarget( std::cout ); info().addTarget( createStyleTarget( stdout, style, "(I)" ) ); warning().addTarget( createStyleTarget( stdout, style, "(W)" ) ); error().addTarget( createStyleTarget( stdout, style, "(E)" ) ); if ( Main::instance().debug() ) debug().addTarget( createStyleTarget( stdout, style, "(D)" ) ); libs_debug_addTarget( stdout ); } void Log::setStdOut( Style style, const char* ) { LogTarget* stdout = new eckit::OStreamTarget( std::cout ); info().setTarget( createStyleTarget( stdout, style, "(I)" ) ); warning().setTarget( createStyleTarget( stdout, style, "(W)" ) ); error().setTarget( createStyleTarget( stdout, style, "(E)" ) ); if ( Main::instance().debug() ) debug().setTarget( createStyleTarget( stdout, style, "(D)" ) ); libs_debug_setTarget( stdout ); } int Log::output_unit() { return fckit_fortranunit_stdout(); } int Log::error_unit() { return fckit_fortranunit_stderr(); } void Log::reset() { eckit::Log::reset(); for ( std::string libname : LibraryManager::list() ) { if ( Channel& debug = LibraryManager::lookup( libname ).debugChannel() ) { debug.reset(); } } } void Log::flush() { eckit::Log::flush(); for ( std::string libname : LibraryManager::list() ) { if ( Channel& debug = LibraryManager::lookup( libname ).debugChannel() ) { debug.flush(); } } } } // namespace fckit fckit-0.14.2/src/fckit/Log.h000066400000000000000000000026411514707373700155000ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #pragma once #include "eckit/log/Log.h" namespace fckit { class Log : public eckit::Log { public: enum Style { SIMPLE = 0, PREFIX = 1, TIMESTAMP = 2 }; static void addFortranUnit( int unit, Style = PREFIX, const char* prefix = "" ); static void setFortranUnit( int unit, Style = PREFIX, const char* prefix = "" ); static void addFile( const std::string& path, Style = PREFIX, const std::string& prefix = "" ); static void setFile( const std::string& path, Style = PREFIX, const std::string& prefix = "" ); static void addFile( const char* path, Style = PREFIX, const char* prefix = "" ); static void setFile( const char* path, Style = PREFIX, const char* prefix = "" ); static void addStdOut( Style = PREFIX, const char* prefix = "" ); static void setStdOut( Style = PREFIX, const char* prefix = "" ); static void reset(); static void flush(); // Fortran unit numbers static int output_unit(); static int error_unit(); }; } // namespace fckit fckit-0.14.2/src/fckit/Main.cc000066400000000000000000000247111514707373700160030ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #include "fckit/Main.h" #include #include #include #include #include #include "eckit/config/LibEcKit.h" #include "eckit/exception/Exceptions.h" #include "eckit/mpi/Comm.h" #include "eckit/os/BackTrace.h" #include "eckit/thread/AutoLock.h" #include "eckit/thread/Mutex.h" #include "eckit/thread/Once.h" #include "fckit/Log.h" static eckit::Once local_mutex; using int32 = std::int32_t; namespace fckit { static std::string exception_what; static eckit::CodeLocation exception_location; static std::string exception_callstack; //------------------------------------------------------------------------------------------------------------------ void fckit_terminate() { // This routine is called for uncaught exceptions. // It can be set with std::set_terminate( &fckit_terminate ) Log::flush(); if ( std::exception_ptr eptr = std::current_exception() ) { std::ostream& out = Log::error(); try { std::rethrow_exception( eptr ); // throw to recognise the type } catch ( const eckit::Abort& exception ) { out << "\n" << "=========================================\n" << "Aborting " << Main::instance().displayName() << "\n" << "-----------------------------------------\n" << exception.what() << "\n"; if ( exception.location() ) out << "-----------------------------------------\n" << "LOCATION: " << exception.location() << "\n"; out << "-----------------------------------------\n" << "BACKTRACE\n" << "-----------------------------------------\n" << eckit::BackTrace::dump() << "\n" << "=========================================\n" << std::endl; exception_what = exception.what(); exception_location = exception.location(); exception_callstack = exception.callStack(); } catch ( const eckit::Exception& exception ) { out << "\n" << "=========================================\n" << "TERMINATING " << Main::instance().displayName() << "\n" << "-----------------------------------------\n" << exception.what() << "\n" << "-----------------------------------------\n"; if ( exception.location() ) out << "LOCATION: " << exception.location() << "\n" << "-----------------------------------------\n"; out << "BACKTRACE\n" << "-----------------------------------------\n" << eckit::BackTrace::dump() << "\n" << "=========================================\n" << std::endl; exception_what = exception.what(); exception_location = exception.location(); exception_callstack = eckit::BackTrace::dump(); } catch ( const std::exception& exception ) { out << "\n" << "=========================================\n" << "TERMINATING " << Main::instance().displayName() << "\n" << "-----------------------------------------\n" << exception.what() << "\n" << "-----------------------------------------\n" << "BACKTRACE\n" << "-----------------------------------------\n" << eckit::BackTrace::dump() << "\n" << "=========================================\n" << std::endl; exception_what = exception.what(); exception_location = eckit::CodeLocation(); exception_callstack = eckit::BackTrace::dump(); } catch ( ... ) { out << "\n" << "=========================================\n" << "TERMINATING " << Main::instance().displayName() << "\n" << "-----------------------------------------\n" << "BACKTRACE\n" << "-----------------------------------------\n" << eckit::BackTrace::dump() << "\n" << "=========================================" << std::endl; exception_what = "Uncaught exception"; exception_location = eckit::CodeLocation(); exception_callstack = eckit::BackTrace::dump(); } } eckit::LibEcKit::instance().abort(); // Just in case we end up here, as last resort, exit immediately without // cleanup. std::_Exit( EXIT_FAILURE ); } //------------------------------------------------------------------------------------------------------------------ void fckit_signal_handler( int32 signum ) { Signal signal = Signals::instance().signal( signum ); // Restore default signal handlers in case another signal is raised by // accident fckit::Signals::instance().restoreAllSignalHandlers(); std::ostream& out = fckit::Log::error(); out << "\n" << "=========================================\n" << signal << " (signal intercepted by fckit)\n"; out << "-----------------------------------------\n" << "BACKTRACE\n" << "-----------------------------------------\n" << eckit::BackTrace::dump() << "\n" << "=========================================\n" << std::endl; exception_what = "Signal " + signal.str(); exception_location = eckit::CodeLocation(); exception_callstack = eckit::BackTrace::dump(); eckit::LibEcKit::instance().abort(); // Just in case we end up here, which normally we shouldn't. std::_Exit( EXIT_FAILURE ); } Signals& Signals::instance() { static Signals signals; return signals; } void Signals::restoreSignalHandler( int signum ) { if ( registered_signals_.find( signum ) != registered_signals_.end() ) { eckit::Log::debug() << "\n"; eckit::Log::debug() << "Restoring default signal handler for signal " << registered_signals_[signum] << "\n"; std::signal( signum, SIG_DFL ); eckit::Log::debug() << std::endl; registered_signals_.erase( signum ); } } void Signals::restoreAllSignalHandlers() { eckit::Log::debug() << "\n"; for ( registered_signals_t::const_iterator it = registered_signals_.begin(); it != registered_signals_.end(); ++it ) { eckit::Log::debug() << "Restoring default signal handler for signal " << it->second.str() << "\n"; std::signal( it->first, SIG_DFL ); } eckit::Log::debug() << std::endl; registered_signals_.clear(); } const Signal& Signals::signal( int signum ) const { return registered_signals_.at( signum ); } std::ostream& operator<<( std::ostream& out, const Signal& signal ) { out << signal.str(); return out; } void Signals::setSignalHandlers() { setSignalHandler( SIGABRT ); setSignalHandler( SIGFPE ); setSignalHandler( SIGILL ); setSignalHandler( SIGINT ); setSignalHandler( SIGSEGV ); setSignalHandler( SIGTERM ); setSignalHandler( SIGKILL ); } void Signals::setSignalHandler( const Signal& signal ) { if ( Main::instance().taskID() == 0 ) eckit::Log::debug() << "Registering signal handler for signal " << std::setw( 2 ) << int( signal ) << " [" << signal << "]" << std::endl; registered_signals_[signal] = signal; std::signal( signal, signal.handler() ); } Signal::Signal( int signum ) : signum_( signum ), str_( strsignal( signum ) ), signal_handler_( fckit_signal_handler ) {} Signal::Signal() : signum_( 0 ), str_(), signal_handler_( SIG_DFL ) {} Signal::Signal( int signum, signal_handler_t signal_handler ) : signum_( signum ), str_( strsignal( signum ) ), signal_handler_( signal_handler ) {} Main::Main( int argc, char** argv, const char* homeenv ) : eckit::Main( argc, argv, homeenv ) { std::set_terminate( &fckit_terminate ); for ( int j = 0; j < argc; ++j ) { std::string arg( argv[j] ); if ( arg.find( "--displayname=" ) == 0 ) { size_t pos = arg.find( "--displayname=" ) + 14; displayName_ = arg.substr( pos ); } if ( arg == "--displayname" ) { if ( j + 1 < argc ) displayName_ = argv[j + 1]; } } taskID( eckit::mpi::comm( "world" ).rank() ); eckit::LibEcKit::instance().setAbortHandler( [] { eckit::Log::error() << "[" << eckit::mpi::comm().rank() << "] " << "calling MPI_Abort" << std::endl; eckit::mpi::comm().abort(); } ); } void Main::initialise( int argc, char** argv, const char* homeenv ) { eckit::AutoLock lock( local_mutex ); if ( not ready() ) { new Main( argc, argv, homeenv ); } } void Main::finalise() { eckit::Log::flush(); } #define SUCCESS 0 extern "C" { int32 fckit__exception_what( char*& what, size_t& what_size ) { what_size = exception_what.size(); what = new char[what_size + 1]; ::strcpy( what, exception_what.c_str() ); return SUCCESS; } int32 fckit__exception_location() { return bool( exception_location ); } int32 fckit__exception_file( char*& file, size_t& file_size ) { std::string f = exception_location ? exception_location.file() : ""; file_size = f.size(); file = new char[file_size + 1]; ::strcpy( file, f.c_str() ); return SUCCESS; } int32 fckit__exception_function( char*& function, size_t& function_size ) { std::string f = exception_location ? exception_location.func() : ""; function_size = f.size(); function = new char[function_size + 1]; ::strcpy( function, f.c_str() ); return SUCCESS; } int32 fckit__exception_line() { return exception_location ? exception_location.line() : 0; } int32 fckit__exception_callstack( char*& callstack, size_t& callstack_size ) { std::string f = exception_callstack; callstack_size = f.size(); callstack = new char[callstack_size + 1]; std::strcpy( callstack, f.c_str() ); return SUCCESS; } } } // namespace fckit fckit-0.14.2/src/fckit/Main.h000066400000000000000000000040541514707373700156430ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #pragma once #include #include #include #include #include "eckit/runtime/Main.h" namespace fckit { class Main : public eckit::Main { public: Main( int argc, char** argv, const char* homeenv = 0 ); static void initialise( int argc, char** argv, const char* homeenv = 0 ); static void initialize( int argc, char** argv, const char* homeenv = 0 ) { initialise( argc, argv, homeenv ); } static void finalise(); static void finalize() { finalise(); } }; // ------------------------------------------------------------------------------------ typedef void ( *signal_handler_t )( std::int32_t ); class Signal { public: Signal(); Signal( int signum ); Signal( int signum, signal_handler_t signal_handler ); operator int() const { return signum_; } std::string str() const { return str_; } const signal_handler_t& handler() const { return signal_handler_; } private: friend std::ostream& operator<<( std::ostream&, const Signal& ); int signum_; std::string str_; signal_handler_t signal_handler_; }; // ------------------------------------------------------------------------------------ class Signals { private: Signals() {} public: static Signals& instance(); void setSignalHandlers(); void setSignalHandler( const Signal& ); void restoreSignalHandler( int signum ); void restoreAllSignalHandlers(); const Signal& signal( int signum ) const; private: typedef std::map registered_signals_t; registered_signals_t registered_signals_; }; // ------------------------------------------------------------------------------------ } // namespace fckit fckit-0.14.2/src/fckit/fckit.h.in000066400000000000000000000055671514707373700164760ustar00rootroot00000000000000#if 0 (C) Copyright 2013 ECMWF. This software is licensed under the terms of the Apache Licence Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. In applying this licence, ECMWF does not waive the privileges and immunities granted to it by virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. #endif #if 0 // clang-format off #endif #ifndef FCKIT_H #define FCKIT_H #define FCKIT_GIT_SHA1 "@fckit_GIT_SHA1@" #define FCKIT_VERSION "@fckit_VERSION@" #define FCKIT_HAVE_ECKIT @fckit_HAVE_ECKIT@ #define FCKIT_HAVE_ECKIT_MPI_PARALLEL @fckit_HAVE_ECKIT_MPI_PARALLEL@ #define FCKIT_HAVE_FINAL @fckit_HAVE_FINAL@ #define FCKIT_FINAL_FUNCTION_RESULT @FCKIT_FINAL_FUNCTION_RESULT@ #define FCKIT_FINAL_UNINITIALIZED_LOCAL @FCKIT_FINAL_UNINITIALIZED_LOCAL@ #define FCKIT_FINAL_UNINITIALIZED_INTENT_OUT @FCKIT_FINAL_UNINITIALIZED_INTENT_OUT@ #define FCKIT_FINAL_UNINITIALIZED_INTENT_INOUT @FCKIT_FINAL_UNINITIALIZED_INTENT_INOUT@ #define FCKIT_FINAL_NOT_PROPAGATING @FCKIT_FINAL_NOT_PROPAGATING@ #define FCKIT_FINAL_NOT_INHERITING @FCKIT_FINAL_NOT_INHERITING@ #define FCKIT_FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY @FCKIT_FINAL_BROKEN_FOR_ALLOCATABLE_ARRAY@ #define FCKIT_FINAL_BROKEN_FOR_AUTOMATIC_ARRAY @FCKIT_FINAL_BROKEN_FOR_AUTOMATIC_ARRAY@ #define FCKIT_FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY @FCKIT_FINAL_NOT_INHERITING_FOR_ALLOCATABLE_ARRAY@ #define FCKIT_FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY @FCKIT_FINAL_NOT_INHERITING_FOR_AUTOMATIC_ARRAY@ #define FCKIT_HAVE_ECKIT_TENSOR @FCKIT_HAVE_ECKIT_TENSOR@ #define FCKIT_FINAL impure elemental #define FCKIT_FINAL_DEBUGGING 0 #define FCKIT_SUPPRESS_UNUSED( X ) \ associate( unused_ => X ); \ end associate #define PGIBUG_ATLAS_197 @PGIBUG_ATLAS_197@ #if 0 Following is to workaround PGI bug which prevents the use of function c_ptr() PGI bug present from version 17.10, fixed since version 19.4 #endif #if PGIBUG_ATLAS_197 #define CPTR_PGIBUG_A cpp_object_ptr #define CPTR_PGIBUG_B shared_object_%cpp_object_ptr #else #define CPTR_PGIBUG_A c_ptr() #define CPTR_PGIBUG_B c_ptr() #endif #define PGIBUG_ATLAS_197_DEBUG 0 #if 0 When above PGIBUG_ATLAS_197_DEBUG==1 then the c_ptr() member functions are disabled from compilation, to detect possible dangerous use cases when the PGI bug ATLAS-197 is present. #endif #define XLBUG_FCKIT_14 1 #if 0 Following is to workaround XL bug where allocate( character(len=xxx,kind=c_char ) :: string ) does not compile #endif #if XLBUG_FCKIT_14 #define FCKIT_ALLOCATE_CHARACTER( VARIABLE, SIZE ) allocate( character(len=(SIZE)) :: VARIABLE ) #else #define FCKIT_ALLOCATE_CHARACTER( VARIABLE, SIZE ) allocate( character(len=(SIZE),kind=c_char) :: VARIABLE ) #endif #if 0 // clang-format on #endif #endif fckit-0.14.2/src/fckit/fckit_yaml_reader/000077500000000000000000000000001514707373700202475ustar00rootroot00000000000000fckit-0.14.2/src/fckit/fckit_yaml_reader/fckit_yaml_reader/000077500000000000000000000000001514707373700237135ustar00rootroot00000000000000fckit-0.14.2/src/fckit/fckit_yaml_reader/fckit_yaml_reader/__init__.py000066400000000000000000000006451514707373700260310ustar00rootroot00000000000000# (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. from fckit_yaml_reader.yaml_reader import *fckit-0.14.2/src/fckit/fckit_yaml_reader/fckit_yaml_reader/ruamel_reader.py000066400000000000000000000012531514707373700270750ustar00rootroot00000000000000#!/usr/bin/env python3 # (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. from ruamel.yaml import YAML class ruamel_reader(YAML): """ A minimal wrapper for ruamel.yaml to create an API consistent with pyyaml. """ def __init__(self): super().__init__(typ='safe') def safe_load(self, stream): return self.load(stream) fckit-0.14.2/src/fckit/fckit_yaml_reader/fckit_yaml_reader/yaml_reader.py000066400000000000000000000007471514707373700265610ustar00rootroot00000000000000#!/usr/bin/env python3 # (C) Copyright 2013 ECMWF. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. # In applying this licence, ECMWF does not waive the privileges and immunities # granted to it by virtue of its status as an intergovernmental organisation nor # does it submit to any jurisdiction. from fckit_yaml_reader.ruamel_reader import ruamel_reader as YAML __all__ = ["YAML"]fckit-0.14.2/src/fckit/fckit_yaml_reader/pyproject.toml000066400000000000000000000006141514707373700231640ustar00rootroot00000000000000[build-system] requires = [ "setuptools>=75.0.0", "wheel" ] build-backend = "setuptools.build_meta" [project] name = "fckit_yaml_reader" version = "0.0.1" requires-python = ">=3.8" dependencies = [ "ruamel.yaml==0.18.6", "ruamel.yaml.clib>=0.2.8", "fypp>=3.2" ] license = {text = "Apache-2.0"} description = "A minimal wrapper for ruamel.yaml to create an API consistent with pyyaml." fckit-0.14.2/src/fckit/fctest.F90000066400000000000000000000245621514707373700163640ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. module fctest use, intrinsic :: iso_c_binding, only: c_float, c_double, c_int32_t, c_int64_t, c_char, c_int implicit none integer(c_int32_t), parameter :: sp=c_float integer(c_int32_t), parameter :: dp=c_double public character(len=1024) :: source_file integer(c_int32_t) :: exit_status interface FCE module procedure fctest_check_equal_int32 module procedure fctest_check_equal_int64_int32 module procedure fctest_check_equal_int32_int64 module procedure fctest_check_equal_int64 module procedure fctest_check_equal_real32 module procedure fctest_check_equal_real64 module procedure fctest_check_equal_string module procedure fctest_check_equal_int32_r1 module procedure fctest_check_equal_int64_r1 module procedure fctest_check_equal_real32_r1 module procedure fctest_check_equal_real64_r1 module procedure fctest_check_equal_logical end interface FCE interface FCC module procedure fctest_check_close_real32 module procedure fctest_check_close_real64 module procedure fctest_check_close_real32_r1 module procedure fctest_check_close_real64_r1 end interface FCC interface ERR module procedure fctest_error end interface ERR ! TODO: These should be private ! private :: c_float, c_double, c_int32_t, c_int64_t, c_char contains function sweep_leading_blanks(in_str) character(kind=c_char,len=*), intent(in) :: in_str character(kind=c_char,len=512) :: sweep_leading_blanks character(kind=c_char) :: ch integer(c_int32_t) :: j do j=1, len_trim(in_str) ! get j-th char ch = in_str(j:j) if (ch .ne. " ") then sweep_leading_blanks = trim(in_str(j:len_trim(in_str))) return endif end do end function sweep_leading_blanks subroutine fctest_error(line) integer(c_int32_t), intent(in) :: line write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) exit_status=1 end subroutine subroutine fctest_check_equal_int32(V1,V2,line) integer(c_int32_t), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_int64(V1,V2,line) integer(c_int64_t), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_int64_int32(V1,V2,line) integer(c_int64_t), intent(in) :: V1 integer(c_int32_t), intent(in) :: V2 integer(c_int32_t), intent(in) :: line if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_int32_int64(V1,V2,line) integer(c_int32_t), intent(in) :: V1 integer(c_int64_t), intent(in) :: V2 integer(c_int32_t), intent(in) :: line if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_real32(V1,V2,line) real(kind=c_float), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_real64(V1,V2,line) real(kind=c_double), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_logical(V1,V2,line) logical, intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line if(V1.neqv.V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_string(V1,V2,line) character(kind=c_char,len=*), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_equal_int32_r1(V1,V2,line) integer(c_int32_t), intent(in) :: V1(:), V2(:) integer(c_int32_t), intent(in) :: line logical :: compare = .True. integer(c_int32_t) :: j if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) if( V1(j)/=V2(j) ) compare = .False. enddo endif if( compare .eqv. .False. ) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ] " endif exit_status=1 endif end subroutine subroutine fctest_check_equal_int64_r1(V1,V2,line) integer(c_int64_t), intent(in) :: V1(:), V2(:) integer(c_int32_t), intent(in) :: line logical :: compare = .True. integer(c_int32_t) :: j if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) if( V1(j)/=V2(j) ) compare = .False. enddo endif if( compare .eqv. .False. ) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif exit_status=1 endif end subroutine subroutine fctest_check_equal_real32_r1(V1,V2,line) real(kind=c_float), intent(in) :: V1(:), V2(:) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) if( V1(j)/=V2(j) ) compare = .False. enddo endif if( compare .eqv. .False. ) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif exit_status=1 endif end subroutine subroutine fctest_check_equal_real64_r1(V1,V2,line) real(kind=c_double), intent(in) :: V1(:), V2(:) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) if( V1(j)/=V2(j) ) compare = .False. enddo endif if( compare .eqv. .False. ) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif exit_status=1 endif end subroutine subroutine fctest_check_close_real32(V1,V2,TOL,line) real(kind=c_float), intent(in) :: V1, V2, TOL integer(c_int32_t), intent(in) :: line if(.not.(abs(V1-V2)<=TOL)) then; write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_close_real64(V1,V2,TOL,line) real(kind=c_double), intent(in) :: V1, V2, TOL integer(c_int32_t), intent(in) :: line if(.not.(abs(V1-V2)<=TOL)) then; write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" exit_status=1 endif end subroutine subroutine fctest_check_close_real32_r1(V1,V2,TOL,line) real(kind=c_float), intent(in) :: V1(:), V2(:) real(kind=c_float), intent(in) :: TOL integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) if(.not.(abs(V1(j)-V2(j))<=TOL)) compare = .False. enddo endif if( compare .eqv. .False. ) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif exit_status=1 endif end subroutine subroutine fctest_check_close_real64_r1(V1,V2,TOL,line) real(kind=c_double), intent(in) :: V1(:), V2(:) real(kind=c_double), intent(in) :: TOL integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) if(.not.(abs(V1(j)-V2(j))<=TOL)) compare = .False. enddo endif if( compare .eqv. .False. ) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif exit_status=1 endif end subroutine function get_source_line(line_number) result(source_line) integer(c_int32_t), intent(in) :: line_number ! Variables integer(c_int32_t) stat, jline character(kind=c_char,len=512) :: source_line ! open input file open (10, file=source_file, status='old', iostat=stat) if (stat .ne. 0)then source_line = 'source_file '//trim(source_file)//' can not be opened' close(10) return end if ! process file do jline=1,line_number read (10, '(A)', end=99) source_line ! read line from input file enddo close(10) ! close files 99 continue close (10) end function get_source_line end module fctest fckit-0.14.2/src/fckit/fctest.h000066400000000000000000000045721514707373700162540ustar00rootroot00000000000000#if 0 (C) Copyright 2013 ECMWF. This software is licensed under the terms of the Apache Licence Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. In applying this licence, ECMWF does not waive the privileges and immunities granted to it by virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. #endif #if 0 // clang-format off #endif #ifndef FCTEST_H #define FCTEST_H #include "fckit/fckit.h" ! TESTSUITE macro: defines a new testsuite ! To be closed with the END_TESTSUITE macro #define TESTSUITE( TESTSUITE_NAME ) \ module TESTSUITE_NAME;\ use fctest;\ contains; ! TESTSUITE_WITH_FIXTURE macro: defines a new testsuite ! with a given module as fixture. This fixture can ! be used to import required functionality to test ! To be closed with the END_TESTSUITE macro #define TESTSUITE_WITH_FIXTURE( TESTSUITE_NAME, TESTSUITE_FIXTURE ) \ module TESTSUITE_NAME;\ use fctest;\ use TESTSUITE_FIXTURE;\ contains ! END_TESTSUITE macro: closes a TESTSUITE_ #define END_TESTSUITE end module ! TEST macro: define a new test within a TESTSUITE_ #define TEST( TEST_NAME ) subroutine TEST_NAME; ! END_TEST macro: closes a TEST_ #define END_TEST end subroutine; ! TESTSUITE_INIT macro: define a function to be called before any other test #define TESTSUITE_INIT subroutine testsuite_init ! END_TESTSUITE_INIT macro: closes the TESTSUITE_INIT_ function #define END_TESTSUITE_INIT end subroutine testsuite_init ! TESTSUITE_FINALIZE macro: define a function to be called after any other test #define TESTSUITE_FINALISE subroutine testsuite_finalize #define TESTSUITE_FINALIZE subroutine testsuite_finalize ! END_TESTSUITE_FINALIZE macro: closes the TESTSUITE_FINALIZE_ function #define END_TESTSUITE_FINALIZE end subroutine testsuite_finalize ! CHECK macro: check if an expression is true, otherwise fail the test #define CHECK( EXPR ) if(.not.(EXPR)) call ERR(__LINE__) #define FCTEST_CHECK CHECK ! CHECK_EQUAL macro: check if 2 values are exactly equal #define CHECK_EQUAL(V1,V2) call FCE(V1,V2,__LINE__) #define FCTEST_CHECK_EQUAL CHECK_EQUAL ! CHECK_EQUAL macro: check if 2 REAL values are equal with a given tolerance #define CHECK_CLOSE(V1,V2,TOL) call FCC(V1,V2,TOL,__LINE__) #define FCTEST_CHECK_CLOSE CHECK_CLOSE ! FCTEST_ERROR macro: show error #define FCTEST_ERROR() call ERR(__LINE__) #if 0 // clang-format on #endif #endif fckit-0.14.2/src/fckit/module/000077500000000000000000000000001514707373700160705ustar00rootroot00000000000000fckit-0.14.2/src/fckit/module/fckit.F90000066400000000000000000000106231514707373700174520ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #ifndef FORD #include "fckit/fckit.h" #endif module fckit_module !! author: Willem Deconinck !! !! Interface to fckit, forwarding the most used types, variables, and functions !! use fckit_main_module, only: & fckit_main use fckit_log_module, only: & fckit_log, & log ! DEPRECATED. Use fckit_log instead use fckit_resource_module, only: & fckit_resource use fckit_mpi_module, only: & fckit_mpi_comm, & fckit_mpi use fckit_exception_module, only: & fckit_exception, & fckit_exception_handler use fckit_signal_module, only: & fckit_signal, & fckit_signal_handler use fckit_pathname_module, only: & fckit_pathname use fckit_configuration_module, only: & fckit_configuration, & fckit_YAMLConfiguration, & deallocate_fckit_configuration use fckit_buffer_module, only: & fckit_buffer use fckit_map_module, only: & fckit_map #if FCKIT_HAVE_ECKIT_TENSOR use fckit_tensor_module, only: & fckit_tensor_real32, & fckit_tensor_real64 #endif implicit none private public :: fckit_main !! - [[fckit_main_module:fckit_main(variable)]] public :: fckit_log !! - [[fckit_log_module:fckit_log(variable)]] public :: fckit_resource !! - [[fckit_resource_module:fckit_resource(interface)]] public :: fckit_mpi_comm !! - [[fckit_mpi_module:fckit_mpi_comm(type)]] public :: fckit_mpi !! - [[fckit_mpi_module:fckit_mpi(variable)]] public :: fckit_exception !! - [[fckit_exception_module:fckit_exception(variable)]] public :: fckit_exception_handler !! - [[fckit_exception_module:fckit_exception_handler(interface)]] public :: fckit_signal !! - [[fckit_signal_module:fckit_signal(variable)]] public :: fckit_signal_handler !! - [[fckit_signal_module:fckit_signal_handler(interface)]] public :: fckit_pathname !! - [[fckit_pathname_module:fckit_pathname(type)]] public :: fckit_configuration !! - [[fckit_configuration_module:fckit_configuration(type)]] public :: fckit_YAMLConfiguration !! - [[fckit_configuration_module:fckit_YAMLConfiguration(interface)]] public :: fckit_buffer !! - [[fckit_buffer_module:fckit_buffer(type)]] public :: fckit_map !! - [[fckit_map_module:fckit_map(type)]] public :: fckit_version !! - [[fckit_module:fckit_version(function)]] public :: fckit_git_sha1 !! - [[fckit_module:fckit_git_sha1(function)]] public :: deallocate_fckit_configuration !! - [[fckit_configuration_module:deallocate_fckit_configuration(subroutine)]] #if FCKIT_HAVE_ECKIT_TENSOR public :: fckit_tensor_real32 !! - [[fckit_tensor_module:fckit_tensor_real32(type)]] public :: fckit_tensor_real64 !! - [[fckit_tensor_module:fckit_tensor_real64(type)]] #endif public :: log ! DEPRECATED. Use fckit_log instead. ! ============================================================================= CONTAINS ! ============================================================================= ! ----------------------------------------------------------------------------- function fckit_version() !! Function that returns the version of fckit use, intrinsic :: iso_c_binding, only : c_char character(kind=c_char,len=8) :: fckit_version fckit_version = FCKIT_VERSION end function ! ----------------------------------------------------------------------------- function fckit_git_sha1(length) result( sha1 ) !! Function that returns the git-sha1 of fckit, if compiled from git repository use, intrinsic :: iso_c_binding, only : c_char, c_int32_t character(kind=c_char,len=40) :: sha1 integer(c_int32_t), optional :: length !! Truncate git sha1 to specified length. Default truncates to 7 chars. integer(c_int32_t) :: opt_length opt_length = 7 if( present(length) ) opt_length = length sha1 = FCKIT_GIT_SHA1 sha1 = sha1(1:min(opt_length, 40)) end function ! ----------------------------------------------------------------------------- end module fckit-0.14.2/src/fckit/module/fckit_C_interop.F90000066400000000000000000000160211514707373700214520ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fckit.h" module fckit_C_interop_module implicit none private !======================================================================== ! Public interface public :: c_ptr_free public :: c_ptr_compare_equal public :: c_ptr_to_loc public :: get_c_commandline_arguments public :: c_str_to_string public :: c_ptr_to_string public :: copy_c_ptr_to_string public :: copy_c_str_to_string public :: c_str public :: c_str_no_trim public :: c_str_right_trim public :: fckit_c_deleter_interface public :: fckit_c_deleter public :: fckit_c_nodeleter ! ============================================================================= ! External functions interface subroutine c_ptr_free(ptr) bind(c, name="fckit__cptr_free") use, intrinsic :: iso_c_binding, only: c_ptr type(c_ptr), value :: ptr end subroutine !int fckit__compare_cptr_equal( void* p1, void* p2 ) function fckit__compare_cptr_equal(p1,p2) bind(c,name="fckit__compare_cptr_equal") result(equal) use, intrinsic :: iso_c_binding, only: c_ptr, c_int32_t integer(c_int32_t) :: equal type(c_ptr), value :: p1 type(c_ptr), value :: p2 end function function fckit__cptr_to_loc(cptr) bind(c,name="fckit__cptr_to_loc") result(loc) use, intrinsic :: iso_c_binding, only: c_ptr, c_int64_t integer(c_int64_t) :: loc type(c_ptr), value :: cptr end function end interface abstract interface subroutine fckit_c_deleter_interface(cptr) bind(c) use, intrinsic :: iso_c_binding type(c_ptr), value :: cptr end subroutine end interface ! ============================================================================= CONTAINS ! ============================================================================= function fckit_c_deleter( deleter ) use, intrinsic :: iso_c_binding, only : c_funloc, c_funptr type(c_funptr) :: fckit_c_deleter procedure(fckit_c_deleter_interface) :: deleter fckit_c_deleter = c_funloc(deleter) end function subroutine fckit_c_nodelete(cptr) bind(c) use, intrinsic :: iso_c_binding type(c_ptr), value :: cptr FCKIT_SUPPRESS_UNUSED(cptr) end subroutine function fckit_c_nodeleter() use, intrinsic :: iso_c_binding, only : c_funloc, c_funptr type(c_funptr) :: fckit_c_nodeleter fckit_c_nodeleter = c_funloc(fckit_c_nodelete) end function function c_ptr_compare_equal(p1,p2) result(equal) use, intrinsic :: iso_c_binding, only: c_ptr logical :: equal type(c_ptr), intent(in) :: p1, p2 if( fckit__compare_cptr_equal(p1,p2) == 1 ) then equal = .True. else equal = .False. endif end function function c_ptr_to_loc(cptr) result(loc) use, intrinsic :: iso_c_binding, only: c_ptr, c_int64_t integer(c_int64_t) :: loc type(c_ptr), intent(in) :: cptr loc = fckit__cptr_to_loc(cptr) end function ! ============================================================================= subroutine get_c_commandline_arguments(argc,argv) use, intrinsic :: iso_c_binding integer(c_int), intent(out) :: argc type(c_ptr), intent(inout) :: argv(:) character(kind=c_char,len=1), save, target :: args(255) character(kind=c_char,len=255), save, target :: cmd character(kind=c_char,len=255) :: arg integer(c_int) :: iarg, arglen, pos, ich, argpos call get_command(cmd) do ich=1,len(cmd) if (cmd(ich:ich) == " ") then cmd(ich:ich) = c_null_char exit endif enddo argv(1) = c_loc(cmd(1:1)) argc = command_argument_count()+1 pos = 1 do iarg=1,argc argpos = pos call get_command_argument(iarg, arg ) arglen = len_trim(arg) do ich=1,arglen args(pos) = arg(ich:ich) pos = pos+1 end do args(pos) = c_null_char; pos = pos+1 args(pos) = " "; pos = pos+1 argv(iarg+1) = c_loc(args(argpos)) enddo end subroutine ! ============================================================================= function c_str_to_string(s) result(string) use, intrinsic :: iso_c_binding character(kind=c_char,len=1), intent(in) :: s(*) character(len=:), allocatable :: string integer i, nchars i = 1 do if (s(i) == c_null_char) exit i = i + 1 enddo nchars = i - 1 ! Exclude null character from Fortran string FCKIT_ALLOCATE_CHARACTER(string,nchars) do i=1,nchars string(i:i) = s(i) enddo end function ! ============================================================================= subroutine copy_c_str_to_string(s,string) use, intrinsic :: iso_c_binding character(kind=c_char,len=1), intent(in) :: s(:) character(len=:), allocatable :: string integer i, nchars do i = 1, size(s) if (s(i) == c_null_char) exit enddo nchars = i - 1 ! Exclude null character from Fortran string FCKIT_ALLOCATE_CHARACTER(string,nchars) do i=1,nchars string(i:i) = s(i) enddo end subroutine ! ============================================================================= subroutine copy_c_ptr_to_string(cptr,string) use, intrinsic :: iso_c_binding type(c_ptr), intent(in) :: cptr character(kind=c_char,len=:), allocatable :: string character(kind=c_char), dimension(:), pointer :: s integer(c_int), parameter :: MAX_STR_LEN = 2550 call c_f_pointer ( cptr , s, (/MAX_STR_LEN/) ) call copy_c_str_to_string( s, string ) end subroutine ! ============================================================================= function c_ptr_to_string(cptr) result(string) use, intrinsic :: iso_c_binding type(c_ptr), intent(in) :: cptr character(kind=c_char,len=:), allocatable :: string character(kind=c_char), dimension(:), pointer :: s integer(c_int), parameter :: MAX_STR_LEN = 2550 call c_f_pointer ( cptr , s, (/MAX_STR_LEN/) ) call copy_c_str_to_string( s, string ) end function ! ============================================================================= function c_str(f_str) use, intrinsic :: iso_c_binding, only: c_char, c_null_char character(kind=c_char,len=*), intent(in) :: f_str character(kind=c_char,len=len_trim(f_str)+1) :: c_str c_str = trim(f_str) // c_null_char end function ! ============================================================================= function c_str_no_trim(f_str) use, intrinsic :: iso_c_binding, only: c_char, c_null_char character(kind=c_char,len=*), intent(in) :: f_str character(kind=c_char,len=len(f_str)+1) :: c_str_no_trim c_str_no_trim = f_str // c_null_char end function ! ============================================================================= function c_str_right_trim(f_str) use, intrinsic :: iso_c_binding, only: c_char, c_null_char character(kind=c_char,len=*), intent(in) :: f_str character(kind=c_char,len=len(f_str)+1) :: c_str_right_trim c_str_right_trim = f_str(1:len_trim(f_str)) // c_null_char end function ! ============================================================================= end module fckit-0.14.2/src/fckit/module/fckit_C_interop.cc000066400000000000000000000013661514707373700215070ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #include #include using int32 = std::int32_t; using int64 = std::int64_t; extern "C" { void fckit__cptr_free( void* ptr[] ) { delete[] ptr; ptr = 0; } int32 fckit__compare_cptr_equal( void* p1, void* p2 ) { return ( p1 == p2 ); } int64 fckit__cptr_to_loc( void* ptr ) { std::intptr_t i = (std::intptr_t)ptr; return i; } } fckit-0.14.2/src/fckit/module/fckit_array.F90000066400000000000000000001312661514707373700206570ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit.h" module fckit_array_module use, intrinsic :: iso_c_binding, only: c_int32_t, c_int64_t, c_float, c_double implicit none private !======================================================================== ! Public interface public :: array_view1d public :: array_stride public :: array_strides !======================================================================== private :: c_int32_t, c_int64_t, c_float, c_double integer(c_int32_t), target :: zero_length_array_int32(0) integer(c_int64_t),target :: zero_length_array_int64(0) real(c_float), target :: zero_length_array_real32(0) real(c_double), target :: zero_length_array_real64(0) logical, target :: zero_length_array_logical(0) interface array_view1d module procedure array_view1d_int32_r0 module procedure array_view1d_int32_r1 module procedure array_view1d_int32_r2 module procedure array_view1d_int32_r3 module procedure array_view1d_int32_r4 module procedure array_view1d_int64_r0 module procedure array_view1d_int64_r1 module procedure array_view1d_int64_r2 module procedure array_view1d_int64_r3 module procedure array_view1d_int64_r4 module procedure array_view1d_real32_r0 module procedure array_view1d_real32_r1 module procedure array_view1d_real32_r2 module procedure array_view1d_real32_r3 module procedure array_view1d_real32_r4 module procedure array_view1d_real64_r0 module procedure array_view1d_real64_r1 module procedure array_view1d_real64_r2 module procedure array_view1d_real64_r3 module procedure array_view1d_real64_r4 module procedure array_view1d_logical_r0 module procedure array_view1d_logical_r1 module procedure array_view1d_logical_r2 module procedure array_view1d_logical_r3 module procedure array_view1d_logical_r4 module procedure array_view1d_logical_r0_mold_int32 module procedure array_view1d_logical_r1_mold_int32 module procedure array_view1d_logical_r2_mold_int32 module procedure array_view1d_logical_r3_mold_int32 module procedure array_view1d_logical_r4_mold_int32 end interface interface array_stride module procedure array_stride_int32_r1_dim module procedure array_stride_int32_r2_dim module procedure array_stride_int32_r3_dim module procedure array_stride_int32_r4_dim module procedure array_stride_int64_r1_dim module procedure array_stride_int64_r2_dim module procedure array_stride_int64_r3_dim module procedure array_stride_int64_r4_dim module procedure array_stride_real32_r1_dim module procedure array_stride_real32_r2_dim module procedure array_stride_real32_r3_dim module procedure array_stride_real32_r4_dim module procedure array_stride_real64_r1_dim module procedure array_stride_real64_r2_dim module procedure array_stride_real64_r3_dim module procedure array_stride_real64_r4_dim module procedure array_stride_logical_r1_dim module procedure array_stride_logical_r2_dim module procedure array_stride_logical_r3_dim module procedure array_stride_logical_r4_dim end interface interface array_strides module procedure array_stride_int32_r1 module procedure array_stride_int32_r2 module procedure array_stride_int32_r3 module procedure array_stride_int32_r4 module procedure array_stride_int64_r1 module procedure array_stride_int64_r2 module procedure array_stride_int64_r3 module procedure array_stride_int64_r4 module procedure array_stride_real32_r1 module procedure array_stride_real32_r2 module procedure array_stride_real32_r3 module procedure array_stride_real32_r4 module procedure array_stride_real64_r1 module procedure array_stride_real64_r2 module procedure array_stride_real64_r3 module procedure array_stride_real64_r4 module procedure array_stride_logical_r1 module procedure array_stride_logical_r2 module procedure array_stride_logical_r3 module procedure array_stride_logical_r4 end interface ! ============================================================================= CONTAINS ! ============================================================================= function c_loc_int32(x) use, intrinsic :: iso_c_binding integer(c_int32_t), target :: x type(c_ptr) :: c_loc_int32 c_loc_int32 = c_loc(x) end function ! ============================================================================= function c_loc_int64(x) use, intrinsic :: iso_c_binding integer(c_int64_t), target :: x type(c_ptr) :: c_loc_int64 c_loc_int64 = c_loc(x) end function ! ============================================================================= function c_loc_real32(x) use, intrinsic :: iso_c_binding real(c_float), target :: x type(c_ptr) :: c_loc_real32 c_loc_real32 = c_loc(x) end function ! ============================================================================= function c_loc_real64(x) use, intrinsic :: iso_c_binding real(c_double), target :: x type(c_ptr) :: c_loc_real64 c_loc_real64 = c_loc(x) end function ! ============================================================================= function c_loc_logical(x) use, intrinsic :: iso_c_binding logical, target :: x type(c_ptr) :: c_loc_logical c_loc_logical = c_loc(x) end function ! ============================================================================= ! view interface ! ============================================================================= function array_view1d_int32_r0(scalar,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int32_t), intent(in), target :: scalar integer(c_int32_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) array_c_ptr = c_loc_int32(scalar) call c_f_pointer ( array_c_ptr , view , (/1/) ) if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int32_r1(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int32_t), intent(in), target :: array(:) integer(c_int32_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int32(array(1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int32_r2(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int32_t), intent(in), target :: array(:,:) integer(c_int32_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int32(array(1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int32_r3(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int32_t), intent(in), target :: array(:,:,:) integer(c_int32_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int32(array(1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int32_r4(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int32_t), intent(in), target :: array(:,:,:,:) integer(c_int32_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int32(array(1,1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int64_r0(scalar,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int64_t), intent(in), target :: scalar integer(c_int64_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int64_t), pointer :: view(:) nullify(view) array_c_ptr = c_loc_int64(scalar) call c_f_pointer ( array_c_ptr , view , (/1/) ) if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int64_r1(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int64_t), intent(in), target :: array(:) integer(c_int64_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int64_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int64(array(1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int64_r2(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int64_t), intent(in), target :: array(:,:) integer(c_int64_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int64_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int64(array(1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int64_r3(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int64_t), intent(in), target :: array(:,:,:) integer(c_int64_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int64_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int64(array(1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_int64_r4(array,mold) result( view ) use, intrinsic :: iso_c_binding integer(c_int64_t), intent(in), target :: array(:,:,:,:) integer(c_int64_t), intent(in), optional :: mold type(c_ptr) :: array_c_ptr integer(c_int64_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_int64(array(1,1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real32_r0(scalar,mold) result( view ) use, intrinsic :: iso_c_binding real(c_float), intent(in), target :: scalar real(c_float), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_float), pointer :: view(:) nullify(view) array_c_ptr = c_loc_real32(scalar) call c_f_pointer ( array_c_ptr , view , (/1/) ) if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real32_r1(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_float), intent(in), target :: array(:) real(c_float), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_float), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real32(array(1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real32_r2(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_float), intent(in), target :: array(:,:) real(c_float), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_float), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real32(array(1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real32_r3(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_float), intent(in), target :: array(:,:,:) real(c_float), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_float), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real32(array(1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real32_r4(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_float), intent(in), target :: array(:,:,:,:) real(c_float), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_float), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real32(array(1,1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real32 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real64_r0(scalar,mold) result( view ) use, intrinsic :: iso_c_binding real(c_double), intent(in), target :: scalar real(c_double), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_double), pointer :: view(:) nullify(view) array_c_ptr = c_loc_real64(scalar) call c_f_pointer ( array_c_ptr , view , (/1/) ) if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real64_r1(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_double), intent(in), target :: array(:) real(c_double), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_double), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real64(array(1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real64_r2(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_double), intent(in), target :: array(:,:) real(c_double), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_double), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real64(array(1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real64_r3(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_double), intent(in), target :: array(:,:,:) real(c_double), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_double), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real64(array(1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_real64_r4(array,mold) result( view ) use, intrinsic :: iso_c_binding real(c_double), intent(in), target :: array(:,:,:,:) real(c_double), intent(in), optional :: mold type(c_ptr) :: array_c_ptr real(c_double), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_real64(array(1,1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_real64 endif if (present(mold)) then FCKIT_SUPPRESS_UNUSED(mold) endif end function ! ============================================================================= function array_view1d_logical_r0(scalar) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: scalar type(c_ptr) :: array_c_ptr logical, pointer :: view(:) nullify(view) array_c_ptr = c_loc_logical(scalar) call c_f_pointer ( array_c_ptr , view , (/1/) ) end function ! ============================================================================= function array_view1d_logical_r1(array) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:) type(c_ptr) :: array_c_ptr logical, pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_logical endif end function ! ============================================================================= function array_view1d_logical_r2(array) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:,:) type(c_ptr) :: array_c_ptr logical, pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_logical endif end function ! ============================================================================= function array_view1d_logical_r3(array) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:,:,:) type(c_ptr) :: array_c_ptr logical, pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_logical endif end function ! ============================================================================= function array_view1d_logical_r4(array) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:,:,:,:) type(c_ptr) :: array_c_ptr logical, pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1,1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_logical endif end function ! ============================================================================= function array_view1d_logical_r0_mold_int32(scalar,mold) result( view ) use, intrinsic :: iso_c_binding logical, intent(in) :: scalar integer(c_int32_t), intent(in) :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) array_c_ptr = c_loc_logical(scalar) call c_f_pointer ( array_c_ptr , view , (/1/) ) FCKIT_SUPPRESS_UNUSED(mold) end function ! ============================================================================= function array_view1d_logical_r1_mold_int32(array,mold) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:) integer(c_int32_t), intent(in) :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif FCKIT_SUPPRESS_UNUSED(mold) end function ! ============================================================================= function array_view1d_logical_r2_mold_int32(array,mold) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:,:) integer(c_int32_t), intent(in) :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif FCKIT_SUPPRESS_UNUSED(mold) end function ! ============================================================================= function array_view1d_logical_r3_mold_int32(array,mold) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:,:,:) integer(c_int32_t), intent(in) :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif FCKIT_SUPPRESS_UNUSED(mold) end function ! ============================================================================= function array_view1d_logical_r4_mold_int32(array,mold) result( view ) use, intrinsic :: iso_c_binding logical, intent(in), target :: array(:,:,:,:) integer(c_int32_t), intent(in) :: mold type(c_ptr) :: array_c_ptr integer(c_int32_t), pointer :: view(:) nullify(view) if( size(array) > 0 ) then array_c_ptr = c_loc_logical(array(1,1,1,1)) call c_f_pointer ( array_c_ptr , view , (/size(array)/) ) else view => zero_length_array_int32 endif FCKIT_SUPPRESS_UNUSED(mold) end function ! ============================================================================= ! stride interface function array_stride_int32_r1_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int32_t), target :: arr(:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2)))-c_ptr_to_loc(c_loc(arr(1))),c_int32_t)/int(4,c_int32_t) end function ! ============================================================================= function array_stride_int32_r2_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int32_t), target :: arr(:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_int32_r3_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int32_t), target :: arr(:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_int32_r4_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int32_t), target :: arr(:,:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 4 .AND. ubound(arr,4) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_int64_r1_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int64_t), target :: arr(:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2)))-c_ptr_to_loc(c_loc(arr(1))),c_int32_t)/int(4,c_int32_t) end function ! ============================================================================= function array_stride_int64_r2_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int64_t),target :: arr(:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_int64_r3_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int64_t),target :: arr(:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_int64_r4_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module integer(c_int64_t),target :: arr(:,:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 4 .AND. ubound(arr,4) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real32_r1_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_float),target :: arr(:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2)))-c_ptr_to_loc(c_loc(arr(1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real32_r2_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_float),target :: arr(:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real32_r3_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_float),target :: arr(:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real32_r4_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_float),target :: arr(:,:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 4 .AND. ubound(arr,4) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real64_r1_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_double),target :: arr(:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2)))-c_ptr_to_loc(c_loc(arr(1))),c_int32_t)/int(8,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real64_r2_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_double),target :: arr(:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr)>0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(8,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(8,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real64_r3_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_double),target :: arr(:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr)>0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(8,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(8,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(8,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_real64_r4_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module real(c_double),target :: arr(:,:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr)>0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(8,c_int32_t) if (dim == 2) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(8,c_int32_t) if (dim == 3) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(8,c_int32_t) if (dim == 4) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(8,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_logical_r1_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module logical,target :: arr(:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr) > 0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2)))-c_ptr_to_loc(c_loc(arr(1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_logical_r2_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module logical,target :: arr(:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr)>0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2)))-c_ptr_to_loc(c_loc(arr(1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_logical_r3_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module logical,target :: arr(:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr)>0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2 .AND. ubound(arr,2) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3 .AND. ubound(arr,3) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= function array_stride_logical_r4_dim(arr,dim) result( stride ) use, intrinsic :: iso_c_binding use :: fckit_c_interop_module logical,target :: arr(:,:,:,:) integer(c_int32_t) :: dim integer(c_int32_t) :: stride stride = 1 if( size(arr)>0 ) then if (dim == 1 .AND. ubound(arr,1) > 1) stride = & int(c_ptr_to_loc(c_loc(arr(2,1,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 2) stride = & int(c_ptr_to_loc(c_loc(arr(1,2,1,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 3) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,2,1)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) if (dim == 4) stride = & int(c_ptr_to_loc(c_loc(arr(1,1,1,2)))-c_ptr_to_loc(c_loc(arr(1,1,1,1))),c_int32_t)/int(4,c_int32_t) else stride = 0 endif end function ! ============================================================================= ! stride interface function array_stride_int32_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int32_t) :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_int32_r1_dim(arr,1) end function ! ============================================================================= function array_stride_int32_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int32_t) :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_int32_r2_dim(arr,1) stride_(2) = array_stride_int32_r2_dim(arr,2) end function ! ============================================================================= function array_stride_int32_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int32_t) :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_int32_r3_dim(arr,1) stride_(2) = array_stride_int32_r3_dim(arr,2) stride_(3) = array_stride_int32_r3_dim(arr,3) end function ! ============================================================================= function array_stride_int32_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int32_t) :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_int32_r4_dim(arr,1) stride_(2) = array_stride_int32_r4_dim(arr,2) stride_(3) = array_stride_int32_r4_dim(arr,3) stride_(4) = array_stride_int32_r4_dim(arr,4) end function ! ============================================================================= function array_stride_int64_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int64_t) :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_int64_r1_dim(arr,1) end function ! ============================================================================= function array_stride_int64_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int64_t) :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_int64_r2_dim(arr,1) stride_(2) = array_stride_int64_r2_dim(arr,2) end function ! ============================================================================= function array_stride_int64_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int64_t) :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_int64_r3_dim(arr,1) stride_(2) = array_stride_int64_r3_dim(arr,2) stride_(3) = array_stride_int64_r3_dim(arr,3) end function ! ============================================================================= function array_stride_int64_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding integer(c_int64_t) :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_int64_r4_dim(arr,1) stride_(2) = array_stride_int64_r4_dim(arr,2) stride_(3) = array_stride_int64_r4_dim(arr,3) stride_(4) = array_stride_int64_r4_dim(arr,4) end function ! ============================================================================= function array_stride_real32_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_float) :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_real32_r1_dim(arr,1) end function ! ============================================================================= function array_stride_real32_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_float) :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_real32_r2_dim(arr,1) stride_(2) = array_stride_real32_r2_dim(arr,2) end function ! ============================================================================= function array_stride_real32_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_float) :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_real32_r3_dim(arr,1) stride_(2) = array_stride_real32_r3_dim(arr,2) stride_(3) = array_stride_real32_r3_dim(arr,3) end function ! ============================================================================= function array_stride_real32_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_float) :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_real32_r4_dim(arr,1) stride_(2) = array_stride_real32_r4_dim(arr,2) stride_(3) = array_stride_real32_r4_dim(arr,3) stride_(4) = array_stride_real32_r4_dim(arr,4) end function ! ============================================================================= function array_stride_real64_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_double) :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_real64_r1_dim(arr,1) end function ! ============================================================================= function array_stride_real64_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_double) :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_real64_r2_dim(arr,1) stride_(2) = array_stride_real64_r2_dim(arr,2) end function ! ============================================================================= function array_stride_real64_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_double) :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_real64_r3_dim(arr,1) stride_(2) = array_stride_real64_r3_dim(arr,2) stride_(3) = array_stride_real64_r3_dim(arr,3) end function ! ============================================================================= function array_stride_real64_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding real(c_double) :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_real64_r4_dim(arr,1) stride_(2) = array_stride_real64_r4_dim(arr,2) stride_(3) = array_stride_real64_r4_dim(arr,3) stride_(4) = array_stride_real64_r4_dim(arr,4) end function ! ============================================================================= function array_stride_logical_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding logical :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_logical_r1_dim(arr,1) end function ! ============================================================================= function array_stride_logical_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding logical :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_logical_r2_dim(arr,1) stride_(2) = array_stride_logical_r2_dim(arr,2) end function ! ============================================================================= function array_stride_logical_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding logical :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_logical_r3_dim(arr,1) stride_(2) = array_stride_logical_r3_dim(arr,2) stride_(3) = array_stride_logical_r3_dim(arr,3) end function ! ============================================================================= function array_stride_logical_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding logical :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_logical_r4_dim(arr,1) stride_(2) = array_stride_logical_r4_dim(arr,2) stride_(3) = array_stride_logical_r4_dim(arr,3) stride_(4) = array_stride_logical_r4_dim(arr,4) end function ! ============================================================================= end module fckit-0.14.2/src/fckit/module/fckit_buffer.F90000066400000000000000000000075521514707373700210120ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fckit.h" module fckit_buffer_module !! Wrap eckit Buffer capabilities. use fckit_shared_object_module, only: fckit_shared_object, fckit_c_deleter, fckit_c_nodeleter implicit none private :: fckit_shared_object private :: fckit_c_deleter private :: fckit_c_nodeleter !======================================================================== ! Public interface public :: fckit_buffer private interface !------------------------------------------------------------------------------- ! int c_fckit_buffer_str( const eckit::Buffer* This, const ! char* &str, size_t &size) !------------------------------------------------------------------------------- function c_fckit_buffer_str( This, str, size ) bind(C,name="c_fckit_buffer_str") use iso_c_binding, only: c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_buffer_str type(c_ptr), value :: This type(c_ptr) :: str integer(c_size_t) :: size end function !------------------------------------------------------------------------------- subroutine c_fckit_buffer_delete( this ) bind(C, name="c_fckit_buffer_delete") use iso_c_binding, only: c_ptr type(c_ptr), value :: this end subroutine end interface !======================================================================== type, extends(fckit_shared_object) :: fckit_buffer !! Buffer !! !! Can contain any data !! A typical use case is with the function [[fckit_mpi_module:fckit_mpi_comm(type):broadcast_file(function)]] !! where a file is read on one MPI task, and broadcast to all MPI tasks, storing it in a buffer. !! This buffer can then be used to construct a configuration !! (see e.g. [[fckit_configuration_module:fckit_YAMLConfiguration(interface)]] ) contains procedure, public :: str #if FCKIT_FINAL_NOT_INHERITING final :: fckit_buffer__final_auto #endif endtype interface fckit_buffer module procedure ctor_from_cptr end interface !======================================================================== contains !--------------------------------------------------------------------------------------- function ctor_from_cptr(cptr, share) result(this) use, intrinsic :: iso_c_binding, only : c_ptr type(c_ptr), value :: cptr type(fckit_buffer) :: this logical, optional :: share logical :: opt_share opt_share = .false. if( present(share) ) opt_share = share if( opt_share ) then call this%reset_c_ptr( cptr , fckit_c_deleter(c_fckit_buffer_delete) ) else call this%reset_c_ptr( cptr , fckit_c_nodeleter() ) endif call this%return() end function !--------------------------------------------------------------------------------------- function str(this) use, intrinsic :: iso_c_binding, only: c_ptr, c_int32_t, c_size_t, c_char use fckit_c_interop_module character(kind=c_char,len=:), allocatable :: str class(fckit_buffer), intent(in) :: this integer(c_int32_t) :: errcode integer(c_size_t) :: str_size type(c_ptr) :: str_cptr errcode = c_fckit_buffer_str(this%CPTR_PGIBUG_B,str_cptr,str_size) FCKIT_ALLOCATE_CHARACTER(str,str_size) str = c_ptr_to_string(str_cptr) call c_ptr_free(str_cptr) end function !======================================================================== #if FCKIT_FINAL_NOT_INHERITING FCKIT_FINAL subroutine fckit_buffer__final_auto(this) type(fckit_buffer), intent(inout) :: this #if FCKIT_FINAL_DEBUGGING write(0,*) "fckit_buffer__final_auto" #endif #if FCKIT_FINAL_NOT_PROPAGATING call this%final() #endif FCKIT_SUPPRESS_UNUSED( this ) end subroutine #endif end module fckit-0.14.2/src/fckit/module/fckit_buffer.cc000066400000000000000000000015371514707373700210360ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #include #include #include #include "eckit/io/SharedBuffer.h" using int32 = std::int32_t; using size_t = std::size_t; extern "C" { int32 c_fckit_buffer_str( const eckit::Buffer* This, char*& str, size_t& size ) { std::string s( *This, This->size() ); size = s.size() + 1; str = new char[size]; strcpy( str, s.c_str() ); return true; } void c_fckit_buffer_delete( eckit::CountedBuffer* This ) { delete This; } } fckit-0.14.2/src/fckit/module/fckit_configuration.F90000066400000000000000000001071371514707373700224100ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fckit.h" module fckit_configuration_module !! author: Willem Deconinck !! !! Module providing the [[fckit_configuration_module:fckit_configuration(type)]] type !! !! The [[fckit_configuration_module:fckit_configuration(type)]] type can be used to !! encapsulate name-value configurations, including nesting of subconfigurations. !! !! The [[fckit_configuration_module:fckit_YAMLConfiguration(interface)]] constructor !! for [[fckit_configuration_module:fckit_configuration(type)]] can create the !! configuration from a YAML file use, intrinsic :: iso_c_binding, only : c_ptr, c_int32_t, c_int64_t, c_float, c_double, c_size_t, c_char use fckit_shared_object_module, only : fckit_shared_object, fckit_c_deleter, fckit_c_nodeleter use fckit_pathname_module, only : fckit_pathname use fckit_buffer_module, only : fckit_buffer implicit none public :: fckit_configuration public :: fckit_YAMLConfiguration public :: deallocate_fckit_configuration private #include "fckit_configuration.inc" !---------------------------------------------------------------------------- TYPE, extends(fckit_shared_object) :: fckit_configuration !! Name-Value configuration type !! !! Names are strings, and values can be !! !! - basic types int32, int64, real32, real64, string, or arrays of these. !! - arrays of basic types !! - Subconfiguration, or arrays of subconfigurations !! !!#### Example construction !! !! From JSON or YAML file (all MPI tasks read) !! !!```fortran !! type(fckit_configuration) :: config !! config = fckit_YAMLConfiguration( fckit_pathname("filepath" ) !!``` !! !! From JSON or YAML file (only one MPI task reads, and broadcasts) !! !!```fortran !! type(fckit_configuration) :: config !! type(fckit_mpi_comm) :: comm !! comm = fckit_mpi_comm("world") !! config = fckit_YAMLConfiguration( comm%broadcast_file("filepath", root=0) ) !!``` contains #if FCKIT_FINAL_NOT_INHERITING final :: fckit_configuration__final_auto #endif procedure, public :: size => fckit_configuration_size !! Function that returns the number of entries procedure, public :: key procedure, public :: has !! Function that returns whether a name is contained in the configuration !! !!#### Example usage: !! !!```fortran !! if( .not. fckit_configuration%has('levels') ) call abort() !!``` procedure, public :: get_size !! Function that returns the size of a name in the configuration !! !!#### Example usage: !! !!```fortran !! nlev = fckit_configuration%get_size('levels') !!``` procedure, private :: set_config procedure, private :: set_config_list procedure, private :: set_logical procedure, private :: set_int32 procedure, private :: set_int64 procedure, private :: set_real32 procedure, private :: set_real64 procedure, private :: set_string procedure, private :: set_array_string procedure, private :: set_array_int32 procedure, private :: set_array_int64 procedure, private :: set_array_real32 procedure, private :: set_array_real64 !---------------------------------------------------------------------------- !> Subroutine to set a name-value configuration !! !! Name is a string, and value any of the basic types, or subconfigurations !! !!#### Example usage !! !!```fortran !! type(fckit_configuration) :: config !! config = fckit_configuration() !! call config%set('grid','O1280') !! call config%set('levels',137) !!``` !! Or with subconfiguration: !! !!```fortran !! type(fckit_configuration) :: config !! type(fckit_configuration) :: grid_config !! !! grid_config = fckit_configuration() !! call grid_config%set('type','reduced_gaussian') !! call grid_config%set('pl',[20,24,28,32,32,28,24,20]) !! call grid_config%set('levels',137) !! !! config = fckit_configuration() !! call config%set('grid',grid_config) !!``` generic, public :: set => & set_config, & set_config_list, & set_logical, & set_int32, & set_int64, & set_real32, & set_real64, & set_string, & set_array_string, & set_array_int32, & set_array_int64, & set_array_real32, & set_array_real64 procedure, private :: get_config procedure, private :: get_config_list procedure, private :: get_int32 procedure, private :: get_int64 procedure, private :: get_logical procedure, private :: get_real32 procedure, private :: get_real64 procedure, private :: get_string procedure, private :: get_array_logical procedure, private :: get_array_int32 procedure, private :: get_array_int64 procedure, private :: get_array_real32 procedure, private :: get_array_real64 procedure, private :: get_array_string !---------------------------------------------------------------------------- !> Function that gets a name-value configuration !! !! Name is a string, and value any of the basic types, or subconfigurations !! !! @Note !! This is a function that returns a logical which is ```.true.``` if the name is found !! in the configuration, and ```.false.``` otherwise. !! @Endnote !! !!#### Example usage !! !!```fortran !! type(fckit_configuration), intent(in) :: config !! character(kind=c_char,len=:), allocatable :: grid_id !! integer(c_int32_t) :: levels !! if( .not. config%get('grid',grid_id) ) then !! grid_id = 'O1280' ! Default if not found !! endif !! if( .not. config%get('levels',levels) ) then !! levels = 137 ! Default if not found !! endif !!``` !! Or with subconfiguration: !! !!```fortran !! type(fckit_configuration), intent(in) :: config !! type(fckit_configuration) :: grid_config !! character(kind=c_char,len=:), allocatable :: grid_type !! integer(c_int32_t) :: grid_levels !! integer, allocatable :: grid_pl(:) !! !! if( .not. config%get('grid',grid_config) ) then !! ! You could abort, or create a default grid_config: !! grid_config = fckit_configuration() !! call grid_config%set('type','reduced_gaussian') !! call grid_config%set('pl',[20,24,28,32,32,28,24,20]) !! call grid_config%set('levels',137) !! endif !! if( .not. grid_config%get('type',grid_type) ) call abort() !! if( .not. grid_config%get('pl',grid_pl) ) call abort() !! if( .not. grid_config%get('levels',levels) ) call abort() !!``` generic, public :: get => & get_config, & get_config_list, & get_int32, & get_int64, & get_logical, & get_real32, & get_real64, & get_string, & get_array_logical, & get_array_int32, & get_array_int64, & get_array_real32, & get_array_real64, & get_array_string procedure, private :: get_config_or_die procedure, private :: get_config_list_or_die procedure, private :: get_int32_or_die procedure, private :: get_int64_or_die procedure, private :: get_logical_or_die procedure, private :: get_real32_or_die procedure, private :: get_real64_or_die procedure, private :: get_string_or_die procedure, private :: get_array_logical_or_die procedure, private :: get_array_int32_or_die procedure, private :: get_array_int64_or_die procedure, private :: get_array_real32_or_die procedure, private :: get_array_real64_or_die procedure, private :: get_array_string_or_die !---------------------------------------------------------------------------- !> Subroutine that gets a name-value configuration, and throws exception !! when not found !! !! Name is a string, and value any of the basic types, or subconfigurations !! !!#### Example usage !! !!```fortran !! type(fckit_configuration), intent(in) :: config !! character(kind=c_char,len=:), allocatable :: grid_id !! integer(c_int32_t) :: levels !! call config%get_or_die('grid',grid_id) ) !! call config%get_or_die('levels',levels) ) !!``` !! Or with subconfiguration: !! !!```fortran !! type(fckit_configuration), intent(in) :: config !! type(fckit_configuration) :: grid_config !! character(kind=c_char,len=:), allocatable :: grid_type !! integer(c_int32_t) :: grid_levels !! integer, allocatable :: grid_pl(:) !! !! call config%get_or_die('grid',grid_config) !! call grid_config%get_or_die('type',grid_type) ) !! call grid_config%get_or_die('pl',grid_pl) ) !! call grid_config%get_or_die('levels',levels) ) !!``` generic, public :: get_or_die => & get_config_or_die, & get_config_list_or_die, & get_int32_or_die, & get_int64_or_die, & get_logical_or_die, & get_real32_or_die, & get_real64_or_die, & get_string_or_die, & get_array_logical_or_die, & get_array_int32_or_die, & get_array_int64_or_die, & get_array_real32_or_die, & get_array_real64_or_die, & get_array_string_or_die procedure :: json !! Return a json string corresponding to this configuration !! !!#### Example usage !! !!```fortran !! type(fckit_configuration), intent(in) :: config !! character(kind=c_char,len=:), allocatable :: json_str !! json_str = config%json() !!``` END TYPE fckit_configuration !------------------------------------------------------------------------------ interface fckit_configuration module procedure ctor module procedure ctor_from_cptr end interface interface fckit_YAMLConfiguration module procedure ctor_from_yaml_file module procedure ctor_from_yamlstr module procedure ctor_from_buffer end interface !------------------------------------------------------------------------------ private :: c_ptr, c_int32_t, c_int64_t, c_float, c_double, c_size_t, c_char private :: fckit_shared_object private :: fckit_c_deleter private :: fckit_c_nodeleter private :: fckit_pathname private :: fckit_buffer !======================================================== contains !======================================================== subroutine throw_configuration_not_found( name ) use fckit_c_interop_module, only : c_str character(kind=c_char,len=*), intent(in) :: name call c_fckit_throw_configuration_not_found(c_str(name)) end subroutine ! ----------------------------------------------------------------------------- ! Config routines subroutine deallocate_fckit_configuration( array ) type(fckit_configuration), allocatable, intent(inout) :: array(:) integer(c_int32_t) :: j if( allocated(array) ) then do j=1,size(array) #if FCKIT_FINAL_DEBUGGING write(0,'(A,I0,A)') " + call array(",j,")%final()" #endif call array(j)%final() enddo #if FCKIT_FINAL_DEBUGGING write(0,*) " + deallocate(array)" #endif deallocate(array) endif end subroutine #if FCKIT_FINAL_NOT_INHERITING FCKIT_FINAL subroutine fckit_configuration__final_auto(this) type(fckit_configuration), intent(inout) :: this #if FCKIT_FINAL_DEBUGGING write(0,*) "fckit_configuration__final_auto" #endif #if FCKIT_FINAL_NOT_PROPAGATING call this%final() #endif FCKIT_SUPPRESS_UNUSED( this ) end subroutine #endif function ctor() result(this) type(fckit_Configuration) :: this call this%reset_c_ptr( c_fckit_configuration_new(), & & fckit_c_deleter(c_fckit_configuration_delete) ) call this%return() end function function ctor_from_cptr(cptr,own) result(this) type(c_ptr), value :: cptr type(fckit_Configuration) :: this logical, optional :: own logical :: opt_own opt_own = .false. if( present(own) ) opt_own = own if( opt_own ) then call this%reset_c_ptr( cptr, fckit_c_deleter(c_fckit_configuration_delete) ) else call this%reset_c_ptr( cptr, fckit_c_nodeleter() ) endif call this%return() end function function ctor_from_yamlstr(yaml) result(this) use fckit_c_interop_module, only : c_str type(fckit_Configuration) :: this character(kind=c_char,len=*), intent(in) :: yaml call this%reset_c_ptr( c_fckit_configuration_new_from_yaml(c_str(yaml)), & & fckit_c_deleter(c_fckit_configuration_delete) ) call this%return() end function function ctor_from_yaml_file(path) result(this) use fckit_c_interop_module, only : c_str type(fckit_Configuration) :: this type(fckit_pathname), intent(in) :: path call this%reset_c_ptr( c_fckit_configuration_new_from_file(c_str(path%str())), & & fckit_c_deleter(c_fckit_configuration_delete) ) call this%return() end function function ctor_from_buffer(buffer) result(this) use fckit_c_interop_module, only : c_str type(fckit_Configuration) :: this type(fckit_buffer), intent(in) :: buffer call this%reset_c_ptr( c_fckit_configuration_new_from_buffer(buffer%CPTR_PGIBUG_B), & & fckit_c_deleter(c_fckit_configuration_delete) ) call buffer%consumed() ! If buffer was constructed inline, this will delete the buffer call this%return() end function function fckit_configuration_size(this) result(val) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(in) :: this integer(c_int32_t) :: val val = c_fckit_configuration_size(this%CPTR_PGIBUG_B) write(0,*) "fckit_configuration_size " , val end function function has(this, name) result(value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name logical :: value integer(c_int32_t) :: value_int value_int = c_fckit_configuration_has(this%CPTR_PGIBUG_B, c_str(name) ) if( value_int == 1 ) then value = .True. else value = .False. end if end function function key(this, index) result(key_str) use fckit_c_interop_module, only : c_str, c_ptr_to_string, c_ptr_free character(kind=c_char,len=:), allocatable :: key_str class(fckit_Configuration), intent(in) :: this integer(c_int32_t), intent(in) :: index type(c_ptr) :: key_cptr integer(c_size_t) :: key_size call c_fckit_configuration_key(this%CPTR_PGIBUG_B, index, key_cptr, key_size) FCKIT_ALLOCATE_CHARACTER(key_str, key_size) key_str = c_ptr_to_string(key_cptr) call c_ptr_free(key_cptr) end function function get_size(this, name) result(val) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int32_t) :: val val = c_fckit_configuration_get_size(this%CPTR_PGIBUG_B, c_str(name) ) end function subroutine set_config(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name class(fckit_Configuration), intent(in) :: value call c_fckit_configuration_set_config(this%CPTR_PGIBUG_B, c_str(name), value%CPTR_PGIBUG_B ) end subroutine subroutine set_config_list(this, name, value) use, intrinsic :: iso_c_binding, only : c_loc use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name type(fckit_Configuration), intent(in) :: value(:) !PGI (17.7) compiler bug when "type" replaced with "class" type(c_ptr), target :: value_cptrs(size(value)) integer(c_int32_t) :: j if( size(value) > 0 ) then do j=1,size(value) value_cptrs(j) = value(j)%CPTR_PGIBUG_B enddo call c_fckit_configuration_set_config_list(this%CPTR_PGIBUG_B, c_str(name), & c_loc(value_cptrs(1)), size(value_cptrs,kind=c_size_t) ) endif end subroutine subroutine set_logical(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name logical, intent(in) :: value integer(c_int32_t) :: value_int if( value ) then value_int = 1 else value_int = 0 end if call c_fckit_configuration_set_bool(this%CPTR_PGIBUG_B, c_str(name), value_int ) end subroutine subroutine set_int32(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int32_t), intent(in) :: value call c_fckit_configuration_set_int32(this%CPTR_PGIBUG_B, c_str(name), value) end subroutine subroutine set_int64(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int64_t), intent(in) :: value call c_fckit_configuration_set_int64(this%CPTR_PGIBUG_B, c_str(name), value) end subroutine subroutine set_real32(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name real(c_float), intent(in) :: value call c_fckit_configuration_set_float(this%CPTR_PGIBUG_B, c_str(name) ,value) end subroutine subroutine set_real64(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name real(c_double), intent(in) :: value call c_fckit_configuration_set_double(this%CPTR_PGIBUG_B, c_str(name) ,value) end subroutine subroutine set_string(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(inout) :: this character(kind=c_char,len=*), intent(in) :: name character(kind=c_char,len=*), intent(in) :: value call c_fckit_configuration_set_string(this%CPTR_PGIBUG_B, c_str(name) , c_str(value) ) end subroutine subroutine set_array_string(this, name, value) use, intrinsic :: iso_c_binding, only : c_f_pointer use fckit_c_interop_module, only : c_str, c_ptr_to_string, c_ptr_free class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name character(kind=c_char,len=*), intent(in) :: value(:) character(kind=c_char,len=:), allocatable :: flatvalue integer(c_size_t) :: length integer(c_int32_t) :: ii length = 0 if( size(value) > 0 ) then length = len(value(1)) allocate( character(len=length*size(value) ) :: flatvalue ) do ii = 1, size(value) flatvalue((ii-1)*length+1:ii*length) = value(ii) enddo call c_fckit_configuration_set_array_string(this%CPTR_PGIBUG_B, c_str(name), & & c_str(flatvalue), length, size(value,kind=c_size_t) ) endif end subroutine subroutine set_array_int32(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int32_t), intent(in) :: value(:) call c_fckit_configuration_set_array_int32(this%CPTR_PGIBUG_B, c_str(name), value, size(value,kind=c_size_t) ) end subroutine subroutine set_array_int64(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int64_t), intent(in) :: value(:) call c_fckit_configuration_set_array_int64(this%CPTR_PGIBUG_B, c_str(name), value, size(value,kind=c_size_t) ) end subroutine subroutine set_array_real32(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_float), intent(in) :: value(:) call c_fckit_configuration_set_array_float(this%CPTR_PGIBUG_B, c_str(name), value, size(value,kind=c_size_t) ) end subroutine subroutine set_array_real64(this, name, value) use fckit_c_interop_module, only : c_str class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_double), intent(in) :: value(:) call c_fckit_configuration_set_array_double(this%CPTR_PGIBUG_B, c_str(name), value, size(value,kind=c_size_t) ) end subroutine function get_config(this, name, value) result(found) use fckit_c_interop_module, only : c_str logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name class(fckit_Configuration), intent(inout) :: value integer(c_int32_t) :: found_int value = fckit_Configuration() found_int = c_fckit_configuration_get_config(this%CPTR_PGIBUG_B, & c_str(name), value%CPTR_PGIBUG_B ) found = .False. if (found_int == 1) then found = .True. endif end function subroutine get_config_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name class(fckit_Configuration), intent(inout) :: value if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_config_list(this, name, value) result(found) use, intrinsic :: iso_c_binding, only : c_f_pointer, c_null_ptr use fckit_c_interop_module, only : c_str, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name type(fckit_Configuration), allocatable, intent(inout) :: value(:) type(c_ptr) :: value_list_cptr type(c_ptr), pointer :: value_cptrs(:) integer(c_size_t) :: value_list_size integer(c_int32_t) :: found_int integer(c_size_t) :: j call deallocate_fckit_configuration(value) value_list_cptr = c_null_ptr found_int = c_fckit_configuration_get_config_list(this%CPTR_PGIBUG_B, c_str(name), & & value_list_cptr, value_list_size) found = .False. if( found_int == 1 ) then found = .true. call c_f_pointer(value_list_cptr,value_cptrs,(/value_list_size/)) allocate(value(value_list_size)) do j=1,value_list_size call value(j)%reset_c_ptr( value_cptrs(j), fckit_c_deleter(c_fckit_configuration_delete) ) enddo call c_ptr_free(value_list_cptr) endif end function subroutine get_config_list_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name type(fckit_Configuration), allocatable, intent(inout) :: value(:) if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_logical(this, name, value) result(found) use fckit_c_interop_module, only : c_str logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name logical, intent(inout) :: value integer(c_int32_t) :: value_int integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_bool(this%CPTR_PGIBUG_B,c_str(name), value_int ) found = .False. if (found_int == 1) found = .True. if (found) then if (value_int > 0) then value = .True. else value = .False. end if endif end function subroutine get_logical_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name logical, intent(inout) :: value if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_int32(this, name, value) result(found) use fckit_c_interop_module, only : c_str logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int32_t), intent(inout) :: value integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_int32(this%CPTR_PGIBUG_B, c_str(name), value ) found = .False. if (found_int == 1) found = .True. end function subroutine get_int32_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int32_t), intent(inout) :: value if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_int64(this, name, value) result(found) use fckit_c_interop_module, only : c_str logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int64_t), intent(inout) :: value integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_int64(this%CPTR_PGIBUG_B, c_str(name), value ) found = .False. if (found_int == 1) found = .True. end function subroutine get_int64_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int64_t), intent(inout) :: value if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_real32(this, name, value) result(found) use fckit_c_interop_module, only : c_str logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_float), intent(inout) :: value integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_float(this%CPTR_PGIBUG_B, c_str(name), value ) found = .False. if (found_int == 1) found = .True. end function subroutine get_real32_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_float), intent(inout) :: value if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_real64(this, name, value) result(found) use fckit_c_interop_module, only : c_str logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_double), intent(inout) :: value integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_double(this%CPTR_PGIBUG_B, c_str(name), value ) found = .False. if (found_int == 1) found = .True. end function subroutine get_real64_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_double), intent(inout) :: value if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_string(this, name, value) result(found) use fckit_c_interop_module, only : c_str, c_ptr_to_string, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name character(kind=c_char,len=:), allocatable, intent(inout) :: value type(c_ptr) :: value_cptr integer(c_int32_t) :: found_int integer(c_size_t) :: value_size found_int = c_fckit_configuration_get_string(this%CPTR_PGIBUG_B,c_str(name),value_cptr,value_size) if( found_int == 1 ) then if( allocated(value) ) deallocate(value) FCKIT_ALLOCATE_CHARACTER(value,value_size) if ( value_size > 0 ) then value = c_ptr_to_string(value_cptr) call c_ptr_free(value_cptr) endif endif found = .False. if (found_int == 1) found = .True. end function subroutine get_string_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name character(kind=c_char,len=:), allocatable, intent(inout) :: value if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_array_logical(this, name, value) result(found) use, intrinsic :: iso_c_binding, only : c_f_pointer use fckit_c_interop_module, only : c_str, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name logical, allocatable, intent(inout) :: value(:) type(c_ptr) :: value_cptr integer(c_int32_t), pointer :: value_fptr(:) integer(c_size_t) :: j, value_size integer(c_int32_t), allocatable :: value_int(:) integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_array_int32(this%CPTR_PGIBUG_B, c_str(name), & & value_cptr, value_size ) if( found_int == 1 ) then call c_f_pointer(value_cptr,value_fptr,(/value_size/)) allocate(value_int(value_size)) value_int(:) = value_fptr(:) if( allocated(value) ) deallocate(value) allocate(value(value_size)) do j = 1, value_size if (value_int(j) > 0) then value(j) = .True. else value(j) = .False. endif end do call c_ptr_free(value_cptr) endif found = .False. if (found_int == 1) found = .True. end function subroutine get_array_logical_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name logical, allocatable, intent(inout) :: value(:) if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_array_int32(this, name, value) result(found) use, intrinsic :: iso_c_binding, only : c_f_pointer use fckit_c_interop_module, only : c_str, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int32_t), allocatable, intent(inout) :: value(:) type(c_ptr) :: value_cptr integer(c_int32_t), pointer :: value_fptr(:) integer(c_size_t) :: value_size integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_array_int32(this%CPTR_PGIBUG_B, c_str(name), & & value_cptr, value_size ) if( found_int == 1 ) then call c_f_pointer(value_cptr,value_fptr,(/value_size/)) if( allocated(value) ) deallocate(value) allocate(value(value_size)) value(:) = value_fptr(:) call c_ptr_free(value_cptr) endif found = .False. if (found_int == 1) found = .True. end function subroutine get_array_int32_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int32_t), allocatable, intent(inout) :: value(:) if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_array_int64(this, name, value) result(found) use, intrinsic :: iso_c_binding, only : c_f_pointer use fckit_c_interop_module, only : c_str, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int64_t), allocatable, intent(inout) :: value(:) type(c_ptr) :: value_cptr integer(c_int64_t), pointer :: value_fptr(:) integer(c_size_t) :: value_size integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_array_int64(this%CPTR_PGIBUG_B, c_str(name), & & value_cptr, value_size ) if( found_int == 1 ) then call c_f_pointer(value_cptr,value_fptr,(/value_size/)) if( allocated(value) ) deallocate(value) allocate(value(value_size)) value(:) = value_fptr(:) call c_ptr_free(value_cptr) endif found = .False. if (found_int == 1) found = .True. end function subroutine get_array_int64_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name integer(c_int64_t), allocatable, intent(inout) :: value(:) if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_array_real32(this, name, value) result(found) use, intrinsic :: iso_c_binding, only : c_f_pointer use fckit_c_interop_module, only : c_str, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_float), allocatable, intent(inout) :: value(:) type(c_ptr) :: value_cptr real(c_float), pointer :: value_fptr(:) integer(c_size_t) :: value_size integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_array_float(this%CPTR_PGIBUG_B, c_str(name), & & value_cptr, value_size ) if( found_int == 1 ) then call c_f_pointer(value_cptr,value_fptr,(/value_size/)) if( allocated(value) ) deallocate(value) allocate(value(value_size)) value(:) = value_fptr(:) call c_ptr_free(value_cptr) endif found = .False. if (found_int == 1) found = .True. end function subroutine get_array_real32_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_float), allocatable, intent(inout) :: value(:) if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_array_real64(this, name, value) result(found) use, intrinsic :: iso_c_binding, only : c_f_pointer use fckit_c_interop_module, only : c_str, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_double), allocatable, intent(inout) :: value(:) type(c_ptr) :: value_cptr real(c_double), pointer :: value_fptr(:) integer(c_size_t) :: value_size integer(c_int32_t) :: found_int found_int = c_fckit_configuration_get_array_double(this%CPTR_PGIBUG_B, c_str(name), & & value_cptr, value_size ) if( found_int == 1 ) then call c_f_pointer(value_cptr,value_fptr,(/value_size/)) if( allocated(value) ) deallocate(value) allocate(value(value_size)) value(:) = value_fptr(:) call c_ptr_free(value_cptr) endif found = .False. if (found_int == 1) found = .True. end function subroutine get_array_real64_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(kind=c_char,len=*), intent(in) :: name real(c_double), allocatable, intent(inout) :: value(:) if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function get_array_string(this,name,value) result(found) use, intrinsic :: iso_c_binding, only : c_f_pointer use fckit_c_interop_module, only : c_str, c_ptr_to_string, c_ptr_free logical :: found class(fckit_Configuration), intent(in) :: this character(len=*), intent(in) :: name character(len=:), allocatable, intent(inout) :: value(:) type(c_ptr) :: value_cptr type(c_ptr) :: offsets_cptr integer(c_size_t), pointer :: offsets_fptr(:) integer(c_size_t), allocatable :: offsets(:) integer(c_size_t) :: value_size integer(c_size_t) :: value_numelem integer(c_int32_t) :: found_int integer(c_size_t) :: maxelemlen integer(c_size_t) :: elemlen integer(c_size_t) :: j character(len=:), allocatable :: flatvalue found_int = c_fckit_configuration_get_array_string(this%CPTR_PGIBUG_B, c_str(name), & & value_cptr, value_size, offsets_cptr, value_numelem) if( found_int == 1 ) then ! Get flat character array allocate(character(len=value_size) :: flatvalue ) if ( value_size > 0 ) then flatvalue = c_ptr_to_string(value_cptr) call c_ptr_free(value_cptr) end if ! Get offsets call c_f_pointer(offsets_cptr,offsets_fptr,(/value_numelem/)) allocate(offsets(value_numelem)) offsets(:) = offsets_fptr(:) call c_ptr_free(offsets_cptr) ! Find maximum length of an element maxelemlen = 0 do j=1,value_numelem if( j < value_numelem ) then maxelemlen = max( maxelemlen, offsets(j+1) - offsets(j) ) else maxelemlen = max( maxelemlen, value_size - offsets(j) ) endif enddo ! Extract values if( allocated(value) ) deallocate(value) allocate(character(len=maxelemlen) :: value(value_numelem) ) do j=1,value_numelem if( j < value_numelem ) then elemlen = offsets(j+1) - offsets(j) else elemlen = value_size - offsets(j) endif value(j) = flatvalue(offsets(j)+1:offsets(j)+elemlen) enddo endif found = .False. if (found_int == 1) found = .True. end function subroutine get_array_string_or_die(this,name,value) class(fckit_Configuration), intent(in) :: this character(len=*), intent(in) :: name character(len=:), allocatable, intent(inout) :: value(:) if( .not. this%get(name,value) ) call throw_configuration_not_found(name) end subroutine function json(this) result(jsonstr) use fckit_c_interop_module, only : c_str, c_ptr_to_string, c_ptr_free character(kind=c_char,len=:), allocatable :: jsonstr class(fckit_Configuration), intent(in) :: this type(c_ptr) :: json_cptr integer(c_size_t) :: json_size call c_fckit_configuration_json(this%CPTR_PGIBUG_B,json_cptr,json_size) FCKIT_ALLOCATE_CHARACTER(jsonstr,json_size) jsonstr = c_ptr_to_string(json_cptr) call c_ptr_free(json_cptr) end function end module fckit_configuration_module fckit-0.14.2/src/fckit/module/fckit_configuration.cc000066400000000000000000000307721514707373700224370ustar00rootroot00000000000000/* * (C) Copyright 2013 ECMWF. * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. */ #include #include #include #include #include #include #include "eckit/config/Configuration.h" #include "eckit/config/LocalConfiguration.h" #include "eckit/config/YAMLConfiguration.h" #include "eckit/exception/Exceptions.h" #include "eckit/filesystem/PathName.h" #include "eckit/log/JSON.h" using eckit::CodeLocation; using eckit::Configuration; using eckit::Exception; using eckit::JSON; using eckit::LocalConfiguration; using eckit::PathName; using eckit::YAMLConfiguration; using std::string; using std::stringstream; using std::vector; using int32 = std::int32_t; using int64 = std::int64_t; using size_t = std::size_t; namespace fckit { class NotLocalConfiguration : public Exception { public: NotLocalConfiguration( const CodeLocation& location ) : Exception( "Configuration must be of concrete LocalConfiguration type", location ) {} }; class ConfigurationNotFound : public Exception { public: ConfigurationNotFound( const std::string& name ) : Exception( "Could not find \"" + name + "\" in Configuration" ) {} }; extern "C" { void c_fckit_throw_configuration_not_found( const char* name ) { throw ConfigurationNotFound( name ); } Configuration* c_fckit_configuration_new() { return new LocalConfiguration(); } Configuration* c_fckit_configuration_new_from_yaml( const char* yaml ) { stringstream s; s << yaml; return new YAMLConfiguration( s ); } const Configuration* c_fckit_configuration_new_from_file( const char* path ) { PathName p( path ); return new YAMLConfiguration( p ); } const Configuration* c_fckit_configuration_new_from_buffer( eckit::CountedBuffer* buffer ) { eckit::SharedBuffer sb( buffer ); return new YAMLConfiguration( eckit::SharedBuffer( buffer ) ); } void c_fckit_configuration_delete( Configuration* This ) { ASSERT( This != nullptr ); delete This; } void c_fckit_configuration_set_config( Configuration* This, const char* name, const Configuration* value ) { ASSERT( This != nullptr ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), LocalConfiguration( *value ) ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_config_list( Configuration* This, const char* name, const Configuration* value[], size_t size ) { ASSERT( This != nullptr ); vector params( size ); for ( size_t i = 0; i < size; ++i ) params[i] = LocalConfiguration( *value[i] ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), params ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_bool( Configuration* This, const char* name, int32 value ) { ASSERT( This != nullptr ); ASSERT( value == 0 || value == 1 ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), bool( value ) ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_int32( Configuration* This, const char* name, int32 value ) { ASSERT( This != nullptr ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), value ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_int64( Configuration* This, const char* name, int64 value ) { ASSERT( This != nullptr ); if ( LocalConfiguration* local = dynamic_cast( This ) ) // TODO: long should be converted to int64 once ECKIT-349 is fixed local->set( string( name ), long( value ) ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_float( Configuration* This, const char* name, float value ) { ASSERT( This != nullptr ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), value ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_double( Configuration* This, const char* name, double value ) { ASSERT( This != nullptr ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), value ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_string( Configuration* This, const char* name, const char* value ) { ASSERT( This != nullptr ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), string( value ) ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_array_string( Configuration* This, const char* name, const char* value, size_t length, size_t size ) { ASSERT( This != nullptr ); vector v; for ( size_t jj = 0; jj < size; ++jj ) { char str[length + 1]; ASSERT( snprintf( str, sizeof( str ), "%s", value + jj * length ) >= 0 ); v.push_back( string( str ) ); } if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), v ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_array_int32( Configuration* This, const char* name, int32 value[], size_t size ) { ASSERT( This != nullptr ); vector v; v.assign( value, value + size ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), v ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_array_int64( Configuration* This, const char* name, int64 value[], size_t size ) { ASSERT( This != nullptr ); // TODO: long should be converted to int64 once ECKIT-349 is fixed vector v; v.assign( value, value + size ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), v ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_array_float( Configuration* This, const char* name, float value[], size_t size ) { vector v; v.assign( value, value + size ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), v ); else throw NotLocalConfiguration( Here() ); } void c_fckit_configuration_set_array_double( Configuration* This, const char* name, double value[], size_t size ) { vector v; v.assign( value, value + size ); if ( LocalConfiguration* local = dynamic_cast( This ) ) local->set( string( name ), v ); else throw NotLocalConfiguration( Here() ); } int32 c_fckit_configuration_get_config( const Configuration* This, const char* name, LocalConfiguration* value ) { if ( !This->get( string( name ), *value ) ) return false; return true; } int32 c_fckit_configuration_get_config_list( const Configuration* This, const char* name, LocalConfiguration**& value, size_t& size ) { value = nullptr; vector vector; if ( !This->get( string( name ), vector ) ) return false; size = vector.size(); value = new LocalConfiguration*[size]; for ( size_t i = 0; i < size; ++i ) { value[i] = new LocalConfiguration( vector[i] ); } return true; } int32 c_fckit_configuration_get_bool( const Configuration* This, const char* name, int32& value ) { bool _value; if ( !This->get( string( name ), _value ) ) { return false; // _value unassigned! } value = _value; return true; } int32 c_fckit_configuration_get_int32( const Configuration* This, const char* name, int32& value ) { if ( !This->get( string( name ), value ) ) return false; return true; } int32 c_fckit_configuration_get_int64( const Configuration* This, const char* name, int64& value ) { // TODO: long should be converted to int64 once ECKIT-349 is fixed long v; if ( !This->get( string( name ), v ) ) return false; value = v; return true; } int32 c_fckit_configuration_get_float( const Configuration* This, const char* name, float& value ) { if ( !This->get( string( name ), value ) ) return false; return true; } int32 c_fckit_configuration_get_double( const Configuration* This, const char* name, double& value ) { if ( !This->get( string( name ), value ) ) return false; return true; } int32 c_fckit_configuration_get_string( const Configuration* This, const char* name, char*& value, size_t& size ) { string s; if ( !This->get( string( name ), s ) ) { value = nullptr; return false; } size = s.size() + 1; value = new char[size]; strcpy( value, s.c_str() ); return true; } int32 c_fckit_configuration_get_array_int32( const Configuration* This, const char* name, int32*& value, size_t& size ) { vector v; if ( !This->get( string( name ), v ) ) return false; size = v.size(); value = new int32[size]; for ( size_t j = 0; j < v.size(); ++j ) value[j] = v[j]; return true; } int32 c_fckit_configuration_get_array_int64( const Configuration* This, const char* name, int64*& value, size_t& size ) { // TODO: long should be converted to int64 once ECKIT-349 is fixed vector v; if ( !This->get( string( name ), v ) ) return false; size = v.size(); value = new int64[size]; for ( size_t j = 0; j < v.size(); ++j ) value[j] = v[j]; return true; } int32 c_fckit_configuration_get_array_float( const Configuration* This, const char* name, float*& value, size_t& size ) { vector v; if ( !This->get( string( name ), v ) ) return false; size = v.size(); value = new float[size]; for ( size_t j = 0; j < v.size(); ++j ) value[j] = v[j]; return true; } int32 c_fckit_configuration_get_array_double( const Configuration* This, const char* name, double*& value, size_t& size ) { vector v; if ( !This->get( string( name ), v ) ) return false; size = v.size(); value = new double[size]; for ( size_t j = 0; j < v.size(); ++j ) value[j] = v[j]; return true; } int32 c_fckit_configuration_get_array_string( const Configuration* This, const char* name, char*& value, size_t& size, size_t*& offsets, size_t& numelem ) { vector s; if ( !This->get( string( name ), s ) ) { return false; } numelem = s.size(); offsets = new size_t[numelem]; size = 0; for ( size_t j = 0; j < numelem; ++j ) { offsets[j] = size; size += s[j].size(); } value = new char[size + 1]; for ( size_t j = 0; j < numelem; ++j ) { strcpy( &value[offsets[j]], s[j].c_str() ); } return true; } int32 c_fckit_configuration_size( const Configuration* This ) { return This->keys().size(); } void c_fckit_configuration_key( const Configuration* This, int32 index, char*& value, size_t& size ) { string key = This->keys()[index-1]; size = key.size() + 1; value = new char[size]; strcpy( value, key.c_str() ); } int32 c_fckit_configuration_has( const Configuration* This, const char* name ) { return This->has( name ); } int32 c_fckit_configuration_get_size( const Configuration* This, const char* name ) { return This->getStringVector( name ).size(); } void c_fckit_configuration_json( const Configuration* This, char*& json, size_t& size ) { stringstream s; JSON parser( s ); parser.precision( 17 ); // round-trippable double parser << *This; string json_str = s.str(); size = json_str.size(); json = new char[size + 1]; strcpy( json, json_str.c_str() ); } } // extern "C" } // namespace fckit fckit-0.14.2/src/fckit/module/fckit_configuration.inc000066400000000000000000000615211514707373700226170ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #ifndef FORD interface !------------------------------------------------------------------------------- ! void c_fckit_throw_configuration_not_found (const char* name) !------------------------------------------------------------------------------- subroutine c_fckit_throw_configuration_not_found( name ) bind(C,name="c_fckit_t& &hrow_configuration_not_found") use iso_c_binding, only: c_char character(c_char), dimension(*) :: name end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Configuration* c_fckit_configuration_new () !------------------------------------------------------------------------------- function c_fckit_configuration_new() bind(C,name="c_fckit_configuration_new") use iso_c_binding, only: c_ptr type(c_ptr) :: c_fckit_configuration_new end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Configuration* c_fckit_configuration_new_from_yaml (const char* yaml) !------------------------------------------------------------------------------- function c_fckit_configuration_new_from_yaml( yaml ) bind(C,name="c_fckit_confi& &guration_new_from_yaml") use iso_c_binding, only: c_ptr, c_char type(c_ptr) :: c_fckit_configuration_new_from_yaml character(c_char), dimension(*) :: yaml end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Configuration* c_fckit_configuration_new_from_file (const char* path) !------------------------------------------------------------------------------- function c_fckit_configuration_new_from_file( path ) bind(C,name="c_fckit_confi& &guration_new_from_file") use iso_c_binding, only: c_ptr, c_char type(c_ptr) :: c_fckit_configuration_new_from_file character(c_char), dimension(*) :: path end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Configuration* c_fckit_configuration_new_from_buffer (eckit::Buffer* buffer) !------------------------------------------------------------------------------- function c_fckit_configuration_new_from_buffer( buffer ) bind(C,name="c_fckit_c& &onfiguration_new_from_buffer") use iso_c_binding, only: c_ptr type(c_ptr) :: c_fckit_configuration_new_from_buffer type(c_ptr), value :: buffer end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_delete (Configuration* This) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_delete( This ) bind(C,name="c_fckit_configurat& &ion_delete") use iso_c_binding, only: c_ptr type(c_ptr), value :: This end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_config (Configuration* This, const char* name, ! const Configuration* value) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_config( This, name, value ) bind(C,name="c& &_fckit_configuration_set_config") use iso_c_binding, only: c_ptr, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr), value :: value end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_config_list (Configuration* This, const char* n ! ame, const Configuration* value[], size_t size) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_config_list( This, name, value, size ) bin& &d(C,name="c_fckit_configuration_set_config_list") use iso_c_binding, only: c_int32_t, c_size_t, c_ptr, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr), value :: value integer(c_size_t), value :: size end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_bool (Configuration* This, const char* name, ! int32 value) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_bool( This, name, value ) bind(C,name="c_& &fckit_configuration_set_bool") use iso_c_binding, only: c_int32_t, c_ptr, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int32_t), value :: value end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_int32 (Configuration* This, const char* name, ! int32 value) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_int32( This, name, value ) bind(C,name="c_& &fckit_configuration_set_int32") use iso_c_binding, only: c_int32_t, c_ptr, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int32_t), value :: value end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_int64 (Configuration* This, const char* name, ! int64 value) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_int64( This, name, value ) bind(C,name="c_& &fckit_configuration_set_int64") use iso_c_binding, only: c_ptr, c_int64_t, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int64_t), value :: value end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_float (Configuration* This, const char* name, f ! loat value) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_float( This, name, value ) bind(C,name="c_& &fckit_configuration_set_float") use iso_c_binding, only: c_ptr, c_char, c_float type(c_ptr), value :: This character(c_char), dimension(*) :: name real(c_float), value :: value end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_double (Configuration* This, const char* name, ! double value) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_double( This, name, value ) bind(C,name="c& &_fckit_configuration_set_double") use iso_c_binding, only: c_ptr, c_char, c_double type(c_ptr), value :: This character(c_char), dimension(*) :: name real(c_double), value :: value end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_string (Configuration* This, const char* name, ! const char* value) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_string( This, name, value ) bind(C,name="c& &_fckit_configuration_set_string") use iso_c_binding, only: c_ptr, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name character(c_char), dimension(*) :: value end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_array_string (Configuration* This, const char* n ! ame, const char* value, size_t size) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_array_string( This, name, value, length, size ) bin& &d(C,name="c_fckit_configuration_set_array_string") use iso_c_binding, only: c_int32_t, c_size_t, c_ptr, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name character(c_char), dimension(*) :: value integer(c_size_t), value :: length integer(c_size_t), value :: size end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_array_int32 (Configuration* This, const char* n ! ame, int32 value[], size_t size) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_array_int32( This, name, value, size ) bin& &d(C,name="c_fckit_configuration_set_array_int32") use iso_c_binding, only: c_int32_t, c_size_t, c_ptr, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int32_t), dimension(*) :: value integer(c_size_t), value :: size end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_array_int64 (Configuration* This, const char* n ! ame, int64 value[], size_t size) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_array_int64( This, name, value, size ) bin& &d(C,name="c_fckit_configuration_set_array_int64") use iso_c_binding, only: c_size_t, c_ptr, c_int64_t, c_char type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int64_t), dimension(*) :: value integer(c_size_t), value :: size end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_array_float (Configuration* This, const char* n ! ame, float value[], size_t size) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_array_float( This, name, value, size ) bin& &d(C,name="c_fckit_configuration_set_array_float") use iso_c_binding, only: c_size_t, c_ptr, c_char, c_float type(c_ptr), value :: This character(c_char), dimension(*) :: name real(c_float), dimension(*) :: value integer(c_size_t), value :: size end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_set_array_double (Configuration* This, const char* ! name, double value[], size_t size) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_set_array_double( This, name, value, size ) bi& &nd(C,name="c_fckit_configuration_set_array_double") use iso_c_binding, only: c_size_t, c_ptr, c_char, c_double type(c_ptr), value :: This character(c_char), dimension(*) :: name real(c_double), dimension(*) :: value integer(c_size_t), value :: size end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_config (const Configuration* This, const char* ! name, LocalConfiguration* value) !------------------------------------------------------------------------------- function c_fckit_configuration_get_config( This, name, value ) bind(C,name="c_f& &ckit_configuration_get_config") use iso_c_binding, only: c_char, c_ptr, c_int32_t integer(c_int32_t) :: c_fckit_configuration_get_config type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr), value :: value end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_config_list (const Configuration* This, const ! char* name, LocalConfiguration** &value, size_t &size) !------------------------------------------------------------------------------- function c_fckit_configuration_get_config_list( This, name, value, size ) bind(& &C,name="c_fckit_configuration_get_config_list") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_configuration_get_config_list type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr) :: value integer(c_size_t) :: size end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_bool (const Configuration* This, const char* ! name, int32& value) !------------------------------------------------------------------------------- function c_fckit_configuration_get_bool( This, name, value ) bind(C,name="c_fc& &kit_configuration_get_bool") use iso_c_binding, only: c_char, c_ptr, c_int32_t integer(c_int32_t) :: c_fckit_configuration_get_bool type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int32_t) :: value end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_int32 (const Configuration* This, const char* ! name, int32& value) !------------------------------------------------------------------------------- function c_fckit_configuration_get_int32( This, name, value ) bind(C,name="c_fc& &kit_configuration_get_int32") use iso_c_binding, only: c_char, c_ptr, c_int32_t integer(c_int32_t) :: c_fckit_configuration_get_int32 type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int32_t) :: value end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_int64 (const Configuration* This, const char* ! name, int64& value) !------------------------------------------------------------------------------- function c_fckit_configuration_get_int64( This, name, value ) bind(C,name="c_fc& &kit_configuration_get_int64") use iso_c_binding, only: c_char, c_ptr, c_int64_t, c_int32_t integer(c_int32_t) :: c_fckit_configuration_get_int64 type(c_ptr), value :: This character(c_char), dimension(*) :: name integer(c_int64_t) :: value end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_float (const Configuration* This, const char* ! name, float& value) !------------------------------------------------------------------------------- function c_fckit_configuration_get_float( This, name, value ) bind(C,name="c_fc& &kit_configuration_get_float") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_float integer(c_int32_t) :: c_fckit_configuration_get_float type(c_ptr), value :: This character(c_char), dimension(*) :: name real(c_float) :: value end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_double (const Configuration* This, const char* ! name, double& value) !------------------------------------------------------------------------------- function c_fckit_configuration_get_double( This, name, value ) bind(C,name="c_f& &ckit_configuration_get_double") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_double integer(c_int32_t) :: c_fckit_configuration_get_double type(c_ptr), value :: This character(c_char), dimension(*) :: name real(c_double) :: value end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_string( const Configuration* This, const char* ! name, char* &value, size_t &size) !------------------------------------------------------------------------------- function c_fckit_configuration_get_string( This, name, value, size ) bind(C,nam& &e="c_fckit_configuration_get_string") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_configuration_get_string type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr) :: value integer(c_size_t) :: size end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_array_int32 (const Configuration* This, const ! char* name, int32* &value, size_t& size) !------------------------------------------------------------------------------- function c_fckit_configuration_get_array_int32( This, name, value, size ) bind(& &C,name="c_fckit_configuration_get_array_int32") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_configuration_get_array_int32 type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr) :: value integer(c_size_t) :: size end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int64 c_fckit_configuration_get_array_int64 (const Configuration* This, const ! char* name, int64* &value, size_t& size) !------------------------------------------------------------------------------- function c_fckit_configuration_get_array_int64( This, name, value, size ) bind(C& &,name="c_fckit_configuration_get_array_int64") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_configuration_get_array_int64 type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr) :: value integer(c_size_t) :: size end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_array_float (const Configuration* This, const ch ! ar* name, float* &value, size_t& size) !------------------------------------------------------------------------------- function c_fckit_configuration_get_array_float( This, name, value, size ) bind(& &C,name="c_fckit_configuration_get_array_float") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_configuration_get_array_float type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr) :: value integer(c_size_t) :: size end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_array_double (const Configuration* This, const ! char* name, double* &value, size_t& size) !------------------------------------------------------------------------------- function c_fckit_configuration_get_array_double( This, name, value, size ) bind& &(C,name="c_fckit_configuration_get_array_double") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_configuration_get_array_double type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr) :: value integer(c_size_t) :: size end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_array_string (const Configuration* This, const c ! har* name, char* &value, size_t& size, size_t* &offsets, size_t& numelem) !------------------------------------------------------------------------------- function c_fckit_configuration_get_array_string( This, name, value, size, offsets, numelem) bind& &(C,name="c_fckit_configuration_get_array_string") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t integer(c_int32_t) :: c_fckit_configuration_get_array_string type(c_ptr), value :: This character(c_char), dimension(*) :: name type(c_ptr) :: value integer(c_size_t) :: size type(c_ptr) :: offsets integer(c_size_t) :: numelem end function !---------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_size (const Configuration* This) !------------------------------------------------------------------------------- function c_fckit_configuration_size( This ) bind(C,name="c_fckit_configura& &tion_size") use iso_c_binding, only: c_ptr, c_int32_t integer(c_int32_t) :: c_fckit_configuration_size type(c_ptr), value :: This end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_has (const Configuration* This, const char *name) !------------------------------------------------------------------------------- function c_fckit_configuration_has( This, name ) bind(C,name="c_fckit_configura& &tion_has") use iso_c_binding, only: c_char, c_ptr, c_int32_t integer(c_int32_t) :: c_fckit_configuration_has type(c_ptr), value :: This character(c_char), dimension(*) :: name end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_key( const Configuration* This, int32 index, char*& value, size_t& size ) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_key( This, index, value, size ) bind(C,nam& &e="c_fckit_configuration_key") use iso_c_binding, only: c_char, c_ptr, c_int32_t, c_size_t type(c_ptr), value :: This integer(c_int32_t), value :: index type(c_ptr) :: value integer(c_size_t) :: size end subroutine !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! int32 c_fckit_configuration_get_size (const Configuration* This, const char *name) !------------------------------------------------------------------------------- function c_fckit_configuration_get_size( This, name ) bind(C,name="c_fckit_configura& &tion_get_size") use iso_c_binding, only: c_char, c_ptr, c_int32_t integer(c_int32_t) :: c_fckit_configuration_get_size type(c_ptr), value :: This character(c_char), dimension(*) :: name end function !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! void c_fckit_configuration_json(const Configuration* This, char* &json, int &s ! ize) !------------------------------------------------------------------------------- subroutine c_fckit_configuration_json( This, json, size ) bind(C,name="c_fckit_& &configuration_json") use iso_c_binding, only: c_ptr, c_size_t type(c_ptr), value :: This type(c_ptr) :: json integer(c_size_t) :: size end subroutine !------------------------------------------------------------------------------- end interface #endif fckit-0.14.2/src/fckit/module/fckit_exception.F90000066400000000000000000000242761514707373700215410ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fckit.h" module fckit_exception_module !! author: Willem Deconinck !! !! Module providing [[fckit_exception_module:fckit_exception(variable)]] global variable implicit none private #include "fckit_exception.inc" public :: fckit_exception public :: fckit_exception_handler type, FORD_PRIVATE :: fckit_exception_location !! Type that gives API to read the location of the thrown exception contains procedure, public, nopass :: is_set => location_is_set !! Function that returns if a location where abort happens is present !! !! This function can be used in an abort handler procedure, public, nopass :: file => location_file !! Function that returns the file where abort is called !! !! This function can be used in an abort handler procedure, public, nopass :: line => location_line !! Function that returns the line where abort is called !! !! This function can be used in an abort handler procedure, public, nopass :: function => location_function !! Function that returns the function where abort is called !! !! This function can be used in an abort handler end type fckit_exception_location type, FORD_PRIVATE :: fckit_exception_type !! Type of the global [[fckit_exception_module:fckit_exception(variable)]] variable type(fckit_exception_location) :: location !! Variable of the type [[fckit_exception_module:fckit_exception_location(type)]] !! exposing the location where the exception is thrown contains procedure, public, nopass :: throw !! Throw exception !! !! If the exception is not caught, the program will try to terminate, and !! fckit terminate handler will be called, giving nice backtrace etc. !! !!####Example usage !! !!```fortran !! call fckit_exception%throw("I have my reasons",___FILE___,___LINE___) !!``` procedure, public, nopass :: abort => fckit_exception__abort !! Throw the ```eckit::Abort``` exception !! !!####Example usage !! !!```fortran !! call fckit_exception%abort("I have my reasons",___FILE___,___LINE___) !!``` !! !! You could create a macro to help: !! !!```fortran !! #define ABORT_HERE( what ) fckit_exception%abort(what,___FILE___,___LINE___) !! !! call ABORT_HERE("I have my reasons") !!``` procedure, public, nopass :: what !! Function that returns the reason for the thrown exception !! !! This function can be used in an abort handler procedure, public, nopass :: callstack !! Function that returns the callstack where exception is thrown !! !! This function can be used in an abort handler procedure, public, nopass :: set_handler !! Subroutine to set custom abort handler !! !!####Example usage !! !!```fortran !! subroutine custom_exception_handler() !! ! handle exception !! end subroutine !! !! subroutine set_custom_exception_handler() !! external :: custom_exception_handler !! procedure(fckit_exception_handler), pointer :: exception_handler => custom_exception_handler !! call fckit_exception%set_handler( exception_handler ) !! end subroutine !!``` end type fckit_exception_type type(fckit_exception_type) :: fckit_exception !! Instance of the [[fckit_exception_module:fckit_exception_type(type)]] type contains !------------------------------------------------------------------------------ subroutine set_handler( exception_handler ) use, intrinsic :: iso_c_binding, only : c_funloc procedure(fckit_exception_handler) :: exception_handler call fckit__set_abort_handler( c_funloc(exception_handler) ) end subroutine !------------------------------------------------------------------------------ subroutine fckit_exception__abort( what, file, line, function ) use, intrinsic :: iso_c_binding, only : c_char, c_int32_t use fckit_c_interop_module, only : c_str character(kind=c_char,len=*), optional :: what !! what for abort character(kind=c_char,len=*), optional :: file !! File path where aborted (hint: use ```___FILE___``` fortran-line-length permitting) integer(c_int32_t), optional :: line !! Line in file where aborted (hint: use ```___LINE___```) character(kind=c_char,len=*), optional :: function !! Function where aborted ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - character(kind=c_char,len=:), allocatable :: opt_what character(kind=c_char,len=:), allocatable :: opt_file integer(c_int32_t) :: opt_line character(kind=c_char,len=:), allocatable :: opt_function if( present(what) ) then allocate( character(len=len_trim(what)) :: opt_what ) opt_what = what else allocate( character(len=0) :: opt_what ) opt_what = "" endif if( present(file) ) then allocate( character(len=len_trim(file)) :: opt_file ) opt_file = file else allocate( character(len=0) :: opt_file ) opt_file = "" endif if( present(line) ) then opt_line = line else opt_line = 0 endif if( present(function) ) then allocate( character(len=len_trim(function)) :: opt_function ) opt_function = function else allocate( character(len=0) :: opt_function ) opt_function = "" endif call fckit__abort( c_str(opt_what), c_str(opt_file), opt_line, c_str(opt_function) ) end subroutine !------------------------------------------------------------------------------ function what() use, intrinsic :: iso_c_binding use fckit_c_interop_module character(kind=c_char,len=:), allocatable :: what !! what for aborting ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - type(c_ptr) :: what_c_ptr integer(c_size_t) :: what_size integer(c_int32_t) :: error_code error_code = fckit__exception_what(what_c_ptr,what_size) FCKIT_ALLOCATE_CHARACTER(what,what_size) what = c_ptr_to_string(what_c_ptr) call c_ptr_free(what_c_ptr) end function !------------------------------------------------------------------------------ function location_is_set() result(location) logical :: location !! True if location is present ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if( fckit__exception_location() == 0 ) then location = .false. else location = .true. endif end function !------------------------------------------------------------------------------ function location_file() result(file) use, intrinsic :: iso_c_binding use fckit_c_interop_module character(kind=c_char,len=:), allocatable :: file !! File where abort is called ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - type(c_ptr) :: file_c_ptr integer(c_size_t) :: file_size integer(c_int32_t) :: error_code error_code = fckit__exception_file(file_c_ptr,file_size) FCKIT_ALLOCATE_CHARACTER(file,file_size) file = c_ptr_to_string(file_c_ptr) call c_ptr_free(file_c_ptr) end function !------------------------------------------------------------------------------ function location_line() result(line) use, intrinsic :: iso_c_binding integer(c_int32_t) :: line !! Line where abort is called ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - line = fckit__exception_line() end function !------------------------------------------------------------------------------ function location_function() result(function) use, intrinsic :: iso_c_binding use fckit_c_interop_module character(kind=c_char,len=:), allocatable :: function !! Function where abort is called ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - type(c_ptr) :: function_c_ptr integer(c_size_t) :: function_size integer(c_int32_t) :: error_code error_code = fckit__exception_function(function_c_ptr,function_size) FCKIT_ALLOCATE_CHARACTER(function,function_size) function = c_ptr_to_string(function_c_ptr) call c_ptr_free(function_c_ptr) end function !------------------------------------------------------------------------------ function callstack() use, intrinsic :: iso_c_binding use fckit_c_interop_module character(kind=c_char,len=:), allocatable :: callstack !! Callstack is called ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - type(c_ptr) :: callstack_c_ptr integer(c_size_t) :: callstack_size integer(c_int32_t) :: error_code error_code = fckit__exception_callstack(callstack_c_ptr,callstack_size) FCKIT_ALLOCATE_CHARACTER(callstack,callstack_size) callstack = c_ptr_to_string(callstack_c_ptr) call c_ptr_free(callstack_c_ptr) end function !------------------------------------------------------------------------------ subroutine throw( what, file, line, function ) use, intrinsic :: iso_c_binding use fckit_c_interop_module, only : c_str character(kind=c_char,len=*) :: what character(kind=c_char,len=*), optional :: file integer(c_int32_t), optional :: line character(kind=c_char,len=*), optional :: function ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - character(kind=c_char,len=:), allocatable :: opt_file integer(c_int32_t) :: opt_line character(kind=c_char,len=:), allocatable :: opt_function if( present(file) ) then allocate( character(len=len_trim(file)) :: opt_file ) opt_file = file else allocate( character(len=0) :: opt_file ) opt_file = "" endif if( present(line) ) then opt_line = line else opt_line = 0 endif if( present(function) ) then allocate( character(len=len_trim(function)) :: opt_function ) opt_function = function else allocate( character(len=0) :: opt_function ) opt_function = "" endif call fckit__exception_throw( c_str(what), c_str(opt_file), opt_line, c_str(opt_function) ) end subroutine !------------------------------------------------------------------------------ end module fckit_exception_module fckit-0.14.2/src/fckit/module/fckit_exception.inc000066400000000000000000000062751514707373700217530ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #ifdef FORD #define FORD_PRIVATE public #else #define FORD_PRIVATE private interface !void fckit__set_abort_handler( eckit::abort_handler_t h ) subroutine fckit__set_abort_handler( h ) bind(c) use iso_c_binding, only : c_funptr type(c_funptr), value :: h end subroutine !void fckit__abort (const char* what, const char* file, int32 line, const char* function ) subroutine fckit__abort(what,file,line,function) bind(c) use iso_c_binding, only : c_char, c_int32_t character(kind=c_char), dimension(*) :: what character(kind=c_char), dimension(*) :: file integer(c_int32_t), value :: line character(kind=c_char), dimension(*) :: function end subroutine !void fckit__exception_throw (const char* what, const char* file, int32 line, const char* function ) subroutine fckit__exception_throw(what,file,line,function) bind(c) use iso_c_binding, only : c_char, c_int32_t character(kind=c_char), dimension(*) :: what character(kind=c_char), dimension(*) :: file integer(c_int32_t), value :: line character(kind=c_char), dimension(*) :: function end subroutine !int fckit__exception_what (char* &what, size_t &what_size) function fckit__exception_what(what,what_size) result(error_code) bind(c) use iso_c_binding, only: c_int32_t, c_size_t, c_ptr integer(c_int32_t) :: error_code type(c_ptr) :: what integer(c_size_t) :: what_size end function !int fckit__exception_location () function fckit__exception_location() result(location) bind(c) use iso_c_binding, only: c_int32_t integer(c_int32_t) :: location end function !int fckit__exception_file (char* &file, size_t &file_size) function fckit__exception_file(file,file_size) result(error_code) bind(c) use iso_c_binding, only: c_int32_t, c_size_t, c_ptr integer(c_int32_t) :: error_code type(c_ptr) :: file integer(c_size_t) :: file_size end function !int fckit__exception_line () function fckit__exception_line() result(line) bind(c) use iso_c_binding, only: c_int32_t integer(c_int32_t) :: line end function !int fckit__exception_function (char* &function, size_t &function_size) function fckit__exception_function(function,function_size) result(error_code) bind(c) use iso_c_binding, only: c_int32_t, c_size_t, c_ptr integer(c_int32_t) :: error_code type(c_ptr) :: function integer(c_size_t) :: function_size end function !int fckit__exception_callstack (char* &callstack, size_t &callstack_size) function fckit__exception_callstack(callstack,callstack_size) result(error_code) bind(c) use iso_c_binding, only: c_int32_t, c_size_t, c_ptr integer(c_int32_t) :: error_code type(c_ptr) :: callstack integer(c_size_t) :: callstack_size end function end interface #endif interface subroutine fckit_exception_handler() end subroutine end interface fckit-0.14.2/src/fckit/module/fckit_final.F90000066400000000000000000000020631514707373700206220ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fckit.h" module fckit_final_module implicit none private !======================================================================== ! Public interface public fckit_final !======================================================================== type, abstract :: fckit_final contains procedure(final_interface), deferred, public :: final !! Finalise object end type ! ============================================================================= CONTAINS ! ============================================================================= subroutine final_interface(this) class(fckit_final), intent(inout) :: this FCKIT_SUPPRESS_UNUSED(this) end subroutine end module fckit-0.14.2/src/fckit/module/fckit_log.F90000066400000000000000000000301261514707373700203130ustar00rootroot00000000000000! (C) Copyright 2013 ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation nor ! does it submit to any jurisdiction. #include "fckit/fckit.h" module fckit_log_module !! Provides [[fckit_log_module:fckit_log(variable)]] for logging and to configure logging use fckit_object_module, only: fckit_object use, intrinsic :: iso_c_binding, only : c_int32_t implicit none private public :: log ! DEPRECATED, USE fckit_log INSTEAD! public :: fckit_log public :: fckit_logchannel private :: fckit_object private :: c_int32_t #include "fckit_log.inc" type, FORD_PRIVATE :: fckit_log_type !! Private type of [[fckit_log_module:fckit_log(variable)]] module variable !! !! It wraps ```eckit::Log```, allowing Fortran and C++ code to log to the !! same output channels integer(c_int32_t) :: SIMPLE = 0 !! Style for logging without any prefix integer(c_int32_t) :: PREFIX = 1 !! Style for logging with prefix !! !! (I) --> info !! (W) --> warning !! (E) --> error !! (D) --> debug integer(c_int32_t) :: TIMESTAMP = 2 !! Style for logging with prefix that contains time stamp and taskID !! !!