├── .github └── workflows │ └── ci.yml ├── .gitignore ├── CMakeLists.txt ├── LICENSE ├── README.md ├── _config.yml ├── fpm.toml ├── src └── functional.f90 └── test ├── test_arange.f90 ├── test_arrstr.f90 ├── test_complement.f90 ├── test_empty.f90 ├── test_filter.f90 ├── test_foldl.f90 ├── test_foldr.f90 ├── test_foldt.f90 ├── test_head.f90 ├── test_init.f90 ├── test_insert.f90 ├── test_intersection.f90 ├── test_iterfold.f90 ├── test_last.f90 ├── test_limit.f90 ├── test_map.f90 ├── test_reverse.f90 ├── test_set.f90 ├── test_sort.f90 ├── test_split.f90 ├── test_strarr.f90 ├── test_subscript.f90 ├── test_tail.f90 ├── test_unfold.f90 ├── test_union.f90 └── testing.f90 /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: ci 2 | 3 | on: 4 | push: 5 | paths: 6 | - "**.f90" 7 | - ".github/workflows/ci.yml" 8 | - "CMakeLists.txt" 9 | pull_request: 10 | paths: 11 | - "**.f90" 12 | - ".github/workflows/ci.yml" 13 | - "CMakeLists.txt" 14 | 15 | jobs: 16 | build: 17 | name: Build and test on Linux 18 | runs-on: ubuntu-latest 19 | 20 | strategy: 21 | matrix: 22 | compiler: [gfortran-9, gfortran-10] 23 | 24 | steps: 25 | - uses: actions/checkout@v2 26 | 27 | - name: Build with CMake 28 | env: 29 | FC: ${{ matrix.compiler }} 30 | run: cmake . && make 31 | 32 | - name: Test 33 | run: ctest 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | 3 | # Compiled Object files 4 | *.slo 5 | *.lo 6 | *.o 7 | *.obj 8 | 9 | # Precompiled Headers 10 | *.gch 11 | *.pch 12 | 13 | # Compiled Dynamic libraries 14 | *.so 15 | *.dylib 16 | *.dll 17 | 18 | # Fortran module files 19 | *.mod 20 | *.smod 21 | 22 | # Compiled Static libraries 23 | *.lai 24 | *.la 25 | *.a 26 | *.lib 27 | 28 | # Executables 29 | *.exe 30 | *.out 31 | *.app 32 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # cmake version, project name, language 2 | cmake_minimum_required(VERSION 2.8 FATAL_ERROR) 3 | project(functional-fortran Fortran) 4 | 5 | # set output paths for modules, archives, and executables 6 | set(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/include) 7 | set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) 8 | set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) 9 | set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) 10 | 11 | # if build type not specified, default to release 12 | if(NOT CMAKE_BUILD_TYPE) 13 | set(CMAKE_BUILD_TYPE "release") 14 | endif() 15 | 16 | # compiler flags for gfortran 17 | if(CMAKE_Fortran_COMPILER_ID MATCHES GNU) 18 | set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -g -C -fbacktrace") 19 | set(CMAKE_Fortran_FLAGS_RELEASE "-O3") 20 | endif() 21 | 22 | # compiler flags for ifort 23 | if(CMAKE_Fortran_COMPILER_ID MATCHES Intel) 24 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -assume realloc_lhs -heap-arrays") 25 | set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -g -C -traceback") 26 | set(CMAKE_Fortran_FLAGS_RELEASE "-O3") 27 | endif() 28 | 29 | # compiler flags for Cray ftn 30 | if(CMAKE_Fortran_COMPILER_ID MATCHES Cray) 31 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -h noomp") 32 | set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -g") 33 | set(CMAKE_Fortran_FLAGS_RELEASE "-O3") 34 | endif() 35 | 36 | # library to archive (libfunctional.a) 37 | add_library(functional src/functional.f90) 38 | add_library(testing test/testing.f90) 39 | 40 | # tests 41 | enable_testing() 42 | foreach(execid arange arrstr complement empty filter foldl foldr foldt head init insert intersection iterfold last limit map reverse set sort split strarr subscript tail unfold union) 43 | add_executable(test_${execid} test/test_${execid}.f90) 44 | target_link_libraries(test_${execid} functional testing) 45 | add_test(test_${execid} bin/test_${execid}) 46 | endforeach() 47 | 48 | install(DIRECTORY "${CMAKE_Fortran_MODULE_DIRECTORY}" DESTINATION "${CMAKE_INSTALL_PREFIX}") 49 | install(DIRECTORY "${CMAKE_LIBRARY_OUTPUT_DIRECTORY}" DESTINATION "${CMAKE_INSTALL_PREFIX}") 50 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016-2020, functional-fortran contributors 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 7 | 8 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 9 | 10 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 11 | 12 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## functional-fortran 2 | 3 | Functional programming for modern Fortran. 4 | 5 | ![Build status](https://github.com/wavebitscientific/functional-fortran/workflows/ci/badge.svg) 6 | [![GitHub issues](https://img.shields.io/github/issues/wavebitscientific/functional-fortran.svg)](https://github.com/wavebitscientific/functional-fortran/issues) 7 | 8 | * [Getting started](#getting-started) 9 | - [Get the code](#get-the-code) 10 | - [Build with fpm](#build-with-fpm) 11 | - [Build with CMake](#build-with-cmake) 12 | - [Or just drop-in the source file](#or-just-drop-in-the-source-file) 13 | - [Use it](#use-it) 14 | * [Why functional-fortran?](#why-functional-fortran) 15 | * [What's included?](#whats-included) 16 | * [Example usage](#example-usage) 17 | * [Contributing](#contributing) 18 | * [Further reading](#further-reading) 19 | 20 | ## Getting started 21 | 22 | ### Get the code 23 | 24 | ``` 25 | git clone https://github.com/wavebitscientific/functional-fortran 26 | cd functional-fortran 27 | ``` 28 | 29 | ### Build with fpm 30 | 31 | This project supports the Fortran Package Manager ([fpm](https://github.com/fortran-lang/fpm)). 32 | 33 | ``` 34 | fpm build --release 35 | fpm test 36 | ``` 37 | 38 | You can also use it as a dependency in your existing fpm package. 39 | Just add functional-fortran to your `fpm.toml`: 40 | 41 | ```toml 42 | [dependencies] 43 | [dependencies.functional] 44 | git = "https://github.com/wavebitscientific/functional-fortran" 45 | ``` 46 | 47 | ### Build with CMake 48 | 49 | Alternatively, you can build functional-fortran with CMake: 50 | 51 | ``` 52 | mkdir build 53 | cd build 54 | cmake .. 55 | make 56 | ctest 57 | ``` 58 | 59 | ### Or just drop-in the source file 60 | 61 | functional-fortran is a single-file library. 62 | Just grab src/functional.f90 and build it however you want. 63 | 64 | ### Use it 65 | 66 | Start using functional-fortran in your code by including the module: 67 | 68 | ``` 69 | use functional 70 | ``` 71 | 72 | ## Why functional-fortran? 73 | 74 | While not designed as a purely functional programming language, 75 | modern Fortran goes a long way by letting the programmer 76 | use `pure` functions to encourage good functional discipline, 77 | express code in mathematical form, and minimize bug-prone mutable state. 78 | This library provides a set of commonly used tools in functional 79 | programming, with the purpose to help Fortran programmers 80 | be less imperative and more functional. 81 | 82 | ## What's included? 83 | 84 | The following functions are provided: 85 | 86 | * `arange` returns a regularly spaced array 87 | * `complement` returns a set complement of two arrays 88 | * `empty` returns an empty array 89 | * `filter` filters an array using a logical input function 90 | * `foldl` recursively left-folds an array using an input function 91 | * `foldr` recursively right-folds an array using an input function 92 | * `foldt` recursively tree-folds an array using an input function 93 | * `head` returns the first element of an array 94 | * `init` returns everything but the last element 95 | * `insert` inserts an element into an array, out-of-bound safe 96 | * `intersection` returns a set intersection of two arrays 97 | * `iterfold` iteratively reduces an array using an input function 98 | * `last` returns the last element of an array 99 | * `limit` limits a scalar or array by given lower and upper bounds 100 | * `map` maps an array with an input function 101 | * `set` returns a set given input array 102 | * `reverse` returns array in reverse order 103 | * `sort` is a recursive quicksort using binary tree pivot 104 | * `split` returns first or second half of an array 105 | * `subscript` is an out-of-bound safe implementation of vector subscript 106 | * `tail` returns everything but the first element 107 | * `unfold` unfolds an array with an input function 108 | * `union` returns a set union of two arrays 109 | 110 | All of the above functions are compatible with the standard Fortran 2008 kinds: 111 | `int8`, `int16`, `int32`, `int64`, `real32`, `real64`, `real128`, 112 | `complex(real32)`, `complex(real64)`, and `complex(real128)`. 113 | 114 | Further, these functions (and their corresponding operators) 115 | are compatible with character strings: 116 | `complement`, `empty`, `head`, `init`, `intersection`, `insert`, 117 | `last`, `reverse`, `set`, `sort`, `split`, `tail`, and `union`. 118 | 119 | Functions that operate on one or two arguments are also available as 120 | unary or binary operators, respectively. These are: 121 | `.complement.`, `.head.`, `.init.`, `.intersection.`, `.last.`, 122 | `.reverse.`, `.set.`, `.sort.`, `.tail.`, and `.union.`. 123 | 124 | ## Example usage 125 | 126 | ### Array functions 127 | 128 | `arange` is used to generate evenly spaced arrays, 129 | given start and end values as input arguments: 130 | 131 | ```fortran 132 | print *, arange(1, 5) 133 | 1 2 3 4 5 134 | ``` 135 | 136 | `arange` works with real numbers as well: 137 | 138 | ```fortran 139 | print *, arange(1., 5.) 140 | 1.00000000 2.00000000 3.00000000 4.00000000 5.00000000 141 | ``` 142 | 143 | Third argument to `arange` (optional) is the increment, 144 | which defaults to `1` if not given: 145 | 146 | ```fortran 147 | print *, arange(1, 15, 3) 148 | 1 4 7 10 13 149 | ``` 150 | 151 | Negative increments work as expected: 152 | 153 | ```fortran 154 | print *, arange(3, 1, -1) 155 | 3 2 1 156 | ``` 157 | 158 | We can use floating-point increments: 159 | 160 | ```fortran 161 | print *, arange(1., 1.5, 0.1) 162 | 1.00000000 1.10000002 1.20000005 1.29999995 1.39999998 1.50000000 163 | ``` 164 | 165 | If `start` is greater than `end` and increment is positive, 166 | `arange` returns an empty array: 167 | 168 | ```fortran 169 | print *, arange(5, 1) 170 | 171 | ``` 172 | 173 | Use `empty` to generate a zero-length array of any Fortran standard 174 | kind: 175 | 176 | ```fortran 177 | print *, size(empty(1)) 178 | 0 179 | ``` 180 | which may be useful to initialize accumulators, for example 181 | see the implementation of set `intersection` in this library. 182 | 183 | 184 | `head` returns the first element of the array: 185 | 186 | ```fortran 187 | print *, head([1, 2, 3]) 188 | 1 189 | ``` 190 | 191 | `tail` returns everything but the first element of the array: 192 | 193 | ```fortran 194 | print *, tail([1, 2, 3]) 195 | 2 3 196 | ``` 197 | 198 | Similarly, `last` returns the last element of the array: 199 | 200 | ```fortran 201 | print *, last([1, 2, 3]) 202 | 3 203 | ``` 204 | 205 | `init` returns everything but the last element of the array: 206 | 207 | ```fortran 208 | print *, init([1, 2, 3]) 209 | 1 2 210 | ``` 211 | 212 | Subscript an array at specific indices: 213 | 214 | ```fortran 215 | print *, subscript([1, 2, 3, 4, 5], [3, 4]) 216 | 3 4 217 | ``` 218 | 219 | Unlike the Fortran 2008 vector subscript, the `subscript` function is out-of-bounds safe, 220 | i.e. subscripting out of bounds returns an empty array: 221 | 222 | ```fortran 223 | print *, subscript([1, 2, 3], [10]) 224 | 225 | ``` 226 | 227 | We can prepend, append, or insert an element into an array using `insert`: 228 | 229 | ```fortran 230 | ! insert a 5 at position 0 to prepend: 231 | print *, insert(5, 0, [1, 2, 3]) 232 | 5 1 2 3 233 | 234 | ! insert a 5 at position 4 to append: 235 | print *, insert(5, 4, [1, 2, 3]) 236 | 1 2 3 5 237 | 238 | ! insert a 2 at position 2: 239 | print *, insert(2, 2, [1, 3, 4]) 240 | 1 2 3 4 241 | ``` 242 | 243 | `split` can be used to return first or second half of an array: 244 | 245 | ```fortran 246 | ! return first half of the array 247 | print *, split(arange(1, 5), 1) 248 | 1 2 249 | 250 | ! return second half of the array 251 | print *, split(arange(1, 5), 2) 252 | 3 4 5 253 | ``` 254 | The above is useful for recursive binary tree searching or sorting, 255 | for example, see the implementation of `sort` in this library. 256 | 257 | `sort` returns a sorted array in ascending order: 258 | 259 | ```fortran 260 | real :: x(5) 261 | call random_number(x) 262 | print *, x 263 | 0.997559547 0.566824675 0.965915322 0.747927666 0.367390871 264 | print *, sort(x) 265 | 0.367390871 0.566824675 0.747927666 0.965915322 0.997559547 266 | ``` 267 | Use `reverse` to sort in descending order: 268 | 269 | ```fortran 270 | print *, reverse(sort(x)) 271 | 0.997559547 0.965915322 0.747927666 0.566824675 0.367390871 272 | ``` 273 | 274 | The `limit` function can be used to contrain a value of a scalar 275 | or an array within a lower and upper limit, for example: 276 | 277 | ```fortran 278 | ! limit a scalar (5) within bounds 1 and 4 279 | print *, limit(5, 1, 4) 280 | 4 281 | 282 | ! flipping the bounds works just as well 283 | print *, limit(5, 4, 1) 284 | 4 285 | ``` 286 | `limit` also works on arrays: 287 | 288 | ```fortran 289 | print *, limit(arange(0, 4), 1, 3): 290 | 1 1 2 3 3 291 | ``` 292 | 293 | ### More functional: `map`, `filter`, `fold`, `unfold` 294 | 295 | `map` has the same functionality as pure elemental functions, 296 | but can be used to apply recursive functions to arrays, for example: 297 | 298 | ```fortran 299 | pure recursive integer function fibonacci(n) result(fib) 300 | integer,intent(in) :: n 301 | if (n == 0) then 302 | fib = 0 303 | else if (n == 1) then 304 | fib = 1 305 | else 306 | fib = fibonacci(n - 1) + fibonacci(n - 2) 307 | end if 308 | end function fibonacci 309 | 310 | print *, map(fibonacci, [17, 5, 13, 22]) 311 | 1597 5 233 17711 312 | ``` 313 | 314 | `filter` returns array elements that satisfy a logical filtering function. 315 | For example, we can define a function that returns .true. when input is an 316 | even number, and use this function to filter an array: 317 | 318 | ```fortran 319 | pure logical function even(x) 320 | integer, intent(in) :: x 321 | even = mod(x, 2) == 0 322 | endfunction even 323 | 324 | print *, filter(even, [1, 2, 3, 4, 5]) 325 | 2 4 326 | ``` 327 | Functions can be chained together into pretty one-liners: 328 | 329 | ```fortran 330 | print *, filter(even, map(fibonacci, arange(1, 10))) 331 | 2 8 34 332 | ``` 333 | 334 | functional-fortran also provides left-, right-, and tree-fold functions, 335 | `foldl`, `foldr`, and `foldt`, respectively. These functions recursively 336 | consume an array using a user-defined function, and return a resulting scalar. 337 | For simple examples of `sum` and `product` functions using folds, we can define 338 | the following addition and multiplication functions that operate on scalars: 339 | 340 | ```fortran 341 | pure real function add(x, y) 342 | real, intent(in) :: x, y 343 | add = x + y 344 | endfunction add 345 | 346 | pure real function mult(x, y) 347 | real, intent(in) :: x, y 348 | mult = x * y 349 | endfunction mult 350 | ``` 351 | We can then calculate the `sum` and `product` of an array by "folding" the 352 | input using the above-defined functions and a start value 353 | (second argument to `fold*`): 354 | 355 | ```fortran 356 | ! left-fold an array using add to compute array sum 357 | print *, foldl(add, 0., arange(1., 5.)) 358 | 15.0000000 359 | 360 | ! left-fold an array using mult to compute array product 361 | print *, foldl(mult, 1., arange(1., 5.)) 362 | 120.000000 363 | ``` 364 | The above is a trivial example that re-invents Fortran intrinsics 365 | as a proof of concept. Intrinsic functions should of course be used 366 | whenever possible. 367 | 368 | `foldl`, `foldr`, and `foldt` return the same result if the user-defined 369 | function is associative. See the [Wikipedia page on fold](https://en.wikipedia.org/wiki/Fold_(higher-order_function)) for more information. 370 | `iterfold` is an iterative (non-recursive) implementation of `foldl` 371 | that is provided for reference. 372 | 373 | Opposite to `fold*`, `unfold` can be used to generate an array 374 | based on a start value `x`, and a function `f`, such that 375 | the resulting array equals `[x, f(x), f(f(x)), f(f(f(x))), ... ]`. 376 | For example: 377 | 378 | ```fortran 379 | pure real function multpt1(x) 380 | real,intent(in) :: x 381 | multpt1 = 1.1 * x 382 | endfunction multpt1 383 | 384 | write(*,*) unfold(multpt1, [1.], 5) 385 | 1.00000000 1.10000002 1.21000004 1.33100009 1.46410012 386 | ``` 387 | 388 | ### Set functions: `set`, `union`, `intersection`, `complement` 389 | 390 | Function `set` returns all unique elements of an input array: 391 | 392 | ```fortran 393 | print *, set([1, 1, 2, 2, 3]) 394 | 1 2 3 395 | ``` 396 | Common functions that operate on sets, `union`, 397 | `intersection`, and `complement`, are also available: 398 | 399 | ```fortran 400 | ! unique elements that are found in either array 401 | print *, union([1, 2, 2], [2, 3, 3, 4]) 402 | 1 2 3 4 403 | 404 | ! unique elements that are found in both arrays 405 | print *, intersection([1, 2, 2], [2, 3, 3, 4]) 406 | 2 407 | 408 | ! unique elements that are found first but not in second array 409 | print *, complement([1, 2, 2], [2, 3, 3, 4]) 410 | 1 411 | ``` 412 | 413 | ## Contributing 414 | 415 | Please submit a bug report or a request for new feature 416 | [here](https://github.com/wavebitscientific/functional-fortran/issues/new). 417 | 418 | ## Further reading 419 | 420 | * [John Backus (1978): Can programming be liberated from the von Neumann style? A functional style and its algebra of programs](http://worrydream.com/refs/Backus-CanProgrammingBeLiberated.pdf) 421 | 422 | * [Functional programming on Wikipedia](https://en.wikipedia.org/wiki/Functional_programming) 423 | 424 | * [Fold (higher-order function) on Wikipedia](https://en.wikipedia.org/wiki/Fold_(higher-order_function)) 425 | 426 | * [Graham Hutton (1999): A tutorial on the universality and expresiveness of fold](http://www.cs.nott.ac.uk/~pszgmh/fold.pdf) 427 | -------------------------------------------------------------------------------- /_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-cayman -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "functional" 2 | version = "0.6.2" 3 | license = "BSD-3-Clause" 4 | author = "Milan Curcic" 5 | maintainer = "milancurcic@hey.com" 6 | copyright = "Copyright (c) 2016-2022, functional-fortran contributors" 7 | -------------------------------------------------------------------------------- /test/test_arange.f90: -------------------------------------------------------------------------------- 1 | program test_arange 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional, only:arange 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 19 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(arange(1_int8, 3_int8) == [1_int8, 2_int8, 3_int8]), & 17 | 'arange, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(arange(1_int16, 3_int16) == [1_int16, 2_int16, 3_int16]), & 21 | 'arange, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(arange(1_int32, 3_int32) == [1_int32, 2_int32, 3_int32]), & 25 | 'arange, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(arange(1_int64, 3_int64) == [1_int64, 2_int64, 3_int64]), & 29 | 'arange, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(arange(1._real32, 3._real32) == [1._real32, 2._real32, 3._real32]), & 33 | 'arange, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(arange(1._real64, 3._real64) == [1._real64, 2._real64, 3._real64]), & 37 | 'arange, real32') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(arange(1._real128, 3._real128) == [1._real128, 2._real128, 3._real128]), & 41 | 'arange, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(arange(1._real128, 3._real128) == [1._real128, 2._real128, 3._real128]), & 45 | 'arange, real128') 46 | n = n + 1 47 | 48 | tests(n) = assert(all(arange(cmplx(1._real32, 0._real32), & 49 | cmplx(3._real32, 0._real32), & 50 | cmplx(1._real32, 0._real32))& 51 | == [cmplx(1._real32, 0._real32), & 52 | cmplx(2._real32, 0._real32), & 53 | cmplx(3._real32, 0._real32)]), & 54 | 'arange, complex real32') 55 | n = n + 1 56 | 57 | tests(n) = assert(all(arange(cmplx(1._real64, 0._real64), & 58 | cmplx(3._real64, 0._real64), & 59 | cmplx(1._real64, 0._real64))& 60 | == [cmplx(1._real64, 0._real64), & 61 | cmplx(2._real64, 0._real64), & 62 | cmplx(3._real64, 0._real64)]), & 63 | 'arange, complex real64') 64 | n = n + 1 65 | 66 | tests(n) = assert(all(arange(cmplx(1._real128, 0._real128), & 67 | cmplx(3._real128, 0._real128), & 68 | cmplx(1._real128, 0._real128))& 69 | == [cmplx(1._real128, 0._real128), & 70 | cmplx(2._real128, 0._real128), & 71 | cmplx(3._real128, 0._real128)]), & 72 | 'arange, complex real128') 73 | n = n + 1 74 | 75 | tests(n) = assert(all(arange(cmplx(1, 1), cmplx(3, 5), cmplx(1, 2))& 76 | == [cmplx(1, 1), cmplx(2, 3), cmplx(3, 5)]), & 77 | 'arange, incrementing both parts of complex numbers') 78 | n = n + 1 79 | 80 | tests(n) = assert(all(arange(1, 10) == arange(1, 10, 1)), & 81 | 'arange increment equals 1 when ommited') 82 | n = n + 1 83 | 84 | tests(n) = assert(all(arange(1., 10.) == real(arange(1, 10, 1))), & 85 | 'integer and real arange variants produce same values') 86 | n = n + 1 87 | 88 | tests(n) = assert(all(arange(0., 2.4, 0.8) == [0., 0.8, 1.6, 2.4]), & 89 | 'custom increment value') 90 | n = n + 1 91 | 92 | tests(n) = assert(all(arange(3, -1, -1) == [3, 2, 1, 0, -1]), & 93 | 'negative increment value') 94 | n = n + 1 95 | 96 | tests(n) = assert(size(arange(1.0, 1.4, 0.1)) == 5, & 97 | 'real32-typed arange returns array of expected size') 98 | n = n + 1 99 | 100 | tests(n) = assert(size(arange(1.0_real64, 1.4_real64, 0.1_real64)) == 5, & 101 | 'real64-typed arange returns array of expected size') 102 | n = n + 1 103 | 104 | tests(n) = assert(size(arange(1.0_real128, 1.4_real128, 0.1_real128)) == 5, & 105 | 'real128-typed arange returns array of expected size') 106 | n = n + 1 107 | 108 | test_failed = .false. 109 | call report_tests(tests, test_failed) 110 | if(test_failed)stop 1 111 | 112 | end program test_arange 113 | -------------------------------------------------------------------------------- /test/test_arrstr.f90: -------------------------------------------------------------------------------- 1 | program test_arrstr 2 | use testing, only:assert, initialize_tests, report_tests 3 | use functional, only:arrstr, empty 4 | 5 | implicit none 6 | 7 | logical, dimension(:), allocatable :: tests 8 | logical :: test_failed 9 | integer :: n, ntests 10 | 11 | n = 1 12 | ntests = 2 13 | call initialize_tests(tests, ntests) 14 | 15 | tests(n) = assert(arrstr(['h', 'e', 'l', 'l', 'o']) == 'hello', & 16 | 'arrstr converts to string') 17 | n = n + 1 18 | 19 | tests(n) = assert(arrstr(empty(' ')) == '', & 20 | 'arrstr converts empty array to ""') 21 | n = n + 1 22 | 23 | test_failed = .false. 24 | call report_tests(tests, test_failed) 25 | if(test_failed)stop 1 26 | 27 | end program test_arrstr 28 | -------------------------------------------------------------------------------- /test/test_complement.f90: -------------------------------------------------------------------------------- 1 | program test_complement 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 12 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(complement([1_int8, 2_int8], [2_int8]) == [1]), & 17 | 'complement, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(complement([1_int16, 2_int16], [2_int16]) == [1]), & 21 | 'complement, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(complement([1_int32, 2_int32], [2_int32]) == [1]), & 25 | 'complement, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(complement([1_int64, 2_int64], [2_int64]) == [1]), & 29 | 'complement, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(complement([1._real32, 2._real32], [2._real32]) == [1]), & 33 | 'complement, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(complement([1._real64, 2._real64], [2._real64]) == [1]), & 37 | 'complement, real64') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(complement([1._real128, 2._real128], [2._real128]) == [1]), & 41 | 'complement, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(complement([cmplx(1._real32, 0._real32), & 45 | cmplx(2._real32, 0._real32)], & 46 | [cmplx(2._real32, 0._real32)])& 47 | == [cmplx(1._real32, 0._real32)]), 'complement, complex real32') 48 | n = n + 1 49 | 50 | tests(n) = assert(all(complement([cmplx(1._real64, 0._real64), & 51 | cmplx(2._real64, 0._real64)], & 52 | [cmplx(2._real64, 0._real64)])& 53 | == [cmplx(1._real64, 0._real64)]), 'complement, complex real64') 54 | n = n + 1 55 | 56 | tests(n) = assert(all(complement([cmplx(1._real64, 0._real64), & 57 | cmplx(2._real64, 0._real64)], & 58 | [cmplx(2._real64, 0._real64)])& 59 | == [cmplx(1._real64, 0._real64)]), 'complement, complex real64') 60 | n = n + 1 61 | 62 | tests(n) = assert(complement('Hello', 'world') == 'He', & 63 | 'complement, character string') 64 | n = n + 1 65 | 66 | tests(n) = assert(all(complement([1, 2], [2]) == ([1, 2].complement.[2])), & 67 | 'complement operator, x.complement.y') 68 | n = n + 1 69 | 70 | test_failed = .false. 71 | call report_tests(tests, test_failed) 72 | if(test_failed)stop 1 73 | 74 | end program test_complement 75 | -------------------------------------------------------------------------------- /test/test_empty.f90: -------------------------------------------------------------------------------- 1 | program test_empty 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional, only:empty 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 10 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(size(empty(1_int8)) == 0, 'empty, int8') 17 | n = n + 1 18 | 19 | tests(n) = assert(size(empty(1_int16)) == 0, 'empty, int16') 20 | n = n + 1 21 | 22 | tests(n) = assert(size(empty(1_int32)) == 0, 'empty, int32') 23 | n = n + 1 24 | 25 | tests(n) = assert(size(empty(1_int64)) == 0, 'empty, int64') 26 | n = n + 1 27 | 28 | tests(n) = assert(size(empty(1._real32)) == 0, 'empty, real32') 29 | n = n + 1 30 | 31 | tests(n) = assert(size(empty(1._real64)) == 0, 'empty, real64') 32 | n = n + 1 33 | 34 | tests(n) = assert(size(empty(1._real128)) == 0, 'empty, real128') 35 | n = n + 1 36 | 37 | tests(n) = assert(size(empty(cmplx(1._real32, 0._real32))) == 0, 'empty, complex32') 38 | n = n + 1 39 | 40 | tests(n) = assert(size(empty(cmplx(1._real64, 0._real64))) == 0, 'empty, complex64') 41 | n = n + 1 42 | 43 | tests(n) = assert(size(empty(cmplx(1._real128, 0._real128))) == 0, 'empty, complex128') 44 | n = n + 1 45 | 46 | test_failed = .false. 47 | call report_tests(tests, test_failed) 48 | if(test_failed)stop 1 49 | 50 | end program test_empty 51 | -------------------------------------------------------------------------------- /test/test_filter.f90: -------------------------------------------------------------------------------- 1 | module mod_filter_functions 2 | 3 | implicit none 4 | 5 | public 6 | 7 | contains 8 | 9 | pure logical function gt3lt5_i1(x) result(res) 10 | use iso_fortran_env, only:int8 11 | integer(int8), intent(in) :: x 12 | res = x > 3 .and. x < 5 13 | end function gt3lt5_i1 14 | 15 | pure logical function gt3lt5_i2(x) result(res) 16 | use iso_fortran_env, only:int16 17 | integer(int16), intent(in) :: x 18 | res = x > 3 .and. x < 5 19 | end function gt3lt5_i2 20 | 21 | pure logical function gt3lt5_i4(x) result(res) 22 | use iso_fortran_env, only:int32 23 | integer(int32), intent(in) :: x 24 | res = x > 3 .and. x < 5 25 | end function gt3lt5_i4 26 | 27 | pure logical function gt3lt5_i8(x) result(res) 28 | use iso_fortran_env, only:int64 29 | integer(int64), intent(in) :: x 30 | res = x > 3 .and. x < 5 31 | end function gt3lt5_i8 32 | 33 | pure logical function gt3lt5_r4(x) result(res) 34 | use iso_fortran_env, only:real32 35 | real(real32), intent(in) :: x 36 | res = x > 3 .and. x < 5 37 | end function gt3lt5_r4 38 | 39 | pure logical function gt3lt5_r8(x) result(res) 40 | use iso_fortran_env, only:real64 41 | real(real64), intent(in) :: x 42 | res = x > 3 .and. x < 5 43 | end function gt3lt5_r8 44 | 45 | pure logical function gt3lt5_r16(x) result(res) 46 | use iso_fortran_env, only:real128 47 | real(real128), intent(in) :: x 48 | res = x > 3 .and. x < 5 49 | end function gt3lt5_r16 50 | 51 | pure logical function gt3lt5_c4(x) result(res) 52 | use iso_fortran_env, only:real32 53 | complex(real32), intent(in) :: x 54 | res = real(x) > 3 .and. real(x) < 5 55 | end function gt3lt5_c4 56 | 57 | pure logical function gt3lt5_c8(x) result(res) 58 | use iso_fortran_env, only:real64 59 | complex(real64), intent(in) :: x 60 | res = real(x) > 3 .and. real(x) < 5 61 | end function gt3lt5_c8 62 | 63 | pure logical function gt3lt5_c16(x) result(res) 64 | use iso_fortran_env, only:real128 65 | complex(real128), intent(in) :: x 66 | res = real(x) > 3 .and. real(x) < 5 67 | end function gt3lt5_c16 68 | 69 | end module mod_filter_functions 70 | 71 | program test_filter 72 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 73 | use testing, only:assert, initialize_tests, report_tests 74 | use functional 75 | use mod_filter_functions 76 | 77 | implicit none 78 | 79 | logical, dimension(:), allocatable :: tests 80 | logical :: test_failed 81 | integer :: n, ntests 82 | 83 | complex(real64), dimension(:), allocatable :: c8 84 | complex(real128), dimension(:), allocatable :: c16 85 | 86 | n = 1 87 | ntests = 11 88 | call initialize_tests(tests, ntests) 89 | 90 | tests(n) = assert(all(filter(gt3lt5_i1, [3_int8, 4_int8, 5_int8]) == [4]), & 91 | 'filter, int8') 92 | n = n + 1 93 | 94 | tests(n) = assert(all(filter(gt3lt5_i2, [3_int16, 4_int16, 5_int16]) == [4]), & 95 | 'filter, int16') 96 | n = n + 1 97 | 98 | tests(n) = assert(all(filter(gt3lt5_i4, [3, 4, 5]) == [4]), & 99 | 'filter, int32') 100 | n = n + 1 101 | 102 | tests(n) = assert(all(filter(gt3lt5_i8, [3_int64, 4_int64, 5_int64]) == [4]), & 103 | 'filter, int64') 104 | n = n + 1 105 | 106 | tests(n) = assert(all(filter(gt3lt5_r4, [3., 4., 5.]) == [4]), & 107 | 'filter, real32') 108 | n = n + 1 109 | 110 | tests(n) = assert(all(filter(gt3lt5_r8, [3._real64, 4._real64, 5._real64]) == [4]), & 111 | 'filter, real64') 112 | n = n + 1 113 | 114 | tests(n) = assert(all(filter(gt3lt5_r16, [3._real128, 4._real128, 5._real128]) == [4]), & 115 | 'filter, real128') 116 | n = n + 1 117 | 118 | tests(n) = assert(all(filter(gt3lt5_c4, & 119 | [cmplx(3., 0.), cmplx(4., 0.), cmplx(5., 0.)]) == [cmplx(4., 0.)]), & 120 | 'filter, complex real32') 121 | n = n + 1 122 | 123 | ! Need to assign to a variable first because cmplx() by default 124 | ! returns single-precision complex number which breaks the generic 125 | ! interface 126 | c8 = [cmplx(3._real64, 0._real64), & 127 | cmplx(4._real64, 0._real64), & 128 | cmplx(5._real64, 0._real64)] 129 | c16 = [cmplx(3._real128, 0._real128), & 130 | cmplx(4._real128, 0._real128), & 131 | cmplx(5._real128, 0._real128)] 132 | 133 | tests(n) = assert(all(filter(gt3lt5_c8, c8) == [cmplx(4., 0.)]), & 134 | 'filter, complex real64') 135 | n = n + 1 136 | 137 | tests(n) = assert(all(filter(gt3lt5_c16, c16) == [cmplx(4., 0.)]), & 138 | 'filter, complex real128') 139 | n = n + 1 140 | 141 | tests(n) = assert(size(filter(gt3lt5_i4, [1, 2, 3, 5, 6])) == 0, & 142 | 'filter returns empty array') 143 | n = n + 1 144 | 145 | test_failed = .false. 146 | call report_tests(tests, test_failed) 147 | if(test_failed)stop 1 148 | 149 | end program test_filter 150 | 151 | -------------------------------------------------------------------------------- /test/test_foldl.f90: -------------------------------------------------------------------------------- 1 | module mod_foldl_functions 2 | 3 | implicit none 4 | 5 | public 6 | 7 | contains 8 | 9 | pure integer(int8) function sum_i1(x, y) result(res) 10 | use iso_fortran_env, only:int8 11 | integer(int8), intent(in) :: x, y 12 | res = x + y 13 | end function sum_i1 14 | 15 | pure integer(int16) function sum_i2(x, y) result(res) 16 | use iso_fortran_env, only:int16 17 | integer(int16), intent(in) :: x, y 18 | res = x + y 19 | end function sum_i2 20 | 21 | pure integer(int32) function sum_i4(x, y) result(res) 22 | use iso_fortran_env, only:int32 23 | integer(int32), intent(in) :: x, y 24 | res = x + y 25 | end function sum_i4 26 | 27 | pure integer(int64) function sum_i8(x, y) result(res) 28 | use iso_fortran_env, only:int64 29 | integer(int64), intent(in) :: x, y 30 | res = x + y 31 | end function sum_i8 32 | 33 | pure real(real32) function sum_r4(x, y) result(res) 34 | use iso_fortran_env, only:real32 35 | real(real32), intent(in) :: x, y 36 | res = x + y 37 | end function sum_r4 38 | 39 | pure real(real64) function sum_r8(x, y) result(res) 40 | use iso_fortran_env, only:real64 41 | real(real64), intent(in) :: x, y 42 | res = x + y 43 | end function sum_r8 44 | 45 | pure real(real128) function sum_r16(x, y) result(res) 46 | use iso_fortran_env, only:real128 47 | real(real128), intent(in) :: x, y 48 | res = x + y 49 | end function sum_r16 50 | 51 | pure complex(real32) function sum_c4(x, y) result(res) 52 | use iso_fortran_env, only:real32 53 | complex(real32), intent(in) :: x, y 54 | res = x + y 55 | end function sum_c4 56 | 57 | pure complex(real64) function sum_c8(x, y) result(res) 58 | use iso_fortran_env, only:real64 59 | complex(real64), intent(in) :: x, y 60 | res = x + y 61 | end function sum_c8 62 | 63 | pure complex(real128) function sum_c16(x, y) result(res) 64 | use iso_fortran_env, only:real128 65 | complex(real128), intent(in) :: x, y 66 | res = x + y 67 | end function sum_c16 68 | 69 | end module mod_foldl_functions 70 | 71 | program test_foldl 72 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 73 | use testing, only:assert, initialize_tests, report_tests 74 | use functional 75 | use mod_foldl_functions 76 | 77 | implicit none 78 | 79 | logical, dimension(:), allocatable :: tests 80 | logical :: test_failed 81 | integer :: n, ntests 82 | 83 | complex(real32), dimension(:), allocatable :: c4 84 | complex(real64), dimension(:), allocatable :: c8 85 | complex(real128), dimension(:), allocatable :: c16 86 | complex(real64) :: c8_start 87 | complex(real128) :: c16_start 88 | 89 | n = 1 90 | ntests = 10 91 | call initialize_tests(tests, ntests) 92 | 93 | tests(n) = assert(foldl(sum_i1, 0_int8, [1_int8, 2_int8, 3_int8, 4_int8, 5_int8]) == 15, & 94 | 'foldl, int8') 95 | n = n + 1 96 | 97 | tests(n) = assert(foldl(sum_i2, 0_int16, [1_int16, 2_int16, 3_int16, 4_int16, 5_int16]) == 15, & 98 | 'foldl, int16') 99 | n = n + 1 100 | 101 | tests(n) = assert(foldl(sum_i4, 0_int32, [1_int32, 2_int32, 3_int32, 4_int32, 5_int32]) == 15, & 102 | 'foldl, int32') 103 | n = n + 1 104 | 105 | tests(n) = assert(foldl(sum_i8, 0_int64, [1_int64, 2_int64, 3_int64, 4_int64, 5_int64]) == 15, & 106 | 'foldl, int64') 107 | n = n + 1 108 | 109 | tests(n) = assert(foldl(sum_r4, 0._real32, [1._real32, 2._real32, 3._real32, 4._real32, 5._real32]) == 15, & 110 | 'foldl, real32') 111 | n = n + 1 112 | 113 | tests(n) = assert(foldl(sum_r8, 0._real64, [1._real64, 2._real64, 3._real64, 4._real64, 5._real64]) == 15, & 114 | 'foldl, real64') 115 | n = n + 1 116 | 117 | tests(n) = assert(foldl(sum_r16, 0._real128, [1._real128, 2._real128, 3._real128, 4._real128, 5._real128]) == 15, & 118 | 'foldl, real128') 119 | n = n + 1 120 | 121 | c4 = arange(cmplx(1, 0), cmplx(5, 0)) 122 | c8 = c4 123 | c16 = c4 124 | 125 | c8_start = cmplx(0, 0) 126 | c16_start = c8_start 127 | 128 | tests(n) = assert(foldl(sum_c4, cmplx(0., 0.), c4) == cmplx(15, 0), & 129 | 'foldl, complex real32') 130 | n = n + 1 131 | 132 | tests(n) = assert(foldl(sum_c8, c8_start, c8) == cmplx(15._real64, 0._real64), & 133 | 'foldl, complex real64') 134 | n = n + 1 135 | 136 | tests(n) = assert(foldl(sum_c16, c16_start, c16) == cmplx(15._real128, 0._real128), & 137 | 'foldl, complex real128') 138 | n = n + 1 139 | 140 | test_failed = .false. 141 | call report_tests(tests, test_failed) 142 | if(test_failed)stop 1 143 | 144 | end program test_foldl 145 | -------------------------------------------------------------------------------- /test/test_foldr.f90: -------------------------------------------------------------------------------- 1 | module mod_foldr_functions 2 | 3 | implicit none 4 | 5 | public 6 | 7 | contains 8 | 9 | pure integer(int8) function sum_i1(x, y) result(res) 10 | use iso_fortran_env, only:int8 11 | integer(int8), intent(in) :: x, y 12 | res = x + y 13 | end function sum_i1 14 | 15 | pure integer(int16) function sum_i2(x, y) result(res) 16 | use iso_fortran_env, only:int16 17 | integer(int16), intent(in) :: x, y 18 | res = x + y 19 | end function sum_i2 20 | 21 | pure integer(int32) function sum_i4(x, y) result(res) 22 | use iso_fortran_env, only:int32 23 | integer(int32), intent(in) :: x, y 24 | res = x + y 25 | end function sum_i4 26 | 27 | pure integer(int64) function sum_i8(x, y) result(res) 28 | use iso_fortran_env, only:int64 29 | integer(int64), intent(in) :: x, y 30 | res = x + y 31 | end function sum_i8 32 | 33 | pure real(real32) function sum_r4(x, y) result(res) 34 | use iso_fortran_env, only:real32 35 | real(real32), intent(in) :: x, y 36 | res = x + y 37 | end function sum_r4 38 | 39 | pure real(real64) function sum_r8(x, y) result(res) 40 | use iso_fortran_env, only:real64 41 | real(real64), intent(in) :: x, y 42 | res = x + y 43 | end function sum_r8 44 | 45 | pure real(real128) function sum_r16(x, y) result(res) 46 | use iso_fortran_env, only:real128 47 | real(real128), intent(in) :: x, y 48 | res = x + y 49 | end function sum_r16 50 | 51 | pure complex(real32) function sum_c4(x, y) result(res) 52 | use iso_fortran_env, only:real32 53 | complex(real32), intent(in) :: x, y 54 | res = x + y 55 | end function sum_c4 56 | 57 | pure complex(real64) function sum_c8(x, y) result(res) 58 | use iso_fortran_env, only:real64 59 | complex(real64), intent(in) :: x, y 60 | res = x + y 61 | end function sum_c8 62 | 63 | pure complex(real128) function sum_c16(x, y) result(res) 64 | use iso_fortran_env, only:real128 65 | complex(real128), intent(in) :: x, y 66 | res = x + y 67 | end function sum_c16 68 | 69 | end module mod_foldr_functions 70 | 71 | program test_foldr 72 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 73 | use testing, only:assert, initialize_tests, report_tests 74 | use functional 75 | use mod_foldr_functions 76 | 77 | implicit none 78 | 79 | logical, dimension(:), allocatable :: tests 80 | logical :: test_failed 81 | integer :: n, ntests 82 | 83 | complex(real32), dimension(:), allocatable :: c4 84 | complex(real64), dimension(:), allocatable :: c8 85 | complex(real128), dimension(:), allocatable :: c16 86 | complex(real64) :: c8_start 87 | complex(real128) :: c16_start 88 | 89 | n = 1 90 | ntests = 10 91 | call initialize_tests(tests, ntests) 92 | 93 | tests(n) = assert(foldr(sum_i1, 0_int8, [1_int8, 2_int8, 3_int8, 4_int8, 5_int8]) == 15, & 94 | 'foldr, int8') 95 | n = n + 1 96 | 97 | tests(n) = assert(foldr(sum_i2, 0_int16, [1_int16, 2_int16, 3_int16, 4_int16, 5_int16]) == 15, & 98 | 'foldr, int16') 99 | n = n + 1 100 | 101 | tests(n) = assert(foldr(sum_i4, 0_int32, [1_int32, 2_int32, 3_int32, 4_int32, 5_int32]) == 15, & 102 | 'foldr, int32') 103 | n = n + 1 104 | 105 | tests(n) = assert(foldr(sum_i8, 0_int64, [1_int64, 2_int64, 3_int64, 4_int64, 5_int64]) == 15, & 106 | 'foldr, int64') 107 | n = n + 1 108 | 109 | tests(n) = assert(foldr(sum_r4, 0._real32, [1._real32, 2._real32, 3._real32, 4._real32, 5._real32]) == 15, & 110 | 'foldr, real32') 111 | n = n + 1 112 | 113 | tests(n) = assert(foldr(sum_r8, 0._real64, [1._real64, 2._real64, 3._real64, 4._real64, 5._real64]) == 15, & 114 | 'foldr, real64') 115 | n = n + 1 116 | 117 | tests(n) = assert(foldr(sum_r16, 0._real128, [1._real128, 2._real128, 3._real128, 4._real128, 5._real128]) == 15, & 118 | 'foldr, real128') 119 | n = n + 1 120 | 121 | c4 = arange(cmplx(1, 0), cmplx(5, 0)) 122 | c8 = c4 123 | c16 = c4 124 | 125 | c8_start = cmplx(0, 0) 126 | c16_start = c8_start 127 | 128 | tests(n) = assert(foldr(sum_c4, cmplx(0., 0.), c4) == cmplx(15, 0), & 129 | 'foldr, complex real32') 130 | n = n + 1 131 | 132 | tests(n) = assert(foldr(sum_c8, c8_start, c8) == cmplx(15._real64, 0._real64), & 133 | 'foldr, complex real64') 134 | n = n + 1 135 | 136 | tests(n) = assert(foldr(sum_c16, c16_start, c16) == cmplx(15._real128, 0._real128), & 137 | 'foldr, complex real128') 138 | n = n + 1 139 | 140 | test_failed = .false. 141 | call report_tests(tests, test_failed) 142 | if(test_failed)stop 1 143 | 144 | end program test_foldr 145 | -------------------------------------------------------------------------------- /test/test_foldt.f90: -------------------------------------------------------------------------------- 1 | module mod_foldt_functions 2 | 3 | implicit none 4 | 5 | public 6 | 7 | contains 8 | 9 | pure integer(int8) function sum_i1(x, y) result(res) 10 | use iso_fortran_env, only:int8 11 | integer(int8), intent(in) :: x, y 12 | res = x + y 13 | end function sum_i1 14 | 15 | pure integer(int16) function sum_i2(x, y) result(res) 16 | use iso_fortran_env, only:int16 17 | integer(int16), intent(in) :: x, y 18 | res = x + y 19 | end function sum_i2 20 | 21 | pure integer(int32) function sum_i4(x, y) result(res) 22 | use iso_fortran_env, only:int32 23 | integer(int32), intent(in) :: x, y 24 | res = x + y 25 | end function sum_i4 26 | 27 | pure integer(int64) function sum_i8(x, y) result(res) 28 | use iso_fortran_env, only:int64 29 | integer(int64), intent(in) :: x, y 30 | res = x + y 31 | end function sum_i8 32 | 33 | pure real(real32) function sum_r4(x, y) result(res) 34 | use iso_fortran_env, only:real32 35 | real(real32), intent(in) :: x, y 36 | res = x + y 37 | end function sum_r4 38 | 39 | pure real(real64) function sum_r8(x, y) result(res) 40 | use iso_fortran_env, only:real64 41 | real(real64), intent(in) :: x, y 42 | res = x + y 43 | end function sum_r8 44 | 45 | pure real(real128) function sum_r16(x, y) result(res) 46 | use iso_fortran_env, only:real128 47 | real(real128), intent(in) :: x, y 48 | res = x + y 49 | end function sum_r16 50 | 51 | pure complex(real32) function sum_c4(x, y) result(res) 52 | use iso_fortran_env, only:real32 53 | complex(real32), intent(in) :: x, y 54 | res = x + y 55 | end function sum_c4 56 | 57 | pure complex(real64) function sum_c8(x, y) result(res) 58 | use iso_fortran_env, only:real64 59 | complex(real64), intent(in) :: x, y 60 | res = x + y 61 | end function sum_c8 62 | 63 | pure complex(real128) function sum_c16(x, y) result(res) 64 | use iso_fortran_env, only:real128 65 | complex(real128), intent(in) :: x, y 66 | res = x + y 67 | end function sum_c16 68 | 69 | end module mod_foldt_functions 70 | 71 | program test_foldt 72 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 73 | use testing, only:assert, initialize_tests, report_tests 74 | use functional 75 | use mod_foldt_functions 76 | 77 | implicit none 78 | 79 | logical, dimension(:), allocatable :: tests 80 | logical :: test_failed 81 | integer :: n, ntests 82 | 83 | complex(real32), dimension(:), allocatable :: c4 84 | complex(real64), dimension(:), allocatable :: c8 85 | complex(real128), dimension(:), allocatable :: c16 86 | complex(real64) :: c8_start 87 | complex(real128) :: c16_start 88 | 89 | n = 1 90 | ntests = 10 91 | call initialize_tests(tests, ntests) 92 | 93 | tests(n) = assert(foldt(sum_i1, 0_int8, [1_int8, 2_int8, 3_int8, 4_int8, 5_int8]) == 15, & 94 | 'foldt, int8') 95 | n = n + 1 96 | 97 | tests(n) = assert(foldt(sum_i2, 0_int16, [1_int16, 2_int16, 3_int16, 4_int16, 5_int16]) == 15, & 98 | 'foldt, int16') 99 | n = n + 1 100 | 101 | tests(n) = assert(foldt(sum_i4, 0_int32, [1_int32, 2_int32, 3_int32, 4_int32, 5_int32]) == 15, & 102 | 'foldt, int32') 103 | n = n + 1 104 | 105 | tests(n) = assert(foldt(sum_i8, 0_int64, [1_int64, 2_int64, 3_int64, 4_int64, 5_int64]) == 15, & 106 | 'foldt, int64') 107 | n = n + 1 108 | 109 | tests(n) = assert(foldt(sum_r4, 0._real32, [1._real32, 2._real32, 3._real32, 4._real32, 5._real32]) == 15, & 110 | 'foldt, real32') 111 | n = n + 1 112 | 113 | tests(n) = assert(foldt(sum_r8, 0._real64, [1._real64, 2._real64, 3._real64, 4._real64, 5._real64]) == 15, & 114 | 'foldt, real64') 115 | n = n + 1 116 | 117 | tests(n) = assert(foldt(sum_r16, 0._real128, [1._real128, 2._real128, 3._real128, 4._real128, 5._real128]) == 15, & 118 | 'foldt, real128') 119 | n = n + 1 120 | 121 | c4 = arange(cmplx(1, 0), cmplx(5, 0)) 122 | c8 = c4 123 | c16 = c4 124 | 125 | c8_start = cmplx(0, 0) 126 | c16_start = c8_start 127 | 128 | tests(n) = assert(foldt(sum_c4, cmplx(0., 0.), c4) == cmplx(15, 0), & 129 | 'foldt, complex real32') 130 | n = n + 1 131 | 132 | tests(n) = assert(foldt(sum_c8, c8_start, c8) == cmplx(15._real64, 0._real64), & 133 | 'foldt, complex real64') 134 | n = n + 1 135 | 136 | tests(n) = assert(foldt(sum_c16, c16_start, c16) == cmplx(15._real128, 0._real128), & 137 | 'foldt, complex real128') 138 | n = n + 1 139 | 140 | test_failed = .false. 141 | call report_tests(tests, test_failed) 142 | if(test_failed)stop 1 143 | 144 | end program test_foldt 145 | -------------------------------------------------------------------------------- /test/test_head.f90: -------------------------------------------------------------------------------- 1 | program test_head 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | complex(real32), dimension(:), allocatable :: c_r4 13 | complex(real64), dimension(:), allocatable :: c_r8 14 | complex(real128), dimension(:), allocatable :: c_r16 15 | 16 | c_r4 = [(1, 2), (2, 4)] 17 | c_r8 = c_r4 18 | c_r16 = c_r4 19 | 20 | n = 1 21 | ntests = 12 22 | call initialize_tests(tests, ntests) 23 | 24 | tests(n) = assert(head([1_int8, 2_int8]) == 1_int8, 'head, int8') 25 | n = n + 1 26 | 27 | tests(n) = assert(head([1_int16, 2_int16]) == 1_int16, 'head, int16') 28 | n = n + 1 29 | 30 | tests(n) = assert(head([1_int32, 2_int32]) == 1_int32, 'head, int32') 31 | n = n + 1 32 | 33 | tests(n) = assert(head([1_int64, 2_int64]) == 1_int64, 'head, int64') 34 | n = n + 1 35 | 36 | tests(n) = assert(head([1._real32, 2._real32]) == 1._real32, 'head, real32') 37 | n = n + 1 38 | 39 | tests(n) = assert(head([1._real64, 2._real64]) == 1._real64, 'head, real64') 40 | n = n + 1 41 | 42 | tests(n) = assert(head([1._real128, 2._real128]) == 1._real128, 'head, real128') 43 | n = n + 1 44 | 45 | tests(n) = assert(head(c_r4) == c_r4(1), 'head, complex real32') 46 | n = n + 1 47 | 48 | tests(n) = assert(head(c_r8) == c_r8(1), 'head, complex real64') 49 | n = n + 1 50 | 51 | tests(n) = assert(head(c_r16) == c_r16(1), 'head, complex real128') 52 | n = n + 1 53 | 54 | tests(n) = assert(head('Hello') == 'H', 'head, character string') 55 | n = n + 1 56 | 57 | tests(n) = assert(head([1, 2]) == .head.[1, 2], 'head operator, .head.x') 58 | n = n + 1 59 | 60 | test_failed = .false. 61 | call report_tests(tests, test_failed) 62 | if(test_failed)stop 1 63 | 64 | end program test_head 65 | -------------------------------------------------------------------------------- /test/test_init.f90: -------------------------------------------------------------------------------- 1 | program test_init 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | complex(real32), dimension(:), allocatable :: c_r4 13 | complex(real64), dimension(:), allocatable :: c_r8 14 | complex(real128), dimension(:), allocatable :: c_r16 15 | 16 | c_r4 = [(1, 2), (2, 4)] 17 | c_r8 = c_r4 18 | c_r16 = c_r4 19 | 20 | n = 1 21 | ntests = 14 22 | call initialize_tests(tests, ntests) 23 | 24 | tests(n) = assert(all(init([1_int8, 2_int8]) == [1_int8]), 'init, int8') 25 | n = n + 1 26 | 27 | tests(n) = assert(all(init([1_int16, 2_int16]) == [1_int16]), 'init, int16') 28 | n = n + 1 29 | 30 | tests(n) = assert(all(init([1_int32, 2_int32]) == [1_int32]), 'init, int32') 31 | n = n + 1 32 | 33 | tests(n) = assert(all(init([1_int64, 2_int64]) == [1_int64]), 'init, int64') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(init([1._real32, 2._real32]) == [1._real32]), 'init, real32') 37 | n = n + 1 38 | 39 | tests(n) = assert(all(init([1._real64, 2._real64]) == [1._real64]), 'init, real64') 40 | n = n + 1 41 | 42 | tests(n) = assert(all(init([1._real128, 2._real128]) == [1._real128]), 'init, real128') 43 | n = n + 1 44 | 45 | tests(n) = assert(all(init(c_r4) == [c_r4(1)]), 'init, complex real32') 46 | n = n + 1 47 | 48 | tests(n) = assert(all(init(c_r8) == [c_r8(1)]), 'init, complex real64') 49 | n = n + 1 50 | 51 | tests(n) = assert(all(init(c_r16) == [c_r16(1)]), 'init, complex real128') 52 | n = n + 1 53 | 54 | tests(n) = assert(init('Hello') == 'Hell', 'init, character string') 55 | n = n + 1 56 | 57 | tests(n) = assert(size(init([1])) == 0, 'size(init([1])) == 0') 58 | n = n + 1 59 | 60 | tests(n) = assert(size(init(init([1]))) == 0, 'size(init(init([1]))) == 0') 61 | n = n + 1 62 | 63 | tests(n) = assert(all(init([1, 2]) == .init.[1, 2]), 'init operator, .init.x') 64 | n = n + 1 65 | 66 | test_failed = .false. 67 | call report_tests(tests, test_failed) 68 | if(test_failed)stop 1 69 | 70 | end program test_init 71 | -------------------------------------------------------------------------------- /test/test_insert.f90: -------------------------------------------------------------------------------- 1 | program test_insert 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 13 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(insert(2_int8, 2, [1_int8, 3_int8]) == [1, 2, 3]), & 17 | 'insert, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(insert(2_int16, 2, [1_int16, 3_int16]) == [1, 2, 3]), & 21 | 'insert, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(insert(2_int32, 2, [1_int32, 3_int32]) == [1, 2, 3]), & 25 | 'insert, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(insert(2_int64, 2, [1_int64, 3_int64]) == [1, 2, 3]), & 29 | 'insert, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(insert(2._real32, 2, [1._real32, 3._real32]) == [1, 2, 3]), & 33 | 'insert, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(insert(2._real64, 2, [1._real64, 3._real64]) == [1, 2, 3]), & 37 | 'insert, real64') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(insert(2._real128, 2, [1._real128, 3._real128]) == [1, 2, 3]), & 41 | 'insert, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(insert(cmplx(2._real32, 0._real32), 2, & 45 | [cmplx(1._real32, 0._real32), cmplx(3._real32, 0._real32)])& 46 | == arange(cmplx(1._real32, 0._real32), cmplx(3._real32, 0._real32))), & 47 | 'insert, real32') 48 | n = n + 1 49 | 50 | tests(n) = assert(all(insert(cmplx(2._real64, 0._real64), 2, & 51 | [cmplx(1._real64, 0._real64), cmplx(3._real64, 0._real64)])& 52 | == arange(cmplx(1._real64, 0._real64), cmplx(3._real64, 0._real64))), & 53 | 'insert, real64') 54 | n = n + 1 55 | 56 | tests(n) = assert(all(insert(cmplx(2._real128, 0._real128), 2, & 57 | [cmplx(1._real128, 0._real128), cmplx(3._real128, 0._real128)])& 58 | == arange(cmplx(1._real128, 0._real128), cmplx(3._real128, 0._real128))), & 59 | 'insert, real128') 60 | n = n + 1 61 | 62 | tests(n) = assert(insert('ell', 2, 'Ho') == 'Hello', & 63 | 'insert character string') 64 | n = n + 1 65 | 66 | tests(n) = assert(all(insert(1, 1, arange(1, 0)) == [1]), & 67 | 'insert into empty array') 68 | n = n + 1 69 | 70 | tests(n) = assert(all(insert(2, 2, [1]) == [1, 2]), & 71 | 'insert out of bounds') 72 | n = n + 1 73 | 74 | test_failed = .false. 75 | call report_tests(tests, test_failed) 76 | if(test_failed)stop 1 77 | 78 | end program test_insert 79 | -------------------------------------------------------------------------------- /test/test_intersection.f90: -------------------------------------------------------------------------------- 1 | program test_intersection 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 12 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(intersection([1_int8, 2_int8], [2_int8, 3_int8]) == [2]), & 17 | 'intersection, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(intersection([1_int16, 2_int16], [2_int16, 3_int16]) == [2]), & 21 | 'intersection, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(intersection([1_int32, 2_int32], [2_int32, 3_int32]) == [2]), & 25 | 'intersection, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(intersection([1_int64, 2_int64], [2_int64, 3_int64]) == [2]), & 29 | 'intersection, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(intersection([1._real32, 2._real32], [2._real32, 3._real32]) == [2]), & 33 | 'intersection, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(intersection([1._real64, 2._real64], [2._real64, 3._real64]) == [2]), & 37 | 'intersection, real64') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(intersection([1._real128, 2._real128], [2._real128, 3._real128]) == [2]), & 41 | 'intersection, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(intersection([cmplx(1._real32, 0._real32), cmplx(2._real32, 0._real32)], & 45 | [cmplx(2._real32, 0._real32), cmplx(3._real32, 0._real32)])& 46 | == [cmplx(2._real32, 0._real32)]), & 47 | 'intersection, complex real32') 48 | n = n + 1 49 | 50 | tests(n) = assert(all(intersection([cmplx(1._real64, 0._real64), cmplx(2._real64, 0._real64)], & 51 | [cmplx(2._real64, 0._real64), cmplx(3._real64, 0._real64)])& 52 | == [cmplx(2._real64, 0._real64)]), & 53 | 'intersection, complex real64') 54 | n = n + 1 55 | 56 | tests(n) = assert(all(intersection([cmplx(1._real128, 0._real128), cmplx(2._real128, 0._real128)], & 57 | [cmplx(2._real128, 0._real128), cmplx(3._real128, 0._real128)])& 58 | == [cmplx(2._real128, 0._real128)]), & 59 | 'intersection, complex real128') 60 | n = n + 1 61 | 62 | tests(n) = assert(intersection('Hello', 'world') == 'lo', & 63 | 'intersection, character string') 64 | n = n + 1 65 | 66 | test_failed = .false. 67 | 68 | tests(n) = assert(all(intersection([1, 2], [2, 3]) == ([1, 2].intersection.[2, 3])), & 69 | 'intersection operator, x.intersection.y') 70 | n = n + 1 71 | 72 | test_failed = .false. 73 | call report_tests(tests, test_failed) 74 | if(test_failed)stop 1 75 | 76 | end program test_intersection 77 | -------------------------------------------------------------------------------- /test/test_iterfold.f90: -------------------------------------------------------------------------------- 1 | module mod_iterfold_functions 2 | 3 | implicit none 4 | 5 | public 6 | 7 | contains 8 | 9 | pure integer(int8) function sum_i1(x, y) result(res) 10 | use iso_fortran_env, only:int8 11 | integer(int8), intent(in) :: x, y 12 | res = x + y 13 | end function sum_i1 14 | 15 | pure integer(int16) function sum_i2(x, y) result(res) 16 | use iso_fortran_env, only:int16 17 | integer(int16), intent(in) :: x, y 18 | res = x + y 19 | end function sum_i2 20 | 21 | pure integer(int32) function sum_i4(x, y) result(res) 22 | use iso_fortran_env, only:int32 23 | integer(int32), intent(in) :: x, y 24 | res = x + y 25 | end function sum_i4 26 | 27 | pure integer(int64) function sum_i8(x, y) result(res) 28 | use iso_fortran_env, only:int64 29 | integer(int64), intent(in) :: x, y 30 | res = x + y 31 | end function sum_i8 32 | 33 | pure real(real32) function sum_r4(x, y) result(res) 34 | use iso_fortran_env, only:real32 35 | real(real32), intent(in) :: x, y 36 | res = x + y 37 | end function sum_r4 38 | 39 | pure real(real64) function sum_r8(x, y) result(res) 40 | use iso_fortran_env, only:real64 41 | real(real64), intent(in) :: x, y 42 | res = x + y 43 | end function sum_r8 44 | 45 | pure real(real128) function sum_r16(x, y) result(res) 46 | use iso_fortran_env, only:real128 47 | real(real128), intent(in) :: x, y 48 | res = x + y 49 | end function sum_r16 50 | 51 | pure complex(real32) function sum_c4(x, y) result(res) 52 | use iso_fortran_env, only:real32 53 | complex(real32), intent(in) :: x, y 54 | res = x + y 55 | end function sum_c4 56 | 57 | pure complex(real64) function sum_c8(x, y) result(res) 58 | use iso_fortran_env, only:real64 59 | complex(real64), intent(in) :: x, y 60 | res = x + y 61 | end function sum_c8 62 | 63 | pure complex(real128) function sum_c16(x, y) result(res) 64 | use iso_fortran_env, only:real128 65 | complex(real128), intent(in) :: x, y 66 | res = x + y 67 | end function sum_c16 68 | 69 | end module mod_iterfold_functions 70 | 71 | program test_iterfold 72 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 73 | use testing, only:assert, initialize_tests, report_tests 74 | use functional 75 | use mod_iterfold_functions 76 | 77 | implicit none 78 | 79 | logical, dimension(:), allocatable :: tests 80 | logical :: test_failed 81 | integer :: n, ntests 82 | 83 | complex(real32), dimension(:), allocatable :: c4 84 | complex(real64), dimension(:), allocatable :: c8 85 | complex(real128), dimension(:), allocatable :: c16 86 | complex(real64) :: c8_start 87 | complex(real128) :: c16_start 88 | 89 | n = 1 90 | ntests = 10 91 | call initialize_tests(tests, ntests) 92 | 93 | tests(n) = assert(iterfold(sum_i1, 0_int8, [1_int8, 2_int8, 3_int8, 4_int8, 5_int8]) == 15, & 94 | 'iterfold, int8') 95 | n = n + 1 96 | 97 | tests(n) = assert(iterfold(sum_i2, 0_int16, [1_int16, 2_int16, 3_int16, 4_int16, 5_int16]) == 15, & 98 | 'iterfold, int16') 99 | n = n + 1 100 | 101 | tests(n) = assert(iterfold(sum_i4, 0_int32, [1_int32, 2_int32, 3_int32, 4_int32, 5_int32]) == 15, & 102 | 'iterfold, int32') 103 | n = n + 1 104 | 105 | tests(n) = assert(iterfold(sum_i8, 0_int64, [1_int64, 2_int64, 3_int64, 4_int64, 5_int64]) == 15, & 106 | 'iterfold, int64') 107 | n = n + 1 108 | 109 | tests(n) = assert(iterfold(sum_r4, 0._real32, [1._real32, 2._real32, 3._real32, 4._real32, 5._real32]) == 15, & 110 | 'iterfold, real32') 111 | n = n + 1 112 | 113 | tests(n) = assert(iterfold(sum_r8, 0._real64, [1._real64, 2._real64, 3._real64, 4._real64, 5._real64]) == 15, & 114 | 'iterfold, real64') 115 | n = n + 1 116 | 117 | tests(n) = assert(iterfold(sum_r16, 0._real128, [1._real128, 2._real128, 3._real128, 4._real128, 5._real128]) == 15, & 118 | 'iterfold, real128') 119 | n = n + 1 120 | 121 | c4 = arange(cmplx(1, 0), cmplx(5, 0)) 122 | c8 = c4 123 | c16 = c4 124 | 125 | c8_start = cmplx(0, 0) 126 | c16_start = c8_start 127 | 128 | tests(n) = assert(iterfold(sum_c4, cmplx(0., 0.), c4) == cmplx(15, 0), & 129 | 'iterfold, complex real32') 130 | n = n + 1 131 | 132 | tests(n) = assert(iterfold(sum_c8, c8_start, c8) == cmplx(15._real64, 0._real64), & 133 | 'iterfold, complex real64') 134 | n = n + 1 135 | 136 | tests(n) = assert(iterfold(sum_c16, c16_start, c16) == cmplx(15._real128, 0._real128), & 137 | 'iterfold, complex real128') 138 | n = n + 1 139 | 140 | test_failed = .false. 141 | call report_tests(tests, test_failed) 142 | if(test_failed)stop 1 143 | 144 | end program test_iterfold 145 | -------------------------------------------------------------------------------- /test/test_last.f90: -------------------------------------------------------------------------------- 1 | program test_last 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | complex(real32), dimension(:), allocatable :: c_r4 13 | complex(real64), dimension(:), allocatable :: c_r8 14 | complex(real128), dimension(:), allocatable :: c_r16 15 | 16 | c_r4 = [(1, 2), (2, 4)] 17 | c_r8 = c_r4 18 | c_r16 = c_r4 19 | 20 | n = 1 21 | ntests = 12 22 | call initialize_tests(tests, ntests) 23 | 24 | tests(n) = assert(last([1_int8, 2_int8]) == 2_int8, 'last, int8') 25 | n = n + 1 26 | 27 | tests(n) = assert(last([1_int16, 2_int16]) == 2_int16, 'last, int16') 28 | n = n + 1 29 | 30 | tests(n) = assert(last([1_int32, 2_int32]) == 2_int32, 'last, int32') 31 | n = n + 1 32 | 33 | tests(n) = assert(last([1_int64, 2_int64]) == 2_int64, 'last, int64') 34 | n = n + 1 35 | 36 | tests(n) = assert(last([1._real32, 2._real32]) == 2._real32, 'last, real32') 37 | n = n + 1 38 | 39 | tests(n) = assert(last([1._real64, 2._real64]) == 2._real64, 'last, real64') 40 | n = n + 1 41 | 42 | tests(n) = assert(last([1._real128, 2._real128]) == 2._real128, 'last, real128') 43 | n = n + 1 44 | 45 | tests(n) = assert(last(c_r4) == c_r4(2), 'last, complex real32') 46 | n = n + 1 47 | 48 | tests(n) = assert(last(c_r8) == c_r8(2), 'last, complex real64') 49 | n = n + 1 50 | 51 | tests(n) = assert(last(c_r16) == c_r16(2), 'last, complex real128') 52 | n = n + 1 53 | 54 | tests(n) = assert(last('Hello') == 'o', 'last, character string') 55 | n = n + 1 56 | 57 | tests(n) = assert(last([1, 2]) == .last.[1, 2], 'last operator, .last.x') 58 | n = n + 1 59 | 60 | test_failed = .false. 61 | call report_tests(tests, test_failed) 62 | if(test_failed)stop 1 63 | 64 | end program test_last 65 | -------------------------------------------------------------------------------- /test/test_limit.f90: -------------------------------------------------------------------------------- 1 | program test_limit 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional, only:limit, arange 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 11 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(limit(2_int8, 1_int8, 3_int8) == 2_int8, & 17 | 'limit, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(limit(2_int16, 1_int16, 3_int16) == 2_int16, & 21 | 'limit, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(limit(2_int32, 1_int32, 3_int32) == 2_int32, & 25 | 'limit, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(limit(2_int64, 1_int64, 3_int64) == 2_int64, & 29 | 'limit, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(limit(2._real32, 1._real32, 3._real32) == 2._real32, & 33 | 'limit, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(limit(2._real64, 1._real64, 3._real64) == 2._real64, & 37 | 'limit, real32') 38 | n = n + 1 39 | 40 | tests(n) = assert(limit(2._real128, 1._real128, 3._real128) == 2._real128, & 41 | 'limit, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(limit(cmplx(-0.5, 1.5), cmplx(0, 0), cmplx(1, 1)) == cmplx(0, 1), & 45 | 'limit, complex real32') 46 | n = n + 1 47 | 48 | tests(n) = assert(limit(cmplx(-0.5_real64, 1.5_real64), cmplx(0._real64, 0._real64), & 49 | cmplx(1._real64, 1._real64)) == cmplx(0._real64, 1._real64), & 50 | 'limit, complex real64') 51 | n = n + 1 52 | 53 | tests(n) = assert(limit(cmplx(-0.5_real128, 1.5_real128), cmplx(0._real128, 0._real128), & 54 | cmplx(1._real128, 1._real128)) == cmplx(0._real128, 1._real128), & 55 | 'limit, complex real128') 56 | n = n + 1 57 | 58 | tests(n) = assert(all(limit(arange(1, 3), 2, 2) == [2, 2, 2]), & 59 | 'limit works on arrays') 60 | n = n + 1 61 | 62 | test_failed = .false. 63 | call report_tests(tests, test_failed) 64 | if(test_failed)stop 1 65 | 66 | end program test_limit 67 | -------------------------------------------------------------------------------- /test/test_map.f90: -------------------------------------------------------------------------------- 1 | module mod_map_functions 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | 4 | implicit none 5 | 6 | public 7 | 8 | contains 9 | 10 | pure integer(int8) function xpowx_i1(x) result(res) 11 | integer(int8), intent(in) :: x 12 | res = x**x 13 | end function xpowx_i1 14 | 15 | pure integer(int16) function xpowx_i2(x) result(res) 16 | integer(int16), intent(in) :: x 17 | res = x**x 18 | end function xpowx_i2 19 | 20 | pure integer(int32) function xpowx_i4(x) result(res) 21 | integer(int32), intent(in) :: x 22 | res = x**x 23 | end function xpowx_i4 24 | 25 | pure integer(int64) function xpowx_i8(x) result(res) 26 | integer(int64), intent(in) :: x 27 | res = x**x 28 | end function xpowx_i8 29 | 30 | pure real(real32) function xpowx_r4(x) result(res) 31 | real(real32), intent(in) :: x 32 | res = x**x 33 | end function xpowx_r4 34 | 35 | pure real(real64) function xpowx_r8(x) result(res) 36 | real(real64), intent(in) :: x 37 | res = x**x 38 | end function xpowx_r8 39 | 40 | pure real(real128) function xpowx_r16(x) result(res) 41 | real(real128), intent(in) :: x 42 | res = x**x 43 | end function xpowx_r16 44 | 45 | pure complex(real32) function xpowx_c4(x) result(res) 46 | complex(real32), intent(in) :: x 47 | res = x**x 48 | end function xpowx_c4 49 | 50 | pure complex(real64) function xpowx_c8(x) result(res) 51 | complex(real64), intent(in) :: x 52 | res = x**x 53 | end function xpowx_c8 54 | 55 | pure complex(real128) function xpowx_c16(x) result(res) 56 | complex(real128), intent(in) :: x 57 | res = x**x 58 | end function xpowx_c16 59 | 60 | end module mod_map_functions 61 | 62 | program test_map 63 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128, compiler_version, compiler_options 64 | use testing, only:assert, initialize_tests, report_tests 65 | use functional 66 | use mod_map_functions 67 | 68 | implicit none 69 | 70 | logical, dimension(:), allocatable :: tests 71 | logical :: test_failed 72 | integer :: n, ntests 73 | 74 | complex(real32), dimension(:), allocatable :: c4 75 | complex(real64), dimension(:), allocatable :: c8 76 | complex(real128), dimension(:), allocatable :: c16 77 | 78 | character(len=100) :: s_compiler_version 79 | logical :: compiler_has_O3 80 | complex(real32), dimension(:), allocatable :: c4res 81 | logical :: c4rescheck 82 | 83 | n = 1 84 | ntests = 10 85 | call initialize_tests(tests, ntests) 86 | 87 | tests(n) = assert(all(map(xpowx_i1, [1_int8, 2_int8, 3_int8])& 88 | == [1_int8, 4_int8, 27_int8]), 'map, int8') 89 | n = n + 1 90 | 91 | tests(n) = assert(all(map(xpowx_i2, [1_int16, 2_int16, 3_int16])& 92 | == [1_int16, 4_int16, 27_int16]), 'map, int16') 93 | n = n + 1 94 | 95 | tests(n) = assert(all(map(xpowx_i4, [1_int32, 2_int32, 3_int32])& 96 | == [1_int32, 4_int32, 27_int32]), 'map, int32') 97 | n = n + 1 98 | 99 | tests(n) = assert(all(map(xpowx_i8, [1_int64, 2_int64, 3_int64])& 100 | == [1_int64, 4_int64, 27_int64]), 'map, int64') 101 | n = n + 1 102 | 103 | tests(n) = assert(all(map(xpowx_r4, [1._real32, 2._real32, 3._real32])& 104 | == [1._real32, 4._real32, 27._real32]), 'map, real32') 105 | n = n + 1 106 | 107 | tests(n) = assert(all(map(xpowx_r8, [1._real64, 2._real64, 3._real64])& 108 | == [1._real64, 4._real64, 27._real64]), 'map, real64') 109 | n = n + 1 110 | 111 | tests(n) = assert(all(map(xpowx_r16, [1._real128, 2._real128, 3._real128])& 112 | == [1._real128, 4._real128, 27._real128]), 'map, real128') 113 | n = n + 1 114 | 115 | c4 = [cmplx(1., 0.), cmplx(2., 0.), cmplx(3., 0.)] 116 | c8 = [cmplx(1._real64, 0._real64), & 117 | cmplx(2._real64, 0._real64), & 118 | cmplx(3._real64, 0._real64)] 119 | c16 = [cmplx(1._real128, 0._real128), & 120 | cmplx(2._real128, 0._real128), & 121 | cmplx(3._real128, 0._real128)] 122 | 123 | ! Special case for gfortran-10 with -O3 if detected 124 | c4rescheck = all(map(xpowx_c4, c4) == c4**c4) ! the default 125 | s_compiler_version = compiler_version() ! e.g., `GCC version {major}.{minor}.{patch}` 126 | compiler_has_O3 = index(compiler_options(), '-O3') /= 0 127 | if ( & 128 | s_compiler_version(1:3) == 'GCC' & 129 | .and. s_compiler_version(13:14) == '10' & 130 | .and. compiler_has_O3 & 131 | ) then 132 | print *, 'using special check for gfortran-10 -O3 for complex real32' 133 | ! Note: `x = map(xpowx_c4, c4) == c4**c4` is T T F (via `print *, x`) even though `map(xpowx_c4, c4) == c4**c4` is T T T 134 | c4res = map(xpowx_c4, c4) 135 | c4rescheck = all(c4res == c4**c4) ! by assigning `c4res` first we are able to get T T T in the comparison 136 | end if 137 | tests(n) = assert(c4rescheck, 'map, complex real32') 138 | n = n + 1 139 | 140 | tests(n) = assert(all(map(xpowx_c8, c8) == c8**c8), 'map, complex real64') 141 | n = n + 1 142 | 143 | tests(n) = assert(all(map(xpowx_c16, c16) == c16**c16), 'map, complex real128') 144 | n = n + 1 145 | 146 | test_failed = .false. 147 | call report_tests(tests, test_failed) 148 | if(test_failed)stop 1 149 | 150 | end program test_map 151 | 152 | -------------------------------------------------------------------------------- /test/test_reverse.f90: -------------------------------------------------------------------------------- 1 | program test_reverse 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 12 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(reverse(arange(1_int8, 3_int8)) == [3, 2, 1]), & 17 | 'reverse, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(reverse(arange(1_int16, 3_int16)) == [3, 2, 1]), & 21 | 'reverse, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(reverse(arange(1_int32, 3_int32)) == [3, 2, 1]), & 25 | 'reverse, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(reverse(arange(1_int64, 3_int64)) == [3, 2, 1]), & 29 | 'reverse, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(reverse(arange(1._real32, 3._real32)) == [3, 2, 1]), & 33 | 'reverse, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(reverse(arange(1._real64, 3._real64)) == [3, 2, 1]), & 37 | 'reverse, real64') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(reverse(arange(1._real128, 3._real128)) == [3, 2, 1]), & 41 | 'reverse, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(reverse(arange(cmplx(1._real32, 0._real32), & 45 | cmplx(3._real32, 0._real32)))& 46 | == arange(cmplx(3._real32, 0._real32), & 47 | cmplx(1._real32, 0._real32), & 48 | cmplx(-1._real32, 0._real32))), & 49 | 'reverse, complex real32') 50 | n = n + 1 51 | 52 | tests(n) = assert(all(reverse(arange(cmplx(1._real64, 0._real64), & 53 | cmplx(3._real64, 0._real64)))& 54 | == arange(cmplx(3._real64, 0._real64), & 55 | cmplx(1._real64, 0._real64), & 56 | cmplx(-1._real64, 0._real64))), & 57 | 'reverse, complex real64') 58 | n = n + 1 59 | 60 | tests(n) = assert(all(reverse(arange(cmplx(1._real128, 0._real128), & 61 | cmplx(3._real128, 0._real128)))& 62 | == arange(cmplx(3._real128, 0._real128), & 63 | cmplx(1._real128, 0._real128), & 64 | cmplx(-1._real128, 0._real128))), & 65 | 'reverse, complex real128') 66 | n = n + 1 67 | 68 | tests(n) = assert(reverse('Hello') == 'olleH', 'reverse character string') 69 | n = n + 1 70 | 71 | tests(n) = assert(all(reverse([1, 2, 3]) == .reverse.[1, 2, 3]), & 72 | 'reverse operator, .reverse.x') 73 | n = n + 1 74 | 75 | test_failed = .false. 76 | call report_tests(tests, test_failed) 77 | if(test_failed)stop 1 78 | 79 | end program test_reverse 80 | -------------------------------------------------------------------------------- /test/test_set.f90: -------------------------------------------------------------------------------- 1 | program test_set 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | complex(real32), dimension(:), allocatable :: c4, c4_res 13 | complex(real64), dimension(:), allocatable :: c8, c8_res 14 | complex(real128), dimension(:), allocatable :: c16, c16_res 15 | 16 | n = 1 17 | ntests = 13 18 | call initialize_tests(tests, ntests) 19 | 20 | tests(n) = assert(all(set([1_int8, 2_int8, 2_int8, 3_int8]) == [1, 2, 3]), & 21 | 'set, int8') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(set([1_int16, 2_int16, 2_int16, 3_int16]) == [1, 2, 3]), & 25 | 'set, int16') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(set([1_int32, 2_int32, 2_int32, 3_int32]) == [1, 2, 3]), & 29 | 'set, int32') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(set([1_int64, 2_int64, 2_int64, 3_int64]) == [1, 2, 3]), & 33 | 'set, int64') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(set([1._real32, 2._real32, 2._real32, 3._real32]) == [1, 2, 3]), & 37 | 'set, real32') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(set([1._real64, 2._real64, 2._real64, 3._real64]) == [1, 2, 3]), & 41 | 'set, real64') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(set([1._real128, 2._real128, 2._real128, 3._real128]) == [1, 2, 3]), & 45 | 'set, real128') 46 | n = n + 1 47 | 48 | c4 = [cmplx(1, 0), cmplx(2, 0), cmplx(2, 0), cmplx(3, 0)] 49 | c4_res = [cmplx(1, 0), cmplx(2, 0), cmplx(3, 0)] 50 | tests(n) = assert(all(set(c4) == c4_res), 'set, complex real32') 51 | n = n + 1 52 | 53 | c8 = c4 54 | c8_res = c4_res 55 | tests(n) = assert(all(set(c8) == c8_res), 'set, complex real64') 56 | n = n + 1 57 | 58 | c16 = c4 59 | c16_res = c4_res 60 | tests(n) = assert(all(set(c16) == c16_res), 'set, complex real128') 61 | n = n + 1 62 | 63 | tests(n) = assert(set('Hello') == 'Helo', 'set, character string') 64 | n = n + 1 65 | 66 | tests(n) = assert(all(set(arange(1, 0)) == arange(1, 0)), & 67 | 'set of empty array is an empty array') 68 | n = n + 1 69 | 70 | tests(n) = assert(all(set([1, 2, 2, 3]) == .set.[1, 2, 2, 3]), & 71 | 'set operator, .set.x') 72 | n = n + 1 73 | 74 | test_failed = .false. 75 | call report_tests(tests, test_failed) 76 | if(test_failed)stop 1 77 | 78 | end program test_set 79 | -------------------------------------------------------------------------------- /test/test_sort.f90: -------------------------------------------------------------------------------- 1 | program test_sort 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | real(real32), dimension(1000) :: x 12 | 13 | n = 1 14 | ntests = 13 15 | call initialize_tests(tests, ntests) 16 | 17 | tests(n) = assert(all(sort([3_int8, 2_int8, 1_int8]) == [1, 2, 3]), & 18 | 'sort, int8') 19 | n = n + 1 20 | 21 | tests(n) = assert(all(sort([3_int16, 2_int16, 1_int16]) == [1, 2, 3]), & 22 | 'sort, int16') 23 | n = n + 1 24 | 25 | tests(n) = assert(all(sort([3_int32, 2_int32, 1_int32]) == [1, 2, 3]), & 26 | 'sort, int32') 27 | n = n + 1 28 | 29 | tests(n) = assert(all(sort([3_int64, 2_int64, 1_int64]) == [1, 2, 3]), & 30 | 'sort, int8') 31 | n = n + 1 32 | 33 | tests(n) = assert(all(sort([3._real32, 2._real32, 1._real32]) == [1, 2, 3]), & 34 | 'sort, real32') 35 | n = n + 1 36 | 37 | tests(n) = assert(all(sort([3._real64, 2._real64, 1._real64]) == [1, 2, 3]), & 38 | 'sort, real64') 39 | n = n + 1 40 | 41 | tests(n) = assert(all(sort([3._real128, 2._real128, 1._real128]) == [1, 2, 3]), & 42 | 'sort, real128') 43 | n = n + 1 44 | 45 | tests(n) = assert(all(sort(arange(cmplx(3._real32, 0._real32), & 46 | cmplx(1._real32, 0._real32), & 47 | cmplx(-1._real32, 0._real32)))& 48 | == arange(cmplx(1._real32, 0._real32), & 49 | cmplx(3._real32, 0._real32))), & 50 | 'sort, complex real32') 51 | n = n + 1 52 | 53 | tests(n) = assert(all(sort(arange(cmplx(3._real64, 0._real64), & 54 | cmplx(1._real64, 0._real64), & 55 | cmplx(-1._real64, 0._real64)))& 56 | == arange(cmplx(1._real64, 0._real64), & 57 | cmplx(3._real64, 0._real64))), & 58 | 'sort, complex real64') 59 | n = n + 1 60 | 61 | tests(n) = assert(all(sort(arange(cmplx(3._real128, 0._real128), & 62 | cmplx(1._real128, 0._real128), & 63 | cmplx(-1._real128, 0._real128)))& 64 | == arange(cmplx(1._real128, 0._real128), & 65 | cmplx(3._real128, 0._real128))), & 66 | 'sort, complex real128') 67 | n = n + 1 68 | 69 | tests(n) = assert(sort('Sorted') == 'Sdeort', 'sort, character string') 70 | n = n + 1 71 | 72 | call random_number(x) 73 | tests(n) = assert(all(tail(sort(x)) >= init(sort(x))), & 74 | 'all(tail(sort(x)) >= init(sort(x))') 75 | n = n + 1 76 | 77 | tests(n) = assert(all(sort(x) == .sort.x), & 78 | 'sort operator, .sort.x') 79 | n = n + 1 80 | 81 | test_failed = .false. 82 | call report_tests(tests, test_failed) 83 | if(test_failed)stop 1 84 | 85 | end program test_sort 86 | -------------------------------------------------------------------------------- /test/test_split.f90: -------------------------------------------------------------------------------- 1 | program test_split 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional, only:arange, split 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 19 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(split(arange(1_int8, 10_int8), 1) == arange(1, 5)), & 17 | 'split(x, 1), int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(split(arange(1_int8, 10_int8), 2) == arange(6, 10)), & 21 | 'split(x, 2), int8') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(split(arange(1_int16, 10_int16), 1) == arange(1, 5)), & 25 | 'split(x, 1), int16') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(split(arange(1_int16, 10_int16), 2) == arange(6, 10)), & 29 | 'split(x, 2), int16') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(split(arange(1_int32, 10_int32), 1) == arange(1, 5)), & 33 | 'split(x, 1), int32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(split(arange(1_int32, 10_int32), 2) == arange(6, 10)), & 37 | 'split(x, 2), int32') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(split(arange(1_int64, 10_int64), 1) == arange(1, 5)), & 41 | 'split(x, 1), int64') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(split(arange(1_int64, 10_int64), 2) == arange(6, 10)), & 45 | 'split(x, 2), int64') 46 | n = n + 1 47 | 48 | tests(n) = assert(all(split(arange(1._real32, 10._real32), 1) == arange(1, 5)), & 49 | 'split(x, 1), real32') 50 | n = n + 1 51 | 52 | tests(n) = assert(all(split(arange(1._real32, 10._real32), 2) == arange(6, 10)), & 53 | 'split(x, 2), real32') 54 | n = n + 1 55 | 56 | tests(n) = assert(all(split(arange(1._real64, 10._real64), 1) == arange(1, 5)), & 57 | 'split(x, 1), real64') 58 | n = n + 1 59 | 60 | tests(n) = assert(all(split(arange(1._real64, 10._real64), 2) == arange(6, 10)), & 61 | 'split(x, 2), real64') 62 | n = n + 1 63 | 64 | tests(n) = assert(all(split(arange(1._real128, 10._real128), 1) == arange(1, 5)), & 65 | 'split(x, 1), real128') 66 | n = n + 1 67 | 68 | tests(n) = assert(all(split(arange(1._real128, 10._real128), 2) == arange(6, 10)), & 69 | 'split(x, 2), real128') 70 | n = n + 1 71 | 72 | tests(n) = assert(split('Hello world', 1) == 'Hello', & 73 | 'split("Hello world", 1)') 74 | n = n + 1 75 | 76 | tests(n) = assert(split('Hello world', 2) == ' world', & 77 | 'split("Hello world", 2)') 78 | n = n + 1 79 | 80 | tests(n) = assert(split('Hello world', 3) == '', & 81 | 'split("Hello world", 3)') 82 | n = n + 1 83 | 84 | tests(n) = assert(all(split([1], 1) == arange(1, 0)), 'split([1], 1) returns an empty array') 85 | n = n + 1 86 | 87 | tests(n) = assert(all(split([1], 2) == [1]), 'split([1], 2) returns [1]') 88 | n = n + 1 89 | 90 | test_failed = .false. 91 | call report_tests(tests, test_failed) 92 | if(test_failed)stop 1 93 | 94 | end program test_split 95 | -------------------------------------------------------------------------------- /test/test_strarr.f90: -------------------------------------------------------------------------------- 1 | program test_strarr 2 | use testing, only:assert, initialize_tests, report_tests 3 | use functional, only:arrstr, strarr, empty 4 | 5 | implicit none 6 | 7 | logical, dimension(:), allocatable :: tests 8 | logical :: test_failed 9 | integer :: n, ntests 10 | 11 | n = 1 12 | ntests = 3 13 | call initialize_tests(tests, ntests) 14 | 15 | tests(n) = assert(all(strarr('hello') == ['h', 'e', 'l', 'l', 'o']), & 16 | 'strarr converts to array') 17 | n = n + 1 18 | 19 | tests(n) = assert(all(strarr('') == empty(' ')), & 20 | 'strarr converts empty string to []') 21 | n = n + 1 22 | 23 | tests(n) = assert(arrstr(strarr('hello')) == 'hello', & 24 | 'arrstr(strarr(string)) == string') 25 | n = n + 1 26 | 27 | test_failed = .false. 28 | call report_tests(tests, test_failed) 29 | if(test_failed)stop 1 30 | 31 | end program test_strarr 32 | -------------------------------------------------------------------------------- /test/test_subscript.f90: -------------------------------------------------------------------------------- 1 | program test_subscript 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 12 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(subscript([1_int8, 2_int8, 3_int8], [2_int8]) == [2_int8]), & 17 | 'subscript, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(subscript([1_int16, 2_int16, 3_int16], [2_int16]) == [2_int16]), & 21 | 'subscript, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(subscript([1_int32, 2_int32, 3_int32], [2_int32]) == [2_int32]), & 25 | 'subscript, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(subscript([1_int64, 2_int64, 3_int64], [2_int64]) == [2_int64]), & 29 | 'subscript, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(subscript([1._real32, 2._real32, 3._real32], [2]) == [2._real32]), & 33 | 'subscript, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(subscript([1._real64, 2._real64, 3._real64], [2]) == [2._real64]), & 37 | 'subscript, real64') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(subscript([1._real128, 2._real128, 3._real128], [2]) == [2._real128]), & 41 | 'subscript, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(size(subscript([1, 2, 3], [0])) == 0, & 45 | 'subscript out of bounds returns empty array') 46 | n = n + 1 47 | 48 | tests(n) = assert(all(subscript([1, 2, 3], [3]) == [3]), & 49 | 'subscript of last element') 50 | n = n + 1 51 | 52 | tests(n) = assert(all(subscript(arange(cmplx(1._real32, 0._real32), & 53 | cmplx(3._real32, 0._real32)), [2])& 54 | == [cmplx(2._real32, 0._real32)]), & 55 | 'subscript, complex real32') 56 | n = n + 1 57 | 58 | tests(n) = assert(all(subscript(arange(cmplx(1._real64, 0._real64), & 59 | cmplx(3._real64, 0._real64)), [2])& 60 | == [cmplx(2._real64, 0._real64)]), & 61 | 'subscript, complex real64') 62 | n = n + 1 63 | 64 | tests(n) = assert(all(subscript(arange(cmplx(1._real128, 0._real128), & 65 | cmplx(3._real128, 0._real128)), [2])& 66 | == [cmplx(2._real128, 0._real128)]), & 67 | 'subscript, complex real128') 68 | n = n + 1 69 | 70 | test_failed = .false. 71 | call report_tests(tests, test_failed) 72 | if(test_failed)stop 1 73 | 74 | end program test_subscript 75 | -------------------------------------------------------------------------------- /test/test_tail.f90: -------------------------------------------------------------------------------- 1 | program test_tail 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | complex(real32), dimension(:), allocatable :: c_r4 13 | complex(real64), dimension(:), allocatable :: c_r8 14 | complex(real128), dimension(:), allocatable :: c_r16 15 | 16 | c_r4 = [(1, 2), (2, 4)] 17 | c_r8 = c_r4 18 | c_r16 = c_r4 19 | 20 | n = 1 21 | ntests = 14 22 | call initialize_tests(tests, ntests) 23 | 24 | tests(n) = assert(all(tail([1_int8, 2_int8]) == [2_int8]), 'tail, int8') 25 | n = n + 1 26 | 27 | tests(n) = assert(all(tail([1_int16, 2_int16]) == [2_int16]), 'tail, int16') 28 | n = n + 1 29 | 30 | tests(n) = assert(all(tail([1_int32, 2_int32]) == [2_int32]), 'tail, int32') 31 | n = n + 1 32 | 33 | tests(n) = assert(all(tail([1_int64, 2_int64]) == [2_int64]), 'tail, int64') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(tail([1._real32, 2._real32]) == [2._real32]), 'tail, real32') 37 | n = n + 1 38 | 39 | tests(n) = assert(all(tail([1._real64, 2._real64]) == [2._real64]), 'tail, real64') 40 | n = n + 1 41 | 42 | tests(n) = assert(all(tail([1._real128, 2._real128]) == [2._real128]), 'tail, real128') 43 | n = n + 1 44 | 45 | tests(n) = assert(all(tail(c_r4) == [c_r4(2)]), 'tail, complex real32') 46 | n = n + 1 47 | 48 | tests(n) = assert(all(tail(c_r8) == [c_r8(2)]), 'tail, complex real64') 49 | n = n + 1 50 | 51 | tests(n) = assert(all(tail(c_r16) == [c_r16(2)]), 'tail, complex real128') 52 | n = n + 1 53 | 54 | tests(n) = assert(tail('Hello') == 'ello', 'tail, character string') 55 | n = n + 1 56 | 57 | tests(n) = assert(size(tail([1._real32])) == 0, 'size(tail([1])) == 0') 58 | n = n + 1 59 | 60 | tests(n) = assert(size(tail(tail([1._real32]))) == 0, 'size(tail(tail([1]))) == 0') 61 | n = n + 1 62 | 63 | tests(n) = assert(all(tail([1, 2]) == .tail.[1, 2]), 'tail operator, .tail.x') 64 | n = n + 1 65 | 66 | test_failed = .false. 67 | call report_tests(tests, test_failed) 68 | if(test_failed)stop 1 69 | 70 | end program test_tail 71 | -------------------------------------------------------------------------------- /test/test_unfold.f90: -------------------------------------------------------------------------------- 1 | module mod_unfold_functions 2 | 3 | implicit none 4 | 5 | public 6 | 7 | contains 8 | 9 | pure integer(int8) function addone_i1(x) result(res) 10 | use iso_fortran_env, only:int8 11 | integer(int8), intent(in) :: x 12 | res = x+1 13 | end function addone_i1 14 | 15 | pure integer(int16) function addone_i2(x) result(res) 16 | use iso_fortran_env, only:int16 17 | integer(int16), intent(in) :: x 18 | res = x+1 19 | end function addone_i2 20 | 21 | pure integer(int32) function addone_i4(x) result(res) 22 | use iso_fortran_env, only:int32 23 | integer(int32), intent(in) :: x 24 | res = x+1 25 | end function addone_i4 26 | 27 | pure integer(int64) function addone_i8(x) result(res) 28 | use iso_fortran_env, only:int64 29 | integer(int64), intent(in) :: x 30 | res = x+1 31 | end function addone_i8 32 | 33 | pure real(real32) function addone_r4(x) result(res) 34 | use iso_fortran_env, only:real32 35 | real(real32), intent(in) :: x 36 | res = x+1 37 | end function addone_r4 38 | 39 | pure real(real64) function addone_r8(x) result(res) 40 | use iso_fortran_env, only:real64 41 | real(real64), intent(in) :: x 42 | res = x+1 43 | end function addone_r8 44 | 45 | pure real(real128) function addone_r16(x) result(res) 46 | use iso_fortran_env, only:real128 47 | real(real128), intent(in) :: x 48 | res = x+1 49 | end function addone_r16 50 | 51 | pure complex(real32) function addone_c4(x) result(res) 52 | use iso_fortran_env, only:real32 53 | complex(real32), intent(in) :: x 54 | res = x+1 55 | end function addone_c4 56 | 57 | pure complex(real64) function addone_c8(x) result(res) 58 | use iso_fortran_env, only:real64 59 | complex(real64), intent(in) :: x 60 | res = x+1 61 | end function addone_c8 62 | 63 | pure complex(real128) function addone_c16(x) result(res) 64 | use iso_fortran_env, only:real128 65 | complex(real128), intent(in) :: x 66 | res = x+1 67 | end function addone_c16 68 | 69 | end module mod_unfold_functions 70 | 71 | program test_unfold 72 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 73 | use testing, only:assert, initialize_tests, report_tests 74 | use functional 75 | use mod_unfold_functions 76 | 77 | implicit none 78 | 79 | logical, dimension(:), allocatable :: tests 80 | logical :: test_failed 81 | integer :: n, ntests 82 | 83 | complex(real64), dimension(:), allocatable :: c8 84 | complex(real128), dimension(:), allocatable :: c16 85 | 86 | n = 1 87 | ntests = 10 88 | call initialize_tests(tests, ntests) 89 | 90 | tests(n) = assert(all(unfold(addone_i1, [1_int8], 3_int8) == [1, 2, 3]), & 91 | 'unfold, int8') 92 | n = n + 1 93 | 94 | tests(n) = assert(all(unfold(addone_i2, [1_int16], 3_int16) == [1, 2, 3]), & 95 | 'unfold, int16') 96 | n = n + 1 97 | 98 | tests(n) = assert(all(unfold(addone_i4, [1_int32], 3_int32) == [1, 2, 3]), & 99 | 'unfold, int32') 100 | n = n + 1 101 | 102 | tests(n) = assert(all(unfold(addone_i8, [1_int64], 3_int64) == [1, 2, 3]), & 103 | 'unfold, int64') 104 | n = n + 1 105 | 106 | tests(n) = assert(all(unfold(addone_r4, [1._real32], 3_int32) == [1, 2, 3]), & 107 | 'unfold, real32') 108 | n = n + 1 109 | 110 | tests(n) = assert(all(unfold(addone_r8, [1._real64], 3_int32) == [1, 2, 3]), & 111 | 'unfold, real64') 112 | n = n + 1 113 | 114 | tests(n) = assert(all(unfold(addone_r16, [1._real128], 3_int32) == [1, 2, 3]), & 115 | 'unfold, real128') 116 | n = n + 1 117 | 118 | tests(n) = assert(all(unfold(addone_c4, [cmplx(1._real32, 0._real32)], 3)& 119 | == arange(cmplx(1._real32, 0._real32), & 120 | cmplx(3._real32, 0._real32))), & 121 | 'unfold, complex real32') 122 | n = n + 1 123 | 124 | c8 = [cmplx(1._real64, 0._real64)] 125 | tests(n) = assert(all(unfold(addone_c8, c8, 3)& 126 | == arange(cmplx(1._real64, 0._real64), & 127 | cmplx(3._real64, 0._real64))), & 128 | 'unfold, complex real64') 129 | n = n + 1 130 | 131 | c16 = [cmplx(1._real128, 0._real128)] 132 | tests(n) = assert(all(unfold(addone_c16, c16, 3)& 133 | == arange(cmplx(1._real128, 0._real128), & 134 | cmplx(3._real128, 0._real128))), & 135 | 'unfold, complex real128') 136 | n = n + 1 137 | 138 | test_failed = .false. 139 | call report_tests(tests, test_failed) 140 | if(test_failed)stop 1 141 | 142 | end program test_unfold 143 | -------------------------------------------------------------------------------- /test/test_union.f90: -------------------------------------------------------------------------------- 1 | program test_union 2 | use iso_fortran_env, only:int8, int16, int32, int64, real32, real64, real128 3 | use testing, only:assert, initialize_tests, report_tests 4 | use functional 5 | 6 | implicit none 7 | 8 | logical, dimension(:), allocatable :: tests 9 | logical :: test_failed 10 | integer :: n, ntests 11 | 12 | n = 1 13 | ntests = 15 14 | call initialize_tests(tests, ntests) 15 | 16 | tests(n) = assert(all(union([1_int8, 2_int8], [2_int8, 3_int8]) == [1, 2, 3]), & 17 | 'union, int8') 18 | n = n + 1 19 | 20 | tests(n) = assert(all(union([1_int16, 2_int16], [2_int16, 3_int16]) == [1, 2, 3]), & 21 | 'union, int16') 22 | n = n + 1 23 | 24 | tests(n) = assert(all(union([1_int32, 2_int32], [2_int32, 3_int32]) == [1, 2, 3]), & 25 | 'union, int32') 26 | n = n + 1 27 | 28 | tests(n) = assert(all(union([1_int64, 2_int64], [2_int64, 3_int64]) == [1, 2, 3]), & 29 | 'union, int64') 30 | n = n + 1 31 | 32 | tests(n) = assert(all(union([1._real32, 2._real32], [2._real32, 3._real32]) == [1, 2, 3]), & 33 | 'union, real32') 34 | n = n + 1 35 | 36 | tests(n) = assert(all(union([1._real64, 2._real64], [2._real64, 3._real64]) == [1, 2, 3]), & 37 | 'union, real64') 38 | n = n + 1 39 | 40 | tests(n) = assert(all(union([1._real128, 2._real128], [2._real128, 3._real128]) == [1, 2, 3]), & 41 | 'union, real128') 42 | n = n + 1 43 | 44 | tests(n) = assert(all(union([cmplx(1._real32, 0._real32), cmplx(2._real32, 0._real32)], & 45 | [cmplx(2._real32, 0._real32), cmplx(3._real32, 0._real32)])& 46 | == [cmplx(1._real32, 0._real32), & 47 | cmplx(2._real32, 0._real32), & 48 | cmplx(3._real32, 0._real32)]), & 49 | 'union, complex real32') 50 | n = n + 1 51 | 52 | tests(n) = assert(all(union([cmplx(1._real64, 0._real64), cmplx(2._real64, 0._real64)], & 53 | [cmplx(2._real64, 0._real64), cmplx(3._real64, 0._real64)])& 54 | == [cmplx(1._real64, 0._real64), & 55 | cmplx(2._real64, 0._real64), & 56 | cmplx(3._real64, 0._real64)]), & 57 | 'union, complex real64') 58 | n = n + 1 59 | 60 | tests(n) = assert(all(union([cmplx(1._real128, 0._real128), cmplx(2._real128, 0._real128)], & 61 | [cmplx(2._real128, 0._real128), cmplx(3._real128, 0._real128)])& 62 | == [cmplx(1._real128, 0._real128), & 63 | cmplx(2._real128, 0._real128), & 64 | cmplx(3._real128, 0._real128)]), & 65 | 'union, complex real128') 66 | n = n + 1 67 | 68 | tests(n) = assert(union('Hello', 'world') == 'Helowrd', & 69 | 'union, character string') 70 | n = n + 1 71 | 72 | tests(n) = assert(all(union(arange(1, 0), arange(1, 0)) == arange(1, 0)), & 73 | 'union of empty arrays is an empty array') 74 | n = n + 1 75 | 76 | tests(n) = assert(all(union([1, 2, 2, 3], arange(1, 0)) == set([1, 2, 2, 3])), & 77 | 'union(x, []) == set(x)') 78 | n = n + 1 79 | 80 | tests(n) = assert(all(union(arange(1, 0), [1, 2, 2, 3]) == set([1, 2, 2, 3])), & 81 | 'union([], x) == set(x)') 82 | n = n + 1 83 | 84 | tests(n) = assert(all(union([1, 2], [3, 4]) == ([1, 2].union.[3, 4])), & 85 | 'union operator, a.union.b') 86 | n = n + 1 87 | 88 | test_failed = .false. 89 | call report_tests(tests, test_failed) 90 | if(test_failed)stop 1 91 | 92 | end program test_union 93 | -------------------------------------------------------------------------------- /test/testing.f90: -------------------------------------------------------------------------------- 1 | module testing 2 | 3 | ! Simple unit testing module. 4 | 5 | implicit none 6 | 7 | private 8 | public :: assert, initialize_tests, report_tests 9 | 10 | contains 11 | 12 | 13 | logical function assert(condition, test_name) 14 | ! Prints the result of the test to standard output. 15 | logical, intent(in) :: condition 16 | character(len=*), intent(in) :: test_name 17 | character(len=69) :: output_test_name 18 | assert = condition 19 | output_test_name = test_name 20 | if (assert) then 21 | write(*, '(a)') 'test ' // output_test_name // ': ' // & 22 | char(27) // '[32mPASS' // char(27) // '[0m' 23 | else 24 | write(*, '(a)') 'test ' // output_test_name // ': ' // & 25 | char(27) // '[31mFAIL' // char(27) // '[0m' 26 | end if 27 | end function assert 28 | 29 | 30 | subroutine initialize_tests(tests, ntests) 31 | ! Initialize the test suite. 32 | logical, allocatable, intent(in out) :: tests(:) 33 | integer, intent(in) :: ntests 34 | if (allocated(tests)) deallocate(tests) 35 | allocate(tests(ntests)) 36 | end subroutine initialize_tests 37 | 38 | 39 | subroutine report_tests(tests, test_failed) 40 | ! Print the test suite report to standard output. 41 | logical, intent(in) :: tests(:) 42 | logical, optional, intent(out) :: test_failed 43 | integer :: n, ntests, nsuccess, nfailure 44 | ntests = size(tests) 45 | nsuccess = 0 46 | nfailure = 0 47 | do n = 1, ntests 48 | if (tests(n)) then 49 | nsuccess = nsuccess + 1 50 | else 51 | nfailure = nfailure + 1 52 | end if 53 | end do 54 | write(*, '(a, i3, a)') 'Ran a total of ', ntests, ' tests.' 55 | write(*, '(i3, a, i3, a)') nsuccess, ' tests PASSED, ', & 56 | nfailure, ' tests FAILED.' 57 | if (present(test_failed)) then 58 | test_failed = .false. 59 | if (.not. nfailure == 0 ) test_failed = .true. 60 | end if 61 | end subroutine report_tests 62 | 63 | end module testing 64 | --------------------------------------------------------------------------------