Skip to content

Commit 147d874

Browse files
sethrjsethrj
authored
Merge pull request #4 from swig-fortran/arbitrary-algorithm
Add fully generic algorithms
2 parents be743af + 94fd085 commit 147d874

16 files changed

+949
-213
lines changed

‎.travis.yml

+17-27
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
1-
language: cpp
21
dist: bionic
3-
compiler: gcc
4-
sudo: false
2+
sudo: required # apt-get done in before_install.sh
3+
language: minimal
54

65
# Only build master or PRs merging into master
76
branches:
@@ -11,30 +10,21 @@ branches:
1110
# List of configurations to check
1211
matrix:
1312
include:
14-
- os: linux
15-
env: FLIBCPP_DEV=ON GENERATOR=ninja
16-
FLIBCPP_FORTRAN_STD=f2003
17-
addons:
18-
apt:
19-
packages:
20-
- gfortran
21-
- python3-sphinx
22-
- valgrind
23-
- os: linux
24-
env: FLIBCPP_DEV=OFF GENERATOR=make
25-
FLIBCPP_FORTRAN_STD=f2008
26-
addons:
27-
apt:
28-
packages:
29-
- gfortran
30-
- os: linux
31-
env: FLIBCPP_DEV=OFF GENERATOR=make
32-
FLIBCPP_FORTRAN_STD=f2008
33-
addons:
34-
apt:
35-
packages:
36-
- gfortran
37-
13+
- os: linux
14+
env: FLIBCPP_DEV=ON GENERATOR=ninja
15+
addons:
16+
apt:
17+
packages:
18+
- python3-sphinx
19+
- valgrind
20+
- os: linux
21+
env: FLIBCPP_DEV=OFF GENERATOR=make
22+
FLIBCPP_FORTRAN_STD=f2003
23+
GCC_VERSION=8
24+
- os: linux
25+
env: FLIBCPP_DEV=OFF GENERATOR=make
26+
FLIBCPP_FORTRAN_STD=f2008
27+
GCC_VERSION=9
3828
# Build phases
3929
before_install:
4030
- source ./scripts/travis/before_install.sh

‎CMakeLists.txt

+1-1
Original file line numberDiff line numberDiff line change
@@ -166,7 +166,7 @@ function(swig_fortran_add_module name)
166166
cxx_std_11
167167
)
168168

169-
if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
169+
if (FLIBCPP_FORTRAN_STD AND CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
170170
# Compile Fortran code with given standard
171171
target_compile_options(${name}
172172
PUBLIC $<$<COMPILE_LANGUAGE:Fortran>:-std=${FLIBCPP_FORTRAN_STD}>

‎doc/examples.rst

+57-8
Original file line numberDiff line numberDiff line change
@@ -9,16 +9,11 @@ Examples
99
The following standalone codes demonstrate how Flibcpp can be used in native
1010
Fortran code.
1111

12-
String conversion and sort
12+
Random numbers and sorting
1313
==========================
1414

15-
This example:
16-
17-
- Introspects the Flibcpp version;
18-
- Converts a user input to an integer, validating it with useful error
19-
messages;
20-
- Fills an array with normally-distributed real numbers; and
21-
- Sorts the array before printing the first few entries.
15+
This simple example generates an array of normally-distributed double-precision
16+
reals, sorts them, and then shuffles them again.
2217

2318
.. literalinclude:: ../example/sort.f90
2419
:linenos:
@@ -32,6 +27,60 @@ from native Fortran strings.
3227
.. literalinclude:: ../example/vecstr.f90
3328
:linenos:
3429

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+
3584
.. ############################################################################
3685
.. end of doc/examples.rst
3786
.. ############################################################################

‎doc/modules/algorithm.rst

+25-11
Original file line numberDiff line numberDiff line change
@@ -10,20 +10,29 @@ Algorithm
1010

1111
The ``flc_algorithm`` module wraps C++ standard `<algorithm>`_ routines.
1212
Instead of taking pairs of iterators, the Flibcpp algorithm subroutines accept
13-
target-qualified 1-D arrays.
14-
15-
Algorithms that take comparators (e.g. sorting and searching) are instantiated
16-
with function pointers that allow user functions to add arbitrary ordering by
17-
defining ``bind(C)`` functions.
18-
19-
Wherever possible, array indices are returned as Fortran 1-offset native
20-
integers, with the value 0 indicating off-the-end (e.g. "not found").
13+
target-qualified one-dimensional arrays. All algorithms follow the
14+
:ref:`indexing convention <conventions_indexing>` that the first element of an
15+
array has index 1, and an index of 0 indicates "not found".
2116

2217
.. _<algorithm> : https://en.cppreference.com/w/cpp/numeric/random
2318

2419
Sorting
2520
=======
2621

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 <example_generic>` for a demonstration.
35+
2736
sort
2837
----
2938

@@ -46,6 +55,8 @@ Checking the ordering of array is just as simple::
4655

4756
sortitude = is_sorted(iarr)
4857

58+
.. _modules_algorithm_argsort:
59+
4960
argsort
5061
-------
5162

@@ -56,11 +67,10 @@ takes an array to analyze and an empty array of integers to fill::
5667
use flc_algorithm, only : argsort, INDEX_INT
5768
implicit none
5869
integer, dimension(5) :: iarr = [ 2, 5, -2, 3, -10000]
59-
integer(INDEX_INT), dimension(5) :: idx
70+
integer(INDEX_INT), dimension(size(iarr)) :: idx
6071

6172
call argsort(iarr, idx)
62-
! This line prints a sorted array:
63-
write(*,*) iarr(idx)
73+
write(*,*) iarr(idx) ! Prints the sorted array
6474

6575
Note that the index array is always a ``INDEX_INT``, which is an alias to
6676
``C_INT``. On some compilers and platforms, this may be the same as native
@@ -77,6 +87,10 @@ zero.
7787
Searching
7888
=========
7989

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+
8094
.. _modules_algorithm_binary_search:
8195

8296
binary_search

‎example/CMakeLists.txt

+22-2
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,31 @@ macro(swig_fortran_add_example name)
1111
target_link_libraries(${name}.exe ${ARGN})
1212
endmacro()
1313

14+
#---------------------------------------------------------------------------##
15+
# TEST LIBRARIES
16+
#---------------------------------------------------------------------------##
17+
18+
add_library(example_utils_lib
19+
"example_utils.f90"
20+
)
21+
target_link_libraries(example_utils_lib flc flc_string flc_vector)
22+
23+
#---------------------------------------------------------------------------##
24+
# EXAMPLES
25+
#---------------------------------------------------------------------------##
26+
1427
swig_fortran_add_example(sort
15-
flc_algorithm flc_random flc_string)
28+
flc_algorithm flc_random flc_string example_utils_lib)
1629

1730
swig_fortran_add_example(vecstr
18-
flc_string flc_vector)
31+
flc_string flc_vector example_utils_lib)
32+
33+
swig_fortran_add_example(sort_generic
34+
flc_algorithm example_utils_lib)
35+
36+
#---------------------------------------------------------------------------##
37+
# TESTS
38+
#---------------------------------------------------------------------------##
1939

2040
if (BUILD_TESTING)
2141
add_test(

‎example/example_utils.f90

+115
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
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+
!-----------------------------------------------------------------------------!

‎example/run-examples.sh

+8
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,14 @@ three
3535
20
3636
EOF
3737

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+
3846
run_test vecstr << EOF
3947
This is the first string
4048
a second string

0 commit comments

Comments
 (0)