Merge pull request #4 from swig-fortran/arbitrary-algorithm

Add fully generic algorithms

Author: sethrj

.travis.yml

@@ -1,7 +1,6 @@
-language: cpp
 dist: bionic
-compiler: gcc
-sudo: false
+sudo: required # apt-get done in before_install.sh
+language: minimal
 
 # Only build master or PRs merging into master
 branches:
@@ -11,30 +10,21 @@ branches:
 # List of configurations to check
 matrix:
   include:
-      - os: linux
-        env: FLIBCPP_DEV=ON GENERATOR=ninja
-             FLIBCPP_FORTRAN_STD=f2003
-        addons:
-          apt:
-            packages:
-            - gfortran
-            - python3-sphinx
-            - valgrind
-      - os: linux
-        env: FLIBCPP_DEV=OFF GENERATOR=make
-             FLIBCPP_FORTRAN_STD=f2008
-        addons:
-          apt:
-            packages:
-            - gfortran
-      - os: linux
-        env: FLIBCPP_DEV=OFF GENERATOR=make
-             FLIBCPP_FORTRAN_STD=f2008
-        addons:
-          apt:
-            packages:
-            - gfortran
-
+    - os: linux
+      env: FLIBCPP_DEV=ON GENERATOR=ninja
+      addons:
+        apt:
+          packages:
+          - python3-sphinx
+          - valgrind
+    - os: linux
+      env: FLIBCPP_DEV=OFF GENERATOR=make
+           FLIBCPP_FORTRAN_STD=f2003
+           GCC_VERSION=8
+    - os: linux
+      env: FLIBCPP_DEV=OFF GENERATOR=make
+           FLIBCPP_FORTRAN_STD=f2008
+           GCC_VERSION=9
 # Build phases
 before_install:
   - source ./scripts/travis/before_install.sh

CMakeLists.txt

@@ -166,7 +166,7 @@ function(swig_fortran_add_module name)
       cxx_std_11
   )
 
-  if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
+  if (FLIBCPP_FORTRAN_STD AND CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
     # Compile Fortran code with given standard
     target_compile_options(${name}
       PUBLIC $<$<COMPILE_LANGUAGE:Fortran>:-std=${FLIBCPP_FORTRAN_STD}>

doc/examples.rst

@@ -9,16 +9,11 @@ Examples
 The following standalone codes demonstrate how Flibcpp can be used in native
 Fortran code.
 
-String conversion and sort
+Random numbers and sorting
 ==========================
 
-This example:
-
- - Introspects the Flibcpp version;
- - Converts a user input to an integer, validating it with useful error
-   messages;
- - Fills an array with normally-distributed real numbers; and
- - Sorts the array before printing the first few entries.
+This simple example generates an array of normally-distributed double-precision
+reals, sorts them, and then shuffles them again.
 
 .. literalinclude:: ../example/sort.f90
    :linenos:
@@ -32,6 +27,60 @@ from native Fortran strings.
 .. literalinclude:: ../example/vecstr.f90
    :linenos:
 
+.. _example_generic:
+
+Generic sorting
+===============
+
+Since sorting algorithms often allow :math:`O(N)` algorithms to be written in
+:math:`O(\log N)`, providing generic sorting routines is immensely useful in
+applications that operate on large chunks of data. This example demonstrates
+the generic version of the :ref:`modules_algorithm_argsort` subroutine by
+sorting a native Fortran array of native Fortran types using a native Fortran
+subroutine. The only C interaction needed is to create C pointers to the
+Fortran array entries and to provide a C-bound comparator that
+converts those pointers back to native Fortran pointers. [#c_f_pointer]_
+
+.. literalinclude:: ../example/sort_generic.f90
+   :linenos:
+
+.. _example_utils:
+
+Example utilities module
+========================
+
+This pure-Fortran module builds on top of functionality from Flibcpp. It
+provides procedures to:
+
+ - Format and print the Flibcpp version;
+ - Converts a user input to an integer, validating it with useful error
+   messages;
+ - Reads a dynamically sized vector of strings from the user.
+
+.. literalinclude:: ../example/example_utils.f90
+   :linenos:
+
+
+.. rubric:: Footnotes
+
+.. [#c_f_pointer] Older versions of Gfortran (before GCC-8) fail to compile the
+   generic sort example because of a bug that incorrectly claims that taking
+   the C pointer of a scalar Fortran value is a violation of the standard:
+
+   .. code-block:: none
+
+      ../example/sort_generic.f90:84:38:
+
+           call c_f_pointer(cptr=rcptr, fptr=rptr)
+                                            1
+      Error: TS 29113/TS 18508: Noninteroperable array FPTR at (1) to
+      C_F_POINTER: Expression is a noninteroperable derived type
+
+   See `this bug report`_ for more details.
+
+   .. _this bug report: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=84924
+
+
 .. ############################################################################
 .. end of doc/examples.rst
 .. ############################################################################

doc/modules/algorithm.rst

@@ -10,20 +10,29 @@ Algorithm
 
 The ``flc_algorithm`` module wraps C++ standard `<algorithm>`_ routines.
 Instead of taking pairs of iterators, the Flibcpp algorithm subroutines accept
-target-qualified 1-D arrays.
-
-Algorithms that take comparators (e.g. sorting and searching) are instantiated
-with function pointers that allow user functions to add arbitrary ordering by
-defining ``bind(C)`` functions.
-
-Wherever possible, array indices are returned as Fortran 1-offset native
-integers, with the value 0 indicating off-the-end (e.g. "not found").
+target-qualified one-dimensional arrays. All algorithms follow the
+:ref:`indexing convention <conventions_indexing>` that the first element of an
+array has index 1, and an index of 0 indicates "not found".
 
 .. _<algorithm> : https://en.cppreference.com/w/cpp/numeric/random
 
 Sorting
 =======
 
+Sorting algorithms for numeric types default to increasing order when provided
+with a single array argument. Numeric sorting routines accept an optional
+second argument, a comparator function, which should return ``true`` if the
+first argument is strictly less than the right-hand side.
+
+.. warning:: For every value of ``a`` and ``b``, the comparator ``cmp`` *must*
+   satisfy ``.not. (cmp(a, b) .and. cmp(b, a))``. If this strict ordering is
+   not satisfied, some of the algorithms below may crash the program.
+
+All sorting algorithms are *also* instantiated so that they accept an array of
+``type(C_PTR)`` and a generic comparator function. **This enables arrays of any
+native Fortran object to be sorted**. See :ref:`the generic
+sorting example <example_generic>` for a demonstration.
+
 sort
 ----
 
@@ -46,6 +55,8 @@ Checking the ordering of array is just as simple::
 
   sortitude = is_sorted(iarr)
 
+.. _modules_algorithm_argsort:
+
 argsort
 -------
 
@@ -56,11 +67,10 @@ takes an array to analyze and an empty array of integers to fill::
   use flc_algorithm, only : argsort, INDEX_INT
   implicit none
   integer, dimension(5) :: iarr = [ 2, 5, -2, 3, -10000]
-  integer(INDEX_INT), dimension(5) :: idx
+  integer(INDEX_INT), dimension(size(iarr)) :: idx
 
   call argsort(iarr, idx)
-  ! This line prints a sorted array:
-  write(*,*) iarr(idx)
+  write(*,*) iarr(idx) ! Prints the sorted array
 
 Note that the index array is always a ``INDEX_INT``, which is an alias to
 ``C_INT``. On some compilers and platforms, this may be the same as native
@@ -77,6 +87,10 @@ zero.
 Searching
 =========
 
+Like the sorting algorithms, searching algorithms are instantiated on numeric
+types and the C pointer type, and they provide an optional procedure pointer
+argument that allows the arrays to be ordered with an arbitrary comparator.
+
 .. _modules_algorithm_binary_search:
 
 binary_search

example/CMakeLists.txt

@@ -11,11 +11,31 @@ macro(swig_fortran_add_example name)
   target_link_libraries(${name}.exe ${ARGN})
 endmacro()
 
+#---------------------------------------------------------------------------##
+# TEST LIBRARIES
+#---------------------------------------------------------------------------##
+
+add_library(example_utils_lib
+  "example_utils.f90"
+)
+target_link_libraries(example_utils_lib flc flc_string flc_vector)
+
+#---------------------------------------------------------------------------##
+# EXAMPLES
+#---------------------------------------------------------------------------##
+
 swig_fortran_add_example(sort
-  flc_algorithm flc_random flc_string)
+  flc_algorithm flc_random flc_string example_utils_lib)
 
 swig_fortran_add_example(vecstr
-  flc_string flc_vector)
+  flc_string flc_vector example_utils_lib)
+
+swig_fortran_add_example(sort_generic
+  flc_algorithm example_utils_lib)
+
+#---------------------------------------------------------------------------##
+# TESTS
+#---------------------------------------------------------------------------##
 
 if (BUILD_TESTING)
   add_test(

example/example_utils.f90

@@ -0,0 +1,115 @@
+!-----------------------------------------------------------------------------!
+! \file   example/example_utils.f90
+! \brief  example_utils module
+! \note   Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC.
+!-----------------------------------------------------------------------------!
+
+module example_utils
+  use, intrinsic :: ISO_FORTRAN_ENV
+  use, intrinsic :: ISO_C_BINDING
+  implicit none
+  integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT
+  public
+    
+contains
+
+subroutine write_version()
+  use flc
+  implicit none
+  ! Print version information
+  write(STDOUT, "(a)") "========================================"
+  write(STDOUT, "(a, a)") "Flibcpp version: ", get_flibcpp_version()
+  write(STDOUT, "(a, 2(i1,'.'), (i1), a)") "(Numeric version: ", &
+      flibcpp_version_major, flibcpp_version_minor, flibcpp_version_patch, &
+      ")"
+  write(STDOUT, "(a)") "========================================"
+end subroutine
+    
+! Loop until the user inputs a positive integer. Catch error conditions. 
+function read_positive_int(desc) result(result_int)
+  use flc
+  use flc_string, only : stoi
+  implicit none
+  character(len=*), intent(in) :: desc
+  character(len=80) :: readstr
+  integer :: result_int, io_ierr
+  do
+    write(STDOUT, *) "Enter " // desc // ": "
+    read(STDIN, "(a)", iostat=io_ierr) readstr
+    if (io_ierr == IOSTAT_END) then
+      ! Error condition: ctrl-D during input
+      write(STDOUT, *) "User terminated"
+      stop 1
+    endif
+
+    result_int = stoi(readstr)
+    if (ierr == 0) then
+      if (result_int <= 0) then
+        ! Error condition: non-positive value
+        write(STDOUT, *) "Invalid " // desc // ": ", result_int
+        continue
+      end if
+
+      write(STDOUT, *) "Read " // desc // "=", result_int
+      exit
+    endif
+
+    if (ierr == SWIG_OVERFLOWERROR) then
+      ! Error condition: integer doesn't fit in native integer
+      write(STDOUT,*) "Your integer is too darn big!"
+    else if (ierr == SWIG_VALUEERROR) then
+      ! Error condition: not an integer at all
+      write(STDOUT,*) "That text you entered? It wasn't an integer."
+    else
+      write(STDOUT,*) "Unknown error", ierr
+    end if
+    write(STDOUT,*) "(Detailed error message: ", get_serr(), ")"
+
+    ! Clear error flag so the next call to stoi succeeds
+    ierr = 0
+  end do
+end function
+
+! Loop until the user inputs a positive integer. Catch error conditions. 
+subroutine read_strings(vec)
+  use flc
+  use flc_string, only : String
+  use flc_vector, only : VectorString
+  use ISO_FORTRAN_ENV
+  implicit none
+  type(VectorString), intent(out) :: vec
+  integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT
+  character(len=80) :: readstr
+  integer :: io_ierr
+  type(String) :: str
+
+  ! Allocate the vector
+  vec = VectorString()
+
+  do
+    ! Request and read a string
+    write(STDOUT, "(a, i3, a)") "Enter string #", vec%size() + 1, &
+        " or Ctrl-D/empty string to complete"
+    read(STDIN, "(a)", iostat=io_ierr) readstr
+    if (io_ierr == IOSTAT_END) then
+      ! Break out of loop on ^D (EOF)
+      exit
+    end if
+
+    ! Add string to the end of the vector
+    call vec%push_back(trim(readstr))
+    ! Get a String object reference to the back to check if it's empty
+    str = vec%back_ref()
+    if (str%empty()) then
+      ! Remove the empty string
+      call vec%pop_back()
+      exit
+    end if
+  end do
+end subroutine
+
+end module
+
+!-----------------------------------------------------------------------------!
+! end of example/example_utils.f90
+!-----------------------------------------------------------------------------!

example/run-examples.sh

@@ -35,6 +35,14 @@ three
 20
 EOF
 
+run_test sort_generic << EOF
+5
+a short string
+a shirt string
+shorter
+and the next string is unallocated
+EOF
+
 run_test vecstr << EOF
 This is the first string
 a second string