├── doc ├── .gitignore ├── version.json.in ├── _static │ ├── flibcpp-tm-footer.tex │ ├── flibcpp-tm-header.tex │ ├── ornltm-extract.sty │ ├── sphinxcustom.sty │ └── references.bib ├── appendices │ ├── license.rst │ └── interface.rst ├── references.rst ├── modules │ ├── chrono.rst │ ├── map.rst │ ├── set.rst │ ├── random.rst │ ├── string.rst │ ├── vector.rst │ └── algorithm.rst ├── Makefile ├── acknowledgments.rst ├── modules.rst ├── index.rst ├── introduction.rst ├── examples.rst ├── CMakeLists.txt ├── _python │ └── monkeysphinx.py ├── infrastructure.rst ├── conventions.rst └── conf.py ├── example ├── .gitignore ├── run-examples.sh ├── sort.f90 ├── CMakeLists.txt ├── vecstr.f90 ├── example_utils.f90 └── sort_generic.f90 ├── test ├── fassert.h ├── CMakeLists.txt ├── test_map.F90 ├── test_set.F90 ├── test_string.F90 ├── test_random.F90 ├── test_vector.F90 └── test_algorithm.F90 ├── cmake ├── flibcpp_version.cpp.in ├── FindSphinx.cmake ├── FlibcppConfig.cmake.in ├── backport-cmake-318 │ ├── UseSWIG │ │ └── ManageSupportFiles.cmake │ └── FindSWIG.cmake ├── FlibUtils.cmake └── CgvFindVersion.cmake ├── scripts ├── travis │ ├── compile.sh │ ├── test.sh │ ├── install.sh │ ├── deploy.sh │ ├── configure.sh │ └── before_install.sh └── build │ └── vostok.sh ├── include ├── import_flc.i ├── flc_chrono.i ├── flc_map.i ├── flc.i ├── flc_random.i ├── flc_vector.i ├── flc_set.i ├── flc_string.i └── flc_algorithm.i ├── LICENSE ├── README.md ├── src ├── flc.f90 └── flcFORTRAN_wrap.cxx └── CMakeLists.txt /doc/.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | -------------------------------------------------------------------------------- /example/.gitignore: -------------------------------------------------------------------------------- 1 | /build/ 2 | /build-*/ 3 | /install/ 4 | /install-*/ 5 | -------------------------------------------------------------------------------- /doc/version.json.in: -------------------------------------------------------------------------------- 1 | {"version": "@Flibcpp_VERSION@", "release": "@Flibcpp_VERSION_STRING@"} 2 | -------------------------------------------------------------------------------- /test/fassert.h: -------------------------------------------------------------------------------- 1 | #define ASSERT(COND) \ 2 | if(.not.(COND))then;print*,"Failure:",__LINE__;stop 1;end if 3 | -------------------------------------------------------------------------------- /doc/_static/flibcpp-tm-footer.tex: -------------------------------------------------------------------------------- 1 | \documentclass{ornltm} 2 | 3 | \author{Seth R.~Johnson} 4 | 5 | \begin{document} 6 | \backmatter 7 | \end{document} 8 | -------------------------------------------------------------------------------- /doc/_static/flibcpp-tm-header.tex: -------------------------------------------------------------------------------- 1 | \documentclass{ornltm} 2 | 3 | \author{Seth R.~Johnson} 4 | \title{Flibcpp User Manual} 5 | \date{Sep.~2021} 6 | \reportnum{ORNL/TM-2021/2041} 7 | \division{Computational Sciences and Engineering Division} 8 | 9 | \begin{document} 10 | \frontmatter 11 | \end{document} 12 | -------------------------------------------------------------------------------- /cmake/flibcpp_version.cpp.in: -------------------------------------------------------------------------------- 1 | extern "C" const char flibcpp_version[] = "@Flibcpp_VERSION_STRING@"; 2 | extern "C" const int flibcpp_version_major = @PROJECT_VERSION_MAJOR@; 3 | extern "C" const int flibcpp_version_minor = @PROJECT_VERSION_MINOR@; 4 | extern "C" const int flibcpp_version_patch = @PROJECT_VERSION_PATCH@; 5 | -------------------------------------------------------------------------------- /scripts/travis/compile.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh -ex 2 | ############################################################################### 3 | # File : scripts/travis/compile.sh 4 | ############################################################################### 5 | 6 | cd ${BUILD_ROOT} && ${GENERATOR} 7 | 8 | ############################################################################### 9 | # end of scripts/travis/compile.sh 10 | ############################################################################### 11 | -------------------------------------------------------------------------------- /doc/appendices/license.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/appendices/license.rst 3 | .. ############################################################################ 4 | 5 | ******* 6 | License 7 | ******* 8 | 9 | .. include:: ../../LICENSE 10 | 11 | .. ############################################################################ 12 | .. end of doc/appendices/license.rst 13 | .. ############################################################################ 14 | -------------------------------------------------------------------------------- /doc/references.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/references.rst 3 | .. ############################################################################ 4 | 5 | ********** 6 | References 7 | ********** 8 | 9 | .. bibliography:: _static/references.bib 10 | :all: 11 | 12 | .. ############################################################################ 13 | .. end of doc/references.rst 14 | .. ############################################################################ 15 | -------------------------------------------------------------------------------- /doc/modules/chrono.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules/chrono.rst 3 | .. ############################################################################ 4 | 5 | .. _modules_chrono: 6 | 7 | ****** 8 | Chrono 9 | ****** 10 | 11 | Time calculations and timers are not yet implemented. 12 | 13 | .. ############################################################################ 14 | .. end of doc/modules/chrono.rst 15 | .. ############################################################################ 16 | -------------------------------------------------------------------------------- /include/import_flc.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file import_flc.i 3 | * 4 | * Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | // Make sure that the downstream module isn't doing ``%import "import_flc.i"`` 9 | // or ``%import "flc.i"``: only ``%include "import_flc.i"`` 10 | #ifndef SWIGIMPORTED 11 | #define FLC_SWIGIMPORTED 12 | #endif 13 | 14 | // Set up macros, etc. 15 | %import "flc.i" 16 | 17 | // Set up integer types 18 | %{ 19 | #include 20 | %} 21 | 22 | // Support external exceptions 23 | %include 24 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | # Minimal makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line. 5 | SPHINXOPTS = 6 | SPHINXBUILD = sphinx-build 7 | SPHINXPROJ = Flibcpp 8 | SOURCEDIR = . 9 | BUILDDIR = _build 10 | 11 | # Put it first so that "make" without argument is like "make help". 12 | help: 13 | @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 14 | 15 | .PHONY: help Makefile 16 | 17 | # Catch-all target: route all unknown targets to Sphinx using the new 18 | # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). 19 | %: Makefile 20 | @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 21 | -------------------------------------------------------------------------------- /cmake/FindSphinx.cmake: -------------------------------------------------------------------------------- 1 | # CMake find_package() Module for Sphinx documentation generator 2 | # http://sphinx-doc.org/ 3 | # 4 | # Example usage: 5 | # 6 | # find_package(Sphinx) 7 | # 8 | # If successful the following variables will be defined 9 | # SPHINX_FOUND 10 | # SPHINX_EXECUTABLE 11 | 12 | find_program(SPHINX_EXECUTABLE 13 | NAMES sphinx-build sphinx-build2 14 | DOC "Path to sphinx-build executable") 15 | 16 | # Handle REQUIRED and QUIET arguments 17 | # this will also set SPHINX_FOUND to true if SPHINX_EXECUTABLE exists 18 | include(FindPackageHandleStandardArgs) 19 | find_package_handle_standard_args(Sphinx 20 | "Failed to locate sphinx-build executable" 21 | SPHINX_EXECUTABLE) 22 | -------------------------------------------------------------------------------- /include/flc_chrono.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc_chrono.i 3 | * 4 | * Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc_chrono" 9 | %include "import_flc.i" 10 | %flc_add_header 11 | 12 | /* ------------------------------------------------------------------------- 13 | * Utility routines 14 | * ------------------------------------------------------------------------- */ 15 | 16 | %{ 17 | #include 18 | #include 19 | #include 20 | %} 21 | 22 | %inline %{ 23 | static void sleep_for(int ms) { 24 | if (ms < 0) 25 | throw std::domain_error("Invalid sleep time"); 26 | std::this_thread::sleep_for(std::chrono::milliseconds(ms)); 27 | } 28 | %} 29 | -------------------------------------------------------------------------------- /scripts/travis/test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh -ex 2 | ############################################################################### 3 | # File : scripts/travis/test.sh 4 | ############################################################################### 5 | 6 | cd ${BUILD_ROOT} 7 | 8 | ctest --output-on-failure 9 | if [ "${FLIBCPP_DEV}" = "ON" ]; then 10 | # Run tests (not examples, which use a shell script) through valgrind 11 | if ! ctest -E examples -D ExperimentalMemCheck --output-on-failure; then 12 | find Testing/Temporary -name "MemoryChecker.*.log" -exec cat {} + 13 | exit 1 14 | fi 15 | fi 16 | 17 | ############################################################################### 18 | # end of scripts/travis/test.sh 19 | ############################################################################### 20 | -------------------------------------------------------------------------------- /scripts/build/vostok.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh -ex 2 | SOURCE=$(cd $(dirname "${BASH_SOURCE[0]}")/../.. && pwd) 3 | BUILD=${SOURCE}/build 4 | PREFIX=${SOURCE}/install 5 | 6 | test -d "${BUILD}" || mkdir -p "${BUILD}" 7 | cd ${BUILD} 8 | 9 | CMAKE=cmake 10 | ${CMAKE} --version 11 | 12 | # NOTE: gcc 10.2 incorrectly warns about logical conversions, see 13 | # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=96319 14 | module load swig/4.0.2-fortran gcc/11 15 | 16 | ${CMAKE} \ 17 | -G Ninja \ 18 | -D FLIBCPP_DEV=ON \ 19 | -D FLIBCPP_Fortran_STANDARD=03 \ 20 | -D BUILD_SHARED_LIBS=ON \ 21 | -D CMAKE_Fortran_FLAGS="-Wall -Wextra -pedantic -Wimplicit-procedure -Wimplicit-interface -Wno-compare-reals" \ 22 | -D CMAKE_CXX_FLAGS="-Wall -Wextra -pedantic -Werror" \ 23 | -D CMAKE_INSTALL_PREFIX="${PREFIX}" \ 24 | ${SOURCE} 25 | ninja -v 26 | ctest --output-on-failure 27 | ninja install 28 | -------------------------------------------------------------------------------- /example/run-examples.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | FAIL=0 4 | 5 | function overall_result 6 | { 7 | exit ${FAIL} 8 | } 9 | trap overall_result EXIT 10 | 11 | function run_test 12 | { 13 | local TESTNAME=$1 14 | local EXE=./${TESTNAME}.exe 15 | local OUT=${TESTNAME}.out 16 | printf "Run %s..." ${TESTNAME} 17 | ${EXE} > ${OUT} 2>&1 18 | if [ $? -eq 0 ]; then 19 | echo "success!" 20 | else 21 | echo "FAILURE!" 22 | FAIL=1 23 | while read line 24 | do 25 | echo "${TESTNAME}: ${line}" 26 | done < ${OUT} 27 | fi 28 | } 29 | 30 | run_test sort << EOF 31 | nope 32 | three 33 | 10000000000000000 34 | 20 ha ha 35 | 20 36 | EOF 37 | 38 | run_test sort_generic << EOF 39 | 5 40 | a short string 41 | a shirt string 42 | shorter 43 | and the next string is unallocated 44 | EOF 45 | 46 | run_test vecstr << EOF 47 | This is the first string 48 | a second string 49 | and the third 50 | EOF 51 | 52 | -------------------------------------------------------------------------------- /include/flc_map.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc_map.i 3 | * 4 | * Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc_map" 9 | %include "import_flc.i" 10 | %flc_add_header 11 | 12 | %include 13 | 14 | /* ------------------------------------------------------------------------- 15 | * Numeric maps 16 | * ------------------------------------------------------------------------- */ 17 | 18 | %template(MapIntInt) std::map; 19 | 20 | /* ------------------------------------------------------------------------- 21 | * String maps 22 | * ------------------------------------------------------------------------- */ 23 | 24 | %include 25 | %import "flc_string.i" 26 | %template(MapStringInt) std::map; 27 | %template(MapStringString) std::map; 28 | -------------------------------------------------------------------------------- /cmake/FlibcppConfig.cmake.in: -------------------------------------------------------------------------------- 1 | get_filename_component(Flibcpp_CMAKE_DIR "${CMAKE_CURRENT_LIST_FILE}" PATH) 2 | 3 | list(APPEND CMAKE_MODULE_PATH ${Flibcpp_CMAKE_DIR}) 4 | 5 | if(NOT TARGET @FLIBCPP_NAMESPACE@flc) 6 | include("${Flibcpp_CMAKE_DIR}/FlibcppTargets.cmake") 7 | endif() 8 | 9 | set(Flibcpp_VERSION_STRING "@Flibcpp_VERSION_STRING@") 10 | 11 | set(Flibcpp_LIBRARIES @FLIBCPP_LIBRARIES@) 12 | 13 | set(FLIBCPP_BUILD_SHARED_LIBS @BUILD_SHARED_LIBS@) 14 | set(FLIBCPP_USE_SWIG @FLIBCPP_USE_SWIG@) 15 | set(FLIBCPP_Fortran_STANDARD @FLIBCPP_Fortran_STANDARD@) 16 | 17 | if(FLIBCPP_USE_SWIG) 18 | set(FLIBCPP_SWIG_EXECUTABLE @SWIG_EXECUTABLE@) 19 | set(FLIBCPP_SWIG_DIR @SWIG_DIR@) 20 | endif() 21 | 22 | if(NOT FLIBCPP_BUILD_SHARED_LIBS) 23 | # Downstream libraries must find and link to the C++ runtimes themselves since 24 | # they can't use the shared library dependencies 25 | enable_language(CXX) 26 | endif() 27 | -------------------------------------------------------------------------------- /test/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | #---------------------------------------------------------------------------## 2 | # \file flibcpp/test/CMakeLists.txt 3 | # 4 | # Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | # Distributed under an MIT open source license: see LICENSE for details. 6 | #---------------------------------------------------------------------------## 7 | 8 | # Create test with dependencies 9 | macro(swig_fortran_add_test TESTNAME) 10 | add_executable(${TESTNAME}.exe ${TESTNAME}.F90) 11 | target_link_libraries(${TESTNAME}.exe ${ARGN}) 12 | add_test(NAME ${TESTNAME} COMMAND ${TESTNAME}.exe) 13 | endmacro() 14 | 15 | swig_fortran_add_test(test_algorithm 16 | flc_algorithm) 17 | swig_fortran_add_test(test_map 18 | flc_map) 19 | swig_fortran_add_test(test_random 20 | flc_random) 21 | swig_fortran_add_test(test_set 22 | flc_set) 23 | swig_fortran_add_test(test_string 24 | flc_string) 25 | swig_fortran_add_test(test_vector 26 | flc_vector) 27 | -------------------------------------------------------------------------------- /doc/acknowledgments.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/acknowledgments.rst 3 | .. ############################################################################ 4 | 5 | .. raw:: latex 6 | 7 | \setcounter{secnumdepth}{0} 8 | 9 | 10 | *************** 11 | Acknowledgments 12 | *************** 13 | 14 | This research was supported by the Exascale Computing Project (17-SC-20-SC), 15 | a joint project of the U.S. Department of Energy's Office of Science and 16 | National Nuclear Security Administration, responsible for delivering a capable 17 | exascale ecosystem, including software, applications, and hardware technology, 18 | to support the nation’s exascale computing imperative. 19 | 20 | This research used resources of the Oak Ridge Leadership Computing Facility, 21 | which is a DOE Office of Science User Facility supported under Contract 22 | DE-AC05-00OR22725. 23 | 24 | .. raw:: latex 25 | 26 | \setcounter{secnumdepth}{2} 27 | 28 | -------------------------------------------------------------------------------- /doc/modules.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules.rst 3 | .. ############################################################################ 4 | 5 | ******* 6 | Modules 7 | ******* 8 | 9 | Flibcpp is organized into distinct modules whose structure mirrors the C++ 10 | standard library include headers. 11 | 12 | The modules themselves are namespaced with a ``flc_`` prefix, so 13 | for example the ``std::sort`` algorithm, available in the ```` 14 | header, can be obtained via:: 15 | 16 | use flc_algorithm, only : sort 17 | 18 | .. toctree:: 19 | modules/algorithm.rst 20 | modules/chrono.rst 21 | modules/map.rst 22 | modules/random.rst 23 | modules/set.rst 24 | modules/string.rst 25 | modules/vector.rst 26 | 27 | 28 | .. ############################################################################ 29 | .. end of doc/modules.rst 30 | .. ############################################################################ 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019--2021 Oak Ridge National Laboratory, UT--Battelle, LLC. 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /scripts/travis/install.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh -ex 2 | ############################################################################### 3 | # File : scripts/travis/install.sh 4 | # 5 | # Install dependencies. 6 | ############################################################################### 7 | 8 | mkdir -p ${INSTALL_ROOT}/bin 9 | 10 | echo "CMake version: $(${CMAKE} --version | head -1)" 11 | echo "CTest version: $(ctest --version | head -1)" 12 | echo "Ninja version: $(ninja --version || echo 'n/a')" 13 | echo "Fortran compiler version: $(${FC} --version | head -1)" 14 | 15 | if [ "${FLIBCPP_DEV}" = "ON" ]; then 16 | # Install SWIG-fortran 17 | cd $(mktemp -d) 18 | git clone --depth=1 https://github.com/swig-fortran/swig 19 | cd swig 20 | echo "SWIG git revision: $(git rev-parse HEAD)" 21 | ./autogen.sh 22 | ./configure --prefix="${INSTALL_ROOT}" --without-alllang --with-fortran=$FC 23 | make 24 | make install 25 | echo "Installed SWIG version: $(swig -version | grep SWIG)" 26 | fi 27 | 28 | ############################################################################### 29 | # end of scripts/travis/install.sh 30 | ############################################################################### 31 | -------------------------------------------------------------------------------- /cmake/backport-cmake-318/UseSWIG/ManageSupportFiles.cmake: -------------------------------------------------------------------------------- 1 | # Distributed under the OSI-approved BSD 3-Clause License. See accompanying 2 | # file Copyright.txt or https://cmake.org/licensing for details. 3 | 4 | 5 | if (ACTION STREQUAL "CLEAN") 6 | # Collect current list of generated files 7 | file (GLOB files LIST_DIRECTORIES FALSE RELATIVE "${SUPPORT_FILES_WORKING_DIRECTORY}" "${SUPPORT_FILES_WORKING_DIRECTORY}/*") 8 | 9 | if (files) 10 | # clean-up the output directory 11 | ## compute full paths 12 | list (TRANSFORM files PREPEND "${SUPPORT_FILES_OUTPUT_DIRECTORY}/") 13 | ## remove generated files from the output directory 14 | file (REMOVE ${files}) 15 | 16 | # clean-up working directory 17 | file (REMOVE_RECURSE "${SUPPORT_FILES_WORKING_DIRECTORY}") 18 | endif() 19 | 20 | file (MAKE_DIRECTORY "${SUPPORT_FILES_WORKING_DIRECTORY}") 21 | endif() 22 | 23 | if (ACTION STREQUAL "COPY") 24 | # Collect current list of generated files 25 | file (GLOB files LIST_DIRECTORIES FALSE "${SUPPORT_FILES_WORKING_DIRECTORY}/*") 26 | 27 | if (files) 28 | # copy files to the output directory 29 | file (COPY ${files} DESTINATION "${SUPPORT_FILES_OUTPUT_DIRECTORY}") 30 | endif() 31 | endif() 32 | -------------------------------------------------------------------------------- /scripts/travis/deploy.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh -e 2 | ############################################################################### 3 | # File : scripts/travis/deploy.sh 4 | ############################################################################### 5 | 6 | if [ $(uname -s) = "Darwin" ]; then 7 | SO_EXT=.dylib 8 | else 9 | SO_EXT=.so 10 | fi 11 | 12 | set -x 13 | cd ${BUILD_ROOT} && ${GENERATOR} install 14 | 15 | # Test existence of install files 16 | test_f() { 17 | if ! [ -f "$1" ]; then 18 | echo -e "\e[0;31mMissing file $1\e[0m" 19 | ls -al "$(dirname "$1")" 20 | return 1 21 | fi 22 | } 23 | 24 | if [ "${FLIBCPP_DEV}" = "ON" ]; then 25 | test_f ${INSTALL_ROOT}/share/doc/Flibcpp/index.html 26 | test_f ${INSTALL_ROOT}/include/flc.i 27 | fi 28 | 29 | test_f ${INSTALL_ROOT}/include/flc.mod 30 | test_f ${INSTALL_ROOT}/lib/libflc${SO_EXT} 31 | test_f ${INSTALL_ROOT}/lib/cmake/Flibcpp/FlibcppConfig.cmake 32 | 33 | # Test external installation 34 | cd ${SOURCE_ROOT}/example 35 | mkdir build 36 | cd build 37 | CMAKE_PREFIX_PATH=${INSTALL_ROOT} ${CMAKE} .. 38 | make 39 | ../run-examples.sh 40 | 41 | ############################################################################### 42 | # end of scripts/travis/deploy.sh 43 | ############################################################################### 44 | -------------------------------------------------------------------------------- /scripts/travis/configure.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh -e 2 | ############################################################################### 3 | # File : scripts/travis/configure.sh 4 | ############################################################################### 5 | 6 | if [ "${GENERATOR}" = "ninja" ]; then 7 | CMAKE_GENERATOR="Ninja" 8 | elif [ "${GENERATOR}" = "make" ]; then 9 | CMAKE_GENERATOR="Unix Makefiles" 10 | else 11 | echo "Invalid generator '${GENERATOR}'" 12 | exit 1 13 | fi 14 | 15 | CXX_FLAGS="-Wall -Wextra -Werror" 16 | Fortran_FLAGS="-Wall -Wextra -Wimplicit-procedure -Wimplicit-interface -Wno-compare-reals -Wno-maybe-uninitialized -Werror" 17 | 18 | set -x 19 | cd ${BUILD_ROOT} && ${CMAKE} -G "${CMAKE_GENERATOR}" \ 20 | -D FLIBCPP_DEV=${FLIBCPP_DEV} \ 21 | -D FLIBCPP_BUILD_EXAMPLES=ON \ 22 | -D FLIBCPP_BUILD_TESTS=ON \ 23 | -D FLIBCPP_Fortran_STANDARD="${FLIBCPP_FSTD}" \ 24 | -D CMAKE_CXX_FLAGS="${CXX_FLAGS}" \ 25 | -D CMAKE_Fortran_FLAGS="${Fortran_FLAGS}" \ 26 | -D CMAKE_INSTALL_PREFIX="${INSTALL_ROOT}" \ 27 | -D MEMORYCHECK_COMMAND_OPTIONS="--error-exitcode=1 --leak-check=full" \ 28 | ${SOURCE_ROOT} 29 | 30 | ############################################################################### 31 | # end of scripts/travis/configure.sh 32 | ############################################################################### 33 | -------------------------------------------------------------------------------- /doc/appendices/interface.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/appendices/interface.rst 3 | .. ############################################################################ 4 | 5 | .. highlight:: swig 6 | 7 | ********* 8 | Interface 9 | ********* 10 | 11 | These are the SWIG interface files used to generate the Flibcpp modules. 12 | 13 | flc 14 | === 15 | 16 | The primary file defines typemaps. 17 | 18 | .. literalinclude:: ../../include/flc.i 19 | :linenos: 20 | 21 | flc_algorithm 22 | ============= 23 | 24 | .. literalinclude:: ../../include/flc_algorithm.i 25 | :linenos: 26 | 27 | flc_chrono 28 | ============= 29 | 30 | .. literalinclude:: ../../include/flc_chrono.i 31 | :linenos: 32 | 33 | flc_random 34 | ============= 35 | 36 | .. literalinclude:: ../../include/flc_random.i 37 | :linenos: 38 | 39 | flc_set 40 | ============= 41 | 42 | .. literalinclude:: ../../include/flc_set.i 43 | :linenos: 44 | 45 | flc_string 46 | ============= 47 | 48 | .. literalinclude:: ../../include/flc_string.i 49 | :linenos: 50 | 51 | flc_vector 52 | ============= 53 | 54 | .. literalinclude:: ../../include/flc_vector.i 55 | :linenos: 56 | 57 | .. ############################################################################ 58 | .. end of doc/appendices/interface.rst 59 | .. ############################################################################ 60 | -------------------------------------------------------------------------------- /doc/index.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/index.rst 3 | .. ############################################################################ 4 | 5 | ======= 6 | Flibcpp 7 | ======= 8 | 9 | .. *************************************************************************** 10 | .. MAIN MATTER 11 | .. *************************************************************************** 12 | 13 | .. raw:: latex 14 | 15 | \begin{abstract} 16 | 17 | Flibcpp uses SWIG-Fortran to generate native Fortran-2003 interfaces to 18 | efficient and robust algorithms and data containers implemented in the C++ 19 | standard library. 20 | 21 | .. raw:: latex 22 | 23 | \end{abstract} 24 | 25 | .. only:: html 26 | 27 | :Release: |version| 28 | :Date: |today| 29 | 30 | .. toctree:: 31 | :maxdepth: 2 32 | :caption: Contents 33 | 34 | introduction.rst 35 | infrastructure.rst 36 | conventions.rst 37 | modules.rst 38 | examples.rst 39 | references.rst 40 | acknowledgments.rst 41 | 42 | .. *************************************************************************** 43 | .. APPENDICES 44 | .. *************************************************************************** 45 | 46 | .. raw:: latex 47 | 48 | \appendix 49 | 50 | .. toctree:: 51 | :maxdepth: 2 52 | :caption: Appendices 53 | 54 | appendices/interface.rst 55 | appendices/license.rst 56 | 57 | -------------------------------------------------------------------------------- /example/sort.f90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file example/sort.f90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | !-----------------------------------------------------------------------------! 6 | 7 | program sort_example 8 | use, intrinsic :: ISO_C_BINDING 9 | use flc 10 | use flc_algorithm, only : sort, shuffle 11 | use flc_random, only : Engine => MersenneEngine4, normal_distribution 12 | use example_utils, only : write_version, read_positive_int, STDOUT 13 | implicit none 14 | integer :: arr_size 15 | real(c_double), dimension(:), allocatable :: x 16 | real(c_double), parameter :: MEAN = 1.0d0, SIGMA = 0.5d0 17 | type(Engine) :: rng 18 | 19 | ! Print version information 20 | call write_version() 21 | 22 | ! Get array size 23 | arr_size = read_positive_int("array size") 24 | allocate(x(arr_size)) 25 | 26 | ! Fill randomly with normal distribution 27 | rng = Engine() 28 | call normal_distribution(MEAN, SIGMA, rng, x) 29 | 30 | ! Sort the array 31 | call sort(x) 32 | write(STDOUT, "(a, 4(f8.3,','))") "First few elements:", x(:min(4, size(x))) 33 | 34 | ! Rearrange it randomly 35 | call shuffle(rng, x) 36 | write(STDOUT, "(a, 4(f8.3,','))") "After shuffling:", x(:min(4, size(x))) 37 | 38 | call rng%release() 39 | end program 40 | 41 | !-----------------------------------------------------------------------------! 42 | ! end of example/sort.f90 43 | !-----------------------------------------------------------------------------! 44 | -------------------------------------------------------------------------------- /doc/introduction.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/introduction.rst 3 | .. ############################################################################ 4 | 5 | ************ 6 | Introduction 7 | ************ 8 | 9 | The Fortran programming language includes many mathematical functions but few 10 | of the generic, high-performance software algorithms and data containers needed 11 | by essentially all modern scientific software. Most Fortran software contains 12 | hand-written code for such algorithms that may be burdensome to maintain and 13 | inflexible, as well as unperformant and erroneous under certain conditions. 14 | 15 | Flibcpp [#flibcpp_vers]_ is a library for use by application developers that provides native 16 | Fortran interfaces to existing high-quality algorithms and containers 17 | implemented in C++ and available on all modern computer systems. 18 | 19 | Flibcpp defines a carefully crafted set of interface files written for the 20 | SWIG-Fortran code generator :cite:`johnson_automated_2020`, an extension of 21 | SWIG :cite:`beazley_automated_2003`. These Fortran interfaces generate native 22 | Fortran 23 | proxy code that comprises a set of thin wrappers to selected functionality in 24 | the C++ standard library. The resulting code is a set of Fortran modules and 25 | C++ wrappers that expose a concise and well-defined interface that may be built 26 | into and distributed with the application. 27 | 28 | The generated modules include functionality for efficient generic sorting and 29 | searching, set operations, random number generation, value mapping, string 30 | manipulation, and dynamically resizing vectors. 31 | 32 | .. [#flibcpp_vers] This documentation is generated from Flibcpp |release|. 33 | 34 | .. ############################################################################ 35 | .. end of doc/introduction.rst 36 | .. ############################################################################ 37 | -------------------------------------------------------------------------------- /example/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | #---------------------------------*-CMake-*-----------------------------------# 2 | # Copyright (c) 2021 Oak Ridge National Laboratory, UT-Battelle, LLC. 3 | # License-Filename: LICENSE 4 | # SPDX-License-Identifier: MIT 5 | #-----------------------------------------------------------------------------# 6 | 7 | if(NOT DEFINED PROJECT_NAME) 8 | # Allow use for this script as an external installation 9 | cmake_minimum_required(VERSION 3.12) 10 | # Enable use as a standalone test 11 | project(FlibcppExample LANGUAGES Fortran) 12 | find_package(Flibcpp CONFIG REQUIRED) 13 | endif() 14 | 15 | # Create executable with dependencies 16 | macro(flibcpp_example name) 17 | add_executable(${name}.exe ${name}.f90) 18 | target_link_libraries(${name}.exe example_utils_lib ${ARGN}) 19 | endmacro() 20 | 21 | #---------------------------------------------------------------------------## 22 | # TEST LIBRARIES 23 | #---------------------------------------------------------------------------## 24 | 25 | add_library(example_utils_lib 26 | "example_utils.f90" 27 | ) 28 | target_link_libraries(example_utils_lib 29 | Flibcpp::flc Flibcpp::flc_string Flibcpp::flc_vector) 30 | 31 | #---------------------------------------------------------------------------## 32 | # EXAMPLES 33 | #---------------------------------------------------------------------------## 34 | 35 | flibcpp_example(sort 36 | Flibcpp::flc_algorithm Flibcpp::flc_random Flibcpp::flc_string) 37 | 38 | flibcpp_example(vecstr 39 | Flibcpp::flc_string Flibcpp::flc_vector) 40 | 41 | flibcpp_example(sort_generic 42 | Flibcpp::flc_algorithm) 43 | 44 | #---------------------------------------------------------------------------## 45 | # TESTS 46 | #---------------------------------------------------------------------------## 47 | 48 | if(BUILD_TESTING) 49 | add_test( 50 | NAME examples 51 | COMMAND "${CMAKE_CURRENT_SOURCE_DIR}/run-examples.sh" 52 | WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}") 53 | endif() 54 | -------------------------------------------------------------------------------- /scripts/travis/before_install.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash -e 2 | ############################################################################### 3 | # File : example/before_install.sh 4 | ############################################################################### 5 | 6 | ############################################################################### 7 | # ENVIRONMENT VARIABLES 8 | ############################################################################### 9 | 10 | export SOURCE_ROOT=${PWD} 11 | export BUILD_ROOT=${SOURCE_ROOT}/build 12 | export INSTALL_ROOT=${HOME}/install 13 | export CMAKE_PREFIX_PATH=${INSTALL_ROOT}:${CMAKE_PREFIX_PATH} 14 | export PATH=${INSTALL_ROOT}/bin:${PATH} 15 | export FC=${FC:-gfortran} 16 | export CC=${CC:-gcc} 17 | export CXX=${CXX:-g++} 18 | export CMAKE=/usr/bin/cmake # precompiled Travis overrides Focal apt 19 | export CTEST=/usr/bin/ctest # precompiled Travis overrides Focal apt 20 | 21 | mkdir -p ${BUILD_ROOT} 22 | 23 | # Define a command (using built-in travis functions) to launch one of our 24 | # scripts 25 | run_script() { 26 | set +exv 27 | fold_start $1 "$2" 28 | local scriptloc="${SOURCE_ROOT}/scripts/travis/$1.sh" 29 | echo -e "\e[0;32mRunning ${scriptloc}\e[0m" 30 | ${scriptloc} 31 | local _RESULT=$? 32 | fold_end $1 33 | if [ ${_RESULT} -ne 0 ]; then 34 | echo -e "\e[1;31m${scriptloc} exited with ${_RESULT}\e[0m" 35 | fi 36 | return ${_RESULT} 37 | } 38 | 39 | ############################################################################### 40 | # UTILITIES FROM TRAVIS 41 | # 42 | # from https://github.com/travis-ci/travis-rubies/blob/build/build.sh 43 | ############################################################################### 44 | 45 | fold_start() { 46 | echo -e "travis_fold:start:$1\033[33;1m$2\033[0m" 47 | } 48 | 49 | fold_end() { 50 | echo -e "\ntravis_fold:end:$1\r" 51 | } 52 | 53 | ############################################################################### 54 | # end of example/before_install.sh 55 | ############################################################################### 56 | -------------------------------------------------------------------------------- /doc/_static/ornltm-extract.sty: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | % File : doc/_sphinx/latex/ornltm-extract.sty 3 | % Author: Seth R Johnson 4 | % Date : Sat Oct 13 13:04:10 2018 5 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | 7 | \NeedsTeXFormat{LaTeX2e}[1995/12/01] 8 | \ProvidesPackage{ornltm-extract}[2018/11/13 package ORNL Technical Memorandum 9 | commands] 10 | 11 | \ProcessOptions\relax 12 | 13 | \RequirePackage{emptypage} % hide footers on blank pages 14 | 15 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 16 | % FRONT MATTER 17 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 18 | 19 | \newif\if@mainmatter 20 | \@mainmattertrue 21 | \def\@cleariffrontmatter{\if@mainmatter\relax\else{\clearpage}\fi} 22 | \def\@cleardbliffrontmatter{\if@mainmatter\relax\else{\cleardoublepage}\fi} 23 | 24 | \newcommand\frontmatter{% 25 | \@mainmatterfalse% 26 | % Reset page numbering for user-added front matter 27 | \pagenumbering{roman}% 28 | \setcounter{page}{3}% 29 | } 30 | 31 | % Abstract gets a new page if it's in the front matter; otherwise it's just at 32 | % the top of the page. 33 | \renewenvironment{abstract}{% 34 | \if@mainmatter\relax\else 35 | \cleardoublepage 36 | \pagenumbering{arabic} 37 | \setcounter{page}{1} 38 | \fi 39 | \addcontentsline{toc}{section}{Abstract} 40 | \phantomsection 41 | \section*{Abstract}% 42 | }{} 43 | 44 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 45 | % MAIN MATTER 46 | % 47 | % not quite the same as in ornltm.cls 48 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 49 | 50 | \newcommand\mainmatter{% 51 | \cleardoublepage% 52 | \@mainmattertrue% 53 | \pagenumbering{arabic}% 54 | \setcounter{page}{1} 55 | \renewcommand{\sectionbreak}{\renewcommand\sectionbreak\cleardoublepage} 56 | } 57 | 58 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 59 | 60 | \endinput 61 | 62 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 63 | % end of ornltm/ornltm/ornltm-style.tex 64 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 65 | -------------------------------------------------------------------------------- /test/test_map.F90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file test/test_map.F90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | ! Distributed under an MIT open source license: see LICENSE for details. 6 | !-----------------------------------------------------------------------------! 7 | 8 | #include "fassert.h" 9 | 10 | program test_map 11 | implicit none 12 | call test_int_int() 13 | call test_string_string() 14 | contains 15 | 16 | !-----------------------------------------------------------------------------! 17 | subroutine test_int_int() 18 | use, intrinsic :: ISO_C_BINDING 19 | use flc_map, only : Map => MapIntInt 20 | implicit none 21 | type(Map) :: m 22 | logical :: inserted = .false. 23 | 24 | m = Map() 25 | ASSERT(m%size() == 0) 26 | ASSERT(m%empty()) 27 | 28 | call m%insert(123, 456) 29 | ASSERT(m%size() == 1) 30 | ASSERT(m%get(123) == 456) 31 | 32 | ! Map elements are unique: inserting does *not* overwrite 33 | call m%insert(123, 567, inserted) 34 | ASSERT(inserted .eqv. .false.) 35 | ASSERT(m%get(123) == 456) 36 | 37 | ! Elements can be overwritten with 'set' 38 | call m%set(123, 567) 39 | ASSERT(m%get(123) == 567) 40 | 41 | ! Elements not present will be created with `get` 42 | ASSERT(m%count(911) == 0) 43 | ASSERT(m%get(911) == 0) 44 | ASSERT(m%count(911) == 1) 45 | 46 | ! Elements can be removed from the map 47 | call m%erase(911) 48 | ASSERT(m%count(911) == 0) 49 | 50 | call m%release() 51 | end subroutine 52 | 53 | !-----------------------------------------------------------------------------! 54 | subroutine test_string_string() 55 | use, intrinsic :: ISO_C_BINDING 56 | use flc_map, only : Map => MapStringString 57 | use flc_string, only : String 58 | implicit none 59 | type(Map) :: m 60 | 61 | m = Map() 62 | ASSERT(m%empty()) 63 | 64 | call m%insert("bugsbunny", "yoohoo") 65 | call m%insert("texas", "howdy") 66 | ASSERT(m%size() == 2) 67 | ASSERT(m%count("bugsbunny") == 1) 68 | ASSERT(m%count("jersey") == 0) 69 | ASSERT(m%get("texas") == "howdy") 70 | call m%release() 71 | end subroutine 72 | 73 | !-----------------------------------------------------------------------------! 74 | end program 75 | -------------------------------------------------------------------------------- /doc/_static/sphinxcustom.sty: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | % File : doc/_sphinx/latex/sphinxcustom.sty 3 | % Author: Seth R Johnson 4 | % Date : Sat Oct 13 17:55:11 2018 5 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | 7 | \NeedsTeXFormat{LaTeX2e}[1995/12/01] 8 | \ProvidesPackage{sphinxcustom}[2018/10/13 package Sphinx supplemental 9 | annotation] 10 | 11 | \ProcessOptions\relax 12 | 13 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 14 | % TABLES 15 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 16 | 17 | % Support top/mid/bottomrule 18 | \RequirePackage{booktabs} 19 | 20 | % Improve column auto-sizing 21 | \setlength{\tymin}{6em} 22 | \setlength{\tymax}{0.75\linewidth} 23 | 24 | % Sphinx caption definition conflicts with the caption package 25 | \renewcommand\sphinxcaption[2][\LTcapwidth]{% 26 | \caption{#2}% 27 | }% 28 | 29 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30 | % TOC 31 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 32 | 33 | \addto\captionsenglish{\renewcommand{\contentsname}{Contents}} 34 | 35 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 36 | % FONTS 37 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 38 | 39 | % Annotation: ``parameter'', ``postprocessor'' etc. 40 | \protected\def\sphinxannotation#1{\emph{\small \color{gray} #1}} 41 | 42 | % Don't use sans serif font for table headers 43 | \renewcommand\sphinxstyletheadfamily\relax 44 | 45 | % Color references instead of italicizing 46 | \definecolor{linkblue}{RGB}{0,5,10} 47 | \protected\def\sphinxcrossref#1{\color{linkblue}#1} 48 | 49 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50 | % PAGE STYLE 51 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 52 | 53 | \fancypagestyle{plain}{ 54 | \renewcommand\headrulewidth{0pt} 55 | \fancyhf{} 56 | \fancyfoot[CE,CO]{\thepage} 57 | } 58 | 59 | \fancypagestyle{normal}{ 60 | \renewcommand\headrulewidth{0pt} 61 | \fancyhf{} 62 | \fancyfoot[CE,CO]{\thepage} 63 | } 64 | 65 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 66 | \endinput 67 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 68 | % end of doc/_sphinx/latex/sphinxcustom.sty 69 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70 | -------------------------------------------------------------------------------- /doc/modules/map.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules/map.rst 3 | .. ############################################################################ 4 | 5 | .. _modules_Map: 6 | 7 | *** 8 | Map 9 | *** 10 | 11 | Maps are sorted dictionaries mapping keys to values. Currently they have 12 | limited functionality and few instantiations: maps of ints to ints and of 13 | strings to strings. 14 | 15 | Basic functionality 16 | =================== 17 | 18 | All map types support the following basic operations. 19 | 20 | Construction and destruction 21 | ---------------------------- 22 | 23 | Like other wrapped C++ classes in Flibcpp, maps are 24 | constructed using an interface function. The default constructor is an empty 25 | map. Maps are destroyed using the ``release`` type-bound subroutine. 26 | 27 | Modification 28 | ------------ 29 | 30 | The contents of the map can be changed with the following methods: 31 | 32 | ``insert``: 33 | Add a new key-value pair to the map. If the key already exists, the value in 34 | the map will remain unchanged. An optional ``logical`` parameter can be 35 | passed that will be set to ``.true.`` if insertion was successful and 36 | ``.false.`` if the key already existed. 37 | 38 | ``set``: 39 | Assign the given value to the key, regardless of whether the value already 40 | existed. 41 | 42 | ``get``: 43 | Return the value for the specified key, creating it with a default value 44 | (zero for numeric types, empty for string types) if it does not exist. 45 | 46 | ``clear``: 47 | Remove all items from the map. 48 | 49 | The ``size`` method returns the number of elements, and ``count`` will return 50 | the number of elements with the given key. 51 | 52 | Here's an example of creating, modifying, and destroying a map:: 53 | 54 | use flc_map, only : Map => MapIntInt 55 | type(Map) :: m 56 | logical :: inserted = .false. 57 | integer(C_INT) :: value 58 | m = Map() 59 | call m%insert(123, 456) 60 | call m%insert(123, 567, inserted) ! inserted = false, value unchanged 61 | call m%set(123, 567) ! value is changed 62 | value = m%get(911) ! implicitly created value of zero 63 | call m%erase(911) 64 | call m%release() 65 | 66 | Iteration 67 | --------- 68 | 69 | Iterating over a map to determine its contents is not yet supported. 70 | 71 | .. ############################################################################ 72 | .. end of doc/modules/map.rst 73 | .. ############################################################################ 74 | -------------------------------------------------------------------------------- /example/vecstr.f90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file example/vecstr.f90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | !-----------------------------------------------------------------------------! 6 | 7 | program vecstr_example 8 | use, intrinsic :: ISO_C_BINDING 9 | use flc 10 | use flc_string, only : String 11 | use flc_vector, only : VectorString 12 | use example_utils, only : read_strings, write_version, STDOUT 13 | implicit none 14 | integer :: i 15 | type(VectorString) :: vec 16 | type(String) :: back, front, temp 17 | character(C_CHAR), dimension(:), pointer :: chars 18 | 19 | ! Print version information 20 | call write_version() 21 | 22 | ! Read a vector of strings 23 | call read_strings(vec) 24 | 25 | write(STDOUT, "(a, i3, a)") "Read ", vec%size(), " strings:" 26 | do i = 1, vec%size() 27 | write(STDOUT, "(i3, ': ', a)") i, vec%get(i) 28 | end do 29 | 30 | if (vec%empty()) then 31 | write(STDOUT, *) "No vectors provided" 32 | call vec%release() 33 | stop 0 34 | endif 35 | 36 | ! Get the final string for modification 37 | back = vec%back_ref() 38 | chars => back%view() 39 | temp = String(back%str()) 40 | ! Change all characters to exclamation points 41 | chars(:) = '!' 42 | write(STDOUT, *) "The last string is very excited: " // vec%get(vec%size()) 43 | 44 | ! Modify a reference to the front value 45 | front = vec%front_ref() 46 | call front%push_back("?") 47 | 48 | ! Insert the original 'back' after the first string (make it element #2) 49 | call vec%insert(2, temp%str()) 50 | ! Inserting the vector invalidates the 'chars' view and back reference. 51 | chars => NULL() 52 | back = vec%back_ref() 53 | write(STDOUT, *) "Inserted the original last string: " // vec%get(2) 54 | 55 | ! Modify back to be something else. 56 | call back%assign("the end") 57 | 58 | write(STDOUT, *) "Modified 'front' string is " // vec%get(1) 59 | write(STDOUT, *) "Modified 'back' string is " // vec%get(vec%size()) 60 | 61 | ! Remove the first string (invalidating back and front references) 62 | call vec%erase(1) 63 | call back%release() 64 | call front%release() 65 | 66 | write(STDOUT, "(a, i3, a)") "Ended up with ", vec%size(), " strings:" 67 | do i = 1, vec%size() 68 | write(STDOUT, "(i3, ': ', a)") i, vec%get(i) 69 | end do 70 | 71 | ! Free allocated vector memory 72 | call vec%release() 73 | end program 74 | 75 | !-----------------------------------------------------------------------------! 76 | ! end of example/sort.f90 77 | !-----------------------------------------------------------------------------! 78 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Flibcpp 2 | 3 | This project uses SWIG-Fortran to expose useful functionality from the C++ 4 | standard library to Fortran 2003 application developers. It generates 5 | self-contained Fortran modules with native proxy classes and functions 6 | which wrap the C++ standard library. 7 | 8 | Currently it's designed around the C++11 standard library, and it instantiates 9 | 32- and 64-bit integers as well as double-precision floats. 10 | All operations directly manipulate arrays of Fortran-owned data to minimize 11 | overhead. 12 | 13 | ## Capabilities 14 | 15 | Functionality includes: 16 | 17 | - Sorting, both canonical and with custom comparison function 18 | - Binary search for indices in a sorted array 19 | - Pseudo-random number generation, including a Gaussian/normal distribution 20 | 21 | ## Getting started 22 | 23 | Installation of Flibcpp is trivial, as it requires no external dependencies 24 | other than existing and compatible C++ and Fortran compilers, and a relatively 25 | recent version of CMake: 26 | 27 | 1. Clone the repository with `git clone https://github.com/swig-fortran/flibcpp` or [download a release](https://github.com/swig-fortran/flibcpp/releases) 28 | 2. Create a build directory and execute `cmake $PATH_TO_SOURCE` (requires CMake 29 | 3.8 or higher) 30 | 3. Install using `make install` 31 | 32 | More detailed installation instructions are available [in the 33 | documentation](https://flibcpp.readthedocs.io/en/latest/introduction.html#installation). 34 | An example Fortran application that depends only on Flibcpp is 35 | available [on Github](https://github.com/swig-fortran/flibcpp-example-app). 36 | 37 | ## Documentation 38 | 39 | The [latest documentation](https://flibcpp.readthedocs.io/en/latest) is hosted 40 | on readthedocs.io. 41 | 42 | ## Contribute 43 | 44 | Pull requests are welcome. Feature requests can be added as issues. If there is 45 | strong interest in adding an option for C++03 compatibility, it could be 46 | added. It would also be trivial to add support for single-precision 47 | floats, but since most scientific software uses double-precision, we only 48 | support those for now. 49 | 50 | ## License 51 | 52 | The source code for FlibCpp, including auto-generated code, is released under 53 | an MIT license. See the LICENSE file. 54 | 55 | It must be linked against an existing C++ standard library implementation (e.g. 56 | [libc++](https://libcxx.llvm.org) or [libstdc++](https://gcc.gnu.org/wiki/Libstdc++)), so those are not covered by this license. 57 | 58 | SWIG is not required to use this project. SWIG-generated code does _not_ 59 | inherit SWIG's GPL license. 60 | 61 | The [CgvFindVersion.cmake helper 62 | script](https://github.com/sethrj/cmake-git-version) used for determining the 63 | release info is released independently under an Apache-2.0 license. 64 | -------------------------------------------------------------------------------- /test/test_set.F90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file test/test_set.F90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | ! Distributed under an MIT open source license: see LICENSE for details. 6 | !-----------------------------------------------------------------------------! 7 | 8 | #include "fassert.h" 9 | 10 | program test_set 11 | implicit none 12 | call test_int() 13 | call test_string() 14 | contains 15 | 16 | !-----------------------------------------------------------------------------! 17 | subroutine test_int() 18 | use, intrinsic :: ISO_C_BINDING 19 | use flc_set, only : Set => SetInt 20 | implicit none 21 | type(Set) :: s, other, op_result 22 | integer :: num_erased 23 | logical :: inserted = .false. 24 | 25 | s = Set() 26 | ASSERT(s%size() == 0) 27 | ASSERT(s%empty()) 28 | 29 | call s%insert(4) 30 | ASSERT(s%size() == 1) 31 | 32 | ! Set elements are unique 33 | call s%insert(10, inserted) 34 | ASSERT(inserted .eqv. .true.) 35 | call s%insert(10, inserted) 36 | ASSERT(s%size() == 2) 37 | ASSERT(inserted .eqv. .false.) 38 | 39 | ! 'erase' takes OPTIONAL argument 40 | call s%erase(10, num_erased) 41 | ASSERT(num_erased == 1) 42 | call s%erase(4) 43 | 44 | ! Insert an array of data 45 | call s%insert([1, 1, 2, 3, 5, 8, 13]) 46 | ASSERT(s%size() == 6) 47 | 48 | other = Set([6, 1, 3, 4, 7]) ! input can be out of order 49 | 50 | op_result = s%difference(other) 51 | ASSERT(op_result%size() == 4) ! 2, 5, 7, 13, 52 | op_result = s%intersection(other) 53 | ASSERT(op_result%size() == 2) ! 1, 3 54 | op_result = s%symmetric_difference(other) 55 | ASSERT(op_result%size() == 7) ! 2, 4, 5, 6, 7, 8, 13 56 | op_result = s%union(other) 57 | ASSERT(op_result%size() == 9) 58 | 59 | ASSERT(.not. s%includes(other)) 60 | call other%clear() 61 | call other%insert([1, 2, 3]) 62 | ASSERT(s%includes(other)) 63 | 64 | call s%release() 65 | call other%release() 66 | call op_result%release() 67 | end subroutine 68 | 69 | !-----------------------------------------------------------------------------! 70 | subroutine test_string() 71 | use, intrinsic :: ISO_C_BINDING 72 | use flc_set, only : Set => SetString 73 | use flc_string, only : String 74 | implicit none 75 | type(Set) :: s 76 | 77 | s = Set() 78 | ASSERT(s%empty()) 79 | 80 | call s%insert("yoohoo") 81 | call s%insert("howdy") 82 | ASSERT(s%size() == 2) 83 | ASSERT(s%count("yoohoo") == 1) 84 | ASSERT(s%count("hiya") == 0) 85 | 86 | call s%insert("howdy") 87 | ASSERT(s%count("howdy") == 1) 88 | ASSERT(s%size() == 2) 89 | 90 | call s%erase("yoohoo") 91 | ASSERT(s%size() == 1) 92 | ASSERT(s%count("yoohoo") == 0) 93 | 94 | call s%clear() 95 | ASSERT(s%empty()) 96 | 97 | call s%release() 98 | end subroutine 99 | 100 | !-----------------------------------------------------------------------------! 101 | end program 102 | -------------------------------------------------------------------------------- /doc/examples.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/examples.rst 3 | .. ############################################################################ 4 | 5 | ******** 6 | Examples 7 | ******** 8 | 9 | The following standalone codes demonstrate how Flibcpp can be used in native 10 | Fortran code. 11 | 12 | Random numbers and sorting 13 | ========================== 14 | 15 | This simple example generates an array of normally-distributed double-precision 16 | reals, sorts them, and then shuffles them again. 17 | 18 | .. literalinclude:: ../example/sort.f90 19 | :linenos: 20 | 21 | Vectors of strings 22 | ================== 23 | 24 | Strings and vectors of strings can be easily manipulated and converted to and 25 | from native Fortran strings. 26 | 27 | .. literalinclude:: ../example/vecstr.f90 28 | :linenos: 29 | 30 | .. _example_generic: 31 | 32 | Generic sorting 33 | =============== 34 | 35 | Since sorting algorithms often allow :math:`O(N)` algorithms to be written in 36 | :math:`O(\log N)`, providing generic sorting routines is immensely useful in 37 | applications that operate on large chunks of data. This example demonstrates 38 | the generic version of the :ref:`modules_algorithm_argsort` subroutine by 39 | sorting a native Fortran array of native Fortran types using a native Fortran 40 | subroutine. The only C interaction needed is to create C pointers to the 41 | Fortran array entries and to provide a C-bound comparator that 42 | converts those pointers back to native Fortran pointers. [#c_f_pointer]_ 43 | 44 | .. literalinclude:: ../example/sort_generic.f90 45 | :linenos: 46 | 47 | .. _example_utils: 48 | 49 | Example utilities module 50 | ======================== 51 | 52 | This pure-Fortran module builds on top of functionality from Flibcpp. It 53 | provides procedures to: 54 | 55 | - Format and print the Flibcpp version; 56 | - Converts a user input to an integer, validating it with useful error 57 | messages; 58 | - Reads a dynamically sized vector of strings from the user. 59 | 60 | .. literalinclude:: ../example/example_utils.f90 61 | :linenos: 62 | 63 | 64 | .. rubric:: Footnotes 65 | 66 | .. [#c_f_pointer] Older versions of Gfortran (before GCC-8) fail to compile the 67 | generic sort example because of a bug that incorrectly claims that taking 68 | the C pointer of a scalar Fortran value is a violation of the standard: 69 | 70 | .. code-block:: none 71 | 72 | ../example/sort_generic.f90:84:38: 73 | 74 | call c_f_pointer(cptr=rcptr, fptr=rptr) 75 | 1 76 | Error: TS 29113/TS 18508: Noninteroperable array FPTR at (1) to 77 | C_F_POINTER: Expression is a noninteroperable derived type 78 | 79 | See `this bug report`_ for more details. 80 | 81 | .. _this bug report: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=84924 82 | 83 | 84 | .. ############################################################################ 85 | .. end of doc/examples.rst 86 | .. ############################################################################ 87 | -------------------------------------------------------------------------------- /test/test_string.F90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file test/test_string.F90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | ! Distributed under an MIT open source license: see LICENSE for details. 6 | !-----------------------------------------------------------------------------! 7 | 8 | #include "fassert.h" 9 | 10 | program test_string 11 | implicit none 12 | call test_class() 13 | call test_conversion() 14 | !call test_reading() 15 | contains 16 | 17 | !-----------------------------------------------------------------------------! 18 | subroutine test_class() 19 | use, intrinsic :: ISO_C_BINDING 20 | use flc_string, only : String 21 | implicit none 22 | type(String) :: s 23 | character, dimension(:), pointer :: charptr 24 | character(len=:), allocatable :: native 25 | integer :: i 26 | 27 | s = String("Hi there!") 28 | ASSERT(s%size() == 9) 29 | ASSERT(s%get(1) == "H") 30 | ASSERT(s%get(4) == "t") 31 | 32 | call s%clear() 33 | call s%push_back("!") 34 | ASSERT(s%size() == 1) 35 | 36 | s = String(10, "*") 37 | ASSERT(s%size() == 10) 38 | ASSERT(s%get(1) == "*") 39 | ASSERT(s%get(10) == "*") 40 | 41 | s = String("Hello!") 42 | call s%set(6, ".") 43 | ASSERT(s%back() == ".") 44 | 45 | ! Interact with an array pointer to the string data 46 | charptr => s%view() 47 | charptr(1) = "Y" 48 | ! Convert the string to a Fortran string 49 | allocate(native, source=s%str()) 50 | ASSERT(native == "Yello.") 51 | call s%pop_back() 52 | call s%append(" there") 53 | ASSERT(s%str() == "Yello there") 54 | 55 | ! Find characters in the string 56 | ASSERT(s%find("o") == 5) 57 | ASSERT(s%find("Q") == 0) 58 | 59 | ! Free memory 60 | call s%release() 61 | 62 | s = String("meowmeow") 63 | i = s%find("meow") 64 | ASSERT(i == 1) 65 | i = s%find("meow", 3) 66 | ASSERT(i == 5) 67 | i = s%find("woof") 68 | ASSERT(i == 0) 69 | call s%release() 70 | end subroutine 71 | 72 | !-----------------------------------------------------------------------------! 73 | subroutine test_conversion() 74 | use, intrinsic :: ISO_C_BINDING 75 | use flc, only : ierr, SWIG_OverflowError, SWIG_ValueError 76 | use flc_string 77 | implicit none 78 | integer(4) :: temp 79 | real(8) :: dbl 80 | 81 | ASSERT(stoi("1234567") == 1234567_c_int32_t) 82 | ASSERT(stoll("1234567890123") == 1234567890123_c_int64_t) 83 | 84 | ! Check alternate bases 85 | ASSERT(stoi("0x100", 16) == 256) 86 | 87 | ! Check error reporting 88 | temp = stoi("1234567890123") 89 | ASSERT(ierr == SWIG_OverflowError) 90 | ierr = 0 91 | 92 | temp = stoi("three") 93 | ASSERT(ierr == SWIG_ValueError) 94 | ierr = 0 95 | 96 | temp = stoi("123 go") 97 | ASSERT(ierr == SWIG_ValueError) 98 | ierr = 0 99 | 100 | dbl = stod("3.625") 101 | ASSERT(dbl == 3.625) 102 | 103 | end subroutine 104 | 105 | !-----------------------------------------------------------------------------! 106 | end program 107 | -------------------------------------------------------------------------------- /doc/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | #---------------------------------------------------------------------------# 2 | # \file doc/CMakeLists.txt 3 | # 4 | # Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | # Distributed under an MIT open source license: see LICENSE for details. 6 | #---------------------------------------------------------------------------# 7 | 8 | configure_file("version.json.in" "version.json" @ONLY) 9 | 10 | function(flibcpp_build_sphinx type output) 11 | add_custom_command(OUTPUT "${output}" 12 | VERBATIM COMMAND 13 | "${CMAKE_COMMAND}" -E env 14 | "PYTHONPATH=${FLIBCPP_PYTHONPATH}" 15 | "CMAKE_CURRENT_BINARY_DIR=${CMAKE_CURRENT_BINARY_DIR}" 16 | "${SPHINX_EXECUTABLE}" -q 17 | -d "${CMAKE_CURRENT_BINARY_DIR}/doctrees" 18 | -b ${type} 19 | "${CMAKE_CURRENT_SOURCE_DIR}" 20 | "${CMAKE_CURRENT_BINARY_DIR}/${type}" 21 | COMMENT "Building ${type} documentation with Sphinx" 22 | DEPENDS "${CMAKE_CURRENT_SOURCE_DIR}/conf.py" 23 | WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" 24 | ${ARGN} 25 | ) 26 | endfunction() 27 | 28 | set(_doc_html "${CMAKE_CURRENT_BINARY_DIR}/html/index.html") 29 | flibcpp_build_sphinx(html "${_doc_html}") 30 | add_custom_target(doc ALL DEPENDS "${_doc_html}") 31 | 32 | install(DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/html/" 33 | DESTINATION "${CMAKE_INSTALL_DOCDIR}" 34 | ) 35 | 36 | # Note: latex generation creates a makefile that must be run 37 | set(_doc_tex "${CMAKE_CURRENT_BINARY_DIR}/latex/Flibcpp.tex") 38 | flibcpp_build_sphinx(latex "${_doc_tex}") 39 | 40 | find_program(LATEXMK_EXECUTABLE latexmk) 41 | if(NOT LATEXMK_EXECUTABLE) 42 | # Local variable to give helpful error at runtime? 43 | set(LATEXMK_EXECUTABLE latexmk) 44 | endif() 45 | 46 | # Download ornltm class 47 | set(_ornltm_base "${CMAKE_CURRENT_BINARY_DIR}/latex/ornltm") 48 | ExternalProject_Add(ornltm 49 | GIT_REPOSITORY https://code.ornl.gov/s3j/ornltm.git 50 | GIT_TAG 05a4b22f104abd53ac7cae72fe03768710b56b86 51 | CONFIGURE_COMMAND "" 52 | BUILD_COMMAND "" 53 | INSTALL_COMMAND "" 54 | SOURCE_DIR "${_ornltm_base}" 55 | ) 56 | 57 | set(_texenv "LATEXOPTS=" "TEXINPUTS=${_ornltm_base}/ornltm:") 58 | function(flibcpp_build_latex input output) 59 | add_custom_command(OUTPUT "${output}" 60 | VERBATIM COMMAND 61 | "${CMAKE_COMMAND}" -E env ${_texenv} 62 | "${LATEXMK_EXECUTABLE}" -pdf "${input}" 63 | WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/latex" 64 | ${ARGN} 65 | ) 66 | endfunction() 67 | 68 | # Generate header 69 | set(_header_pdf "${CMAKE_CURRENT_BINARY_DIR}/latex/flibcpp-tm-header.pdf") 70 | flibcpp_build_latex( 71 | "${CMAKE_CURRENT_SOURCE_DIR}/_static/flibcpp-tm-header.tex" 72 | "${_header_pdf}" 73 | COMMENT "Building tech memo header" 74 | DEPENDS ornltm 75 | ) 76 | 77 | # Generate header 78 | set(_footer_pdf "${CMAKE_CURRENT_BINARY_DIR}/latex/flibcpp-tm-footer.pdf") 79 | flibcpp_build_latex( 80 | "${CMAKE_CURRENT_SOURCE_DIR}/_static/flibcpp-tm-footer.tex" 81 | "${_footer_pdf}" 82 | COMMENT "Building tech memo footer" 83 | DEPENDS ornltm 84 | ) 85 | 86 | # Generate PDF 87 | set(_doc_pdf "${CMAKE_CURRENT_BINARY_DIR}/latex/Flibcpp.pdf") 88 | flibcpp_build_latex( 89 | Flibcpp 90 | "${_doc_pdf}" 91 | COMMENT "Building PDF documentation from LaTeX" 92 | DEPENDS "${_doc_tex}" "${_header_pdf}" "${_footer_pdf}" ornltm 93 | ) 94 | 95 | add_custom_target(doc_pdf DEPENDS "${_doc_pdf}") 96 | -------------------------------------------------------------------------------- /include/flc.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc.i 3 | * 4 | * Copyright (c) 2019-2020 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc" 9 | 10 | #if defined(SWIGIMPORTED) && !defined(FLC_SWIGIMPORTED) 11 | #error "To import the FLC module correctly, use ``%include \"import_flc.i\"``" 12 | #endif 13 | 14 | /* ------------------------------------------------------------------------- 15 | * Header definition macros 16 | * ------------------------------------------------------------------------- */ 17 | 18 | %define %flc_add_header 19 | %insert("fbegin") %{ 20 | ! Flibcpp project, https://github.com/swig-fortran/flibcpp 21 | ! Copyright (c) 2019-2020 Oak Ridge National Laboratory, UT-Battelle, LLC. 22 | ! Distributed under an MIT open source license: see LICENSE for details. 23 | %} 24 | %insert("begin") %{ 25 | /* 26 | * Flibcpp project, https://github.com/swig-fortran/flibcpp 27 | * Copyright (c) 2019-2020 Oak Ridge National Laboratory, UT-Battelle, LLC. 28 | * Distributed under an MIT open source license: see LICENSE for details. 29 | */ 30 | %} 31 | %enddef 32 | 33 | %flc_add_header 34 | 35 | /* ------------------------------------------------------------------------- 36 | * Exception handling 37 | * ------------------------------------------------------------------------- */ 38 | 39 | // Rename the error variables' internal C symbols 40 | #define SWIG_FORTRAN_ERROR_INT flc_ierr 41 | #define SWIG_FORTRAN_ERROR_STR flc_get_serr 42 | 43 | // Restore names in the wrapper code 44 | %rename(ierr) flc_ierr; 45 | %rename(get_serr) flc_get_serr; 46 | 47 | // Unless we're directly building this module, delay exception handling 48 | #ifndef SWIGIMPORTED 49 | %include 50 | #endif 51 | 52 | /* ------------------------------------------------------------------------- 53 | * Data types and instantiation 54 | * ------------------------------------------------------------------------- */ 55 | 56 | // Note: stdint.i inserts #include 57 | %include 58 | 59 | %define %flc_template_numeric(SRC, DST) 60 | %template(DST) SRC; 61 | %template(DST) SRC; 62 | %template(DST) SRC; 63 | %enddef 64 | 65 | /* ------------------------------------------------------------------------- 66 | * Array view translation 67 | * ------------------------------------------------------------------------- */ 68 | 69 | %include 70 | %apply (SWIGTYPE *DATA, size_t SIZE) { 71 | (int32_t *DATA, size_t DATASIZE), 72 | (int64_t *DATA, size_t DATASIZE), 73 | (double *DATA, size_t DATASIZE), 74 | (void **DATA, size_t DATASIZE)}; 75 | 76 | %apply (SWIGTYPE const *DATA, size_t SIZE) { 77 | (int32_t const *DATA, size_t DATASIZE), 78 | (int64_t const *DATA, size_t DATASIZE), 79 | (double const *DATA, size_t DATASIZE), 80 | (void* const *DATA, size_t DATASIZE)}; 81 | 82 | /* ------------------------------------------------------------------------- 83 | * Version information 84 | * ------------------------------------------------------------------------- */ 85 | 86 | %apply char* { const char flibcpp_version[] }; 87 | %fortranbindc flibcpp_version_major; 88 | %fortranbindc flibcpp_version_minor; 89 | %fortranbindc flibcpp_version_patch; 90 | 91 | // These symbols are defined in the CMake-generated `flibcpp_version.cpp` 92 | %inline %{ 93 | extern "C" { 94 | extern const char flibcpp_version[]; 95 | extern const int flibcpp_version_major; 96 | extern const int flibcpp_version_minor; 97 | extern const int flibcpp_version_patch; 98 | } 99 | %} 100 | -------------------------------------------------------------------------------- /doc/_python/monkeysphinx.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | # -*- coding: utf-8 -*- 3 | # Copyright (c) 2019-2021 Oak Ridge National Laboratory, UT-Battelle, LLC. 4 | # License-Filename: LICENSE 5 | # SPDX-License-Identifier: MIT 6 | """ 7 | Monkey-patch sphinx to shoehorn latex output into an ORNL TM compatible style. 8 | """ 9 | 10 | import sphinx 11 | 12 | try: 13 | from sphinx.writers.html5 import HTML5Translator 14 | from sphinx.writers.latex import LaTeXTranslator, Table 15 | from sphinx.builders.latex.transforms import BibliographyTransform 16 | except ImportError as e: 17 | print("ERROR: failed to import writers/builders:", e) 18 | LaTeXTranslator = Table = BibliographyTransform = None 19 | 20 | def monkey(cls, replace=True): 21 | if cls is None: 22 | def _monkey(func): 23 | return func 24 | else: 25 | def _monkey(func, cls=cls, replace=replace): 26 | exists = hasattr(cls, func.__name__) 27 | if exists != replace: 28 | print("ERROR: class {} {} method {}".format( 29 | cls.__name__, "has no" if replace else "already has a", 30 | func.__name__)) 31 | else: 32 | # print("Applying patch to {}.{}".format( 33 | # cls.__name__, func.__name__)) 34 | setattr(cls, func.__name__, func) 35 | return func 36 | return _monkey 37 | 38 | @monkey(LaTeXTranslator) 39 | def visit_desc_annotation(self, node): 40 | self.body.append(r'\sphinxannotation{') 41 | 42 | @monkey(LaTeXTranslator) 43 | def depart_desc_annotation(self, node): 44 | self.body.append(r'}') 45 | 46 | @monkey(LaTeXTranslator, replace=False) 47 | def visit_enquote(self, node): 48 | self.body.append(r'``') 49 | 50 | @monkey(LaTeXTranslator, replace=False) 51 | def depart_enquote(self, node): 52 | self.body.append(r"''") 53 | 54 | @monkey(HTML5Translator, replace=False) 55 | def visit_enquote(self, node): 56 | self.body.append(r'&ldquot;') 57 | 58 | @monkey(HTML5Translator, replace=False) 59 | def depart_enquote(self, node): 60 | self.body.append(r"&rdquot;") 61 | 62 | # Replace bibliography's enclosing section rather than moving after appendices 63 | @monkey(BibliographyTransform) 64 | def run(self, **kwargs): 65 | from docutils import nodes 66 | from sphinx.builders.latex.nodes import thebibliography 67 | citations = thebibliography() 68 | section_parent = None 69 | for node in self.document.traverse(nodes.citation): 70 | parent = node.parent 71 | parent.remove(node) 72 | citations += node 73 | if section_parent is None: 74 | # Find first section parent 75 | while parent: 76 | if isinstance(parent, nodes.section): 77 | section_parent = parent 78 | break 79 | parent = parent.parent 80 | 81 | if section_parent and len(citations) > 0: 82 | section_parent.replace_self(citations) 83 | 84 | 85 | @monkey(LaTeXTranslator) 86 | def visit_colspec(self, node): 87 | # type: (nodes.Node) -> None 88 | self.table.colcount += 1 89 | if 'colwidth' in node: 90 | self.table.colwidths.append(node['colwidth']) 91 | if 'stub' in node: 92 | self.table.stubs.append(self.table.colcount - 1) 93 | 94 | @monkey(LaTeXTranslator) 95 | def depart_row(self, node): 96 | # Don't add horizontal rules between rows 97 | self.body.append('\\\\\n') 98 | self.table.row += 1 99 | 100 | @monkey(Table) 101 | def get_colspec(self): 102 | if self.colspec: 103 | return self.colspec 104 | if self.get_table_type() == 'tabulary': 105 | # sphinx.sty sets T to be J by default. 106 | return '{' + ('T' * self.colcount) + '}\n' 107 | return '{' + ('l' * self.colcount) + '}\n' 108 | -------------------------------------------------------------------------------- /include/flc_random.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc_random.i 3 | * 4 | * Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc_random" 9 | %include "import_flc.i" 10 | %flc_add_header 11 | 12 | %{ 13 | #include 14 | #if defined(_MSC_VER) && _MSC_VER < 1900 15 | // Visual studio 2012's standard library lacks iterator constructors for 16 | // std::discrete_distribution 17 | #define FLC_MISSING_DISCRETE_ITER 18 | #endif 19 | %} 20 | 21 | /* ------------------------------------------------------------------------- 22 | * Macros 23 | * ------------------------------------------------------------------------- */ 24 | 25 | %define %flc_random_engine(NAME, GENERATOR, RESULT_TYPE) 26 | namespace std { 27 | 28 | %rename(NAME) GENERATOR; 29 | %rename("next") GENERATOR::operator(); 30 | 31 | class GENERATOR 32 | { 33 | public: 34 | typedef RESULT_TYPE result_type; 35 | 36 | GENERATOR(); 37 | explicit GENERATOR(result_type seed_value); 38 | void seed(result_type seed_value); 39 | void discard(unsigned long long count); 40 | result_type operator()(); 41 | }; 42 | 43 | } // namespace std 44 | %enddef 45 | 46 | /* ------------------------------------------------------------------------- 47 | * RNG distribution routines 48 | * ------------------------------------------------------------------------- */ 49 | 50 | %{ 51 | template 52 | static inline void flc_generate(D dist, G& g, T* data, size_t size) { 53 | T* const end = data + size; 54 | while (data != end) { 55 | *data++ = dist(g); 56 | } 57 | } 58 | %} 59 | 60 | %apply (const SWIGTYPE *DATA, size_t SIZE) { 61 | (const double *WEIGHTS, size_t WEIGHTSIZE) }; 62 | 63 | %inline %{ 64 | template 65 | static void uniform_int_distribution(T left, T right, 66 | G& engine, T* DATA, size_t DATASIZE) { 67 | flc_generate(std::uniform_int_distribution(left, right), 68 | engine, DATA, DATASIZE); 69 | } 70 | 71 | template 72 | static void uniform_real_distribution(T left, T right, 73 | G& engine, T* DATA, size_t DATASIZE) { 74 | flc_generate(std::uniform_real_distribution(left, right), 75 | engine, DATA, DATASIZE); 76 | } 77 | 78 | template 79 | static void normal_distribution(T mean, T stddev, 80 | G& engine, T* DATA, size_t DATASIZE) { 81 | flc_generate(std::normal_distribution(mean, stddev), 82 | engine, DATA, DATASIZE); 83 | } 84 | 85 | template 86 | static void discrete_distribution(const double* WEIGHTS, size_t WEIGHTSIZE, 87 | G& engine, T* DATA, size_t DATASIZE) { 88 | #ifndef FLC_MISSING_DISCRETE_ITER 89 | std::discrete_distribution dist(WEIGHTS, WEIGHTS + WEIGHTSIZE); 90 | #else 91 | std::discrete_distribution dist( 92 | std::initializer_list(WEIGHTS, WEIGHTS + WEIGHTSIZE)); 93 | #endif 94 | T* const end = DATA + DATASIZE; 95 | while (DATA != end) { 96 | *DATA++ = dist(engine) + 1; // Note: transform to Fortran 1-offset 97 | } 98 | } 99 | %} 100 | 101 | %define %flc_distribution(NAME, STDENGINE, TYPE) 102 | %template(NAME##_distribution) NAME##_distribution< TYPE, std::STDENGINE >; 103 | %enddef 104 | 105 | // Engines 106 | %flc_random_engine(MersenneEngine4, mt19937, int32_t) 107 | %flc_random_engine(MersenneEngine8, mt19937_64, int64_t) 108 | 109 | #define FLC_DEFAULT_ENGINE mt19937 110 | %flc_distribution(uniform_int, FLC_DEFAULT_ENGINE, int32_t) 111 | %flc_distribution(uniform_int, FLC_DEFAULT_ENGINE, int64_t) 112 | %flc_distribution(uniform_real, FLC_DEFAULT_ENGINE, double) 113 | 114 | %flc_distribution(normal, FLC_DEFAULT_ENGINE, double) 115 | 116 | // Discrete sampling distribution 117 | %flc_distribution(discrete, FLC_DEFAULT_ENGINE, int32_t) 118 | %flc_distribution(discrete, FLC_DEFAULT_ENGINE, int64_t) 119 | -------------------------------------------------------------------------------- /src/flc.f90: -------------------------------------------------------------------------------- 1 | ! This file was automatically generated by SWIG (https://www.swig.org). 2 | ! Version 4.1.1+fortran 3 | ! 4 | ! Do not make changes to this file unless you know what you are doing - modify 5 | ! the SWIG interface file instead. 6 | 7 | ! Flibcpp project, https://github.com/swig-fortran/flibcpp 8 | ! Copyright (c) 2019-2020 Oak Ridge National Laboratory, UT-Battelle, LLC. 9 | ! Distributed under an MIT open source license: see LICENSE for details. 10 | 11 | module flc 12 | use, intrinsic :: ISO_C_BINDING 13 | implicit none 14 | private 15 | 16 | ! DECLARATION CONSTRUCTS 17 | integer(C_INT), public, & 18 | bind(C, name="flc_ierr") :: ierr 19 | type, bind(C) :: SwigArrayWrapper 20 | type(C_PTR), public :: data = C_NULL_PTR 21 | integer(C_SIZE_T), public :: size = 0 22 | end type 23 | public :: get_serr 24 | integer(C_INT), parameter, public :: SWIG_UnknownError = -1_C_INT 25 | integer(C_INT), parameter, public :: SWIG_IOError = -2_C_INT 26 | integer(C_INT), parameter, public :: SWIG_RuntimeError = -3_C_INT 27 | integer(C_INT), parameter, public :: SWIG_IndexError = -4_C_INT 28 | integer(C_INT), parameter, public :: SWIG_TypeError = -5_C_INT 29 | integer(C_INT), parameter, public :: SWIG_DivisionByZero = -6_C_INT 30 | integer(C_INT), parameter, public :: SWIG_OverflowError = -7_C_INT 31 | integer(C_INT), parameter, public :: SWIG_SyntaxError = -8_C_INT 32 | integer(C_INT), parameter, public :: SWIG_ValueError = -9_C_INT 33 | integer(C_INT), parameter, public :: SWIG_SystemError = -10_C_INT 34 | integer(C_INT), parameter, public :: SWIG_AttributeError = -11_C_INT 35 | integer(C_INT), parameter, public :: SWIG_MemoryError = -12_C_INT 36 | integer(C_INT), parameter, public :: SWIG_NullReferenceError = -13_C_INT 37 | public :: get_flibcpp_version 38 | integer(C_INT), public, protected, & 39 | bind(C, name="flibcpp_version_major") :: flibcpp_version_major 40 | integer(C_INT), public, protected, & 41 | bind(C, name="flibcpp_version_minor") :: flibcpp_version_minor 42 | integer(C_INT), public, protected, & 43 | bind(C, name="flibcpp_version_patch") :: flibcpp_version_patch 44 | 45 | ! WRAPPER DECLARATIONS 46 | interface 47 | subroutine SWIG_free(cptr) & 48 | bind(C, name="free") 49 | use, intrinsic :: ISO_C_BINDING 50 | type(C_PTR), value :: cptr 51 | end subroutine 52 | function swigc_get_serr() & 53 | bind(C, name="_wrap_get_serr") & 54 | result(fresult) 55 | use, intrinsic :: ISO_C_BINDING 56 | import :: swigarraywrapper 57 | type(SwigArrayWrapper) :: fresult 58 | end function 59 | 60 | function swigc_flibcpp_version_get() & 61 | bind(C, name="_wrap_flibcpp_version_get") & 62 | result(fresult) 63 | use, intrinsic :: ISO_C_BINDING 64 | import :: swigarraywrapper 65 | type(SwigArrayWrapper) :: fresult 66 | end function 67 | 68 | end interface 69 | 70 | 71 | contains 72 | ! MODULE SUBPROGRAMS 73 | 74 | subroutine SWIGTM_fout_char_Sm_(imout, fout) 75 | use, intrinsic :: ISO_C_BINDING 76 | type(SwigArrayWrapper), intent(in) :: imout 77 | character(len=:), allocatable, intent(out) :: fout 78 | character(kind=C_CHAR), dimension(:), pointer :: chars 79 | integer(kind=C_SIZE_T) :: i 80 | call c_f_pointer(imout%data, chars, [imout%size]) 81 | allocate(character(len=imout%size) :: fout) 82 | do i=1, imout%size 83 | fout(i:i) = char(ichar(chars(i))) 84 | end do 85 | end subroutine 86 | 87 | function get_serr() & 88 | result(swig_result) 89 | use, intrinsic :: ISO_C_BINDING 90 | character(len=:), allocatable :: swig_result 91 | type(SwigArrayWrapper) :: fresult 92 | 93 | fresult = swigc_get_serr() 94 | call SWIGTM_fout_char_Sm_(fresult, swig_result) 95 | if (.false.) call SWIG_free(fresult%data) 96 | end function 97 | 98 | function get_flibcpp_version() & 99 | result(swig_result) 100 | use, intrinsic :: ISO_C_BINDING 101 | character(len=:), allocatable :: swig_result 102 | type(SwigArrayWrapper) :: fresult 103 | 104 | fresult = swigc_flibcpp_version_get() 105 | call SWIGTM_fout_char_Sm_(fresult, swig_result) 106 | if (.false.) call SWIG_free(fresult%data) 107 | end function 108 | 109 | 110 | end module 111 | -------------------------------------------------------------------------------- /example/example_utils.f90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file example/example_utils.f90 3 | ! \brief example_utils module 4 | ! \note Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | !-----------------------------------------------------------------------------! 6 | 7 | module example_utils 8 | use, intrinsic :: ISO_FORTRAN_ENV 9 | use, intrinsic :: ISO_C_BINDING 10 | implicit none 11 | integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT 12 | public 13 | 14 | contains 15 | 16 | subroutine write_version() 17 | use flc 18 | implicit none 19 | ! Print version information 20 | write(STDOUT, "(a)") "========================================" 21 | write(STDOUT, "(a, a)") "Flibcpp version: ", get_flibcpp_version() 22 | write(STDOUT, "(a, 2(i1,'.'), (i1), a)") "(Numeric version: ", & 23 | flibcpp_version_major, flibcpp_version_minor, flibcpp_version_patch, & 24 | ")" 25 | write(STDOUT, "(a)") "========================================" 26 | end subroutine 27 | 28 | ! Loop until the user inputs a positive integer. Catch error conditions. 29 | function read_positive_int(desc) result(result_int) 30 | use flc 31 | use flc_string, only : stoi 32 | implicit none 33 | character(len=*), intent(in) :: desc 34 | character(len=80) :: readstr 35 | integer :: result_int, io_ierr 36 | do 37 | write(STDOUT, *) "Enter " // desc // ": " 38 | read(STDIN, "(a)", iostat=io_ierr) readstr 39 | if (io_ierr == IOSTAT_END) then 40 | ! Error condition: ctrl-D during input 41 | write(STDOUT, *) "User terminated" 42 | stop 1 43 | endif 44 | 45 | result_int = stoi(readstr) 46 | if (ierr == 0) then 47 | if (result_int <= 0) then 48 | ! Error condition: non-positive value 49 | write(STDOUT, *) "Invalid " // desc // ": ", result_int 50 | continue 51 | end if 52 | 53 | write(STDOUT, *) "Read " // desc // "=", result_int 54 | exit 55 | endif 56 | 57 | if (ierr == SWIG_OVERFLOWERROR) then 58 | ! Error condition: integer doesn't fit in native integer 59 | write(STDOUT,*) "Your integer is too darn big!" 60 | else if (ierr == SWIG_VALUEERROR) then 61 | ! Error condition: not an integer at all 62 | write(STDOUT,*) "That text you entered? It wasn't an integer." 63 | else 64 | write(STDOUT,*) "Unknown error", ierr 65 | end if 66 | write(STDOUT,*) "(Detailed error message: ", get_serr(), ")" 67 | 68 | ! Clear error flag so the next call to stoi succeeds 69 | ierr = 0 70 | end do 71 | end function 72 | 73 | ! Loop until the user inputs a positive integer. Catch error conditions. 74 | subroutine read_strings(vec) 75 | use flc 76 | use flc_string, only : String 77 | use flc_vector, only : VectorString 78 | use ISO_FORTRAN_ENV 79 | implicit none 80 | type(VectorString), intent(out) :: vec 81 | integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT 82 | character(len=80) :: readstr 83 | integer :: io_ierr 84 | type(String) :: str 85 | 86 | ! Allocate the vector 87 | vec = VectorString() 88 | 89 | do 90 | ! Request and read a string 91 | write(STDOUT, "(a, i3, a)") "Enter string #", vec%size() + 1, & 92 | " or Ctrl-D/empty string to complete" 93 | read(STDIN, "(a)", iostat=io_ierr) readstr 94 | if (io_ierr == IOSTAT_END) then 95 | ! Break out of loop on ^D (EOF) 96 | exit 97 | end if 98 | 99 | ! Add string to the end of the vector 100 | call vec%push_back(trim(readstr)) 101 | ! Get a String object reference to the back to check if it's empty 102 | str = vec%back_ref() 103 | if (str%empty()) then 104 | ! Remove the empty string 105 | call vec%pop_back() 106 | exit 107 | end if 108 | end do 109 | end subroutine 110 | 111 | end module 112 | 113 | !-----------------------------------------------------------------------------! 114 | ! end of example/example_utils.f90 115 | !-----------------------------------------------------------------------------! 116 | -------------------------------------------------------------------------------- /doc/_static/references.bib: -------------------------------------------------------------------------------- 1 | @article{beazley_automated_2003, 2 | title = {Automated scientific software scripting with {SWIG}}, 3 | volume = {19}, 4 | issn = {0167739X}, 5 | url = {http://linkinghub.elsevier.com/retrieve/pii/S0167739X02001711}, 6 | doi = {10.1016/S0167-739X(02)00171-1}, 7 | abstract = {Scripting languages such as Python and Tcl are a powerful tool for the construction of flexible scientific software because they provide scientists with an interpreted problem solving environment and they provide a modular framework for controlling software components written in C, C++, and Fortran. However, a common problem faced by the developers of a scripted scientific application is that of integrating compiled code with an interpreter. To solve this problem, an extensible compiler, simplified wrapper and interface generator (SWIG), has been developed to automate the task of integrating compiled code with scripting language interpreters. SWIG requires no modifications to existing code and uses existing source to create bindings for nine different target languages including Python, Perl, Tcl, Ruby, Guile, and Java. By automating language integration, SWIG enables scientists to use scripting languages at all stages of software development and allows existing software to be more easily integrated into a scripting environment. Although SWIG has been in use for more than 6 years, little has been published on its design and the underlying mechanisms that make it work. Therefore, the primary goal of this paper is to cover these topics.}, 8 | language = {en}, 9 | number = {5}, 10 | urldate = {2018-09-06}, 11 | journal = {Future Generation Computer Systems}, 12 | author = {Beazley, D.M.}, 13 | month = jul, 14 | year = {2003}, 15 | pages = {599--609}, 16 | file = {Beazley - 2003 - Automated scientific software scripting with SWIG.pdf:/Users/s3j/Zotero/storage/LKCUYK6D/Beazley - 2003 - Automated scientific software scripting with SWIG.pdf:application/pdf} 17 | } 18 | 19 | @article{mcinnes_how_2021, 20 | title = {How community software ecosystems can unlock the potential of exascale computing}, 21 | volume = {1}, 22 | issn = {2662-8457}, 23 | url = {http://www.nature.com/articles/s43588-021-00033-y}, 24 | doi = {10.1038/s43588-021-00033-y}, 25 | language = {en}, 26 | number = {2}, 27 | urldate = {2021-05-22}, 28 | journal = {Nature Computational Science}, 29 | author = {McInnes, Lois Curfman and Heroux, Michael A. and Draeger, Erik W. and Siegel, Andrew and Coghlan, Susan and Antypas, Katie}, 30 | month = feb, 31 | year = {2021}, 32 | pages = {92--94}, 33 | file = {McInnes et al. - 2021 - How community software ecosystems can unlock the p.pdf:/Users/s3j/Zotero/storage/T5G46MCK/McInnes et al. - 2021 - How community software ecosystems can unlock the p.pdf:application/pdf} 34 | } 35 | 36 | @article{johnson_automated_2020, 37 | title = {Automated {Fortran}-{C}++ {Bindings} for {Large}-{Scale} {Scientific} {Applications}}, 38 | volume = {22}, 39 | issn = {1521-9615, 1558-366X}, 40 | url = {https://ieeexplore.ieee.org/document/8745480/}, 41 | doi = {10.1109/MCSE.2019.2924204}, 42 | abstract = {Although many active scientific codes use modern Fortran, most contemporary scientific software libraries are implemented in C and C++. Providing their numerical, algorithmic, or data management features to Fortran codes requires writing and maintaining substantial amounts of glue code. This article introduces a tool that automatically generates native Fortran 2003 interfaces to C and C++ libraries. The tool supports C++ features that have no direct Fortran analog, such as templated functions and exceptions. A set of simple examples demonstrate the utility and scope of the tool, and timing measurements with a mock numerical library illustrate the minimal performance impact of the generated wrapper code.}, 43 | language = {en}, 44 | number = {5}, 45 | urldate = {2019-08-20}, 46 | journal = {Computing in Science \& Engineering}, 47 | author = {Johnson, Seth R. and Prokopenko, Andrey and Evans, Katherine J.}, 48 | month = oct, 49 | year = {2020}, 50 | pages = {84--94}, 51 | file = {Johnson et al. - 2020 - Automated Fortran-C++ Bindings for Large-Scale Sci.pdf:/Users/s3j/Zotero/storage/IDWGIGJQ/Johnson et al. - 2020 - Automated Fortran-C++ Bindings for Large-Scale Sci.pdf:application/pdf} 52 | } 53 | -------------------------------------------------------------------------------- /include/flc_vector.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc_vector.i 3 | * 4 | * Copyright (c) 2019-2020 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc_vector" 9 | %include "import_flc.i" 10 | %flc_add_header 11 | 12 | %include 13 | %include 14 | 15 | /* ------------------------------------------------------------------------- 16 | * Macro definitions 17 | * ------------------------------------------------------------------------- */ 18 | 19 | %define %flc_std_vector_extend_pod(CTYPE, IMTYPE) 20 | %extend { 21 | %apply (const SWIGTYPE *DATA, ::size_t SIZE) 22 | { (const CTYPE* DATA, size_type SIZE) }; 23 | 24 | // Construct from an array of data 25 | vector(const CTYPE* DATA, size_type SIZE) { 26 | return new std::vector(DATA, DATA + SIZE); 27 | } 28 | 29 | // Assign from another vector 30 | void assign(const CTYPE* DATA, size_type SIZE) { 31 | $self->assign(DATA, DATA + SIZE); 32 | } 33 | 34 | // Get a mutable view to ourself 35 | %fortran_array_pointer(IMTYPE, vector& view); 36 | 37 | %typemap(out, noblock=1) vector& view { 38 | $result.data = ($1->empty() ? NULL : &(*$1->begin())); 39 | $result.size = $1->size(); 40 | } 41 | 42 | vector& view() { 43 | return *$self; 44 | } 45 | } 46 | %enddef 47 | 48 | /* ------------------------------------------------------------------------- */ 49 | /*! \def %flc_template_std_vector_pod 50 | * 51 | * Inject member functions and typemaps for POD classes, and instantiate. 52 | * 53 | * The added methods provide an efficient constructor from a Fortan array view. 54 | * It also offers a "view" functionality for getting an array pointer to the 55 | * vector-owned data. 56 | * 57 | * This definition is considered part of the \em public API so that downstream 58 | * apps that generate FLC-based bindings can instantiate their own POD vectors. 59 | */ 60 | %define %flc_template_std_vector_pod(NAME, T) 61 | 62 | namespace std { 63 | template<> class vector { 64 | 65 | %swig_std_vector(T, const T&) 66 | %swig_std_vector_extend_ref(T) 67 | %flc_std_vector_extend_pod(T, T) 68 | }; 69 | } 70 | 71 | // Instantiate the template 72 | %template(NAME) std::vector; 73 | 74 | %enddef 75 | 76 | 77 | /* ------------------------------------------------------------------------- */ 78 | /*! \def %flc_template_std_vector_complex 79 | * 80 | * Inject member functions and typemaps for std::complex instantiations. 81 | * 82 | * This definition is considered part of the \em public API so that downstream 83 | * apps that generate FLC-based bindings can instantiate their own POD vectors. 84 | */ 85 | %define %flc_template_std_vector_complex(NAME, T) 86 | 87 | namespace std { 88 | template<> class vector > { 89 | 90 | %swig_std_vector(std::complex, const std::complex&) 91 | %swig_std_vector_extend_ref(std::complex) 92 | %flc_std_vector_extend_pod(std::complex, SwigComplex_##T) 93 | }; 94 | } 95 | 96 | // Instantiate the template 97 | %template(NAME) std::vector >; 98 | 99 | %enddef 100 | 101 | /* ------------------------------------------------------------------------- 102 | * Numeric vectors 103 | * ------------------------------------------------------------------------- */ 104 | 105 | %flc_template_std_vector_pod(VectorInt4, int32_t) 106 | %flc_template_std_vector_pod(VectorInt8, int64_t) 107 | %flc_template_std_vector_pod(VectorReal8, double) 108 | 109 | %flc_template_std_vector_complex(VectorComplex8, double) 110 | 111 | /* ------------------------------------------------------------------------- 112 | * String vectors 113 | * ------------------------------------------------------------------------- */ 114 | 115 | %include 116 | %import "flc_string.i" 117 | 118 | %apply SWIGTYPE& { const std::string& value }; 119 | 120 | %extend std::vector { 121 | void set_ref(size_type index, const std::string& value) { 122 | SWIG_check_range(index, $self->size(), 123 | "std::vector::set_ref", 124 | return); 125 | (*$self)[index] = value; 126 | } 127 | } 128 | 129 | %template(VectorString) std::vector; 130 | 131 | %clear const std::string& value; 132 | -------------------------------------------------------------------------------- /include/flc_set.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc_set.i 3 | * 4 | * Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc_set" 9 | %include "import_flc.i" 10 | %flc_add_header 11 | 12 | %include 13 | 14 | // Support for set operations 15 | %{ 16 | #include 17 | #include 18 | %} 19 | 20 | /* ------------------------------------------------------------------------- 21 | * Macro definitions 22 | * ------------------------------------------------------------------------- */ 23 | 24 | %define %flc_define_set_algorithm(FUNCNAME) 25 | %insert("header") { 26 | template 27 | static Set_t flc_##FUNCNAME(const Set_t& left, const Set_t& right) 28 | { 29 | Set_t result; 30 | std::FUNCNAME(left.begin(), left.end(), 31 | right.begin(), right.end(), 32 | std::inserter(result, result.end())); 33 | return result; 34 | } 35 | } // end %insert 36 | %enddef 37 | 38 | %define %flc_extend_set_algorithm(FUNCNAME, RETVAL, TYPE) 39 | // The rename with the stringifying macro is necessary because 'union' is a 40 | // keyword. 41 | %rename(#FUNCNAME) std::set::set_##FUNCNAME; 42 | %extend std::set { 43 | RETVAL set_##FUNCNAME(const std::set& other) 44 | { return flc_set_##FUNCNAME(*$self, other); } 45 | } // end %extend 46 | %enddef 47 | 48 | %define %flc_std_set_extend_pod(CTYPE) 49 | %extend { 50 | %apply (const SWIGTYPE *DATA, ::size_t SIZE) 51 | { (const CTYPE* DATA, size_type SIZE) }; 52 | 53 | // Construct from an array of data 54 | set(const CTYPE* DATA, size_type SIZE) { 55 | return new std::set(DATA, DATA + SIZE); 56 | } 57 | 58 | // Insert an array of data 59 | void insert(const CTYPE* DATA, size_type SIZE) { 60 | $self->insert(DATA, DATA + SIZE); 61 | } 62 | } 63 | %enddef 64 | 65 | /* ------------------------------------------------------------------------- */ 66 | /*! \def %specialize_std_set_pod 67 | * 68 | * Inject member functions and typemaps for POD classes. 69 | * 70 | * These provide an efficient constructor from a Fortan array view. 71 | * 72 | * This definition is considered part of the \em public API so that downstream 73 | * apps that generate FLC-based bindings can instantiate their own POD sets. 74 | */ 75 | %define %specialize_std_set_pod(T) 76 | 77 | namespace std { 78 | template<> class set { 79 | %swig_std_set(T, std::less, std::allocator) 80 | %flc_std_set_extend_pod(T) 81 | }; 82 | } 83 | %enddef 84 | 85 | /* ------------------------------------------------------------------------- 86 | * Algorithms 87 | * ------------------------------------------------------------------------- */ 88 | 89 | %flc_define_set_algorithm(set_difference) 90 | %flc_define_set_algorithm(set_intersection) 91 | %flc_define_set_algorithm(set_symmetric_difference) 92 | %flc_define_set_algorithm(set_union) 93 | 94 | %insert("header") %{ 95 | template 96 | static bool flc_set_includes(const Set_t& left, const Set_t& right) 97 | { 98 | return std::includes(left.begin(), left.end(), 99 | right.begin(), right.end()); 100 | } 101 | %} 102 | 103 | %define %flc_extend_algorithms(TYPE) 104 | %flc_extend_set_algorithm(difference, std::set, TYPE) 105 | %flc_extend_set_algorithm(intersection, std::set, TYPE) 106 | %flc_extend_set_algorithm(symmetric_difference, std::set, TYPE) 107 | %flc_extend_set_algorithm(union, std::set, TYPE) 108 | %flc_extend_set_algorithm(includes, bool, TYPE) 109 | %enddef 110 | 111 | /* ------------------------------------------------------------------------- 112 | * Numeric sets 113 | * ------------------------------------------------------------------------- */ 114 | 115 | %flc_extend_algorithms(int) 116 | %specialize_std_set_pod(int) 117 | 118 | %template(SetInt) std::set; 119 | 120 | /* ------------------------------------------------------------------------- 121 | * String sets 122 | * ------------------------------------------------------------------------- */ 123 | 124 | // Allow direct insertion of a wrapped std::string 125 | %extend std::set { 126 | %apply SWIGTYPE& { const std::string& STR_CLASS }; 127 | 128 | void insert_ref(const std::string& STR_CLASS) { 129 | $self->insert(STR_CLASS); 130 | } 131 | } 132 | 133 | %include 134 | %import "flc_string.i" 135 | %flc_extend_algorithms(std::string) 136 | %template(SetString) std::set; 137 | -------------------------------------------------------------------------------- /doc/modules/set.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules/set.rst 3 | .. ############################################################################ 4 | 5 | .. _modules_Set: 6 | 7 | *** 8 | Set 9 | *** 10 | 11 | Sets are sorted containers of unique elements. The ``flc_set`` module 12 | defines sets of ``integer`` and of ``type(String)``. 13 | 14 | Basic functionality 15 | =================== 16 | 17 | All set types support the following basic operations. 18 | 19 | Construction and destruction 20 | ---------------------------- 21 | 22 | Like other wrapped C++ classes in Flibcpp, sets are 23 | constructed using an interface function. The default constructor is an empty 24 | set. Sets are destroyed using the ``release`` type-bound subroutine. 25 | 26 | Modification 27 | ------------ 28 | 29 | The two primary operations on a set are ``insert`` and ``erase`` for adding 30 | an element to and removing an element from the set. A ``clear`` subroutine 31 | removes all elements from the set. 32 | 33 | The ``size`` method returns the number of elements, and ``count`` will return 34 | the number of elements of a given value. 35 | 36 | Here's an example of creating, modifying, and destroying a set:: 37 | 38 | use flc_set, only : Set => SetInt 39 | type(Set) :: s 40 | logical :: inserted 41 | s = Set() 42 | call s%insert(2) 43 | call s%insert(3, inserted) ! Set has 2 elements, inserted => true 44 | call s%insert(3, inserted) ! Duplicate element, ignored; inserted => false 45 | call s%erase(2) ! Remove 2 from the set 46 | call s%erase(1) ! Nonexistent set element, ignored 47 | write(0,*) "Number of 3s in the set:" s%count(3) 48 | call s%clear() ! Remove all elements, size is now zero 49 | call s%insert(1) 50 | call s%release() ! Free memory 51 | 52 | Set operations 53 | -------------- 54 | 55 | The Fortran ``Set`` classes have been extended to include several useful set 56 | algorithms. (In C++, these are implemented using the ```` header and 57 | therefore should resemble the functions in 58 | :ref:`the flc_algorithm module `. 59 | 60 | All set operations take a single argument, another ``Set`` object, and do not 61 | modify either the original or the argument. All but the ``includes`` return 62 | newly allocated ``Set`` instances and do not modify the original sets. 63 | 64 | ``difference``: :math:`A \setminus B` 65 | Returns a new set with all elements from the original that are *not* present 66 | in the other set. 67 | 68 | ``intersection``: :math:`A \cap B` 69 | Return all elements that are in both sets. 70 | 71 | ``symmetric_difference``: :math:`(A \setminus B) \cup (B \setminus A)` 72 | Return all elements that are in one set or the other but not both. 73 | 74 | ``union``: :math:`A \cup B` 75 | Return all elements that are in either set. 76 | 77 | ``includes``: :math:`A \supseteq B` 78 | Return whether all elements of the other set are in the original set. 79 | 80 | Iteration 81 | --------- 82 | 83 | Iterating over a set to determine its contents is not yet supported. 84 | 85 | Numeric sets 86 | =============== 87 | 88 | Unlike :ref:`vectors`, the ``flc_set`` module includes 89 | a single "native integer" numeric instantiations. The value type is 90 | ``integer(C_INT)`` and is 64 bits on most modern systems. Since the C++ 91 | implementation of numerical sets is not very efficient, the assumption is that 92 | the ``set`` will be used in a non-numerically-intensive capacity where the 93 | default integer is the most appropriate option. 94 | 95 | Construct from an array 96 | ----------------------- 97 | 98 | Numeric sets can be created very efficiently from Fortran data by accepting 99 | an array argument:: 100 | 101 | use flc_set, only : Set => SetInt 102 | type(Set) :: s 103 | 104 | s = Set([1, 1, 2, 10]) 105 | write(0,*) "Size should be 3:", s%size() 106 | 107 | The ``assign`` bound method acts like a constructor but for an existing set. 108 | 109 | String sets 110 | ============== 111 | 112 | The native "element" type of ``SetString`` is a ``character(len=:)``. Set 113 | operations that accept an input will take any native character string; and 114 | returned values will be allocatable character arrays. 115 | 116 | An additional ``insert_ref`` function allows assignment of 117 | :ref:`String types ` 118 | 119 | .. ############################################################################ 120 | .. end of doc/modules/set.rst 121 | .. ############################################################################ 122 | -------------------------------------------------------------------------------- /cmake/backport-cmake-318/FindSWIG.cmake: -------------------------------------------------------------------------------- 1 | # Distributed under the OSI-approved BSD 3-Clause License. See accompanying 2 | # file Copyright.txt or https://cmake.org/licensing for details. 3 | 4 | #[=======================================================================[.rst: 5 | FindSWIG 6 | -------- 7 | 8 | Find the Simplified Wrapper and Interface Generator (SWIG_) executable. 9 | 10 | 11 | This module finds an installed SWIG and determines its version. If a 12 | ``COMPONENTS`` or ``OPTIONAL_COMPONENTS`` argument is given to ``find_package``, 13 | it will also determine supported target languages. The module sents the 14 | following variables: 15 | 16 | ``SWIG_FOUND`` 17 | Whether SWIG and any required components were found on the system. 18 | ``SWIG_EXECUTABLE`` 19 | Path to the SWIG executable. 20 | ``SWIG_DIR`` 21 | Path to the installed SWIG ``Lib`` directory (result of ``swig -swiglib``). 22 | ``SWIG_VERSION`` 23 | SWIG executable version (result of ``swig -version``). 24 | ``SWIG__FOUND`` 25 | If ``COMPONENTS`` or ``OPTIONAL_COMPONENTS`` are requested, each available 26 | target language ```` (lowercase) will be set to TRUE. 27 | 28 | Any ``COMPONENTS`` given to ``find_package`` should be the names of supported 29 | target languages as provided to the LANGUAGE argument of ``swig_add_library``, 30 | such as ``python`` or ``perl5``. Language names *must* be lowercase. 31 | 32 | All information is collected from the ``SWIG_EXECUTABLE``, so the version 33 | to be found can be changed from the command line by means of setting 34 | ``SWIG_EXECUTABLE``. 35 | 36 | Example usage requiring SWIG 4.0 or higher and Python language support, with 37 | optional Fortran support: 38 | 39 | .. code-block:: cmake 40 | 41 | find_package(SWIG 4.0 COMPONENTS python OPTIONAL_COMPONENTS fortran) 42 | if(SWIG_FOUND) 43 | message("SWIG found: ${SWIG_EXECUTABLE}") 44 | if(NOT SWIG_fortran_FOUND) 45 | message(WARNING "SWIG Fortran bindings cannot be generated") 46 | endif() 47 | endif() 48 | 49 | .. _`SWIG`: http://swig.org 50 | 51 | #]=======================================================================] 52 | 53 | find_program(SWIG_EXECUTABLE NAMES swig4.0 swig3.0 swig2.0 swig) 54 | 55 | if(SWIG_EXECUTABLE) 56 | execute_process(COMMAND ${SWIG_EXECUTABLE} -swiglib 57 | OUTPUT_VARIABLE SWIG_swiglib_output 58 | ERROR_VARIABLE SWIG_swiglib_error 59 | RESULT_VARIABLE SWIG_swiglib_result) 60 | 61 | if(SWIG_swiglib_result) 62 | if(SWIG_FIND_REQUIRED) 63 | message(SEND_ERROR "Command \"${SWIG_EXECUTABLE} -swiglib\" failed with output:\n${SWIG_swiglib_error}") 64 | else() 65 | message(STATUS "Command \"${SWIG_EXECUTABLE} -swiglib\" failed with output:\n${SWIG_swiglib_error}") 66 | endif() 67 | else() 68 | string(REGEX REPLACE "[\n\r]+" ";" SWIG_swiglib_output ${SWIG_swiglib_output}) 69 | find_path(SWIG_DIR swig.swg PATHS ${SWIG_swiglib_output} NO_CMAKE_FIND_ROOT_PATH) 70 | if(SWIG_DIR) 71 | set(SWIG_USE_FILE ${CMAKE_CURRENT_LIST_DIR}/UseSWIG.cmake) 72 | execute_process(COMMAND ${SWIG_EXECUTABLE} -version 73 | OUTPUT_VARIABLE SWIG_version_output 74 | ERROR_VARIABLE SWIG_version_output 75 | RESULT_VARIABLE SWIG_version_result) 76 | if(SWIG_version_result) 77 | message(SEND_ERROR "Command \"${SWIG_EXECUTABLE} -version\" failed with output:\n${SWIG_version_output}") 78 | else() 79 | string(REGEX REPLACE ".*SWIG Version[^0-9.]*\([0-9.]+\).*" "\\1" 80 | SWIG_version_output "${SWIG_version_output}") 81 | set(SWIG_VERSION ${SWIG_version_output} CACHE STRING "Swig version" FORCE) 82 | endif() 83 | endif() 84 | endif() 85 | 86 | if(SWIG_FIND_COMPONENTS) 87 | execute_process(COMMAND ${SWIG_EXECUTABLE} -help 88 | OUTPUT_VARIABLE SWIG_swighelp_output 89 | ERROR_VARIABLE SWIG_swighelp_error 90 | RESULT_VARIABLE SWIG_swighelp_result) 91 | if(SWIG_swighelp_result) 92 | message(SEND_ERROR "Command \"${SWIG_EXECUTABLE} -help\" failed with output:\n${SWIG_swiglib_error}") 93 | else() 94 | string(REPLACE "\n" ";" SWIG_swighelp_output "${SWIG_swighelp_output}") 95 | foreach(SWIG_line IN LISTS SWIG_swighelp_output) 96 | if(SWIG_line MATCHES "-([A-Za-z0-9_]+) +- *Generate.*wrappers") 97 | set(SWIG_${CMAKE_MATCH_1}_FOUND TRUE) 98 | endif() 99 | endforeach() 100 | endif() 101 | endif() 102 | endif() 103 | 104 | include(FindPackageHandleStandardArgs) 105 | find_package_handle_standard_args( 106 | SWIG HANDLE_COMPONENTS 107 | REQUIRED_VARS SWIG_EXECUTABLE SWIG_DIR 108 | VERSION_VAR SWIG_VERSION) 109 | 110 | mark_as_advanced(SWIG_DIR SWIG_VERSION SWIG_EXECUTABLE) 111 | -------------------------------------------------------------------------------- /doc/infrastructure.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/infrastructure.rst 3 | .. ############################################################################ 4 | 5 | ************** 6 | Infrastructure 7 | ************** 8 | 9 | Flibcpp is built using modern CMake_, and it has no external dependencies. This 10 | makes installation and usage quite simple as long as you have a relatively 11 | recent software stack with a Fortran and compatible C++ compiler. 12 | 13 | Installation 14 | ============ 15 | 16 | 1. Download and install CMake if it's not already on your system. It is highly 17 | recommended to use a package manager such as Homebrew_ for Mac or YUM_ for 18 | Red Hat Linux. 19 | 2. Download the `Flibcpp source code`_ from GitHub if you haven't already. 20 | 3. Create a new build directory (for example purposes, create a subdirectory 21 | named ``build`` inside your downloaded source directory) and ``cd`` to it. 22 | 4. Run CMake: ``cmake ..`` 23 | 5. Make and install (by default it will install to ``/usr/local``): 24 | ``make install``. 25 | 26 | By default, Flibcpp builds shared libraries. Add the CMake argument 27 | ``-DBUILD_SHARED_LIBS:BOOL=OFF`` to build static libraries. 28 | 29 | .. _CMake: https://cmake.org 30 | .. _Homebrew: https://brew.sh 31 | .. _YUM: https://access.redhat.com/solutions/9934 32 | .. _Flibcpp source code: https://github.com/swig-fortran/flibcpp/releases 33 | 34 | Downstream usage as a library 35 | ============================= 36 | 37 | The Flibcpp library is most easily used when your downstream app is built with 38 | CMake. It should require a single line to initialize:: 39 | 40 | find_package(Flibcpp REQUIRED CONFIG) 41 | 42 | and a single line to link against your app or library:: 43 | 44 | target_link_libraries(example_backend Flibcpp::flc_random Flibcpp::flc_algorithm) 45 | 46 | If your installation prefix for Flibcpp is a system default path (such as 47 | ``/usr/local``) or in your ``$CMAKE_PREFIX_PATH`` environment variable, it 48 | should automatically find the necessary CMake configure file. 49 | 50 | An `example Fortran application`_ that depends only on Flibcpp is 51 | available on Github. 52 | 53 | .. _example Fortran application: https://github.com/swig-fortran/flibcpp-example-app 54 | 55 | If you're using a simple standalone Makefile to build your Fortran code, you 56 | will have to inform the compiler of the proper include path, library path, and 57 | library names. Depending on your system configuration, you might have to 58 | also explicitly link your app against the compiler's C++ standard libraries 59 | using ``-lstdc++``. 60 | 61 | Downstream usage as a component 62 | =============================== 63 | 64 | Flibcpp's SWIG interface files can be used with your Fortran-accessible 65 | C++ project to seamlessly integrate the Flibcpp Fortran wrapper code with 66 | yours. To start, you must have the latest version of the `SWIG+Fortran`_ tool 67 | installed on your machine: the version of SWIG used by your installation of 68 | Flibcpp *must* match the version used by your downstream library/app. When you 69 | build Flibcpp for downstream SWIG usage, you must configure using ``cmake 70 | -DFLIBCPP_USE_SWIG=ON ..``. This will cause the SWIG interface files to be 71 | installed to ``${CMAKE_PREFIX_PATH}/include`` to make them available 72 | downstream. Finally, in your downstream SWIG interface code, instead of calling 73 | ``%import `` you must use ``%include ``. This is necessary 74 | to inject function declarations and other internal macros into your wrapper 75 | code. 76 | 77 | At that point, all you have to do is (for example) ``%import `` to 78 | allow ``std::vector`` in your library headers to be wrapped by 79 | Flibcpp's ``VectorReal8`` Fortran proxy derived type. 80 | 81 | An `example C++/Fortran library`_ that integrates with Flibcpp will be made 82 | available on Github. 83 | 84 | .. _SWIG+Fortran: https://github.com/swig-fortran 85 | .. _example C++/Fortran library: https://github.com/swig-fortran/flibcpp-example-lib). 86 | 87 | Developing 88 | ========== 89 | 90 | If you are interested in extending the capabilities of Flibcpp, you will need 91 | the latest version of the `SWIG+Fortran`_ tool installed on your machine. When 92 | configuring CMake, you will want to configure using 93 | ``cmake -DFLIBCPP_DEV=ON ..`` to enable tests and documentation. Tests, 94 | examples, and documentation can be independently enabled using the 95 | ``FLIBCPP_BUILD_TESTS``, ``FLIBCPP_BUILD_EXAMPLES``, and ``FLIBCPP_BUILD_DOCS`` 96 | options. 97 | 98 | .. ############################################################################ 99 | .. end of doc/introduction.rst 100 | .. ############################################################################ 101 | -------------------------------------------------------------------------------- /test/test_random.F90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file test/test_algorithm.F90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | ! Distributed under an MIT open source license: see LICENSE for details. 6 | !-----------------------------------------------------------------------------! 7 | 8 | #include "fassert.h" 9 | 10 | program test_random 11 | implicit none 12 | call test_engines() 13 | call test_uniform_int_distribution() 14 | call test_uniform_real_distribution() 15 | call test_normal_distribution() 16 | call test_discrete_distribution() 17 | contains 18 | 19 | !-----------------------------------------------------------------------------! 20 | subroutine test_engines() 21 | use, intrinsic :: ISO_C_BINDING 22 | use flc_random, only : MersenneEngine4, MersenneEngine8 23 | implicit none 24 | type(MersenneEngine4) :: eng4 25 | type(MersenneEngine8) :: eng8 26 | integer(4), dimension(2) :: i4 27 | integer(8), dimension(2) :: i8 28 | integer(4), dimension(2), parameter :: expected_i4 = [ & 29 | 822569775, 2137449171] 30 | integer(8), dimension(2), parameter :: expected_i8 = [ & 31 | -973404863619218144_8 , 963351229459618018_8] 32 | 33 | eng4 = MersenneEngine4(1234_c_int32_t) 34 | i4(1) = eng4%next() 35 | i4(2) = eng4%next() 36 | ASSERT(all(expected_i4 == i4)) 37 | 38 | eng8 = MersenneEngine8(1234_c_int64_t) 39 | i8(1) = eng8%next() 40 | i8(2) = eng8%next() 41 | ASSERT(all(expected_i8 == i8)) 42 | 43 | call eng4%release() 44 | call eng8%release() 45 | end subroutine 46 | 47 | !-----------------------------------------------------------------------------! 48 | subroutine test_uniform_int_distribution() 49 | use, intrinsic :: ISO_C_BINDING 50 | use flc_random, only : Engine => MersenneEngine4, uniform_int_distribution 51 | implicit none 52 | integer(C_INT), dimension(:), allocatable :: arr 53 | type(Engine) :: rng 54 | 55 | allocate(arr(128)) 56 | rng = Engine(1234_c_int32_t) ! Initialize with seed 57 | 58 | call uniform_int_distribution(5, 15, rng, arr) 59 | ASSERT(minval(arr) >= 5) 60 | ASSERT(maxval(arr) <= 15) 61 | ASSERT(abs(sum(arr) - (10 * size(arr))) < size(arr) / 10) 62 | 63 | call rng%release() 64 | end subroutine 65 | 66 | !-----------------------------------------------------------------------------! 67 | subroutine test_uniform_real_distribution() 68 | use, intrinsic :: ISO_C_BINDING 69 | use flc_random, only : Engine => MersenneEngine4, uniform_real_distribution 70 | implicit none 71 | real(C_DOUBLE), dimension(256) :: arr 72 | real(C_DOUBLE) :: avg 73 | type(Engine) :: rng 74 | 75 | rng = Engine() ! Initialize with default seed 76 | 77 | call uniform_real_distribution(5.d0, 15.d0, rng, arr) 78 | ASSERT(minval(arr) >= 5.d0) 79 | ASSERT(maxval(arr) <= 15.d0) 80 | 81 | avg = sum(arr) / real(size(arr), kind=8) 82 | ASSERT(avg >= 9.5 .and. avg <= 10.5) 83 | 84 | call rng%release() 85 | end subroutine 86 | 87 | !-----------------------------------------------------------------------------! 88 | subroutine test_normal_distribution() 89 | use, intrinsic :: ISO_C_BINDING 90 | use flc_random, only : Engine => MersenneEngine4, normal_distribution 91 | implicit none 92 | real(C_DOUBLE), dimension(:), allocatable :: arr 93 | real(C_DOUBLE) :: avg 94 | type(Engine) :: rng 95 | 96 | allocate(arr(1024)) 97 | rng = Engine() ! Initialize with default seed 98 | 99 | ! Mean=10, sigma=2 100 | call normal_distribution(10.0d0, 2.0d0, rng, arr) 101 | 102 | avg = sum(arr) / real(size(arr), kind=8) 103 | ASSERT(avg >= 9.9 .and. avg <= 10.1) 104 | 105 | call rng%release() 106 | end subroutine 107 | 108 | !-----------------------------------------------------------------------------! 109 | subroutine test_discrete_distribution() 110 | use, intrinsic :: ISO_C_BINDING 111 | use flc_random, only : Engine => MersenneEngine4, discrete_distribution 112 | implicit none 113 | real(C_DOUBLE), dimension(4), parameter :: weights & 114 | = [.125d0, .125d0, .25d0, .5d0] 115 | integer(C_INT), dimension(1024) :: sampled 116 | integer(C_INT), dimension(4) :: tallied = 0 117 | integer(C_INT), dimension(4), parameter :: gold_result = [130, 127, 267, 500] 118 | type(Engine) :: rng 119 | integer :: i 120 | 121 | ! Sample 1024 random ints 122 | rng = Engine() 123 | call discrete_distribution(weights, rng, sampled) 124 | call rng%release() 125 | 126 | ASSERT(minval(sampled) == 1) 127 | ASSERT(maxval(sampled) == size(weights)) 128 | do i = 1, size(sampled) 129 | tallied(sampled(i)) = tallied(sampled(i)) + 1 130 | enddo 131 | 132 | ASSERT(all(tallied == gold_result)) 133 | end subroutine 134 | 135 | !-----------------------------------------------------------------------------! 136 | 137 | end program 138 | 139 | -------------------------------------------------------------------------------- /doc/modules/random.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules/random.rst 3 | .. ############################################################################ 4 | 5 | .. _modules_random: 6 | 7 | ****** 8 | Random 9 | ****** 10 | 11 | The ``flc_random`` module contains advanced pseudo-random number generation 12 | from the ``_ C++ header. 13 | 14 | The C++11 way of generating random numbers takes some getting used to. Rather 15 | than having a single global function that returns a random real number in the 16 | range :math:`[0,1)`, C++11 has independent *engine* objects that generate 17 | streams of random bits. Different *distribution* objects convert those bits 18 | into samples of a distribution. 19 | 20 | Although C++11 defines a dizzying variety of random number engines, 21 | ``flc_random`` wraps just two: the 32- and 64-bit `Mersenne Twister` 22 | algorithms. The 32-bit version (``MersenneEngine4``) is currently the only 23 | engine type that can be used with distributions and algorithms. 24 | 25 | Flibcpp wraps distribution objects as independent subroutines. Each subroutine 26 | accepts the constructor parameters of the distribution, the random engine, and 27 | a target Fortran array to be filled with random numbers. 28 | 29 | Generating an array with 10 normally-distributed reals with a mean of 8 and a 30 | standard deviation of 2 is done as such:: 31 | 32 | use flc_random, only : Engine => MersenneEngine4, normal_distribution 33 | real(C_DOUBLE), dimension(20) :: arr 34 | type(Engine) :: rng 35 | 36 | rng = Engine() 37 | call normal_distribution(8.0d0, 2.0d0, rng, arr) 38 | call rng%release() 39 | 40 | .. _ : https://en.cppreference.com/w/cpp/numeric/random 41 | .. _Mersenne Twister : https://en.wikipedia.org/wiki/Mersenne_Twister 42 | 43 | Engines 44 | ======= 45 | 46 | The two Mersenne twister engines in ``flc_random`` return different-sized 47 | integers per call: 48 | 49 | - ``MersenneEngine4``: each invocation returns a 32-bit ``integer(4)`` 50 | - ``MersenneEngine8``: each invocation returns a 64-bit ``integer(8)`` 51 | 52 | Engines can be constructed using one of two interface functions: the 53 | argument-free ``MersenneEngine4()`` uses the default seed, and the engine takes 54 | a single argument ``MersenneEngine4(1234567)`` with the seed. Alternatively, 55 | the seed can be set (or reset) using the ``seed()`` type-bound procedure. 56 | 57 | Generally, engines are used with distributions (described below). However, if 58 | necessary, individual randomly generated values can be obtained by calling 59 | the ``next()`` type-bound procedure. 60 | 61 | .. warning:: C++ generates *unsigned* integers with entropy in every bit. This 62 | means that the integers obtained from ``engine%next()``, reinterpreted as 63 | signed Fortran integers, may be negative. 64 | 65 | In most cases, the default distribution-compatible ``MersenneEngine4`` should 66 | be used, since the distributions described below require it. 67 | 68 | Distributions 69 | ============= 70 | 71 | Distributions produce numerical values from the random bitstream provided by 72 | an RNG engine. For efficiency, each distribution subroutine accepts an *array* 73 | of values that are filled with samples of the distribution. 74 | 75 | normal_distribution 76 | ------------------- 77 | 78 | Each element of the sampled array is distributed according to a Gaussian 79 | function with the given mean and standard deviation. 80 | 81 | uniform_int_distribution 82 | ------------------------ 83 | 84 | Each element is uniformly sampled between the two provided bounds, inclusive on 85 | both sides. 86 | 87 | uniform_real_distribution 88 | ------------------------- 89 | 90 | Each element is a sample of a uniform distribution between the two bounds, 91 | inclusive on left side only. 92 | 93 | discrete_distribution 94 | --------------------- 95 | 96 | The discrete distribution is constructed with an array of :math:`N` weights: 97 | the probability that an index in the range :math:`[1, N]` will be selected. 98 | :: 99 | 100 | real(C_DOUBLE), dimension(4), parameter :: weights & 101 | = [.125d0, .125d0, .25d0, .5d0] 102 | integer(C_INT), dimension(1024) :: sampled 103 | call discrete_distribution(weights, Engine(), sampled) 104 | 105 | In the above example, ``1`` and ``2`` will are expected to each occupy an 106 | eighth of the ``sampled`` array, approximately a quarter of the ``sampled`` 107 | array's values will be ``3``, and about a half will be ``4``. 108 | 109 | .. note:: The C++ distribution returns values in :math:`[0, N)`, so in 110 | accordance with Flibcpp's :ref:`indexing convention ` 111 | the result is transformed when provided to Fortran users. 112 | 113 | .. ############################################################################ 114 | .. end of doc/modules/random.rst 115 | .. ############################################################################ 116 | -------------------------------------------------------------------------------- /doc/modules/string.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules/string.rst 3 | .. ############################################################################ 4 | 5 | .. _modules_string: 6 | 7 | ****** 8 | String 9 | ****** 10 | 11 | The string module includes the ``String`` derived type and a handful of string 12 | conversion functions. 13 | 14 | .. _modules_string_type: 15 | 16 | String type 17 | =========== 18 | 19 | The C++ standard library "string" is a dynamically resizable, mutable character 20 | array. 21 | 22 | Constructors 23 | ------------ 24 | 25 | Strings are constructed using three interface functions: 26 | 27 | - The function without arguments creates an empty string; 28 | - An integer argument ``count`` and a single character will create a string 29 | of size ``count`` filled with that character; and 30 | - A standard Fortran ``character(kind=C_CHAR, len=*)`` which will be copied 31 | to the string. 32 | 33 | Here are three examples of initialization:: 34 | 35 | use flc_string, only : String 36 | type(String) :: s 37 | 38 | s = String() 39 | ! s%size() == 0 40 | s = String(10, "!") 41 | ! s%size() == 10 42 | ! s%get(i) == "!" 43 | s = String("I am a string!") 44 | 45 | 46 | Character element access 47 | ------------------------ 48 | 49 | The number of characters in the string is returned by the bound function 50 | ``size``. The ``get`` function returns the character at an index; and ``front`` 51 | and ``back`` are aliases for ``get(1)`` and ``get(v%size())``, respectively. 52 | 53 | .. important:: Unlike the C++ version of this class, **strings in Flibcpp 54 | use 1-offset indexing**. See :ref:`conventions_indexing`. 55 | 56 | Modification 57 | ------------ 58 | 59 | Like :ref:`vectors `, Strings can be resized dynamically using 60 | a variety of methods: 61 | 62 | - ``resize`` to specify an exact size; 63 | - ``push_back`` to add a new character to the end of it; 64 | - ``append`` to add another string to the end 65 | - ``pop_back`` to remove the last character; 66 | - ``clear`` to remove all elements. 67 | 68 | The string also has a ``set`` bound subroutine for assigning a character to a 69 | specified index:: 70 | 71 | type(String) :: s 72 | 73 | s = String("=", 10) 74 | call s%set(1, "8") 75 | call s%set(s%size(), "D") 76 | 77 | Search 78 | ------ 79 | 80 | The ``find`` bound function will search for a substring, starting at an 81 | optional position. Like the :ref:`search 82 | algorithms ` in Flibcpp, a search result of `0` 83 | indicates "not found" and any other result is the 1-offset index in the 84 | string. :: 85 | 86 | type(String) :: s 87 | integer :: i 88 | 89 | s = String("meowmeow") 90 | i = s%find("meow") ! Returns 1 91 | i = s%find("meow", 3) ! Returns 5 92 | i = s%find("woof") ! Returns 0 93 | 94 | View as an array pointer 95 | ------------------------ 96 | 97 | The string can be viewed (and indeed modified) as an array of character 98 | elements:: 99 | 100 | type(String) :: s 101 | character, dimension(:), pointer :: charptr 102 | 103 | s = String("Hello!") 104 | charptr => s%view() 105 | charptr(6) = "?" ! change greeting to a question 106 | 107 | Conversion to native string 108 | --------------------------- 109 | 110 | The ``str`` type-bound function returns an allocated character string:: 111 | 112 | character(len=:), allocatable :: native 113 | type(String) :: s 114 | 115 | s = String("Hello world") 116 | native = s%str() 117 | write(0,"(a)") native 118 | 119 | 120 | Conversion functions 121 | ==================== 122 | 123 | The ``flc_string`` module includes several module procedures for converting 124 | native Fortran strings to integers and real numbers. These functions are robust 125 | and exception-safe, allowing intelligent error handling from the Fortran side. 126 | 127 | - Integer conversion: ``stoi``, ``stol``, ``stoll`` 128 | - Real conversion: ``stof``, ``stod`` 129 | 130 | :: 131 | 132 | use flc, only : ierr, get_serr, SWIG_OverflowError, SWIG_ValueError 133 | use flc_string 134 | implicit none 135 | integer(4) :: temp 136 | character(len=100) :: tempstr 137 | 138 | read(*, '(a)') tempstr 139 | temp = stoi(trim(tempstr)) 140 | if (ierr == SWIG_OverflowError) then 141 | write(0,*) "Your integer is too darn big!" 142 | elseif (ierr == SWIG_ValueError) then 143 | write(0,*) "That thing you entered? It wasn't an integer." 144 | end if 145 | 146 | Integer conversion defaults to base-10, but passing an additional integer 147 | argument allows conversion from other bases. The special integer value of ``0`` 148 | allows auto-detection of values in octal (with a leading ``0`` as in ``0777``) 149 | or hexadecimal (with a leading ``0x`` as in ``0xb1f1c2a3``). 150 | 151 | .. ############################################################################ 152 | .. end of doc/modules/string.rst 153 | .. ############################################################################ 154 | -------------------------------------------------------------------------------- /test/test_vector.F90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file test/test_vector.F90 3 | ! 4 | ! Copyright (c) 2019-2020 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | ! Distributed under an MIT open source license: see LICENSE for details. 6 | !-----------------------------------------------------------------------------! 7 | 8 | #include "fassert.h" 9 | 10 | program test_vector 11 | implicit none 12 | call test_int4() 13 | call test_complex8() 14 | call test_string() 15 | contains 16 | 17 | !-----------------------------------------------------------------------------! 18 | subroutine test_int4() 19 | use, intrinsic :: ISO_C_BINDING 20 | use flc, only : ierr, get_serr 21 | use flc_vector, only : Vector => VectorInt4 22 | implicit none 23 | integer(4), dimension(4), parameter :: iarr = [ 1, -2, 4, -8 ] 24 | integer(4), dimension(:), pointer :: view => NULL() 25 | integer(4), pointer :: element_ptr => NULL() 26 | type(Vector) :: v, v2 27 | 28 | v = Vector(iarr) 29 | ASSERT(v%size() == 4) 30 | ASSERT(v%get(1) == 1_c_int) 31 | ASSERT(v%get(4) == -8_c_int) 32 | 33 | call v%clear() 34 | call v%push_back(123_c_int) 35 | ASSERT(v%size() == 1) 36 | 37 | call v%assign(iarr) 38 | ASSERT(v%size() == 4) 39 | ASSERT(v%get(1) == 1_c_int) 40 | ASSERT(v%get(4) == -8_c_int) 41 | 42 | ! Remove the 3rd element (value of 4) 43 | call v%erase(3) 44 | ASSERT(ierr == 0) 45 | view => v%view() 46 | ASSERT(size(view) == 3) 47 | ASSERT(view(2) == -2) 48 | ASSERT(view(3) == -8) 49 | 50 | ! Remove the last two elements (start/stop). Note that since we modified the 51 | ! vector, we have to update the view 52 | call v%erase(2, 4) 53 | view => v%view() 54 | ASSERT(ierr == 0) 55 | ASSERT(size(view) == 1) 56 | ASSERT(view(1) == 1) 57 | 58 | ! Make a bad call and check+clear the error 59 | call v%erase(12345) 60 | write (0,*) "Should have a nice error message here: ", get_serr() 61 | ASSERT(ierr /= 0) 62 | ! Clear the error 63 | ierr = 0 64 | 65 | ! Copy to a new vector and delete the old 66 | call v%assign(iarr) 67 | v2 = Vector(v) 68 | call v%release() 69 | ASSERT(v2%size() == 4) 70 | 71 | ! Assign by reference 72 | element_ptr => v2%get_ref(2) 73 | ASSERT(element_ptr == -2) 74 | element_ptr = 1234 75 | ASSERT(v2%get(2) == 1234) 76 | call v2%release() 77 | 78 | ! Create from an in-place array 79 | v = Vector([integer(4) :: 1, 2, 3, 5, 8, 13]) 80 | ASSERT(v%size() == 6) 81 | ASSERT(v%get(1) == 1) 82 | ASSERT(v%back() == 13) 83 | call v%release() 84 | end subroutine 85 | 86 | !-----------------------------------------------------------------------------! 87 | pure elemental function is_close(a, b) result(fresult) 88 | use, intrinsic :: ISO_C_BINDING 89 | implicit none 90 | complex(C_DOUBLE_COMPLEX), intent(in) :: a 91 | complex(C_DOUBLE_COMPLEX), intent(in) :: b 92 | logical :: fresult 93 | fresult = abs(a - b) < 1.0d-12 94 | end function 95 | 96 | subroutine test_complex8() 97 | use, intrinsic :: ISO_C_BINDING 98 | use flc, only : ierr, get_serr 99 | use flc_vector, only : Vector => VectorComplex8 100 | implicit none 101 | complex(8), dimension(3), parameter :: carr & 102 | = [ complex(8) :: (1, -2), (2, 1), (1.5d0, 0) ] 103 | complex(8), dimension(:), pointer :: view => NULL() 104 | complex(8), pointer :: element_ptr => NULL() 105 | type(Vector) :: v 106 | 107 | v = Vector(carr) 108 | ASSERT(v%size() == 3) 109 | ASSERT(is_close(v%get(1), cmplx(1, -2, C_DOUBLE_COMPLEX))) 110 | ASSERT(is_close(v%get(3), cmplx(1.5d0, 0, C_DOUBLE_COMPLEX))) 111 | 112 | call v%erase(2) 113 | ASSERT(ierr == 0) 114 | view => v%view() 115 | ASSERT(size(view) == 2) 116 | ASSERT(is_close(view(2), cmplx(1.5d0, 0, C_DOUBLE_COMPLEX))) 117 | 118 | call v%push_back((10d0, -5d0)) 119 | ASSERT(v%size() == 3) 120 | ASSERT(is_close(v%get(3), cmplx(10, -5, C_DOUBLE_COMPLEX))) 121 | ASSERT(is_close(v%back(), cmplx(10, -5, C_DOUBLE_COMPLEX))) 122 | 123 | ! Assign by reference 124 | element_ptr => v%get_ref(2) 125 | write(*,*) "value:", v%get(2) 126 | ASSERT(is_close(element_ptr, (1.5d0, 0d0))) 127 | element_ptr = (3, 4) 128 | ASSERT(is_close(v%get(2), (3d0, 4d0))) 129 | 130 | call v%release() 131 | 132 | end subroutine 133 | 134 | !-----------------------------------------------------------------------------! 135 | subroutine test_string() 136 | use, intrinsic :: ISO_C_BINDING 137 | use flc_vector, only : Vector => VectorString 138 | use flc_string, only : String 139 | implicit none 140 | type(Vector) :: v 141 | type(String) :: sref 142 | 143 | v = Vector(5, "mine") ! 5 elements, all "mine" 144 | call v%set(5, "yours") 145 | ASSERT(v%get(5) == "yours") 146 | sref = v%get_ref(1) 147 | ASSERT(sref%str() == "mine") 148 | call sref%assign("I me") 149 | ! Changing the reference changes the value in the original vector 150 | ASSERT(v%get(1) == "I me") 151 | 152 | call v%set_ref(4, v%get_ref(5)) 153 | ASSERT(v%get(4) == "yours") 154 | 155 | call sref%release() 156 | call v%release() 157 | end subroutine 158 | 159 | !-----------------------------------------------------------------------------! 160 | end program 161 | -------------------------------------------------------------------------------- /example/sort_generic.f90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file example/sort_generic.f90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | !-----------------------------------------------------------------------------! 6 | 7 | ! Mock-up of a user-created type and comparison operator 8 | module sort_generic_extras 9 | implicit none 10 | public 11 | 12 | ! Declare an example Fortran derived type 13 | type :: FortranString 14 | character(len=:), allocatable :: chars 15 | end type 16 | 17 | ! Declare a 'less than' operator for that type 18 | interface operator(<) 19 | module procedure fortranstring_less 20 | end interface 21 | 22 | contains 23 | 24 | ! Lexicographically compare strings of equal length. 25 | elemental function chars_less(left, right, length) & 26 | result(fresult) 27 | character(len=*), intent(in) :: left 28 | character(len=*), intent(in) :: right 29 | integer, intent(in) :: length 30 | logical :: fresult 31 | integer :: i, lchar, rchar 32 | 33 | ! If any character code is less than the RHS, it is less than. 34 | do i = 1, length 35 | lchar = ichar(left(i:i)) 36 | rchar = ichar(right(i:i)) 37 | if (lchar < rchar) then 38 | fresult = .true. 39 | return 40 | elseif (lchar > rchar) then 41 | fresult = .false. 42 | return 43 | endif 44 | end do 45 | 46 | fresult = .false. 47 | end function 48 | 49 | elemental function fortranstring_less(self, other) & 50 | result(fresult) 51 | type(FortranString), intent(in) :: self 52 | type(FortranString), intent(in) :: other 53 | logical :: fresult 54 | 55 | if (.not. allocated(other%chars)) then 56 | ! RHS is null and LHS is not 57 | fresult = .true. 58 | elseif (.not. allocated(self%chars)) then 59 | ! LHS is null => "greater than" (if LHS is string) or equal (if both null) 60 | fresult = .false. 61 | elseif (len(self%chars) < len(other%chars)) then 62 | ! Since LHS is shorter, it is "less than" the RHS. 63 | fresult = .true. 64 | elseif (len(self%chars) > len(other%chars)) then 65 | ! If RHS is shorter 66 | fresult = .false. 67 | else 68 | ! Compare strings of equal length 69 | fresult = chars_less(self%chars, other%chars, len(self%chars)) 70 | endif 71 | end function 72 | 73 | ! C++-accessible comparison function for two pointers-to-strings 74 | ! (null strings always compare "greater than" to move to end of a list) 75 | function compare_strings(lcptr, rcptr) bind(C) & 76 | result(fresult) 77 | use, intrinsic :: ISO_C_BINDING 78 | type(C_PTR), intent(in), value :: lcptr 79 | type(C_PTR), intent(in), value :: rcptr 80 | logical(C_BOOL) :: fresult 81 | type(FortranString), pointer :: lptr 82 | type(FortranString), pointer :: rptr 83 | 84 | if (.not. c_associated(rcptr)) then 85 | ! RHS is null and LHS is not 86 | fresult = .true. 87 | elseif (.not. c_associated(lcptr)) then 88 | ! LHS is null => "greater than" (if LHS is string) or equal (if both null) 89 | fresult = .false. 90 | else 91 | ! Both associated: convert from C to Fortran pointers 92 | call c_f_pointer(cptr=lcptr, fptr=lptr) 93 | call c_f_pointer(cptr=rcptr, fptr=rptr) 94 | 95 | ! Compare the strings 96 | fresult = (lptr < rptr) 97 | endif 98 | end function 99 | end module 100 | 101 | program sort_generic_example 102 | use, intrinsic :: ISO_FORTRAN_ENV 103 | use, intrinsic :: ISO_C_BINDING 104 | use flc 105 | use flc_algorithm, only : argsort, INDEX_INT 106 | use sort_generic_extras, only : compare_strings, FortranString 107 | use example_utils, only : write_version, read_positive_int, STDOUT, STDIN 108 | implicit none 109 | type(FortranString), dimension(:), allocatable, target :: fs_array 110 | type(C_PTR), dimension(:), allocatable, target :: ptrs 111 | integer(INDEX_INT), dimension(:), allocatable, target :: ordering 112 | character(len=80) :: readstr 113 | integer :: arr_size, i, io_ierr 114 | 115 | call write_version() 116 | 117 | ! Read strings 118 | arr_size = read_positive_int("string array size") 119 | allocate(fs_array(arr_size)) 120 | do i = 1, arr_size 121 | write(STDOUT, "(a, i3)") "Enter string #", i 122 | read(STDIN, "(a)", iostat=io_ierr) readstr 123 | if (io_ierr == IOSTAT_END) then 124 | ! Leave further strings unallocated 125 | exit 126 | endif 127 | ! Allocate string 128 | allocate(fs_array(i)%chars, source=trim(readstr)) 129 | enddo 130 | 131 | ! Create C pointers to the Fortran objects 132 | ptrs = [(c_loc(fs_array(i)), i = 1, arr_size)] 133 | 134 | ! Use 'argsort' to determine the new ordering 135 | allocate(ordering(arr_size)) 136 | call argsort(ptrs, ordering, compare_strings) 137 | write(STDOUT, "(a, 20(i3))") "New order:", ordering 138 | 139 | ! Reorder the Fortran data 140 | fs_array = fs_array(ordering) 141 | 142 | ! Print the results 143 | write(STDOUT, *) "Sorted:" 144 | do i = 1, arr_size 145 | if (.not. allocated(fs_array(i)%chars)) then 146 | write(STDOUT, "(i3, '-', i3, a)") i, arr_size, " are unallocated" 147 | exit 148 | endif 149 | write(STDOUT, "(i3, ': ', a)") i, fs_array(i)%chars 150 | enddo 151 | 152 | end program 153 | 154 | !-----------------------------------------------------------------------------! 155 | ! end of example/sort.f90 156 | !-----------------------------------------------------------------------------! 157 | -------------------------------------------------------------------------------- /include/flc_string.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc_string.i 3 | * 4 | * Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc_string" 9 | %include "import_flc.i" 10 | %flc_add_header 11 | 12 | // SWIG always represents std::string as native strings. We load its typemaps 13 | // but will explicitly create the class. 14 | %include 15 | 16 | // Include typemaps for integer offsets and native integer types 17 | %include 18 | 19 | /* ------------------------------------------------------------------------- 20 | * Typemaps 21 | * ------------------------------------------------------------------------- */ 22 | 23 | // Typemap to convert positions from npos -> 0 and 1-offset otherwise. Similar 24 | // to 25 | %apply int FORTRAN_INT { size_t POSITION }; 26 | %typemap(out, noblock=1) size_t POSITION { 27 | $result = ($1 == std::string::npos ? 0 : $1 + 1); 28 | } 29 | 30 | /* ------------------------------------------------------------------------- 31 | * String class definition 32 | * ------------------------------------------------------------------------- */ 33 | 34 | namespace std { 35 | class string { 36 | public: 37 | // >>> TYPES 38 | typedef size_t size_type; 39 | typedef ptrdiff_t difference_type; 40 | typedef char value_type; 41 | typedef const char& const_reference; 42 | 43 | // Typemaps for making std::vector feel more like native Fortran: 44 | // - Use Fortran 1-offset indexing 45 | %apply int FORTRAN_INDEX {size_type pos, 46 | size_type index, 47 | size_type start_index, 48 | size_type stop_index}; 49 | // - Use native Fortran integers in proxy code 50 | %apply int FORTRAN_INT {size_type}; 51 | 52 | // - Use fortran indexing (and 0 for not found) for search 53 | %apply size_t POSITION {size_type find}; 54 | 55 | // - Allow access as an array view 56 | %apply SWIGTYPE& { string& view }; 57 | %fortran_array_pointer(char, string& view); 58 | %typemap(out, noblock=1) string& view { 59 | $result.data = ($1->empty() ? NULL : const_cast($1->data())); 60 | $result.size = $1->size(); 61 | } 62 | 63 | // - Allow interaction with other string objects 64 | %apply SWIGTYPE& {const string& OTHER}; 65 | 66 | public: 67 | // >>> MEMBER FUNCTIONS 68 | 69 | string(); 70 | string(size_type count, value_type ch); 71 | string(const std::string& s); 72 | 73 | // Accessors 74 | size_type size() const; 75 | bool empty() const; 76 | 77 | const_reference front() const; 78 | const_reference back() const; 79 | 80 | // Modify 81 | void resize(size_type count); 82 | void resize(size_type count, value_type v); 83 | void assign(const string& s); 84 | void push_back(value_type v); 85 | void pop_back(); 86 | void clear(); 87 | 88 | // String operations 89 | size_type find(const string& s, size_type pos = 0); 90 | void append(const string& s); 91 | int compare(const string& OTHER); 92 | 93 | // >>> EXTENSIONS 94 | 95 | %extend { 96 | %fragment("SWIG_check_range"); 97 | 98 | void set(size_type index, value_type v) { 99 | SWIG_check_range(index, $self->size(), 100 | "std::string::set", 101 | return); 102 | (*$self)[index] = v; 103 | } 104 | 105 | value_type get(size_type index) { 106 | SWIG_check_range(index, $self->size(), 107 | "std::string::get", 108 | return $self->front()); 109 | return (*$self)[index]; 110 | } 111 | 112 | // Get a character array view 113 | string& view() { return *$self; } 114 | 115 | // Get a copy as a native Fortran string 116 | const string& str() { return *$self; } 117 | } 118 | }; 119 | 120 | /* ------------------------------------------------------------------------- 121 | * String conversion routines 122 | * ------------------------------------------------------------------------- */ 123 | 124 | %exception { 125 | SWIG_check_unhandled_exception(); 126 | try { 127 | $action 128 | } 129 | catch (const std::invalid_argument& e) { 130 | SWIG_exception(SWIG_ValueError, e.what()); 131 | } 132 | catch (const std::out_of_range& e) { 133 | SWIG_exception(SWIG_OverflowError, e.what()); 134 | } 135 | } 136 | 137 | %fragment("", "header") %{ 138 | #include 139 | %} 140 | 141 | %fragment("flc_has_junk", "header", 142 | fragment="", fragment="") %{ 143 | SWIGINTERN bool flc_has_junk(const std::string& s, size_t pos) { 144 | return !std::all_of(s.begin() + pos, s.end(), 145 | [](unsigned char c) -> bool { return std::isspace(c); }); 146 | } 147 | %} 148 | 149 | %typemap(in, numinputs=0, noblock=1) size_t* result_pos (size_t temp_pos) { 150 | temp_pos = 0; 151 | $1 = &temp_pos; 152 | } 153 | %typemap(argout, noblock=1, fragment="flc_has_junk") size_t* result_pos { 154 | if (flc_has_junk(*arg1, temp_pos$argnum)) { 155 | SWIG_exception(SWIG_ValueError, "Junk at end of string"); 156 | } 157 | } 158 | 159 | // String conversion routines 160 | #define %add_string_int_conversion(RETURN_TYPE, NAME) \ 161 | RETURN_TYPE NAME(const string& s, size_t* result_pos, int base = 10) 162 | #define %add_string_real_conversion(RETURN_TYPE, NAME) \ 163 | RETURN_TYPE NAME(const string& s, size_t* result_pos) 164 | 165 | %add_string_int_conversion(int, stoi); 166 | %add_string_int_conversion(long, stol); 167 | %add_string_int_conversion(long long, stoll); 168 | %add_string_real_conversion(float, stof); 169 | %add_string_real_conversion(double, stod); 170 | 171 | // Don't add exception code for subsequent functions 172 | %exception; 173 | 174 | } // namespace std 175 | -------------------------------------------------------------------------------- /doc/modules/vector.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules/vector.rst 3 | .. ############################################################################ 4 | 5 | .. _modules_Vector: 6 | 7 | ****** 8 | Vector 9 | ****** 10 | 11 | Vectors are resizeable arrays of elements. The ``flc_vector`` module 12 | instantiates vectors of ``integer(4)``, ``integer(8)``, ``real(8)``, 13 | ``complex(8)``, and ``type(String)``. 14 | 15 | Common functionality 16 | ==================== 17 | 18 | All vector types support the following basic operations. 19 | 20 | Construction and destruction 21 | ---------------------------- 22 | 23 | Vectors are constructed using four interface functions: 24 | 25 | - The function without arguments creates an empty vector; 26 | - A single integer argument assigns that many elements with default values; 27 | and 28 | - An integer argument followed by an element with the vector's element type 29 | will copy that value to all elements of the vector. 30 | - A vector object will create a copy of that vector. 31 | 32 | Here are three examples of initialization:: 33 | 34 | use flc_vector, only : Vector => VectorInt4 35 | type(Vector) :: v 36 | 37 | v = Vector() 38 | ! v%size() == 0 39 | v = Vector(10) 40 | ! v%size() == 10 41 | ! v%get(i) == 0 42 | v = Vector(10, 123) 43 | ! v%size() == 10 44 | ! v%get(i) == 123 45 | 46 | Vectors are destroyed using the ``release`` type-bound subroutine:: 47 | 48 | call v%release() 49 | 50 | Modification 51 | ------------ 52 | 53 | Vectors can be resized dynamically using ``resize``, which acts like the 54 | constructors described above. An element can be added to 55 | the end of the vector (increasing the size by one) with ``push_back``. The 56 | ``insert`` method can insert an element at a specific index, and ``erase`` 57 | removes a specific vector index or range of indices. ``clear`` removes 58 | all elements. Finally, ``set`` sets the value of an element at a given index. 59 | 60 | .. important:: Unlike the C++ version of this class, **all vectors in Flibcpp 61 | use 1-offset indexing**. This means that ``v%get(1)`` is the same as the C++ 62 | ``v[0]``: it returns the first element (i.e. the element with an offset of 63 | zero). 64 | 65 | Here's an example of modifying a vector:: 66 | 67 | use flc_vector, only : Vector => VectorInt4 68 | type(Vector) :: v 69 | v = Vector() 70 | call v%resize(4, 123) ! give each element the value 123 71 | call v%push_back(-1) ! size increased by 1, last element has value -1 72 | call v%insert(2, -2) ! First 3 elements are [123, 123, -2] 73 | call v%erase(1, 3) ! Remove the first two elements 74 | call v%erase(2) ! Remove the second element 75 | call v%set(1, -123) ! Change the value of the first element 76 | call v%clear() ! Remove all elements, size is now zero 77 | 78 | Access 79 | ------ 80 | 81 | The size of a vector is returned by the bound function ``size``; ``get`` 82 | returns the value at an index; and ``front`` and ``back`` are aliases for 83 | ``get(1)`` and ``get(v%size())``, respectively. 84 | 85 | Additionally, ``front_ref``, ``back_ref``, and ``get_ref`` return Fortran 86 | pointers to the elements of the array. 87 | 88 | .. warning:: Array element pointers are valid **only** as long as the vector's 89 | size is not changed. Calling ``erase``, ``push_back``, and so forth will 90 | invalidate the pointer; accessing it at that point results in undefined 91 | behavior. 92 | 93 | Numeric vectors 94 | =============== 95 | 96 | As with the algorithms and other methods, the ``flc_vector`` module includes 97 | three scalar numeric instantiations, but it also includes an instantiation for 98 | complex numbers. Each instantiation has a distinct derived type: 99 | 100 | - ``VectorInt4``: each element is ``integer(4)`` 101 | - ``VectorInt8``: each element is ``integer(8)`` 102 | - ``VectorReal8``: each element is ``real(8)`` 103 | - ``VectorComplex8``: each element is ``complex(8)`` 104 | 105 | Construct from an array 106 | ----------------------- 107 | 108 | Numeric vectors can be created very efficiently from Fortran data by accepting 109 | an array pointer:: 110 | 111 | use flc_vector, only : Vector => VectorInt4 112 | integer(4), dimension(4), parameter :: iarr = [ 1, -2, 4, -8 ] 113 | type(Vector) :: v 114 | 115 | v = Vector(iarr) 116 | write(0,*) "Size should be 4:", v%size() 117 | 118 | The ``assign`` bound method acts like a constructor but for an existing vector. 119 | 120 | View as an array pointer 121 | ------------------------ 122 | 123 | Numeric vectors can also return an array pointer to the vector's contents. 124 | These views support native Fortran array operations and access the same 125 | underlying memory as the C++ object:: 126 | 127 | use flc_vector, only : Vector => VectorInt4 128 | integer(4), dimension(:), pointer :: vptr 129 | type(Vector) :: v 130 | 131 | ! 132 | vptr => v%view() 133 | if (size(vptr) > 2) then 134 | vptr(2) = 4 135 | end if 136 | 137 | .. warning:: A vector's view is valid **only** as long as the vector's size is 138 | not changed. Calling ``erase``, ``push_back``, and so forth will invalidate 139 | the view; accessing it at that point results in undefined behavior. 140 | 141 | String vectors 142 | ============== 143 | 144 | The native "element" type of ``VectorString`` is a ``character(len=:)``. Vector 145 | operations that accept an input will take any native character string; and 146 | returned values will be allocatable character arrays. 147 | 148 | The ``front_ref``, ``back_ref``, and ``get_ref`` functions allow the underlying 149 | ``std::string`` class to be accessed with the ``String`` Fortran derived type 150 | wrapper. Note that unlike for intrinsic types, where these functions return a 151 | ``integer, pointer``, the vector of strings returns just ``type(String)``. 152 | However, as with native pointers described above, these references are 153 | *invalid* once the string changes size. They should be cleared with the 154 | ``%release()`` bound method. 155 | 156 | An additional ``set_ref`` function allows vector elements to be assigned from 157 | ``String`` types. 158 | 159 | .. ############################################################################ 160 | .. end of doc/modules/vector.rst 161 | .. ############################################################################ 162 | -------------------------------------------------------------------------------- /doc/conventions.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/conventions.rst 3 | .. ############################################################################ 4 | 5 | ************ 6 | Conventions 7 | ************ 8 | 9 | Since the C++ and Fortran binding code are generated by SWIG-Fortran, most 10 | conventions are based on its defaults and built-in wrappers as described in 11 | `the SWIG+Fortran manual page`. This section attempts to describe all 12 | conventions used by Flibcpp that may be ambiguous to either a C++ or Fortran 13 | user. Since Flibcpp's target audience is Fortran users, the library tries to 14 | follows existing Fortran conventions, and this document attempts to remain true 15 | to the official Fortran nomenclature as described in the ISO standards. 16 | 17 | .. _the SWIG+Fortran manual page: https://github.com/swig-fortran/swig/blob/master/Doc/Manual/src/Fortran.md 18 | 19 | Basic types 20 | ============== 21 | 22 | The C++ standard library features many numeric classes and functions that take 23 | a template parameter corresponding to the type of a single element used by the 24 | class or algorithm. All such classes or functions that Flibcpp includes are 25 | templated on: 26 | 27 | - 32-bit integers (``integer(4)`` or ``integer(C_INT32_T)``), with a suffix of 28 | ``Int4`` where applicable; 29 | - 64-bit integers (``integer(8)`` or ``integer(C_INT64_T)``), with a suffix of 30 | ``Int8`` where applicable; and 31 | - 64-bit reals (``real(8)`` or ``real(C_DOUBLE)``), with a suffix of 32 | ``Real8`` where applicable. 33 | 34 | In general, most templated C++ functions use Fortran generic procedures to 35 | allow a single procedure name to operate on multiple types, and only the 36 | derived types (such as ``VectorInt4``) require the suffix. 37 | 38 | Error handling 39 | ============== 40 | 41 | Some modules support error handling for checking input values. In all cases, 42 | the error status and a message can be accessed and cleared through the main 43 | ``flc`` module:: 44 | 45 | use flc, only : ierr, get_serr 46 | 47 | ! 48 | if (ierr /= 0) then 49 | write(1,*) "Error", ierr, ":", get_serr() 50 | ! Reset the error flag to indicate that the error has been successfully 51 | ! handled. 52 | ierr = 0 53 | fi 54 | 55 | Since errors do not immediately exit, it is up to the application code to check 56 | for and clear them. Failing to clear the error code may cause the application 57 | to exit on a subsequent Flibcpp procedure call. 58 | 59 | .. _conventions_indexing: 60 | 61 | Indexing 62 | ======== 63 | 64 | C and C++ use the convention that 0 corresponds to the first element in an 65 | array: specifically, it indicates an *offset* of zero from the array's 66 | beginning. In Fortran, the convention is for the first element to have an index 67 | of 1, so Flibcpp has the same convention. 68 | 69 | This convention makes native array integration straightforward. For example, 70 | when the :ref:`modules_algorithm_binary_search` algorithm is used with any 71 | value ``val`` in the sorted array ``arr``, the following logical expression 72 | will be true:: 73 | 74 | arr(binary_search(arr, val)) == val 75 | 76 | An additional convention Flibcpp uses is for an invalid index to have a value 77 | of zero. Thus, the :ref:`modules_algorithm_binary_search` algorithm returns 78 | zero if asked to find an element that's not present. 79 | 80 | Derived type behavior 81 | ===================== 82 | 83 | The derived types defined by Flibcpp are all "proxy" objects that operate on 84 | *pointers* to C++-owned objects. Some derived type values (i.e. class 85 | instances) will "own" the associated data, while some will merely reference 86 | data owned by other C++ objects. 87 | 88 | .. note:: Memory management in SWIG-Fortran-generated code is unintuitive and 89 | could change. If you have feedback, please contact the author. 90 | 91 | Construction 92 | ------------ 93 | 94 | Although Fortran separates the processes of allocation and initialization, C++ 95 | combines them into the single act of *construction*. Thus the proxy objects in 96 | Flibcpp can either be in an unassigned, deallocated state or in an 97 | allocated and internally consistent state. 98 | 99 | Each derived type, such as the :ref:`modules_string_type`, is constructed using 100 | a *module procedure interface* with the same name as the type. This procedure, 101 | defined in the same module as the derived type, is a ``function`` that returns 102 | a "constructed" type:: 103 | 104 | use flc_string, only : String 105 | type(String) :: s 106 | 107 | s = String() 108 | 109 | Most classes have more than one constructor (i.e. procedure interface) that 110 | gives the object a more substantial initial state. For example, numeric vectors 111 | can be constructed directly from a Fortran array:: 112 | 113 | use flc_vector, only : Vector => VectorInt4 114 | type(Vector) :: v, v2 115 | v = Vector([1, 2, 3, 5, 8, 13]) 116 | 117 | Assignment 118 | ---------- 119 | 120 | SWIG-Fortran, and consequently Flibcpp, defines assignment operators for its 121 | types that control memory ownership. Assignment for these types can be grouped 122 | into two categories: assignment directly from a Flibcpp function return value, 123 | and assignment from an existing Flibcpp derived type value. 124 | 125 | Flibcpp (or any other SWIG-Fortran) wrapper code sets the correct ownership 126 | flag on a return value: non-owning for raw pointers and references; owning for 127 | return-by-value. When the left-hand side of an assignment is uninitialized, it 128 | captures the returned value and obtains the correct ownership flag. If the 129 | left-hand side *is* initialized, it is automatically destroyed first. 130 | 131 | Assignment from within Fortran is like pointer assignment. The left-hand side 132 | becomes a non-owning reference to the right-hand side. 133 | 134 | Destruction 135 | ----------- 136 | 137 | Unlike native allocatable Fortran types, Flibcpp derived types are not 138 | automatically deallocated when ending a procedure. Therefore to avoid 139 | leaking memory, these derived type values must be explicitly cleaned up and 140 | 141 | released. This is done by the type-bound subroutine named ``release``:: 142 | 143 | type(Vector), intent(inout) :: v 144 | call v%release() 145 | 146 | If the value ``v`` above owns the associated memory (i.e. if it was constructed 147 | in user code), then Flibcpp cleans up and deallocates the C++ instance, and 148 | sets ``v`` to an uninitialized state. If ``v`` merely points to existing C++ 149 | data, i.e. if it was assigned to the return result of a C++ accessor, then 150 | Flibcpp will simply set ``v`` to an uninitialized state. 151 | 152 | .. ############################################################################ 153 | .. end of doc/conventions.rst 154 | .. ############################################################################ 155 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | #---------------------------------*-CMake-*----------------------------------# 2 | # Copyright (c) 2019-2021 Oak Ridge National Laboratory, UT-Battelle, LLC. 3 | # License-Filename: LICENSE 4 | # SPDX-License-Identifier: MIT 5 | #---------------------------------------------------------------------------# 6 | 7 | cmake_minimum_required(VERSION 3.8...3.31) 8 | 9 | # Determine version number from git metadata 10 | include("${CMAKE_CURRENT_LIST_DIR}/cmake/CgvFindVersion.cmake") 11 | cgv_find_version(Flibcpp) 12 | 13 | project(Flibcpp VERSION "${Flibcpp_VERSION}" LANGUAGES CXX Fortran) 14 | cmake_policy(VERSION 3.8...3.31) 15 | 16 | list(APPEND CMAKE_MODULE_PATH "${PROJECT_SOURCE_DIR}/cmake") 17 | include(FlibUtils) 18 | 19 | #---------------------------------------------------------------------------# 20 | # OPTIONS 21 | #---------------------------------------------------------------------------# 22 | option(BUILD_SHARED_LIBS "Build shared libraries" ON) 23 | option(FLIBCPP_DEV "Default to using development-centered options" OFF) 24 | option(FLIBCPP_BUILD_DOCS "Build documentation with Sphinx" ${FLIBCPP_DEV}) 25 | option(FLIBCPP_USE_SWIG "Regenerate source files using SWIG" ${FLIBCPP_DEV}) 26 | 27 | if(CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME) 28 | set(_DEFAULT_BUILD_EXAMPLES ON) 29 | endif() 30 | option(FLIBCPP_BUILD_EXAMPLES "Build examples" ${_DEFAULT_BUILD_EXAMPLES}) 31 | 32 | if(FLIBCPP_DEV) 33 | set(_DEFAULT_BUILD_TESTS ON) 34 | endif() 35 | option(FLIBCPP_BUILD_TESTS "Build Flibcpp tests" ${_DEFAULT_BUILD_TESTS}) 36 | 37 | #---------------------------------------------------------------------------# 38 | # FLAGS 39 | #---------------------------------------------------------------------------# 40 | 41 | # Define FLIBCPP_Fortran_STANDARD and add as Fortran compile options 42 | flib_fortran_standard(FLIBCPP "03") 43 | 44 | # Build type 45 | if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) 46 | if(FLIBCPP_DEV) 47 | set(_CMAKE_BUILD_TYPE "Debug") 48 | else () 49 | set(_CMAKE_BUILD_TYPE "RelWithDebInfo") 50 | endif() 51 | message(STATUS "No build type selected, default to ${_CMAKE_BUILD_TYPE}") 52 | set(CMAKE_BUILD_TYPE "${_CMAKE_BUILD_TYPE}" CACHE STRING "Build type" FORCE) 53 | endif() 54 | 55 | #---------------------------------------------------------------------------# 56 | # MODULES TO LOAD 57 | #---------------------------------------------------------------------------# 58 | 59 | # Load SWIG if FLIBCPP_USE_SWIG is true 60 | flib_find_and_use_swig(FLIBCPP) 61 | 62 | # Load CTest if applicable 63 | if(FLIBCPP_BUILD_TESTS OR FLIBCPP_BUILD_EXAMPLES) 64 | include(CTest) 65 | endif() 66 | 67 | if(FLIBCPP_BUILD_DOCS) 68 | find_package(Sphinx REQUIRED) 69 | include(ExternalProject) # for pdf header 70 | set(FLIBCPP_PYTHONPATH "$ENV{PYTHONPATH}" CACHE STRING 71 | "Python path used for generating documentation" 72 | ) 73 | endif() 74 | 75 | #---------------------------------------------------------------------------# 76 | # LIBRARY 77 | #---------------------------------------------------------------------------# 78 | 79 | include(GNUInstallDirs) 80 | 81 | set(FLIBCPP_NAMESPACE "Flibcpp::") 82 | flib_dir_variables(FLIBCPP) 83 | 84 | # List of libraries exported by cmake/FlibcppConfig.cmake.in 85 | set(FLIBCPP_LIBRARIES) 86 | 87 | function(flibcpp_add_module name) 88 | flib_add_fortran_module(FLIBCPP ${name} "cxx" "f90" ${ARGN}) 89 | 90 | # Compile C++ code with C++11 91 | target_compile_features(${name} 92 | PRIVATE 93 | cxx_std_11 94 | ) 95 | # Compile with e.g. std=c++11 instead of =gnu++11 96 | set_property(TARGET ${name} PROPERTY CXX_EXTENSIONS OFF) 97 | 98 | # Allow the library to be referred to by its namespaced version, for use by 99 | # downstream projects that *directly* compile flibcpp 100 | add_library(${FLIBCPP_NAMESPACE}${name} ALIAS ${name}) 101 | # Set up installation 102 | install(TARGETS 103 | ${name} 104 | EXPORT Flibcpp-targets 105 | LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} 106 | ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} 107 | ) 108 | # Add to list of targets to export 109 | set(FLIBCPP_LIBRARIES ${FLIBCPP_LIBRARIES} ${FLIBCPP_NAMESPACE}${name} 110 | PARENT_SCOPE 111 | ) 112 | endfunction() 113 | 114 | # Configure version information and generate primary flibcpp module 115 | set(FLIBCPP_VERSION_CPP "${CMAKE_CURRENT_BINARY_DIR}/flibcpp_version.cpp") 116 | configure_file("${CMAKE_CURRENT_LIST_DIR}/cmake/flibcpp_version.cpp.in" 117 | "${FLIBCPP_VERSION_CPP}" @ONLY) 118 | flibcpp_add_module(flc "${FLIBCPP_VERSION_CPP}") 119 | 120 | # Also install 'import_flc' if using SWIG 121 | if(FLIBCPP_USE_SWIG) 122 | install(FILES 123 | "${CMAKE_CURRENT_SOURCE_DIR}/include/import_flc.i" 124 | DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}" 125 | ) 126 | endif() 127 | 128 | flibcpp_add_module(flc_algorithm) 129 | target_link_libraries(flc_algorithm flc_random flc) 130 | 131 | flibcpp_add_module(flc_map) 132 | target_link_libraries(flc_map flc flc_string) 133 | 134 | flibcpp_add_module(flc_random) 135 | target_link_libraries(flc_random flc) 136 | 137 | flibcpp_add_module(flc_set) 138 | target_link_libraries(flc_set flc flc_string) 139 | 140 | flibcpp_add_module(flc_string) 141 | target_link_libraries(flc_string flc) 142 | 143 | flibcpp_add_module(flc_vector) 144 | target_link_libraries(flc_vector flc flc_string) 145 | 146 | #---------------------------------------------------------------------------# 147 | # INSTALLATION 148 | #---------------------------------------------------------------------------# 149 | 150 | set(FLIBCPP_INSTALL_CONFIGDIR 151 | "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}") 152 | 153 | # Install module files 154 | install(DIRECTORY 155 | "${CMAKE_Fortran_MODULE_DIRECTORY}/" 156 | DESTINATION "${FLIBCPP_INSTALL_MODULEDIR}" 157 | ) 158 | 159 | install(EXPORT Flibcpp-targets 160 | FILE FlibcppTargets.cmake 161 | NAMESPACE ${FLIBCPP_NAMESPACE} 162 | DESTINATION ${FLIBCPP_INSTALL_CONFIGDIR} 163 | ) 164 | 165 | # Create a ConfigVersion.cmake file 166 | include(CMakePackageConfigHelpers) 167 | 168 | configure_package_config_file( 169 | "${CMAKE_CURRENT_SOURCE_DIR}/cmake/FlibcppConfig.cmake.in" 170 | "${CMAKE_CURRENT_BINARY_DIR}/FlibcppConfig.cmake" 171 | INSTALL_DESTINATION ${FLIBCPP_INSTALL_CONFIGDIR} 172 | ) 173 | 174 | write_basic_package_version_file( 175 | "${CMAKE_CURRENT_BINARY_DIR}/FlibcppConfigVersion.cmake" 176 | VERSION ${PROJECT_VERSION} 177 | COMPATIBILITY SameMajorVersion 178 | ) 179 | 180 | install(FILES 181 | "${CMAKE_CURRENT_BINARY_DIR}/FlibcppConfig.cmake" 182 | "${CMAKE_CURRENT_BINARY_DIR}/FlibcppConfigVersion.cmake" 183 | DESTINATION ${FLIBCPP_INSTALL_CONFIGDIR} 184 | ) 185 | 186 | #---------------------------------------------------------------------------# 187 | # TESTING AND DOCS 188 | #---------------------------------------------------------------------------# 189 | 190 | if(FLIBCPP_BUILD_TESTS) 191 | add_subdirectory(test) 192 | endif() 193 | 194 | if(FLIBCPP_BUILD_EXAMPLES) 195 | add_subdirectory(example) 196 | endif() 197 | 198 | if(FLIBCPP_BUILD_DOCS) 199 | add_subdirectory(doc) 200 | endif() 201 | 202 | -------------------------------------------------------------------------------- /doc/conf.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | # 3 | # Configuration file for the Sphinx documentation builder. 4 | # 5 | # This file does only contain a selection of the most common options. For a 6 | # full list see the documentation: 7 | # http://www.sphinx-doc.org/en/master/config 8 | 9 | # -- Path setup -------------------------------------------------------------- 10 | 11 | # If extensions (or modules to document with autodoc) are in another directory, 12 | # add these directories to sys.path here. If the directory is relative to the 13 | # documentation root, use os.path.abspath to make it absolute, like shown here. 14 | # 15 | # import os 16 | # import sys 17 | # sys.path.insert(0, os.path.abspath('.')) 18 | 19 | import glob 20 | import json 21 | import os 22 | import sys 23 | 24 | # -- Project information ----------------------------------------------------- 25 | 26 | project = 'Flibcpp' 27 | copyright = '2021, Oak Ridge National Laboratory, UT-Battelle, LLC' 28 | author = 'Seth R Johnson' 29 | 30 | # The version info for the project you're documenting, acts as replacement for 31 | # |version| and |release|, also used in various other places throughout the 32 | # built documents. 33 | try: 34 | build_dir = os.environ['CMAKE_CURRENT_BINARY_DIR'] 35 | with open(os.path.join(build_dir, 'version.json'), 'r') as f: 36 | vers_dat = json.load(f) 37 | except (KeyError, IOError) as e: 38 | print("Failed to load version:", e) 39 | version = '' 40 | release = '' 41 | else: 42 | version = vers_dat['version'] 43 | release = vers_dat['release'] 44 | 45 | sys.path.insert(0, os.path.join(os.path.abspath('.'), "_python")) 46 | import monkeysphinx 47 | 48 | # -- General configuration --------------------------------------------------- 49 | 50 | # If your documentation needs a minimal Sphinx version, state it here. 51 | # 52 | # needs_sphinx = '1.0' 53 | 54 | # Add any Sphinx extension module names here, as strings. They can be 55 | # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom 56 | # ones. 57 | extensions = [ 58 | 'sphinx.ext.mathjax', 59 | 'sphinx.ext.githubpages', 60 | ] 61 | 62 | try: 63 | import pybtex 64 | except ImportError: 65 | print("Can't import pybtex: bibliography will not be generated.") 66 | print("Download and install using `pip install sphinxcontrib-bibtex`") 67 | else: 68 | extensions.append("sphinxcontrib.bibtex") 69 | bibtex_bibfiles = ['_static/references.bib'] 70 | 71 | # Add any paths that contain templates here, relative to this directory. 72 | templates_path = [] 73 | 74 | # The suffix(es) of source filenames. 75 | # You can specify multiple suffix as a list of string: 76 | # 77 | # source_suffix = ['.rst', '.md'] 78 | source_suffix = '.rst' 79 | 80 | # The master toctree document. 81 | master_doc = 'index' 82 | 83 | # The language for content autogenerated by Sphinx. Refer to documentation 84 | # for a list of supported languages. 85 | # 86 | # This is also used if you do content translation via gettext catalogs. 87 | # Usually you set "language" from the command line for these cases. 88 | language = None 89 | 90 | # List of patterns, relative to source directory, that match files and 91 | # directories to ignore when looking for source files. 92 | # This pattern also affects html_static_path and html_extra_path . 93 | exclude_patterns = [] 94 | 95 | # The name of the Pygments (syntax highlighting) style to use. 96 | pygments_style = 'sphinx' 97 | highlight_language = 'fortran' 98 | 99 | 100 | # -- Options for HTML output ------------------------------------------------- 101 | 102 | # The theme to use for HTML and HTML Help pages. See the documentation for 103 | # a list of builtin themes. 104 | # 105 | html_theme = 'alabaster' 106 | 107 | # Theme options are theme-specific and customize the look and feel of a theme 108 | # further. For a list of options available for each theme, see the 109 | # documentation. 110 | # 111 | # html_theme_options = {} 112 | 113 | # Add any paths that contain custom static files (such as style sheets) here, 114 | # relative to this directory. They are copied after the builtin static files, 115 | # so a file named "default.css" will overwrite the builtin "default.css". 116 | html_static_path = [] 117 | 118 | # Custom sidebar templates, must be a dictionary that maps document names 119 | # to template names. 120 | # 121 | # The default sidebars (for documents that don't match any pattern) are 122 | # defined by theme itself. Builtin themes are using these templates by 123 | # default: ``['localtoc.html', 'relations.html', 'sourcelink.html', 124 | # 'searchbox.html']``. 125 | # 126 | # html_sidebars = {} 127 | 128 | 129 | # -- Options for HTMLHelp output --------------------------------------------- 130 | 131 | # Output file base name for HTML help builder. 132 | htmlhelp_basename = 'Flibcpp' 133 | 134 | 135 | # -- Options for LaTeX output ------------------------------------------------ 136 | 137 | 138 | latex_elements = { 139 | # The paper size ('letterpaper' or 'a4paper'). 140 | 'papersize': 'letterpaper', 141 | 142 | 'extraclassoptions': 'oneside', 143 | 144 | # The font size ('10pt', '11pt' or '12pt'). 145 | 'pointsize': '11pt', 146 | 147 | # Additional stuff for the LaTeX preamble. 148 | 'preamble': r""" 149 | % Reset styles changed by sphinx.sty 150 | \usepackage{ornltm-style} 151 | \usepackage{ornltm-extract} 152 | \usepackage{sphinxcustom} 153 | \usepackage{microtype} 154 | \usepackage{pdfpages} 155 | """, 156 | 157 | # Table of contents 158 | 'tableofcontents': r""" 159 | \frontmatter 160 | % Plain page 161 | \thispagestyle{plain}% 162 | \phantomsection\addcontentsline{toc}{section}{Contents} 163 | \tableofcontents 164 | % % 165 | % \cleardoublepage 166 | % \thispagestyle{plain}% 167 | % \phantomsection\addcontentsline{toc}{section}{List of Figures} 168 | % \listoffigures 169 | % % 170 | % \cleardoublepage 171 | % \thispagestyle{plain}% 172 | % \phantomsection\addcontentsline{toc}{section}{List of Tables} 173 | % \listoftables 174 | % \cleardoublepage 175 | % \pagestyle{normal} 176 | """, 177 | # No chapter styles needed 178 | 'fncychap': "", 179 | # Make references more robust to renumbering 180 | 'hyperref': r""" 181 | \usepackage[hypertexnames=false]{hyperref} 182 | \usepackage{hypcap} 183 | \urlstyle{same} 184 | """, 185 | # Replace maketitle with generated title page: 186 | # see http://texdoc.net/texmf-dist/doc/latex/pdfpages/pdfpages.pdf 187 | # and documents repo: 188 | 'maketitle': r"\includepdf[pages=-]{flibcpp-tm-header.pdf}", 189 | 'atendofbody': r"\includepdf[pages=-]{flibcpp-tm-footer.pdf}", 190 | } 191 | 192 | # Grouping the document tree into LaTeX files. List of tuples 193 | # (source start file, target name, title, 194 | # author, documentclass [howto, manual, or own class]). 195 | latex_documents = [ 196 | (master_doc, 'Flibcpp.tex', 'Flibcpp User Manual', 197 | author, 'howto'), 198 | ] 199 | 200 | latex_additional_files = glob.glob("_static/*.sty") 201 | 202 | # -- Options for manual page output ------------------------------------------ 203 | 204 | # One entry per manual page. List of tuples 205 | # (source start file, name, description, authors, manual section). 206 | man_pages = [ 207 | (master_doc, 'flibcpp', 'Flibcpp Documentation', 208 | [author], 1) 209 | ] 210 | 211 | 212 | # -- Options for Texinfo output ---------------------------------------------- 213 | 214 | # Grouping the document tree into Texinfo files. List of tuples 215 | # (source start file, target name, title, author, 216 | # dir menu entry, description, category) 217 | texinfo_documents = [ 218 | (master_doc, 'Flibcpp', 'Flibcpp Documentation', 219 | author, 'Flibcpp', 'One line description of project.', 220 | 'Miscellaneous'), 221 | ] 222 | 223 | 224 | # -- Extension configuration ------------------------------------------------- 225 | -------------------------------------------------------------------------------- /doc/modules/algorithm.rst: -------------------------------------------------------------------------------- 1 | .. ############################################################################ 2 | .. File : doc/modules/algorithm.rst 3 | .. ############################################################################ 4 | 5 | .. _modules_algorithm: 6 | 7 | ********* 8 | Algorithm 9 | ********* 10 | 11 | The ``flc_algorithm`` module wraps C++ standard ``_ routines. 12 | Instead of taking pairs of iterators, the Flibcpp algorithm subroutines accept 13 | target-qualified one-dimensional arrays. All algorithms follow the 14 | :ref:`indexing convention ` that the first element of an 15 | array has index 1, and an index of 0 indicates "not found". 16 | 17 | .. _ : https://en.cppreference.com/w/cpp/numeric/random 18 | 19 | Sorting 20 | ======= 21 | 22 | Sorting algorithms for numeric types default to increasing order when provided 23 | with a single array argument. Numeric sorting routines accept an optional 24 | second argument, a comparator function, which should return ``true`` if the 25 | first argument is strictly less than the right-hand side. 26 | 27 | .. warning:: For every value of ``a`` and ``b``, the comparator ``cmp`` *must* 28 | satisfy ``.not. (cmp(a, b) .and. cmp(b, a))``. If this strict ordering is 29 | not satisfied, some of the algorithms below may crash the program. 30 | 31 | All sorting algorithms are *also* instantiated so that they accept an array of 32 | ``type(C_PTR)`` and a generic comparator function. **This enables arrays of any 33 | native Fortran object to be sorted**. See :ref:`the generic 34 | sorting example ` for a demonstration. 35 | 36 | sort 37 | ---- 38 | 39 | Sorting and checking order is a single simple subroutine call:: 40 | 41 | use flc_algorithm, only : sort 42 | implicit none 43 | integer, dimension(5) :: iarr = [ 2, 5, -2, 3, -10000] 44 | 45 | call sort(iarr) 46 | 47 | is_sorted 48 | --------- 49 | 50 | Checking the ordering of array is just as simple:: 51 | 52 | use flc_algorithm, only : is_sorted 53 | integer, dimension(5) :: iarr = [ 2, 5, -2, 3, -10000] 54 | logical :: sortitude 55 | 56 | sortitude = is_sorted(iarr) 57 | 58 | .. _modules_algorithm_argsort: 59 | 60 | argsort 61 | ------- 62 | 63 | A routine that provides the indices that correspond to a sorted array, like 64 | Numpy's argsort_ , 65 | takes an array to analyze and an empty array of integers to fill:: 66 | 67 | use flc_algorithm, only : argsort, INDEX_INT 68 | implicit none 69 | integer, dimension(5) :: iarr = [ 2, 5, -2, 3, -10000] 70 | integer(INDEX_INT), dimension(size(iarr)) :: idx 71 | 72 | call argsort(iarr, idx) 73 | write(*,*) iarr(idx) ! Prints the sorted array 74 | 75 | Note that the index array is always a ``INDEX_INT``, which is an alias to 76 | ``C_INT``. On some compilers and platforms, this may be the same as native 77 | Fortran integer, but it's not guaranteed. 78 | 79 | The ``data`` and ``idx`` arguments to ``argsort`` *must* be the same size. If 80 | the index array is larger than the data, invalid entries will be filled with 81 | zero. 82 | 83 | .. _argsort: https://docs.scipy.org/doc/numpy-1.15.0/reference/generated/numpy.argsort.html 84 | 85 | .. _modules_algorithm_searching: 86 | 87 | Searching 88 | ========= 89 | 90 | Like the sorting algorithms, searching algorithms are instantiated on numeric 91 | types and the C pointer type, and they provide an optional procedure pointer 92 | argument that allows the arrays to be ordered with an arbitrary comparator. 93 | 94 | .. _modules_algorithm_binary_search: 95 | 96 | binary_search 97 | ------------- 98 | 99 | A binary search can be performed on sorted data to efficiently find an element 100 | in a range. If the element is not found, the function returns zero; otherwise, 101 | it returns the Fortran index of the array. 102 | 103 | The input array **must** be sorted. 104 | 105 | Example:: 106 | 107 | use flc_algorithm, only : binary_search, INDEX_INT 108 | implicit none 109 | integer(INDEX_INT) :: idx 110 | integer, dimension(6) :: iarr = [ -5, 1, 1, 2, 4, 9] 111 | 112 | idx = binary_search(iarr, -100) ! returns 0 113 | idx = binary_search(iarr, 1) ! returns 2 114 | idx = binary_search(iarr, 2) ! returns 4 115 | idx = binary_search(iarr, 3) ! returns 0 116 | idx = binary_search(iarr, 9) ! returns 6 117 | idx = binary_search(iarr, 10) ! returns 0 118 | 119 | equal_range 120 | ----------- 121 | 122 | Finds the range of elements in a sorted array equivalent to the given value. If 123 | the exact value isn't present, the first index will point 124 | to the index at which the value could be inserted to maintain a sorted array. 125 | If searching for a value that's in the sorted array more than once, the 126 | expression ``arr(first_idx:last_idx)`` will return the equal values. If the 127 | value isn't present, ``arr(first_idx:last_idx)`` will be an empty array, and 128 | the first index will be the point at which the element would be located if it 129 | were present. 130 | 131 | Example:: 132 | 133 | use flc_algorithm, only : equal_range, INDEX_INT 134 | implicit none 135 | integer(INDEX_INT) :: first, last 136 | integer, dimension(6) :: iarr = [ -5, 1, 1, 2, 4, 9] 137 | 138 | call equal_range(iarr, -6, first, last) ! (first,last) are (1,0) 139 | call equal_range(iarr, -5, first, last) ! (first,last) are (1,1) 140 | call equal_range(iarr, 1, first, last) ! (first,last) are (2,3) 141 | call equal_range(iarr, 3, first, last) ! (first,last) are (5,4) 142 | call equal_range(iarr, 9, first, last) ! (first,last) are (6,6) 143 | 144 | 145 | minmax_element 146 | -------------- 147 | 148 | Finds the smallest and largest element in an array. 149 | Note that the *first* occurrence of the minimum value is selected, and the 150 | *last* occurrence of the maximum value is selected. Thus, for a sorted array 151 | ``arr`` which may have duplicate elements, the expression 152 | ``arr(min_idx:max_idx)`` will always return the entire array. 153 | 154 | Example:: 155 | 156 | use flc_algorithm, only : minmax_element, INDEX_INT 157 | implicit none 158 | integer, dimension(6) :: iarr = [ -5, 1000, -1000, 999, -1000, 1000] 159 | integer(INDEX_INT) :: min_idx, max_idx 160 | 161 | call minmax_element(iarr, min_idx, max_idx) ! min_idx == 3, max_idx == 6 162 | 163 | .. _modules_algorithm_set_operations: 164 | 165 | Set operations 166 | ============== 167 | 168 | Sorted arrays can be manipulated as "sets," supporting unions, intersections, 169 | and differences. 170 | 171 | includes 172 | -------- 173 | 174 | Whether one set encloses another set: every item of the second array is present 175 | in the first array. 176 | 177 | Example:: 178 | 179 | use flc_algorithm, only : includes 180 | implicit none 181 | integer, dimension(6) :: iarr = [ -5, 1, 2, 4, 9] 182 | integer, dimension(3) :: jarr = [ 1, 2, 5] 183 | logical :: is_superset 184 | 185 | is_superset = includes(iarr, iarr)) ! true 186 | is_superset = includes(iarr, iarr(:3))) ! true 187 | is_superset = includes(iarr, iarr(3:))) ! true 188 | is_superset = includes(iarr(3:), iarr)) ! false 189 | is_superset = includes(iarr, jarr) ! false 190 | is_superset = includes(iarr, jarr(1:2))) ! true 191 | 192 | Not yet implemented 193 | ------------------- 194 | 195 | - set_difference 196 | - set_intersection 197 | - set_symmetric_difference 198 | - set_union 199 | 200 | Modifying 201 | ========= 202 | 203 | .. _modules_algorithm_shuffle: 204 | 205 | shuffle 206 | ------- 207 | 208 | The "shuffle" subroutine depends on the :ref:`modules_random` module so that it 209 | can use the default random number generator to randomly reorder an array. 210 | 211 | Example:: 212 | 213 | use flc_algorithm, only : shuffle 214 | use flc_random, only : Engine => MersenneEngine4 215 | implicit none 216 | integer :: i 217 | integer, dimension(8) :: iarr = (/ ((i), i = -4, 3) /) 218 | type(Engine) :: rng 219 | rng = Engine() 220 | 221 | call shuffle(rng, iarr) 222 | 223 | Not yet implemented 224 | ------------------- 225 | 226 | - unique 227 | 228 | 229 | .. ############################################################################ 230 | .. end of doc/modules/algorithm.rst 231 | .. ############################################################################ 232 | -------------------------------------------------------------------------------- /include/flc_algorithm.i: -------------------------------------------------------------------------------- 1 | /*! 2 | * \file flc_algorithm.i 3 | * 4 | * Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | * Distributed under an MIT open source license: see LICENSE for details. 6 | */ 7 | 8 | %module "flc_algorithm" 9 | %include "import_flc.i" 10 | %flc_add_header 11 | 12 | %{ 13 | #include 14 | #include 15 | #include 16 | %} 17 | 18 | /* ------------------------------------------------------------------------- 19 | * Macros 20 | * ------------------------------------------------------------------------- */ 21 | %define %flc_cmp_algorithm(RETURN_TYPE, FUNCNAME, ARGS, CALL) 22 | 23 | %inline { 24 | // Operate using default "less than" 25 | template 26 | static RETURN_TYPE FUNCNAME(ARGS) { 27 | return FUNCNAME##_impl(CALL, std::less()); 28 | } 29 | // Operate using user-provided function pointer 30 | template 31 | static RETURN_TYPE FUNCNAME##_cmp(ARGS, bool (*cmp)(T, T)) { 32 | return FUNCNAME##_impl(CALL, cmp); 33 | } 34 | } 35 | 36 | // Instantiate numeric overloads 37 | %flc_template_numeric(FUNCNAME, FUNCNAME) 38 | %flc_template_numeric(FUNCNAME##_cmp, FUNCNAME) 39 | 40 | // Instantiate comparators with void* arguments 41 | %template(FUNCNAME) FUNCNAME##_cmp; 42 | 43 | %enddef 44 | 45 | /* ------------------------------------------------------------------------- */ 46 | %define %flc_typemaps(NAME, TYPE...) 47 | 48 | // Apply array conversion typemap 49 | %apply (const SWIGTYPE *DATA, size_t SIZE) { 50 | (TYPE const *DATA1, size_t DATASIZE1), 51 | (TYPE const *DATA2, size_t DATASIZE2) }; 52 | 53 | // Explicitly declare function interface for callbacks 54 | %fortrancallback("%s") flc_cmp_##NAME; 55 | extern "C" bool flc_cmp_##NAME(TYPE left, TYPE right); 56 | 57 | %enddef 58 | 59 | /* ------------------------------------------------------------------------- 60 | * Types 61 | * ------------------------------------------------------------------------- */ 62 | 63 | // Alias the native C integer to an "indexing" integer returned by algorithm 64 | // functions. 65 | %inline %{ 66 | typedef int index_int; 67 | %} 68 | %insert("fdecl") %{integer, parameter, public :: INDEX_INT = C_INT 69 | %} 70 | 71 | // Give it a particularly named type in the Fortran proxy code. 72 | %apply int { index_int }; 73 | %typemap(ftype, in="integer(INDEX_INT), intent(in)") index_int 74 | %{integer(INDEX_INT)%} 75 | 76 | // Apply array-to-C translation for numeric values 77 | %apply (SWIGTYPE *DATA, size_t SIZE) { (index_int *IDX, size_t IDXSIZE) }; 78 | 79 | // Apply array and callback typemaps 80 | %flc_typemaps(int4 , int32_t ) 81 | %flc_typemaps(int8 , int64_t ) 82 | %flc_typemaps(real8, double ) 83 | %flc_typemaps(index, index_int ) 84 | %flc_typemaps(ptr , void* ) 85 | 86 | /* ------------------------------------------------------------------------- 87 | * Sorting routines 88 | * ------------------------------------------------------------------------- */ 89 | 90 | %{ 91 | template 92 | static void sort_impl(T *data, size_t size, Compare cmp) { 93 | return std::sort(data, data + size, cmp); 94 | } 95 | 96 | template 97 | static bool is_sorted_impl(const T *data, size_t size, Compare cmp) { 98 | return std::is_sorted(data, data + size, cmp); 99 | } 100 | 101 | template 102 | static void argsort_impl(const T *data, size_t size, 103 | index_int *index, size_t index_size, 104 | Compare cmp) { 105 | // Fill invalid indices with zero 106 | if (size < index_size) { 107 | std::fill(index + size, index + index_size, 0); 108 | } 109 | size = std::min(size, index_size); 110 | // Fill the indices with 1 through size 111 | std::iota(index, index + size, 1); 112 | // Define a comparator that accesses the original data 113 | auto int_sort_cmp = [cmp, data](index_int left, index_int right) 114 | { return cmp(data[left - 1], data[right - 1]); }; 115 | // Let the standard library do all the hard work! 116 | std::sort(index, index + size, int_sort_cmp); 117 | } 118 | 119 | %} 120 | 121 | %flc_cmp_algorithm(void, sort, 122 | %arg(T *DATA, size_t DATASIZE), 123 | %arg(DATA, DATASIZE)) 124 | %flc_cmp_algorithm(bool, is_sorted, 125 | %arg(const T *DATA, size_t DATASIZE), 126 | %arg(DATA, DATASIZE)) 127 | %flc_cmp_algorithm(void, argsort, 128 | %arg(const T *DATA, size_t DATASIZE, 129 | index_int *IDX, size_t IDXSIZE), 130 | %arg(DATA, DATASIZE, IDX, IDXSIZE)) 131 | 132 | /* ------------------------------------------------------------------------- 133 | * Searching routines 134 | * ------------------------------------------------------------------------- */ 135 | 136 | %{ 137 | template 138 | static index_int binary_search_impl(const T *data, size_t size, T value, 139 | Compare cmp) { 140 | const T *end = data + size; 141 | auto iter = std::lower_bound(data, end, value, cmp); 142 | if (iter == end || cmp(*iter, value) || cmp(value, *iter)) 143 | return 0; 144 | // Index of the found item *IN FORTAN INDEXING* 145 | return (iter - data) + 1; 146 | } 147 | 148 | template 149 | static void equal_range_impl(const T *data, size_t size, T value, 150 | index_int &first_index, index_int &last_index, 151 | Compare cmp) { 152 | const T *end = data + size; 153 | auto range_pair = std::equal_range(data, end, value, cmp); 154 | // Index of the min/max items *IN FORTAN INDEXING* 155 | first_index = range_pair.first - data + 1; 156 | last_index = range_pair.second - data; 157 | } 158 | 159 | template 160 | static void minmax_element_impl(const T *data, size_t size, 161 | index_int &min_index, index_int &max_index, 162 | Compare cmp) { 163 | const T *end = data + size; 164 | auto mm_pair = std::minmax_element(data, end, cmp); 165 | // Index of the min/max items *IN FORTAN INDEXING* 166 | min_index = mm_pair.first - data + 1; 167 | max_index = mm_pair.second - data + 1; 168 | } 169 | %} 170 | 171 | %flc_cmp_algorithm(index_int, binary_search, 172 | %arg(const T *DATA, size_t DATASIZE, T value), 173 | %arg(DATA, DATASIZE, value)) 174 | 175 | %flc_cmp_algorithm(void, equal_range, 176 | %arg(const T *DATA, size_t DATASIZE, T value, 177 | index_int &first_index, index_int &last_index), 178 | %arg(DATA, DATASIZE, value, first_index, last_index)) 179 | 180 | %flc_cmp_algorithm(void, minmax_element, 181 | %arg(const T *DATA, size_t DATASIZE, 182 | index_int &min_index, index_int &max_index), 183 | %arg(DATA, DATASIZE, min_index, max_index)) 184 | 185 | /* ------------------------------------------------------------------------- 186 | * Set operation routines 187 | * ------------------------------------------------------------------------- */ 188 | 189 | %{ 190 | template 191 | static bool includes_impl(const T *data1, size_t size1, 192 | const T *data2, size_t size2, 193 | Compare cmp) { 194 | return std::includes(data1, data1 + size1, data2, data2 + size2, cmp); 195 | } 196 | %} 197 | 198 | %flc_cmp_algorithm(bool, includes, 199 | %arg(const T *DATA1, size_t DATASIZE1, 200 | const T *DATA2, size_t DATASIZE2), 201 | %arg(DATA1, DATASIZE1, DATA2, DATASIZE2)) 202 | 203 | /* ------------------------------------------------------------------------- 204 | * Modifying routines 205 | * ------------------------------------------------------------------------- */ 206 | 207 | %{ 208 | #include 209 | %} 210 | 211 | %import "flc_random.i" 212 | 213 | %inline { 214 | template 215 | static void shuffle(std::FLC_DEFAULT_ENGINE& g, T *DATA, size_t DATASIZE) { 216 | std::shuffle(DATA, DATA + DATASIZE, g); 217 | } 218 | } 219 | 220 | %flc_template_numeric(shuffle, shuffle) 221 | %template(shuffle) shuffle; 222 | -------------------------------------------------------------------------------- /cmake/FlibUtils.cmake: -------------------------------------------------------------------------------- 1 | #----------------------------------*-CMake-*----------------------------------# 2 | # Copyright (c) 2021 Oak Ridge National Laboratory, UT-Battelle, LLC. 3 | # License-Filename: LICENSE 4 | # SPDX-License-Identifier: MIT 5 | #[=======================================================================[.rst: 6 | 7 | FlibUtils 8 | --------- 9 | 10 | Utility functions for generating SWIG Fortran through CMake. These are designed 11 | for simple projects with SWIG ``.i`` files in a top-level ``include`` directory 12 | that generate SWIG source code into a top-level ``src`` directory. 13 | 14 | .. command:: flib_warn_undefined 15 | 16 | Print a "package author" warning if the variable is defined: allowing the 17 | build to potentially complete but making clear where the first expectation 18 | failed. 19 | 20 | .. command:: flib_fortran_standard 21 | 22 | Define a cache variable ${prefix}_Fortran_STANDARD that adds Fortran compiler 23 | flags as a directory-level property to enforce a compiler standard. (Only for 24 | GCC/Intel.) This should generally be used at a project-level scope. 25 | 26 | flib_fortran_standard() 27 | 28 | .. command:: flib_find_and_use_swig 29 | 30 | If variable _USE_SWIG is true, find a Fortran-compatible verison 31 | of SWIG, and include the UseSWIG file. This is a macro, so the find/use 32 | variables will propagate into the caller. 33 | 34 | flib_find_and_use_swig() 35 | 36 | This should be called at the top level of the project so that all 37 | subdirectories can access the FindSWIG variables. The macro affords 38 | backward compatibility through CMake 3.12. 39 | 40 | .. command:: flib_dir_variables 41 | 42 | Define CMAKE_Fortran_MODULE_DIRECTORY and other internal variables (starting 43 | with ) needed for ``flib_add_fortran_module``. 44 | 45 | .. command:: flib_add_fortran_module 46 | 47 | Create a SWIG+Fortran module and write to the interface/generate directories, 48 | or use precompiled source if ``_USE_SWIG`` is false. 49 | 50 | flib_add_fortran_module( [source [...]]) 51 | 52 | ```` 53 | Same as the other prefix variables. 54 | 55 | ```` 56 | SWIG module name, expected to be at ``${_INTERFACE_DIR}/${name}.i``. 57 | This will also be the name of the target that's created. 58 | 59 | ```` 60 | Extension of the C/C++ file being created. If not ``c``, the ``CPLUSPLUS`` 61 | property is set to true enabling the SWIG ``-cpp`` option. 62 | 63 | ```` 64 | Extension of the Fortran file to create. This should generally be ``f90`` 65 | (no C preprocesssing) or ``F90`` (with preprocessing). 66 | 67 | source... 68 | Additional source files to compile into the target. 69 | 70 | #]=======================================================================] 71 | 72 | macro(flib_warn_undefined var) 73 | if(NOT DEFINED ${var}) 74 | message(AUTHOR_WARNING "Expected ${var} to be defined") 75 | endif() 76 | endmacro() 77 | 78 | #-----------------------------------------------------------------------------# 79 | 80 | function(flib_fortran_standard prefix) 81 | if(ARGC GREATER 1) 82 | set(default "${ARGV1}") 83 | else() 84 | set(default "none") 85 | endif() 86 | set(${prefix}_Fortran_STANDARD "${default}" CACHE STRING 87 | "Fortran standard for compiling generated code") 88 | set_property(CACHE ${prefix}_Fortran_STANDARD PROPERTY 89 | STRINGS "03" "08" "15" "18" "none") 90 | 91 | if(NOT ${prefix}_Fortran_STANDARD STREQUAL "none") 92 | set(_flib_fprefix) 93 | if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") 94 | set(_flib_fprefix "-std=f20") 95 | elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") 96 | set(_flib_fprefix "-std") 97 | else() 98 | message(WARNING "Fortran standard flags are not known for " 99 | "compilier '${CMAKE_Fortran_COMPILER_ID}': ignoring " 100 | "${prefix}_Fortran_STANDARD=${${prefix}_Fortran_STANDARD}. " 101 | "Configure with the FFLAGS environment variable " 102 | "or explicitly specify CMAKE_Fortran_FLAGS") 103 | set(${prefix}_Fortran_STANDARD "none" CACHE FORCE STRING 104 | "Disabled: unknown compiler") 105 | endif() 106 | 107 | if(_flib_fprefix) 108 | set(_flib_fflag "${_flib_fprefix}${${prefix}_Fortran_STANDARD}") 109 | add_compile_options("$<$:${_flib_fflag}>") 110 | endif() 111 | endif() 112 | endfunction() 113 | 114 | #-----------------------------------------------------------------------------# 115 | # Note: this must appear at CMakeLists level, not macro level 116 | if(CMAKE_VERSION VERSION_LESS 3.18) 117 | list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/backport-cmake-318") 118 | endif() 119 | 120 | macro(flib_find_and_use_swig prefix) 121 | flib_warn_undefined(${prefix}_USE_SWIG) 122 | 123 | if(${prefix}_USE_SWIG) 124 | if(NOT SWIG_fortran_FOUND) 125 | find_package(SWIG COMPONENTS fortran REQUIRED) 126 | endif() 127 | 128 | if(CMAKE_VERSION VERSION_LESS 3.12) 129 | message(FATAL_ERROR "CMake 3.12 or higher is required to regenerate " 130 | "Fortran bindings using SWIG. Set ${prefix}_USE_SWIG to OFF " 131 | "and reconfigure.") 132 | endif() 133 | 134 | if(CMAKE_VERSION GREATER_EQUAL 3.13) 135 | cmake_policy(SET CMP0078 "NEW") 136 | else() 137 | set(FlibUtils_CMP0078 "NEW") 138 | endif() 139 | if(CMAKE_VERSION GREATER_EQUAL 3.14) 140 | cmake_policy(SET CMP0086 "NEW") 141 | else() 142 | set(FlibUtils_CMP0086 "NEW") 143 | endif() 144 | include(UseSWIG) 145 | endif() 146 | endmacro() 147 | 148 | #-----------------------------------------------------------------------------# 149 | 150 | macro(flib_dir_variables prefix) 151 | # You must include GNUInstallDirs prior to calling this macro 152 | flib_warn_undefined(CMAKE_INSTALL_INCLUDEDIR) 153 | 154 | set(CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/fortran") 155 | set(${prefix}_INTERFACE_DIR "${CMAKE_CURRENT_SOURCE_DIR}/include") 156 | set(${prefix}_GENERATE_DIR "${CMAKE_CURRENT_SOURCE_DIR}/src") 157 | set(${prefix}_INSTALL_MODULEDIR "${CMAKE_INSTALL_INCLUDEDIR}") 158 | endmacro() 159 | 160 | #-----------------------------------------------------------------------------# 161 | 162 | function(flib_add_fortran_module prefix name cext fext) 163 | # You must call flib_dir_variables before this function. 164 | flib_warn_undefined(${prefix}_USE_SWIG) 165 | flib_warn_undefined(${prefix}_GENERATE_DIR) 166 | 167 | if(${prefix}_USE_SWIG) 168 | set(src_file "${${prefix}_INTERFACE_DIR}/${name}.i") 169 | if(NOT cext STREQUAL "c") 170 | # C++ file 171 | set_property(SOURCE "${src_file}" PROPERTY 172 | CPLUSPLUS ON) 173 | if(NOT cext STREQUAL "cxx") 174 | set_property(SOURCE "${src_file}" PROPERTY APPEND 175 | SWIG_COMPILE_OPTIONS "-cppext;${cext}") 176 | endif() 177 | endif() 178 | if(NOT fext STREQUAL "f90") 179 | set_property(SOURCE "${src_file}" PROPERTY APPEND 180 | SWIG_COMPILE_OPTIONS "-fext;${fext}") 181 | endif() 182 | 183 | # We need to include the source directory 184 | set_property(SOURCE "${src_file}" PROPERTY 185 | USE_TARGET_INCLUDE_DIRECTORIES ON) 186 | 187 | # Create the library 188 | swig_add_library(${name} 189 | LANGUAGE Fortran 190 | TYPE USE_BUILD_SHARED_LIBS 191 | OUTPUT_DIR "${${prefix}_GENERATE_DIR}" 192 | SOURCES "${src_file}" ${ARGN} 193 | ) 194 | 195 | # Add SWIG headers 196 | target_include_directories(${name} 197 | PUBLIC 198 | "$" 199 | "$" 200 | ) 201 | 202 | # Install the interface file for downstream libraries to use 203 | install(FILES 204 | "${src_file}" 205 | DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}" 206 | ) 207 | else() 208 | # SWIG is *not* being used: compile the code committed in the repository, 209 | # generated by the developer with SWIG. 210 | add_library(${name} 211 | "${${prefix}_GENERATE_DIR}/${name}.${fext}" 212 | "${${prefix}_GENERATE_DIR}/${name}FORTRAN_wrap.${cext}" 213 | ${ARGN} 214 | ) 215 | endif() 216 | 217 | target_include_directories(${name} 218 | PUBLIC 219 | # Fortran modules 220 | $ 221 | $ 222 | ) 223 | endfunction() 224 | -------------------------------------------------------------------------------- /test/test_algorithm.F90: -------------------------------------------------------------------------------- 1 | !-----------------------------------------------------------------------------! 2 | ! \file test/test_algorithm.F90 3 | ! 4 | ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. 5 | ! Distributed under an MIT open source license: see LICENSE for details. 6 | !-----------------------------------------------------------------------------! 7 | 8 | #include "fassert.h" 9 | 10 | module fortran_comparators 11 | implicit none 12 | public 13 | contains 14 | 15 | function compare_ge(left, right) bind(C) & 16 | result(fresult) 17 | use, intrinsic :: ISO_C_BINDING 18 | integer(C_INT), intent(in), value :: left 19 | integer(C_INT), intent(in), value :: right 20 | logical(C_BOOL) :: fresult 21 | 22 | fresult = (left >= right) 23 | end function 24 | 25 | function compare_ptr(lcptr, rcptr) bind(C) & 26 | result(fresult) 27 | use, intrinsic :: ISO_C_BINDING 28 | type(C_PTR), intent(in), value :: lcptr 29 | type(C_PTR), intent(in), value :: rcptr 30 | logical(C_BOOL) :: fresult 31 | integer(C_INT), pointer :: lval 32 | integer(C_INT), pointer :: rval 33 | 34 | ! First check association: null => "less than" 35 | if (.not. c_associated(lcptr)) then 36 | fresult = .true. 37 | return 38 | elseif (.not. c_associated(rcptr)) then 39 | fresult = .false. 40 | return 41 | endif 42 | 43 | ! Convert from C to Fortran pointers 44 | call c_f_pointer(cptr=lcptr, fptr=lval) 45 | call c_f_pointer(cptr=rcptr, fptr=rval) 46 | 47 | ! Compare the values 48 | fresult = (lval < rval) 49 | end function 50 | end module 51 | 52 | program test_algorithm 53 | implicit none 54 | call test_sort() 55 | call test_sort_compare() 56 | call test_sort_generic() 57 | call test_argsort() 58 | 59 | call test_binary_search() 60 | call test_equal_range() 61 | call test_minmax_element() 62 | 63 | call test_includes() 64 | 65 | call test_shuffle() 66 | contains 67 | 68 | !-----------------------------------------------------------------------------! 69 | subroutine test_sort() 70 | use, intrinsic :: ISO_C_BINDING 71 | use flc_algorithm, only : sort 72 | implicit none 73 | integer(4), dimension(5) :: iarr = [ 2, 5, -2, 3, -10000] 74 | integer(C_INT64_T), dimension(5) :: larr = [ 2_C_INT64_T, 5_C_INT64_T, & 75 | -2_C_INT64_T, -10000_C_INT64_T, 10000000000_C_INT64_T] 76 | real(c_double), dimension(4) :: darr = [ 2.1d0, 5.9d0, 0.d0, -1.25d0 ] 77 | 78 | call sort(iarr) 79 | write(*,"(A8,(8I10))") "Result:", iarr 80 | call sort(larr) 81 | write(*,*) "Result:", larr 82 | call sort(darr) 83 | write(*,"(A8,(8f10.3))") "Result:", darr 84 | 85 | end subroutine 86 | 87 | !-----------------------------------------------------------------------------! 88 | subroutine test_sort_compare() 89 | use, intrinsic :: ISO_C_BINDING 90 | use fortran_comparators, only : compare_ge 91 | use flc_algorithm, only : sort 92 | implicit none 93 | integer(C_INT), dimension(:), allocatable :: arr 94 | character(len=*), parameter :: outfmt = "(A12,(8I6))" 95 | 96 | allocate(arr(5), source=[ 2, 3, 4, 4, 9]) 97 | 98 | call sort(arr, compare_ge) 99 | write(*,outfmt) "Result:", arr 100 | end subroutine 101 | 102 | !-----------------------------------------------------------------------------! 103 | subroutine test_sort_generic() 104 | use, intrinsic :: ISO_C_BINDING 105 | use fortran_comparators 106 | use flc_algorithm, only : sort 107 | implicit none 108 | integer(C_INT), dimension(:), allocatable, target :: arr, sorted, expected 109 | type(c_ptr), dimension(:), allocatable :: ptrs 110 | integer(C_INT), pointer :: fptr 111 | integer :: i 112 | 113 | ! Allcoate the test array 114 | allocate(arr(5), source=[ 200, 1, 3, -10, 0]) 115 | 116 | ! Create array of pointers 117 | allocate(ptrs(size(arr))) 118 | do i = 1, size(arr) 119 | ptrs(i) = c_loc(arr(i)) 120 | enddo 121 | 122 | ! Sort the pointers 123 | call sort(ptrs, compare_ptr) 124 | 125 | ! Copy pointers back to an array 126 | allocate(sorted(size(ptrs))) 127 | do i = 1, size(sorted) 128 | call c_f_pointer(ptrs(i), fptr) 129 | sorted(i) = fptr 130 | enddo 131 | 132 | expected = [-10, 0, 1, 3, 200] 133 | do i = 1, size(sorted) 134 | ASSERT(sorted(i) == expected(i)) 135 | enddo 136 | end subroutine 137 | 138 | !-----------------------------------------------------------------------------! 139 | subroutine test_argsort() 140 | use flc_algorithm, only : argsort, INDEX_INT 141 | implicit none 142 | integer, dimension(5) :: iarr = [ 2, 5, -2, 3, -10000] 143 | integer(INDEX_INT), dimension(size(iarr)) :: idx 144 | character(len=*), parameter :: outfmt = "(A12,(8I6))" 145 | 146 | ! Call correctly, with size(idx) == size(iarr) 147 | call argsort(iarr, idx) 148 | write(*,outfmt) "Result:", idx 149 | write(*,outfmt) "Reorganized:", iarr(idx) 150 | 151 | ! Call with size(idx) > size(iarr) 152 | idx(:) = -1 153 | call argsort(iarr(1:3), idx) 154 | write(*,outfmt) "Bad:", idx 155 | 156 | ! Call with size(idx) < size(iarr) 157 | idx(:) = -1 158 | call argsort(iarr, idx(1:3)) 159 | write(*,outfmt) "Also bad:", idx 160 | 161 | end subroutine 162 | 163 | !-----------------------------------------------------------------------------! 164 | subroutine test_shuffle() 165 | use flc_algorithm, only : shuffle 166 | use flc_random, only : Engine => MersenneEngine4 167 | use, intrinsic :: ISO_C_BINDING 168 | implicit none 169 | integer :: i 170 | integer, dimension(8) :: iarr = (/ ((i), i = -4, 3) /) 171 | type(Engine) :: rng 172 | rng = Engine() 173 | 174 | do i = 1,3 175 | call shuffle(rng, iarr) 176 | write(*,"(A,(8I4))") "Shuffled:", iarr 177 | end do 178 | call rng%release() 179 | 180 | ! Shuffle using temporary RNG using seed 12345 181 | rng = Engine(12345_c_int32_t) 182 | call shuffle(rng, iarr) 183 | call rng%release 184 | write(*,"(A,(8I4))") "Shuffled:", iarr 185 | end subroutine 186 | 187 | !-----------------------------------------------------------------------------! 188 | subroutine test_binary_search() 189 | use flc_algorithm, only : binary_search 190 | implicit none 191 | integer, dimension(6) :: iarr = [ -5, 1, 1, 2, 4, 9] 192 | 193 | ASSERT(binary_search(iarr, -100) == 0) ! not found 194 | ASSERT(binary_search(iarr, 1) == 2) 195 | ASSERT(binary_search(iarr, 2) == 4) 196 | ASSERT(binary_search(iarr, 3) == 0) ! not found 197 | ASSERT(binary_search(iarr, 9) == 6) 198 | ASSERT(binary_search(iarr, 10) == 0) 199 | 200 | end subroutine 201 | 202 | !-----------------------------------------------------------------------------! 203 | subroutine test_equal_range() 204 | use flc_algorithm, only : equal_range, INDEX_INT 205 | implicit none 206 | integer(INDEX_INT) :: first_idx, last_idx 207 | integer, dimension(6) :: iarr = [ -5, 1, 1, 2, 4, 9] 208 | 209 | call equal_range(iarr, -6, first_idx, last_idx) 210 | ASSERT(first_idx == 1) 211 | ASSERT(last_idx == 0) 212 | write(*,"(A,(8I4))") "Equal to -6:", iarr(first_idx:last_idx) 213 | 214 | call equal_range(iarr, -5, first_idx, last_idx) 215 | ASSERT(first_idx == 1) 216 | ASSERT(last_idx == 1) 217 | write(*,"(A,(8I4))") "Equal to -5:", iarr(first_idx:last_idx) 218 | 219 | call equal_range(iarr, 1, first_idx, last_idx) 220 | ASSERT(first_idx == 2) 221 | ASSERT(last_idx == 3) 222 | write(*,"(A,(8I4))") "Equal to 1:", iarr(first_idx:last_idx) 223 | 224 | call equal_range(iarr, 3, first_idx, last_idx) 225 | ASSERT(first_idx == 5) 226 | ASSERT(last_idx == 4) 227 | 228 | call equal_range(iarr, 9, first_idx, last_idx) 229 | ASSERT(first_idx == 6) 230 | ASSERT(last_idx == 6) 231 | write(*,"(A,(8I4))") "Equal to 9:", iarr(first_idx:last_idx) 232 | 233 | call equal_range(iarr, 10, first_idx, last_idx) 234 | ASSERT(first_idx == 7) 235 | ASSERT(last_idx == 6) 236 | write(*,"(A,(8I4))") "Equal to 10:", iarr(first_idx:last_idx) 237 | 238 | 239 | end subroutine 240 | 241 | !-----------------------------------------------------------------------------! 242 | subroutine test_minmax_element() 243 | use flc_algorithm, only : minmax_element, INDEX_INT 244 | implicit none 245 | integer, dimension(6) :: iarr = [ -5, 1000, -1000, 999, -1000, 1000] 246 | integer(INDEX_INT) :: min_idx, max_idx 247 | 248 | call minmax_element(iarr, min_idx, max_idx) 249 | ASSERT(iarr(min_idx) == -1000) 250 | ASSERT(iarr(max_idx) == 1000) 251 | ! First occurrence is preferably selected for min 252 | ASSERT(min_idx == 3) 253 | ! Second occurrence is preferably selected for max 254 | ASSERT(max_idx == 6) 255 | 256 | end subroutine 257 | 258 | !-----------------------------------------------------------------------------! 259 | subroutine test_includes() 260 | use flc_algorithm, only : includes 261 | implicit none 262 | integer, dimension(5) :: iarr = [ -5, 1, 2, 4, 9] 263 | integer, dimension(3) :: jarr = [ 1, 2, 5] 264 | 265 | ASSERT(includes(iarr, iarr)) 266 | ASSERT(includes(iarr, iarr(:3))) 267 | ASSERT(includes(iarr, iarr(3:))) 268 | ASSERT(.not. includes(iarr(3:), iarr)) 269 | ASSERT(.not. includes(iarr, jarr)) 270 | ASSERT(includes(iarr, jarr(1:2))) 271 | 272 | end subroutine 273 | 274 | !-----------------------------------------------------------------------------! 275 | 276 | end program 277 | 278 | -------------------------------------------------------------------------------- /src/flcFORTRAN_wrap.cxx: -------------------------------------------------------------------------------- 1 | /* ---------------------------------------------------------------------------- 2 | * This file was automatically generated by SWIG (https://www.swig.org). 3 | * Version 4.1.1+fortran 4 | * 5 | * Do not make changes to this file unless you know what you are doing - modify 6 | * the SWIG interface file instead. 7 | * ----------------------------------------------------------------------------- */ 8 | 9 | /* 10 | * Flibcpp project, https://github.com/swig-fortran/flibcpp 11 | * Copyright (c) 2019-2020 Oak Ridge National Laboratory, UT-Battelle, LLC. 12 | * Distributed under an MIT open source license: see LICENSE for details. 13 | */ 14 | 15 | /* ----------------------------------------------------------------------------- 16 | * This section contains generic SWIG labels for method/variable 17 | * declarations/attributes, and other compiler dependent labels. 18 | * ----------------------------------------------------------------------------- */ 19 | 20 | /* template workaround for compilers that cannot correctly implement the C++ standard */ 21 | #ifndef SWIGTEMPLATEDISAMBIGUATOR 22 | # if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) 23 | # define SWIGTEMPLATEDISAMBIGUATOR template 24 | # elif defined(__HP_aCC) 25 | /* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ 26 | /* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ 27 | # define SWIGTEMPLATEDISAMBIGUATOR template 28 | # else 29 | # define SWIGTEMPLATEDISAMBIGUATOR 30 | # endif 31 | #endif 32 | 33 | /* inline attribute */ 34 | #ifndef SWIGINLINE 35 | # if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) 36 | # define SWIGINLINE inline 37 | # else 38 | # define SWIGINLINE 39 | # endif 40 | #endif 41 | 42 | /* attribute recognised by some compilers to avoid 'unused' warnings */ 43 | #ifndef SWIGUNUSED 44 | # if defined(__GNUC__) 45 | # if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) 46 | # define SWIGUNUSED __attribute__ ((__unused__)) 47 | # else 48 | # define SWIGUNUSED 49 | # endif 50 | # elif defined(__ICC) 51 | # define SWIGUNUSED __attribute__ ((__unused__)) 52 | # else 53 | # define SWIGUNUSED 54 | # endif 55 | #endif 56 | 57 | #ifndef SWIG_MSC_UNSUPPRESS_4505 58 | # if defined(_MSC_VER) 59 | # pragma warning(disable : 4505) /* unreferenced local function has been removed */ 60 | # endif 61 | #endif 62 | 63 | #ifndef SWIGUNUSEDPARM 64 | # ifdef __cplusplus 65 | # define SWIGUNUSEDPARM(p) 66 | # else 67 | # define SWIGUNUSEDPARM(p) p SWIGUNUSED 68 | # endif 69 | #endif 70 | 71 | /* internal SWIG method */ 72 | #ifndef SWIGINTERN 73 | # define SWIGINTERN static SWIGUNUSED 74 | #endif 75 | 76 | /* internal inline SWIG method */ 77 | #ifndef SWIGINTERNINLINE 78 | # define SWIGINTERNINLINE SWIGINTERN SWIGINLINE 79 | #endif 80 | 81 | /* exporting methods */ 82 | #if defined(__GNUC__) 83 | # if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) 84 | # ifndef GCC_HASCLASSVISIBILITY 85 | # define GCC_HASCLASSVISIBILITY 86 | # endif 87 | # endif 88 | #endif 89 | 90 | #ifndef SWIGEXPORT 91 | # if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) 92 | # if defined(STATIC_LINKED) 93 | # define SWIGEXPORT 94 | # else 95 | # define SWIGEXPORT __declspec(dllexport) 96 | # endif 97 | # else 98 | # if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) 99 | # define SWIGEXPORT __attribute__ ((visibility("default"))) 100 | # else 101 | # define SWIGEXPORT 102 | # endif 103 | # endif 104 | #endif 105 | 106 | /* calling conventions for Windows */ 107 | #ifndef SWIGSTDCALL 108 | # if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) 109 | # define SWIGSTDCALL __stdcall 110 | # else 111 | # define SWIGSTDCALL 112 | # endif 113 | #endif 114 | 115 | /* Deal with Microsoft's attempt at deprecating C standard runtime functions */ 116 | #if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) 117 | # define _CRT_SECURE_NO_DEPRECATE 118 | #endif 119 | 120 | /* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ 121 | #if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) 122 | # define _SCL_SECURE_NO_DEPRECATE 123 | #endif 124 | 125 | /* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ 126 | #if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) 127 | # define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 128 | #endif 129 | 130 | /* Intel's compiler complains if a variable which was never initialised is 131 | * cast to void, which is a common idiom which we use to indicate that we 132 | * are aware a variable isn't used. So we just silence that warning. 133 | * See: https://github.com/swig/swig/issues/192 for more discussion. 134 | */ 135 | #ifdef __INTEL_COMPILER 136 | # pragma warning disable 592 137 | #endif 138 | 139 | 140 | #ifndef SWIGEXTERN 141 | # ifdef __cplusplus 142 | # define SWIGEXTERN extern 143 | # else 144 | # define SWIGEXTERN 145 | # endif 146 | #endif 147 | 148 | 149 | #define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ 150 | { throw std::logic_error("In " DECL ": " MSG); } 151 | 152 | /* SWIG Errors applicable to all language modules, values are reserved from -1 to -99 */ 153 | #define SWIG_UnknownError -1 154 | #define SWIG_IOError -2 155 | #define SWIG_RuntimeError -3 156 | #define SWIG_IndexError -4 157 | #define SWIG_TypeError -5 158 | #define SWIG_DivisionByZero -6 159 | #define SWIG_OverflowError -7 160 | #define SWIG_SyntaxError -8 161 | #define SWIG_ValueError -9 162 | #define SWIG_SystemError -10 163 | #define SWIG_AttributeError -11 164 | #define SWIG_MemoryError -12 165 | #define SWIG_NullReferenceError -13 166 | 167 | 168 | 169 | #ifdef __cplusplus 170 | extern "C" { 171 | #endif 172 | SWIGEXPORT void SWIG_check_unhandled_exception_impl(const char* decl); 173 | SWIGEXPORT void SWIG_store_exception(const char* decl, int errcode, const char *msg); 174 | #ifdef __cplusplus 175 | } 176 | #endif 177 | 178 | 179 | #undef SWIG_exception_impl 180 | #define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ 181 | SWIG_store_exception(DECL, CODE, MSG); RETURNNULL; 182 | 183 | 184 | 185 | #define SWIG_VERSION 0x040101 186 | #define SWIGFORTRAN 187 | 188 | #ifdef __cplusplus 189 | #include 190 | /* SwigValueWrapper is described in swig.swg */ 191 | template class SwigValueWrapper { 192 | struct SwigSmartPointer { 193 | T *ptr; 194 | SwigSmartPointer(T *p) : ptr(p) { } 195 | ~SwigSmartPointer() { delete ptr; } 196 | SwigSmartPointer& operator=(SwigSmartPointer& rhs) { T* oldptr = ptr; ptr = 0; delete oldptr; ptr = rhs.ptr; rhs.ptr = 0; return *this; } 197 | void reset(T *p) { T* oldptr = ptr; ptr = 0; delete oldptr; ptr = p; } 198 | } pointer; 199 | SwigValueWrapper& operator=(const SwigValueWrapper& rhs); 200 | SwigValueWrapper(const SwigValueWrapper& rhs); 201 | public: 202 | SwigValueWrapper() : pointer(0) { } 203 | SwigValueWrapper& operator=(const T& t) { SwigSmartPointer tmp(new T(t)); pointer = tmp; return *this; } 204 | #if __cplusplus >=201103L 205 | SwigValueWrapper& operator=(T&& t) { SwigSmartPointer tmp(new T(std::move(t))); pointer = tmp; return *this; } 206 | operator T&&() const { return std::move(*pointer.ptr); } 207 | #else 208 | operator T&() const { return *pointer.ptr; } 209 | #endif 210 | T *operator&() const { return pointer.ptr; } 211 | static void reset(SwigValueWrapper& t, T *p) { t.pointer.reset(p); } 212 | }; 213 | 214 | /* 215 | * SwigValueInit() is a generic initialisation solution as the following approach: 216 | * 217 | * T c_result = T(); 218 | * 219 | * doesn't compile for all types for example: 220 | * 221 | * unsigned int c_result = unsigned int(); 222 | */ 223 | template T SwigValueInit() { 224 | return T(); 225 | } 226 | 227 | #if __cplusplus >=201103L 228 | # define SWIG_STD_MOVE(OBJ) std::move(OBJ) 229 | #else 230 | # define SWIG_STD_MOVE(OBJ) OBJ 231 | #endif 232 | 233 | #endif 234 | 235 | 236 | #include 237 | 238 | 239 | /* Support for the `contract` feature. 240 | * 241 | * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in 242 | * the fortran.cxx file. 243 | */ 244 | #define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ 245 | if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } 246 | 247 | 248 | #define SWIG_as_voidptr(a) const_cast< void * >(static_cast< const void * >(a)) 249 | #define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),reinterpret_cast< void** >(a)) 250 | 251 | 252 | 253 | extern "C" { 254 | 255 | int flc_ierr = 0; 256 | 257 | } 258 | 259 | 260 | 261 | #include 262 | #ifdef _MSC_VER 263 | # ifndef strtoull 264 | # define strtoull _strtoui64 265 | # endif 266 | # ifndef strtoll 267 | # define strtoll _strtoi64 268 | # endif 269 | #endif 270 | 271 | 272 | struct SwigArrayWrapper { 273 | void* data; 274 | size_t size; 275 | }; 276 | 277 | 278 | SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { 279 | SwigArrayWrapper result; 280 | result.data = NULL; 281 | result.size = 0; 282 | return result; 283 | } 284 | 285 | 286 | #include 287 | 288 | 289 | // Stored exception message 290 | SWIGINTERN const char* swig_last_exception_cstr = NULL; 291 | // Retrieve error message 292 | SWIGEXPORT const char* flc_get_serr() { 293 | if (!swig_last_exception_cstr) { 294 | SWIG_store_exception("UNKNOWN", SWIG_RuntimeError, 295 | "no error string was present"); 296 | } 297 | return swig_last_exception_cstr; 298 | } 299 | 300 | 301 | #include 302 | 303 | 304 | #include 305 | 306 | extern "C" { 307 | 308 | // Call this function before any new action 309 | SWIGEXPORT void SWIG_check_unhandled_exception_impl(const char* decl) { 310 | if (flc_ierr != 0) { 311 | // Construct message; calling the error string function ensures that 312 | // the string is allocated if the user did something goofy like 313 | // manually setting the integer. Since this function is not expected to 314 | // be wrapped by a catch statement, it will probably terminate the 315 | // program. 316 | std::string msg("An unhandled exception occurred before a call to "); 317 | msg += decl; 318 | msg += "; "; 319 | std::string prev_msg = flc_get_serr(); 320 | prev_msg[0] = std::tolower(prev_msg[0]); 321 | msg += prev_msg; 322 | throw std::runtime_error(msg); 323 | } 324 | } 325 | 326 | // Save an exception to the fortran error code and string 327 | SWIGEXPORT void SWIG_store_exception(const char *decl, 328 | int errcode, 329 | const char *msg) { 330 | ::flc_ierr = errcode; 331 | 332 | static std::string last_exception_msg; 333 | // Save the message to a std::string first 334 | last_exception_msg = "In "; 335 | last_exception_msg += decl; 336 | last_exception_msg += ": "; 337 | last_exception_msg += msg; 338 | swig_last_exception_cstr = last_exception_msg.c_str(); 339 | } 340 | } 341 | 342 | 343 | #include 344 | #include 345 | 346 | 347 | #include 348 | 349 | 350 | extern "C" { 351 | extern const char flibcpp_version[]; 352 | extern const int flibcpp_version_major; 353 | extern const int flibcpp_version_minor; 354 | extern const int flibcpp_version_patch; 355 | } 356 | 357 | extern "C" { 358 | SWIGEXPORT SwigArrayWrapper _wrap_get_serr() { 359 | SwigArrayWrapper fresult ; 360 | char *result = 0 ; 361 | 362 | result = (char *)flc_get_serr(); 363 | fresult.size = strlen((char*)(result)); 364 | fresult.data = const_cast< char * >(result); 365 | return fresult; 366 | } 367 | 368 | 369 | SWIGEXPORT SwigArrayWrapper _wrap_flibcpp_version_get() { 370 | SwigArrayWrapper fresult ; 371 | char *result = 0 ; 372 | 373 | result = (char *)(char *)flibcpp_version; 374 | fresult.size = strlen((char*)(result)); 375 | fresult.data = const_cast< char * >(result); 376 | return fresult; 377 | } 378 | 379 | 380 | } // extern 381 | 382 | -------------------------------------------------------------------------------- /cmake/CgvFindVersion.cmake: -------------------------------------------------------------------------------- 1 | #------------------------------- -*- cmake -*- -------------------------------# 2 | # SPDX-License-Identifier: Apache-2.0 3 | # 4 | # https://github.com/sethrj/cmake-git-version 5 | # 6 | # Copyright 2021-2025 UT-Battelle, LLC 7 | # 8 | # Licensed under the Apache License, Version 2.0 (the "License"); 9 | # you may not use this file except in compliance with the License. 10 | # You may obtain a copy of the License at 11 | # 12 | # http://www.apache.org/licenses/LICENSE-2.0 13 | # 14 | # Unless required by applicable law or agreed to in writing, software 15 | # distributed under the License is distributed on an "AS IS" BASIS, 16 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 17 | # See the License for the specific language governing permissions and 18 | # limitations under the License. 19 | #[=======================================================================[.rst: 20 | 21 | CgvFindVersion 22 | -------------- 23 | 24 | .. command:: cgv_find_version 25 | 26 | Get the project version using Git descriptions to ensure the version numbers 27 | are always synchronized between Git and CMake:: 28 | 29 | cgv_find_version([]) 30 | 31 | ```` 32 | Name of the project. 33 | 34 | This command sets the numeric (usable in CMake version comparisons) and 35 | extended (useful for exact versioning) version variables in the parent 36 | package:: 37 | 38 | ${projname}_VERSION 39 | ${projname}_VERSION_STRING 40 | 41 | It takes the project name as an optional argument so that it may be used 42 | *before* calling the CMake ``project`` command. 43 | 44 | The project version string uses an approximation to SemVer strings, appearing 45 | as v0.1.2 if the version is actually a tagged release, or 46 | v0.1.3-2+branch.abcdef if it's not. Pre-releases should be tagged as 47 | v1.0.0-rc.1, and subsequent commits will show as v1.0.0-rc.1.23+branch.abc123. 48 | 49 | If a non-tagged version is exported, or an untagged shallow git clone is used, 50 | it's impossible to determine the version from the tag, so a warning will be 51 | issued and the version will be set to 0.0.0. 52 | 53 | The default regex used to match the numeric version and full version string 54 | from the git tag is:: 55 | 56 | v([0-9.]+)(-[a-z]+[0-9.]*)? 57 | 58 | but you can override the regex by setting the ``CGV_TAG_REGEX`` variable 59 | before calling ``cgv_find_version``. For example, Geant4 tags such as 60 | ``geant4-11-02-ref-09`` can be matched with:: 61 | 62 | geant4-([0-9-]+[0-9]+)(-[a-z]+-[0-9]+)? 63 | 64 | Finally, this script records the time stamp of the file used to generate the 65 | metadata, and it will re-run cmake if that file changes, and re-run the 66 | associated git commands only if the file changes. 67 | 68 | .. note:: In order for this script to work properly with archived git 69 | repositories (generated with ``git-archive`` or GitHub's release tarball 70 | feature), it's necessary to add to your ``.gitattributes`` file:: 71 | 72 | CgvFindVersion.cmake export-subst 73 | 74 | The install script included alongside this file (in the original 75 | repository) sets this property. 76 | 77 | This script can also be run from the command line to determine git repository 78 | data:: 79 | 80 | cmake -P cmake/CgvFindVersion.cmake 81 | 82 | To print only the version string (to stderr), and from a custom directory:: 83 | 84 | cmake -DSOURCE_DIR=. -DONLY=VERSION -P cmake/CgvFindVersion.cmake 85 | 86 | #]=======================================================================] 87 | 88 | if(CMAKE_SCRIPT_MODE_FILE) 89 | cmake_minimum_required(VERSION 3.8...3.30) 90 | endif() 91 | 92 | set(CGV_SOURCE_DIR "${CMAKE_CURRENT_LIST_DIR}") 93 | 94 | #-----------------------------------------------------------------------------# 95 | # Get a reproducible timestamp 96 | macro(_cgv_timestamp tsfile tsvar) 97 | if(EXISTS "${tsfile}") 98 | file(TIMESTAMP "${tsfile}" ${tsvar} "%Y%m%d.%H%M%S" UTC) 99 | else() 100 | set(${tsvar} "") 101 | endif() 102 | endmacro() 103 | 104 | #-----------------------------------------------------------------------------# 105 | # Execute a command, logging verbosely, saving output 106 | macro(_cgv_git_call_output output_var) 107 | message(VERBOSE "Executing ${GIT_EXECUTABLE} from ${CGV_SOURCE_DIR}: ${ARGN}") 108 | execute_process( 109 | COMMAND "${GIT_EXECUTABLE}" ${ARGN} 110 | WORKING_DIRECTORY "${CGV_SOURCE_DIR}" 111 | OUTPUT_STRIP_TRAILING_WHITESPACE 112 | ERROR_VARIABLE GIT_ERR 113 | RESULT_VARIABLE GIT_RESULT 114 | OUTPUT_VARIABLE ${output_var} 115 | ) 116 | endmacro() 117 | 118 | #-----------------------------------------------------------------------------# 119 | # Save the version with a timestamp to a cache variable 120 | 121 | function(_cgv_store_version vstring vsuffix vhash tsfile) 122 | if(NOT vstring) 123 | message(WARNING "The version metadata for ${CGV_PROJECT} could not " 124 | "be determined: installed version number may be incorrect") 125 | endif() 126 | # Replace 11-03 with 11.3 127 | string(REGEX REPLACE "-+0*" "." vstring "${vstring}") 128 | # Remove trailing periods 129 | string(REGEX REPLACE "\\.+$" "" vstring "${vstring}") 130 | # Remove leading zeros from version components 131 | string(REGEX REPLACE "0+([1-9]+[0-9]*)" "\\1" vstring "${vstring}") 132 | 133 | # Get timestamp 134 | _cgv_timestamp("${tsfile}" _vtimestamp) 135 | # Set up cached data list 136 | set(_CACHED_VERSION 137 | "${vstring}" "${vsuffix}" "${vhash}" "${tsfile}" "${_vtimestamp}" 138 | ) 139 | # Note: extra 'unset' is necessary if using CMake presets with 140 | # ${CGV_PROJECT}_GIT_DESCRIBE="", even with INTERNAL/FORCE 141 | unset("${CGV_CACHE_VAR}" CACHE) 142 | set("${CGV_CACHE_VAR}" "${_CACHED_VERSION}" CACHE INTERNAL 143 | "Version string and hash for ${CGV_PROJECT}") 144 | message(VERBOSE "Set ${CGV_CACHE_VAR}=${vstring};${vsuffix};${vhash} from ${tsfile}") 145 | endfunction() 146 | 147 | #-----------------------------------------------------------------------------# 148 | # Get the path to the git head used to describe the current repostiory 149 | function(_cgv_git_path resultvar) 150 | if(GIT_EXECUTABLE) 151 | _cgv_git_call_output(_TSFILE "rev-parse" "--git-path" "HEAD") 152 | else() 153 | set(GIT_RESULT 1) 154 | set(GIT_ERR "GIT_EXECUTABLE is not defined") 155 | endif() 156 | if(GIT_RESULT) 157 | message(AUTHOR_WARNING "Failed to get path to git head: ${GIT_ERR}") 158 | set(_TSFILE) 159 | else() 160 | get_filename_component(_TSFILE "${_TSFILE}" ABSOLUTE BASE_DIR 161 | "${CGV_SOURCE_DIR}" 162 | ) 163 | endif() 164 | 165 | set(${resultvar} "${_TSFILE}" PARENT_SCOPE) 166 | endfunction() 167 | 168 | #-----------------------------------------------------------------------------# 169 | # Process description tag: e.g. v0.4.0-2-gc4af497 or v0.4.0 or v2.0.0-rc.2 170 | 171 | function(_cgv_try_parse_git_describe version_string branch_string tsfile) 172 | # Regex groups: 173 | # 1: primary version (1.2.3) 174 | # 2: pre-release: dev/alpha/rc annotation (-rc.1) 175 | # 3: post-tag description (-123-gabcd123) 176 | # 4: number of commits since (aka distance to) tag (123) 177 | # 5: commit hash (abcd213) 178 | set(_DESCR_REGEX "^${CGV_TAG_REGEX}(-([0-9]+)-g([0-9a-f]+))?") 179 | string(REGEX MATCH "${_DESCR_REGEX}" _MATCH "${version_string}") 180 | if(NOT _MATCH) 181 | message(AUTHOR_WARNING 182 | "Failed to parse description '${version_string}' with regex '${_DESCR_REGEX}'" 183 | ) 184 | return() 185 | endif() 186 | 187 | if(NOT CMAKE_MATCH_3) 188 | # This is a tagged release! 189 | _cgv_store_version("${CMAKE_MATCH_1}" "${CMAKE_MATCH_2}" "" "${tsfile}") 190 | return() 191 | endif() 192 | 193 | if(CMAKE_MATCH_2) 194 | # After a pre-release, e.g. -rc.1, for SemVer compatibility 195 | set(_prerelease "${CMAKE_MATCH_2}.${CMAKE_MATCH_4}") 196 | else() 197 | # After a release, e.g. -123 198 | set(_prerelease "-${CMAKE_MATCH_4}") 199 | endif() 200 | 201 | if(branch_string) 202 | set(_suffix "${branch_string}.${CMAKE_MATCH_5}") 203 | else() 204 | set(_suffix "${CMAKE_MATCH_5}") 205 | endif() 206 | 207 | # Qualify the version number with the distance-to-tag and hash 208 | _cgv_store_version( 209 | "${CMAKE_MATCH_1}" # 1.2.3 210 | "${_prerelease}" # -rc.2.3, -beta.1, -123 211 | "${_suffix}" # abcdef 212 | "${tsfile}" # timestamp file 213 | ) 214 | endfunction() 215 | 216 | #-----------------------------------------------------------------------------# 217 | 218 | function(_cgv_try_archive_md) 219 | # Get a possible Git version generated using git-archive (see the 220 | # .gitattributes file) 221 | set(_ARCHIVE_DESCR "v1.0.4") 222 | set(_ARCHIVE_TAG "HEAD -> master, tag: v1.0.4") 223 | set(_ARCHIVE_HASH "334b225") 224 | if(_ARCHIVE_HASH MATCHES "^\\$.*\\$$") 225 | # Not a git archive 226 | return() 227 | endif() 228 | 229 | set(_TSFILE "${CMAKE_CURRENT_LIST_FILE}") 230 | string(REGEX MATCH "->\\s+(\\S+)" _MATCH "${_ARCHIVE_TAG}") 231 | if(_MATCH) 232 | set(_BRANCH "${CMAKE_MATCH_1}") 233 | else() 234 | set(_BRANCH) 235 | endif() 236 | 237 | if(_ARCHIVE_DESCR) 238 | _cgv_try_parse_git_describe("${_ARCHIVE_DESCR}" "${_BRANCH}" "${_TSFILE}") 239 | if(${CGV_CACHE_VAR}) 240 | # Successfully parsed description 241 | return() 242 | endif() 243 | endif() 244 | 245 | string(REGEX MATCH "tag: *${CGV_TAG_REGEX}" _MATCH "${_ARCHIVE_TAG}") 246 | if(_MATCH) 247 | set(_VERSION "${CMAKE_MATCH_1}") 248 | set(_SUFFIX "${CMAKE_MATCH_2}") 249 | set(_HASH) 250 | else() 251 | message(AUTHOR_WARNING 252 | "Could not match a version tag for " 253 | "git description '${_ARCHIVE_TAG}': perhaps this archive was not " 254 | "exported from a tagged commit?" 255 | ) 256 | string(REGEX MATCH " *([0-9a-f]+)" _MATCH "${_ARCHIVE_HASH}") 257 | if(NOT _MATCH) 258 | # Could not even find a git hash 259 | return() 260 | endif() 261 | 262 | # Found a hash but no version 263 | set(_VERSION) 264 | set(_SUFFIX) 265 | set(_HASH "${CMAKE_MATCH_1}") 266 | endif() 267 | 268 | _cgv_store_version("${_VERSION}" "${_SUFFIX}" "${_HASH}" "${_TSFILE}") 269 | endfunction() 270 | 271 | #-----------------------------------------------------------------------------# 272 | # Try git's 'describe' function 273 | function(_cgv_try_git_describe) 274 | # First time calling "git describe" 275 | if(NOT Git_FOUND) 276 | find_package(Git QUIET) 277 | if(NOT Git_FOUND) 278 | message(WARNING "Could not find Git, needed to find the version tag") 279 | return() 280 | endif() 281 | endif() 282 | 283 | if(CGV_TAG_REGEX MATCHES "^\\^?([a-z-]+)") 284 | set(_match "--match" "${CMAKE_MATCH_1}*") 285 | else() 286 | set(_match) 287 | endif() 288 | 289 | # Load git description 290 | _cgv_git_call_output(_VERSION_STRING "describe" "--tags" ${_match}) 291 | if(GIT_RESULT) 292 | message(AUTHOR_WARNING "No suitable git tags found': ${GIT_ERR}") 293 | return() 294 | endif() 295 | if(GIT_ERR) 296 | message(AUTHOR_WARNING "git describe warned: ${GIT_ERR}") 297 | endif() 298 | if(NOT _VERSION_STRING) 299 | message(AUTHOR_WARNING "Failed to get ${CGV_PROJECT} version from git: " 300 | "git describe returned an empty string") 301 | return() 302 | endif() 303 | 304 | # Get git branch: may fail if detached, leading to empty output, which is 305 | # the desired behavior 306 | _cgv_git_call_output(_BRANCH_STRING "symbolic-ref" "--short" "HEAD") 307 | 308 | _cgv_git_path(_TSFILE) 309 | _cgv_try_parse_git_describe("${_VERSION_STRING}" "${_BRANCH_STRING}" "${_TSFILE}") 310 | endfunction() 311 | 312 | #-----------------------------------------------------------------------------# 313 | 314 | function(_cgv_try_git_hash) 315 | if(NOT GIT_EXECUTABLE) 316 | return() 317 | endif() 318 | # Fall back to just getting the hash 319 | _cgv_git_call_output(_VERSION_HASH "log" "-1" "--format=%h" "HEAD") 320 | if(_VERSION_HASH_RESULT) 321 | message(AUTHOR_WARNING "Failed to get current commit hash from git: " 322 | "${_VERSION_HASH_ERR}") 323 | return() 324 | endif() 325 | 326 | _cgv_git_path(_TSFILE) 327 | _cgv_store_version("" "" "${_VERSION_HASH}" "${_TSFILE}") 328 | endfunction() 329 | 330 | function(_cgv_try_all) 331 | if(${CGV_CACHE_VAR}) 332 | # Previous configure already set the variable: check the timestamp 333 | list(LENGTH ${CGV_CACHE_VAR} _len) 334 | if(_len EQUAL 5) 335 | list(GET ${CGV_CACHE_VAR} 3 _tsfile) 336 | list(GET ${CGV_CACHE_VAR} 4 _timestamp) 337 | else() 338 | message(VERBOSE "Old cache variable ${CGV_CACHE_VAR}: length=${_len}") 339 | set(_tsfile) 340 | endif() 341 | if(_tsfile) 342 | _cgv_timestamp("${_tsfile}" _curtimestamp) 343 | if(_timestamp AND _timestamp STREQUAL _curtimestamp) 344 | message(VERBOSE "Equal time stamp from ${_tsfile}: ${_timestamp}") 345 | # Time stamp is equal; version doesn't need to be updated 346 | return() 347 | else() 348 | message(VERBOSE 349 | "Stale timestamp from ${_tsfile}: ${_timestamp} != ${_curtimestamp}" 350 | ) 351 | endif() 352 | endif() 353 | unset(${CGV_CACHE_VAR} CACHE) 354 | endif() 355 | 356 | _cgv_try_archive_md() 357 | if(${CGV_CACHE_VAR}) 358 | return() 359 | endif() 360 | 361 | _cgv_try_git_describe() 362 | if(${CGV_CACHE_VAR}) 363 | return() 364 | endif() 365 | 366 | _cgv_try_git_hash() 367 | if(${CGV_CACHE_VAR}) 368 | return() 369 | endif() 370 | 371 | # Fallback: no metadata detected 372 | set(${CGV_CACHE_VAR} "" "-unknown" "") 373 | endfunction() 374 | 375 | #-----------------------------------------------------------------------------# 376 | 377 | function(cgv_find_version) 378 | # Set CGV_ variables that are used in embedded macros/functions 379 | if(ARGC GREATER 0) 380 | set(CGV_PROJECT "${ARGV0}") 381 | elseif(NOT CGV_PROJECT) 382 | if(NOT CMAKE_PROJECT_NAME) 383 | message(FATAL_ERROR "Project name is not defined") 384 | endif() 385 | set(CGV_PROJECT "${CMAKE_PROJECT_NAME}") 386 | endif() 387 | 388 | if(NOT CGV_TAG_REGEX) 389 | set(CGV_TAG_REGEX "v([0-9.]+)(-[a-z]+[0-9.]*)?") 390 | endif() 391 | 392 | set(CGV_CACHE_VAR "${CGV_PROJECT}_GIT_DESCRIBE") 393 | 394 | # Try all possible ways of obtaining metadata 395 | _cgv_try_all() 396 | 397 | # Unpack stored version 398 | set(_CACHED_VERSION "${${CGV_CACHE_VAR}}") 399 | list(GET _CACHED_VERSION 0 _VERSION_STRING) 400 | list(GET _CACHED_VERSION 1 _VERSION_STRING_SUFFIX) 401 | list(GET _CACHED_VERSION 2 _VERSION_HASH) 402 | list(GET _CACHED_VERSION 3 _TSFILE) 403 | 404 | if(NOT _VERSION_STRING) 405 | set(_VERSION_STRING "0.0.0") 406 | endif() 407 | 408 | if(_VERSION_HASH) 409 | set(_FULL_VERSION_STRING "${_VERSION_STRING}${_VERSION_STRING_SUFFIX}+${_VERSION_HASH}") 410 | else() 411 | set(_FULL_VERSION_STRING "${_VERSION_STRING}${_VERSION_STRING_SUFFIX}") 412 | endif() 413 | 414 | if(_TSFILE) 415 | # Re-run cmake if the timestamp file changes 416 | set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS "${_TSFILE}") 417 | endif() 418 | 419 | # Set version number and descriptive version in parent scope 420 | set(${CGV_PROJECT}_VERSION "${_VERSION_STRING}" PARENT_SCOPE) 421 | set(${CGV_PROJECT}_VERSION_STRING "${_FULL_VERSION_STRING}" PARENT_SCOPE) 422 | endfunction() 423 | 424 | #-----------------------------------------------------------------------------# 425 | 426 | if(CMAKE_SCRIPT_MODE_FILE) 427 | if(DEFINED SOURCE_DIR) 428 | set(CGV_SOURCE_DIR ${SOURCE_DIR}) 429 | endif() 430 | cgv_find_version(TEMP) 431 | if(DEFINED ONLY) 432 | # Print only the given variable, presumably VERSION or VERSION_STRING 433 | # (will print to stderr) 434 | set(VERSION "${TEMP_VERSION}") 435 | set(VERSION_STRING "${TEMP_VERSION_STRING}") 436 | message("${${ONLY}}") 437 | else() 438 | message("VERSION=\"${TEMP_VERSION}\"") 439 | message("VERSION_STRING=\"${TEMP_VERSION_STRING}\"") 440 | endif() 441 | endif() 442 | 443 | # cmake-git-version 1.2.1-5+main.bdcc7d7 444 | --------------------------------------------------------------------------------