fortran-testdrive-0.6.0/ 0000775 0001750 0001750 00000000000 15201524527 015366 5 ustar alastair alastair fortran-testdrive-0.6.0/LICENSE-MIT 0000664 0001750 0001750 00000002066 15201524466 017030 0 ustar alastair alastair MIT License
Copyright (c) 2020-2021 Sebastian Ehlert
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
fortran-testdrive-0.6.0/requirements.txt 0000664 0001750 0001750 00000000021 15201524466 020645 0 ustar alastair alastair meson
ninja
gcovr fortran-testdrive-0.6.0/src/ 0000775 0001750 0001750 00000000000 15201524466 016157 5 ustar alastair alastair fortran-testdrive-0.6.0/src/testdrive_version.f90 0000664 0001750 0001750 00000003526 15201524466 022263 0 ustar alastair alastair ! This file is part of test-drive.
! SPDX-Identifier: Apache-2.0 OR MIT
!
! Licensed under either of Apache License, Version 2.0 or MIT license
! at your option; you may not use this file except in compliance with
! the License.
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
module testdrive_version
implicit none
private
public :: testdrive_version_string, testdrive_version_compact
public :: get_testdrive_version
!> String representation of the test-drive version
character(len=*), parameter :: testdrive_version_string = "0.6.0"
!> Numeric representation of the test-drive version
integer, parameter :: testdrive_version_compact(3) = [0, 6, 0]
contains
!> Getter function to retrieve test-drive version
subroutine get_testdrive_version(major, minor, patch, string)
!> Major version number of the test-drive version
integer, intent(out), optional :: major
!> Minor version number of the test-drive version
integer, intent(out), optional :: minor
!> Patch version number of the test-drive version
integer, intent(out), optional :: patch
!> String representation of the test-drive version
character(len=:), allocatable, intent(out), optional :: string
if (present(major)) then
major = testdrive_version_compact(1)
end if
if (present(minor)) then
minor = testdrive_version_compact(2)
end if
if (present(patch)) then
patch = testdrive_version_compact(3)
end if
if (present(string)) then
string = testdrive_version_string
end if
end subroutine get_testdrive_version
end module testdrive_version
fortran-testdrive-0.6.0/src/meson.build 0000664 0001750 0001750 00000001143 15201524466 020320 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
srcs += files(
'testdrive.F90',
'testdrive_version.f90',
)
fortran-testdrive-0.6.0/src/CMakeLists.txt 0000664 0001750 0001750 00000001276 15201524466 020725 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
list(
APPEND srcs
"${dir}/testdrive.F90"
"${dir}/testdrive_version.f90"
)
set(srcs "${srcs}" PARENT_SCOPE)
fortran-testdrive-0.6.0/src/testdrive.F90 0000664 0001750 0001750 00000233014 15201524466 020453 0 ustar alastair alastair ! This file is part of test-drive.
! SPDX-Identifier: Apache-2.0 OR MIT
!
! Licensed under either of Apache License, Version 2.0 or MIT license
! at your option; you may not use this file except in compliance with
! the License.
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
!# Enable support for quadruple precision
#ifndef WITH_QP
#define WITH_QP 0
#endif
!# Enable support for extended double precision
#ifndef WITH_XDP
#define WITH_XDP 0
#endif
!# Enable ieee_is_nan for NaN detection
#ifndef WITH_IEEE_IS_NAN
#define WITH_IEEE_IS_NAN 0
#endif
!> Provides a light-weight procedural testing framework for Fortran projects.
!>
!> Testsuites are defined by a [[collect_interface]] returning a set of
!> [[unittest_type]] objects. To create a new test use the [[new_unittest]]
!> constructor, which requires a test identifier and a procedure with a
!> [[test_interface]] compatible signature. The error status is communicated
!> by the allocation status of an [[error_type]].
!>
!> The necessary boilerplate code to setup the test entry point is just
!>
!>```fortran
!>program tester
!> use, intrinsic :: iso_fortran_env, only : error_unit
!> use testdrive, only : run_testsuite, new_testsuite, testsuite_type
!> use test_suite1, only : collect_suite1
!> use test_suite2, only : collect_suite2
!> implicit none
!> integer :: stat, is
!> type(testsuite_type), allocatable :: testsuites(:)
!> character(len=*), parameter :: fmt = '("#", *(1x, a))'
!>
!> stat = 0
!>
!> testsuites = [ &
!> new_testsuite("suite1", collect_suite1), &
!> new_testsuite("suite2", collect_suite2) &
!> ]
!>
!> do is = 1, size(testsuites)
!> write(error_unit, fmt) "Testing:", testsuites(is)%name
!> call run_testsuite(testsuites(is)%collect, error_unit, stat)
!> end do
!>
!> if (stat > 0) then
!> write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
!> error stop
!> end if
!>
!>end program tester
!>```
!>
!> Every test is defined in a separate module using a ``collect`` function, which
!> is exported and added to the ``testsuites`` array in the test runner.
!> All test have a simple interface with just an allocatable [[error_type]] as
!> output to provide the test results.
!>
!>```fortran
!>module test_suite1
!> use testdrive, only : new_unittest, unittest_type, error_type, check
!> implicit none
!> private
!>
!> public :: collect_suite1
!>
!>contains
!>
!>!> Collect all exported unit tests
!>subroutine collect_suite1(testsuite)
!> !> Collection of tests
!> type(unittest_type), allocatable, intent(out) :: testsuite(:)
!>
!> testsuite = [ &
!> new_unittest("valid", test_valid), &
!> new_unittest("invalid", test_invalid, should_fail=.true.) &
!> ]
!>
!>end subroutine collect_suite1
!>
!>subroutine test_valid(error)
!> type(error_type), allocatable, intent(out) :: error
!> ! ...
!>end subroutine test_valid
!>
!>subroutine test_invalid(error)
!> type(error_type), allocatable, intent(out) :: error
!> ! ...
!>end subroutine test_invalid
!>
!>end module test_suite1
!>```
!>
!> For an example setup checkout the ``test/`` directory in this project.
module testdrive
use, intrinsic :: iso_fortran_env, only : error_unit
implicit none
private
public :: run_testsuite, run_selected, new_unittest, new_testsuite
public :: select_test, select_suite
public :: unittest_type, testsuite_type, error_type
public :: check, test_failed, skip_test
public :: test_interface, collect_interface
public :: get_argument, get_variable, to_string
public :: junit_output, junit_header
public :: init_color_output
!> Single precision real numbers
integer, parameter :: sp = selected_real_kind(6)
!> Double precision real numbers
integer, parameter :: dp = selected_real_kind(15)
#if WITH_XDP
!> Extended double precision real numbers
integer, parameter :: xdp = selected_real_kind(18)
#endif
#if WITH_QP
!> Quadruple precision real numbers
integer, parameter :: qp = selected_real_kind(33)
#endif
!> Char length for integers
integer, parameter :: i1 = selected_int_kind(2)
!> Short length for integers
integer, parameter :: i2 = selected_int_kind(4)
!> Length of default integers
integer, parameter :: i4 = selected_int_kind(9)
!> Long length for integers
integer, parameter :: i8 = selected_int_kind(18)
!> Error code for success
integer, parameter :: success = 0
!> Error code for failure
integer, parameter :: fatal = 1
!> Error code for skipped test
integer, parameter :: skipped = 77
!> Error message
type :: error_type
!> Error code
integer :: stat = success
!> Payload of the error
character(len=:), allocatable :: message
contains
!> Escalate uncaught errors
final :: escalate_error
end type error_type
interface check
module procedure :: check_stat
module procedure :: check_logical
module procedure :: check_float_sp
module procedure :: check_float_dp
#if WITH_XDP
module procedure :: check_float_xdp
#endif
#if WITH_QP
module procedure :: check_float_qp
#endif
module procedure :: check_float_exceptional_sp
module procedure :: check_float_exceptional_dp
#if WITH_XDP
module procedure :: check_float_exceptional_xdp
#endif
#if WITH_QP
module procedure :: check_float_exceptional_qp
#endif
module procedure :: check_complex_sp
module procedure :: check_complex_dp
#if WITH_XDP
module procedure :: check_complex_xdp
#endif
#if WITH_QP
module procedure :: check_complex_qp
#endif
module procedure :: check_complex_exceptional_sp
module procedure :: check_complex_exceptional_dp
#if WITH_XDP
module procedure :: check_complex_exceptional_xdp
#endif
#if WITH_QP
module procedure :: check_complex_exceptional_qp
#endif
module procedure :: check_float_absrel_sp
module procedure :: check_float_absrel_dp
#if WITH_XDP
module procedure :: check_float_absrel_xdp
#endif
#if WITH_QP
module procedure :: check_float_absrel_qp
#endif
module procedure :: check_complex_absrel_sp
module procedure :: check_complex_absrel_dp
#if WITH_XDP
module procedure :: check_complex_absrel_xdp
#endif
#if WITH_QP
module procedure :: check_complex_absrel_qp
#endif
module procedure :: check_int_i1
module procedure :: check_int_i2
module procedure :: check_int_i4
module procedure :: check_int_i8
module procedure :: check_bool
module procedure :: check_string
end interface check
interface to_string
module procedure :: integer_i1_to_string
module procedure :: integer_i2_to_string
module procedure :: integer_i4_to_string
module procedure :: integer_i8_to_string
module procedure :: real_sp_to_string
module procedure :: real_dp_to_string
#if WITH_XDP
module procedure :: real_xdp_to_string
#endif
#if WITH_QP
module procedure :: real_qp_to_string
#endif
module procedure :: complex_sp_to_string
module procedure :: complex_dp_to_string
#if WITH_XDP
module procedure :: complex_xdp_to_string
#endif
#if WITH_QP
module procedure :: complex_qp_to_string
#endif
end interface to_string
!> Check for not-a-number (NaN) values. Uses the IEEE intrinsic
!> `ieee_is_nan` when available, and falls back to a portable
!> comparison-based implementation (using `HUGE`/`ABS`) when IEEE
!> arithmetic is disabled.
interface is_nan
module procedure :: is_nan_sp
module procedure :: is_nan_dp
#if WITH_XDP
module procedure :: is_nan_xdp
#endif
#if WITH_QP
module procedure :: is_nan_qp
#endif
end interface is_nan
abstract interface
!> Entry point for tests
subroutine test_interface(error)
import :: error_type
!> Error handling
type(error_type), allocatable, intent(out) :: error
end subroutine test_interface
end interface
!> Declaration of a unit test
type :: unittest_type
!> Name of the test
character(len=:), allocatable :: name
!> Entry point of the test
procedure(test_interface), pointer, nopass :: test => null()
!> Whether test is supposed to fail
logical :: should_fail = .false.
contains
!> Deallocate unittest's internal data
final :: destroy_unittest
end type unittest_type
abstract interface
!> Collect all tests
subroutine collect_interface(testsuite)
import :: unittest_type
#ifdef __NVCOMPILER_LLVM__
! this is only an issue with nvhpc 25.9, possibly a bug in the compiler ! verify in next release
import :: test_interface
#endif
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
end subroutine collect_interface
end interface
!> Collection of unit tests
type :: testsuite_type
!> Name of the testsuite
character(len=:), allocatable :: name
!> Entry point of the test
procedure(collect_interface), pointer, nopass :: collect => null()
contains
!> Deallocate testsuite's internal data
final :: destroy_testsuite
end type testsuite_type
!> Output JUnit.xml for discovering unit tests by other tools
type :: junit_output
!> XML output string (initial block)
character(len=:), allocatable :: xml_start
!> XML output string (current block)
character(len=:), allocatable :: xml_block
!> XML output string (final block)
character(len=:), allocatable :: xml_final
!> Unique identifier
integer :: uid = 0
!> Timestamp
character(len=19) :: timestamp = '1970-01-01T00:00:00'
!> Hostname
character(len=:), allocatable :: hostname
!> Package name
character(len=:), allocatable :: package
!> Testsuite name
character(len=:), allocatable :: testsuite
!> Number of tests
integer :: tests = 0
!> Number of failures
integer :: failures = 0
!> Number of errors
integer :: errors = 0
!> Number of skipped tests
integer :: skipped = 0
!> Running time
real(sp) :: time = 0.0_sp
contains
final :: destroy_junit_output
end type junit_output
!> Container for terminal escape code
type :: color_code
!> Style descriptor
integer(i1) :: style = -1_i1
!> Background color descriptor
integer(i1) :: bg = -1_i1
!> Foreground color descriptor
integer(i1) :: fg = -1_i1
end type color_code
interface operator(+)
module procedure :: add_color
end interface operator(+)
interface operator(//)
module procedure :: concat_color_left
module procedure :: concat_color_right
end interface operator(//)
!> Colorizer class for handling colorful output in the terminal
type, public :: color_output
type(color_code) :: &
reset = color_code(), &
bold = color_code(), &
dim = color_code(), &
italic = color_code(), &
underline = color_code(), &
blink = color_code(), &
reverse = color_code(), &
hidden = color_code()
type(color_code) :: &
black = color_code(), &
red = color_code(), &
green = color_code(), &
yellow = color_code(), &
blue = color_code(), &
magenta = color_code(), &
cyan = color_code(), &
white = color_code()
type(color_code) :: &
bg_black = color_code(), &
bg_red = color_code(), &
bg_green = color_code(), &
bg_yellow = color_code(), &
bg_blue = color_code(), &
bg_magenta = color_code(), &
bg_cyan = color_code(), &
bg_white = color_code()
end type color_output
interface color_output
module procedure :: new_color_output
end interface color_output
type(color_output), protected :: color
character(len=*), parameter :: fmt = '(1x, *(1x, a))'
character(len=*), parameter :: newline = new_line("a")
contains
!> Driver for testsuite
recursive subroutine run_testsuite(collect, unit, stat, parallel, junit)
!> Collect tests
procedure(collect_interface) :: collect
!> Unit for IO
integer, intent(in) :: unit
!> Number of failed tests
integer, intent(inout) :: stat
!> Run the tests in parallel
logical, intent(in), optional :: parallel
!> Produce junit output
type(junit_output), intent(inout), optional :: junit
type(unittest_type), allocatable :: testsuite(:)
integer :: it
logical :: parallel_
parallel_ = .true.
if(present(parallel)) parallel_ = parallel
call collect(testsuite)
call junit_push_suite(junit, "testdrive")
!$omp parallel do schedule(dynamic) shared(testsuite, unit) reduction(+:stat) &
!$omp if (parallel_)
do it = 1, size(testsuite)
!$omp critical(testdrive_testsuite)
write(unit, '(1x, 4(1x, a))') &
& "Starting", (color%blue)//testsuite(it)%name//color%reset, &
& color%dim//"..."//color%reset, &
& color%bold//"(" // color%cyan//to_string(it)//color%bold // &
& "/" // color%cyan//to_string(size(testsuite))//color%bold // ")"//color%reset
!$omp end critical(testdrive_testsuite)
call run_unittest(testsuite(it), unit, stat, junit)
end do
call junit_pop_suite(junit)
end subroutine run_testsuite
!> Driver for selective testing
recursive subroutine run_selected(collect, name, unit, stat, junit)
!> Collect tests
procedure(collect_interface) :: collect
!> Name of the selected test
character(len=*), intent(in) :: name
!> Unit for IO
integer, intent(in) :: unit
!> Number of failed tests
integer, intent(inout) :: stat
!> Produce junit output
type(junit_output), intent(inout), optional :: junit
type(unittest_type), allocatable :: testsuite(:)
integer :: it
call collect(testsuite)
call junit_push_suite(junit, "testdrive")
it = select_test(testsuite, name)
if (it > 0 .and. it <= size(testsuite)) then
call run_unittest(testsuite(it), unit, stat, junit)
else
write(unit, fmt) "Available tests:"
do it = 1, size(testsuite)
write(unit, fmt) "-", testsuite(it)%name
end do
stat = -huge(it)
end if
call junit_pop_suite(junit)
end subroutine run_selected
!> Run a selected unit test
recursive subroutine run_unittest(test, unit, stat, junit)
!> Unit test
type(unittest_type), intent(in) :: test
!> Unit for IO
integer, intent(in) :: unit
!> Number of failed tests
integer, intent(inout) :: stat
!> Produce junit output
type(junit_output), intent(inout), optional :: junit
type(error_type), allocatable :: error
character(len=:), allocatable :: message
call test%test(error)
if (.not.test_skipped(error)) then
if (allocated(error) .neqv. test%should_fail) stat = stat + 1
end if
call junit_push_test(junit, test, error, 0.0_sp)
call make_output(message, test, error)
!$omp critical(testdrive_testsuite)
write(unit, '(a)') message
!$omp end critical(testdrive_testsuite)
if (allocated(error)) then
call clear_error(error)
end if
end subroutine run_unittest
pure function test_skipped(error) result(is_skipped)
!> Error handling
type(error_type), intent(in), optional :: error
!> Test was skipped
logical :: is_skipped
is_skipped = .false.
if (present(error)) then
is_skipped = error%stat == skipped
end if
end function test_skipped
!> Create output message for test (this procedure is pure and therefore cannot launch tests)
pure subroutine make_output(output, test, error)
!> Output message for display
character(len=:), allocatable, intent(out) :: output
!> Unit test
type(unittest_type), intent(in) :: test
!> Error handling
type(error_type), intent(in), optional :: error
character(len=:), allocatable :: label
type(color_code) :: label_color
if (test_skipped(error)) then
label_color = color%yellow + color%bold
label = "SKIPPED"
else if (present(error) .neqv. test%should_fail) then
if (test%should_fail) then
label_color = color%magenta + color%bold
label = "UNEXPECTED PASS"
else
label_color = color%red + color%bold
label = "FAILED"
end if
else
if (test%should_fail) then
label_color = color%cyan + color%bold
label = "EXPECTED FAIL"
else
label_color = color%green + color%bold
label = "PASSED"
end if
end if
output = " " // color%dim//"..."//color%reset // " " // &
& color%blue//test%name//color%reset // &
& " "//color%bold//"["//label_color//label//color%bold//"]"//color%reset
if (present(error)) then
output = output // newline // " "//color%bold//"Message:"//color%reset//" " // error%message
end if
end subroutine make_output
!> Initialize output for JUnit.xml
pure subroutine junit_header(junit, package)
!> JUnit output
type(junit_output), intent(inout), optional :: junit
!> Package name
character(len=*), intent(in) :: package
if (.not.present(junit)) return
junit%xml_start = &
& '' // newline // &
& '' // newline
junit%xml_block = ''
junit%xml_final = &
& ''
junit%hostname = 'localhost'
junit%package = package
end subroutine junit_header
!> Register a test suite in JUnit.xml
subroutine junit_push_suite(junit, name)
!> JUnit output
type(junit_output), intent(inout), optional :: junit
!> Name of the test suite
character(len=*), intent(in) :: name
if (.not.present(junit)) return
junit%timestamp = get_timestamp()
junit%testsuite = name
junit%uid = junit%uid + 1
end subroutine junit_push_suite
!> Finalize a test suite in JUnit.xml
subroutine junit_pop_suite(junit)
!> JUnit output
type(junit_output), intent(inout), optional :: junit
if (.not.present(junit)) return
junit%xml_start = &
& junit%xml_start // &
& ' ' // newline // &
& ' ' // newline // &
& ' ' // newline // &
& junit%xml_block // newline // &
& ' ' // newline
junit%xml_block = ''
junit%tests = 0
junit%failures = 0
junit%errors = 0
junit%skipped = 0
junit%time = 0.0_sp
call junit_write(junit)
end subroutine junit_pop_suite
!> Register a new unit test
subroutine junit_push_test(junit, test, error, time)
!> JUnit output
type(junit_output), intent(inout), optional :: junit
!> Unit test
type(unittest_type), intent(in) :: test
!> Error handling
type(error_type), intent(in), optional :: error
!> Running time
real(sp), intent(in) :: time
if (.not.present(junit)) return
!$omp critical(testdrive_junit)
junit%tests = junit%tests + 1
junit%time = junit%time + time
junit%xml_block = &
& junit%xml_block // &
& ' ' // newline
if (test_skipped(error)) then
junit%xml_block = &
& junit%xml_block // &
& ' ' // newline
junit%skipped = junit%skipped + 1
elseif (present(error)) then
if (test%should_fail) then
junit%xml_block = &
& junit%xml_block // &
& ' ' // newline // &
& ' "'//error%message//'"' // newline // &
& ' ' // newline
else
junit%xml_block = &
& junit%xml_block // &
& ' ' // newline
junit%failures = junit%failures + 1
end if
else
if (test%should_fail) then
junit%xml_block = &
& junit%xml_block // &
& ' ' // newline
junit%failures = junit%failures + 1
else
junit%xml_block = &
& junit%xml_block // &
& ' ' // newline // &
& ' "Test passed successfully"' // newline // &
& ' ' // newline
end if
end if
junit%xml_block = &
& junit%xml_block // &
& ' ' // newline
!$omp end critical(testdrive_junit)
end subroutine junit_push_test
!> Write results to JUnit.xml
subroutine junit_write(junit)
!> JUnit output
type(junit_output), intent(inout), optional :: junit
integer :: io
if (.not.present(junit)) return
open( &
& newunit=io, &
& file='JUnit'//junit%package//'.xml', &
& status='replace', &
& action='write')
write(io, '(a)') junit%xml_start // junit%xml_final
close(io)
end subroutine junit_write
!> deallocate internal data of junit_output
subroutine destroy_junit_output(self)
!> JUnit output
type(junit_output), intent(inout) :: self
if (allocated(self%xml_start)) deallocate(self%xml_start)
if (allocated(self%xml_block)) deallocate(self%xml_block)
if (allocated(self%xml_final)) deallocate(self%xml_final)
if (allocated(self%hostname)) deallocate(self%hostname)
if (allocated(self%package)) deallocate(self%package)
if (allocated(self%testsuite)) deallocate(self%testsuite)
end subroutine destroy_junit_output
!> Create ISO 8601 formatted timestamp
function get_timestamp() result(timestamp)
!> ISO 8601 formatted timestamp
character(len=19) :: timestamp
character(len=8) :: date
character(len=10) :: time
call date_and_time(date=date, time=time)
timestamp = date(1:4) // "-" // date(5:6) // "-" // date(7:8) // "T" // &
& time(1:2) // ":" // time(3:4) // ":" // time(5:6)
end function get_timestamp
!> Select a unit test from all available tests
function select_test(tests, name) result(pos)
!> Name identifying the test suite
character(len=*), intent(in) :: name
!> Available unit tests
type(unittest_type) :: tests(:)
!> Selected test suite
integer :: pos
integer :: it
pos = 0
do it = 1, size(tests)
if (name == tests(it)%name) then
pos = it
exit
end if
end do
end function select_test
!> Select a test suite from all available suites
function select_suite(suites, name) result(pos)
!> Name identifying the test suite
character(len=*), intent(in) :: name
!> Available test suites
type(testsuite_type) :: suites(:)
!> Selected test suite
integer :: pos
integer :: it
pos = 0
do it = 1, size(suites)
if (name == suites(it)%name) then
pos = it
exit
end if
end do
end function select_suite
!> Register a new unit test
function new_unittest(name, test, should_fail) result(self)
!> Name of the test
character(len=*), intent(in) :: name
!> Entry point for the test
procedure(test_interface) :: test
!> Whether test is supposed to error or not
logical, intent(in), optional :: should_fail
!> Newly registered test
type(unittest_type) :: self
self%name = name
self%test => test
if (present(should_fail)) self%should_fail = should_fail
end function new_unittest
!> Finalize unit test
subroutine destroy_unittest(self)
!> unittest to destroy
type(unittest_type), intent(inout) :: self
if (allocated(self%name)) deallocate(self%name)
self%test => null()
end subroutine destroy_unittest
!> Register a new testsuite
function new_testsuite(name, collect) result(self)
!> Name of the testsuite
character(len=*), intent(in) :: name
!> Entry point to collect tests
procedure(collect_interface) :: collect
!> Newly registered testsuite
type(testsuite_type) :: self
self%name = name
self%collect => collect
end function new_testsuite
!> Finalize testsuite
subroutine destroy_testsuite(self)
!> testsuite to destroy
type(testsuite_type), intent(inout) :: self
if (allocated(self%name)) deallocate(self%name)
self%collect => null()
end subroutine destroy_testsuite
subroutine check_stat(error, stat, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Status of operation
integer, intent(in) :: stat
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (stat /= success) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Non-zero exit code encountered", more)
end if
end if
end subroutine check_stat
subroutine check_logical(error, expression, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Result of logical operator
logical, intent(in) :: expression
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (.not.expression) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Condition not fullfilled", more)
end if
end if
end subroutine check_logical
subroutine check_float_dp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(dp), intent(in) :: actual
!> Expected floating point value
real(dp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(dp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(dp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(expected)
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_float_dp
subroutine check_float_exceptional_dp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(dp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(actual)) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_float_exceptional_dp
subroutine check_float_sp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(sp), intent(in) :: actual
!> Expected floating point value
real(sp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(sp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(sp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(expected)
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_float_sp
subroutine check_float_exceptional_sp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(sp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(actual)) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_float_exceptional_sp
#if WITH_XDP
subroutine check_float_xdp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(xdp), intent(in) :: actual
!> Expected floating point value
real(xdp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(xdp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(xdp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(expected)
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_float_xdp
subroutine check_float_exceptional_xdp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(xdp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(actual)) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_float_exceptional_xdp
#endif
#if WITH_QP
subroutine check_float_qp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(qp), intent(in) :: actual
!> Expected floating point value
real(qp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(qp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(qp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(expected)
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_float_qp
subroutine check_float_exceptional_qp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(qp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(actual)) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_float_exceptional_qp
#endif
subroutine check_complex_dp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(dp), intent(in) :: actual
!> Expected floating point value
complex(dp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(dp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(dp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(abs(expected))
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_complex_dp
subroutine check_complex_exceptional_dp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(dp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_complex_exceptional_dp
subroutine check_complex_sp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(sp), intent(in) :: actual
!> Expected floating point value
complex(sp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(sp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(sp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(abs(expected))
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_complex_sp
subroutine check_complex_exceptional_sp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(sp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_complex_exceptional_sp
#if WITH_XDP
subroutine check_complex_xdp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(xdp), intent(in) :: actual
!> Expected floating point value
complex(xdp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(xdp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(xdp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(abs(expected))
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_complex_xdp
subroutine check_complex_exceptional_xdp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(xdp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_complex_exceptional_xdp
#endif
#if WITH_QP
subroutine check_complex_qp(error, actual, expected, message, more, thr, rel)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(qp), intent(in) :: actual
!> Expected floating point value
complex(qp), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Allowed threshold for matching floating point values
real(qp), intent(in), optional :: thr
!> Check for relative errors instead
logical, intent(in), optional :: rel
logical :: relative
real(qp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
if (present(thr)) then
threshold = thr
else
threshold = epsilon(abs(expected))
end if
if (present(rel)) then
relative = rel
else
relative = .false.
end if
if (relative) then
diff = abs(actual - expected) / abs(expected)
else
diff = abs(actual - expected)
end if
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
if (relative) then
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(int(diff*100))//"%)", &
more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end if
end subroutine check_complex_qp
subroutine check_complex_exceptional_qp(error, actual, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(qp), intent(in) :: actual
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, "Exceptional value 'not a number' found", more)
end if
end if
end subroutine check_complex_exceptional_qp
#endif
subroutine check_float_absrel_dp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(dp), intent(in) :: actual
!> Expected floating point value
real(dp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(dp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(dp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(dp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_float_absrel_dp
subroutine check_float_absrel_sp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(sp), intent(in) :: actual
!> Expected floating point value
real(sp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(sp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(sp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(sp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_float_absrel_sp
#if WITH_XDP
subroutine check_float_absrel_xdp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(xdp), intent(in) :: actual
!> Expected floating point value
real(xdp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(xdp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(xdp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(xdp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_float_absrel_xdp
#endif
#if WITH_QP
subroutine check_float_absrel_qp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
real(qp), intent(in) :: actual
!> Expected floating point value
real(qp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(qp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(qp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(qp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_float_absrel_qp
#endif
subroutine check_complex_absrel_dp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(dp), intent(in) :: actual
!> Expected floating point value
complex(dp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(dp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(dp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(dp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_complex_absrel_dp
subroutine check_complex_absrel_sp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(sp), intent(in) :: actual
!> Expected floating point value
complex(sp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(sp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(sp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(sp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_complex_absrel_sp
#if WITH_XDP
subroutine check_complex_absrel_xdp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(xdp), intent(in) :: actual
!> Expected floating point value
complex(xdp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(xdp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(xdp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(xdp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_complex_absrel_xdp
#endif
#if WITH_QP
subroutine check_complex_absrel_qp(error, actual, expected, thr_abs, thr_rel, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found floating point value
complex(qp), intent(in) :: actual
!> Expected floating point value
complex(qp), intent(in) :: expected
!> Absolute threshold for matching floating point values
real(qp), intent(in) :: thr_abs
!> Relative threshold for matching floating point values
real(qp), intent(in) :: thr_rel
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
real(qp) :: diff, threshold
call check(error, actual, message, more)
if (allocated(error)) return
diff = abs(actual - expected)
threshold = max(thr_abs, abs(thr_rel * expected))
if (diff > threshold) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Floating point value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual)//" "//&
"(difference: "//to_string(diff)//")", &
more)
end if
end if
end subroutine check_complex_absrel_qp
#endif
subroutine check_int_i1(error, actual, expected, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found integer value
integer(i1), intent(in) :: actual
!> Expected integer value
integer(i1), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (expected /= actual) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Integer value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual), &
more)
end if
end if
end subroutine check_int_i1
subroutine check_int_i2(error, actual, expected, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found integer value
integer(i2), intent(in) :: actual
!> Expected integer value
integer(i2), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (expected /= actual) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Integer value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual), &
more)
end if
end if
end subroutine check_int_i2
subroutine check_int_i4(error, actual, expected, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found integer value
integer(i4), intent(in) :: actual
!> Expected integer value
integer(i4), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (expected /= actual) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Integer value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual), &
more)
end if
end if
end subroutine check_int_i4
subroutine check_int_i8(error, actual, expected, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found integer value
integer(i8), intent(in) :: actual
!> Expected integer value
integer(i8), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (expected /= actual) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Integer value mismatch", &
"expected "//to_string(expected)//" but got "//to_string(actual), &
more)
end if
end if
end subroutine check_int_i8
subroutine check_bool(error, actual, expected, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found boolean value
logical, intent(in) :: actual
!> Expected boolean value
logical, intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (expected .neqv. actual) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Logical value mismatch", &
"expected "//merge("T", "F", expected)//" but got "//merge("T", "F", actual), &
more)
end if
end if
end subroutine check_bool
subroutine check_string(error, actual, expected, message, more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> Found boolean value
character(len=*), intent(in) :: actual
!> Expected boolean value
character(len=*), intent(in) :: expected
!> A detailed message describing the error
character(len=*), intent(in), optional :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
if (expected /= actual) then
if (present(message)) then
call test_failed(error, message, more)
else
call test_failed(error, &
"Character value mismatch", &
"expected '"//expected//"' but got '"//actual//"'", &
more)
end if
end if
end subroutine check_string
subroutine test_failed(error, message, more, and_more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> A detailed message describing the error
character(len=*), intent(in) :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Another line of error message
character(len=*), intent(in), optional :: and_more
character(len=*), parameter :: skip = newline // repeat(" ", 11)
allocate(error)
error%stat = fatal
error%message = message
if (present(more)) then
error%message = error%message // skip // more
end if
if (present(and_more)) then
error%message = error%message // skip // and_more
end if
end subroutine test_failed
!> A test is skipped because certain requirements are not met to run the actual test
subroutine skip_test(error, message, more, and_more)
!> Error handling
type(error_type), allocatable, intent(out) :: error
!> A detailed message describing the error
character(len=*), intent(in) :: message
!> Another line of error message
character(len=*), intent(in), optional :: more
!> Another line of error message
character(len=*), intent(in), optional :: and_more
call test_failed(error, message, more, and_more)
error%stat = skipped
end subroutine skip_test
!> Obtain the command line argument at a given index
subroutine get_argument(idx, arg)
!> Index of command line argument, range [0:command_argument_count()]
integer, intent(in) :: idx
!> Command line argument
character(len=:), allocatable, intent(out) :: arg
integer :: length, stat
call get_command_argument(idx, length=length, status=stat)
if (stat /= success) return
allocate(character(len=length) :: arg, stat=stat)
if (stat /= success) return
if (length > 0) then
call get_command_argument(idx, arg, status=stat)
if (stat /= success) deallocate(arg)
end if
end subroutine get_argument
!> Obtain the value of an environment variable
subroutine get_variable(var, val)
!> Name of variable
character(len=*), intent(in) :: var
!> Value of variable
character(len=:), allocatable, intent(out) :: val
integer :: length, stat
call get_environment_variable(var, length=length, status=stat)
if (stat /= success) return
allocate(character(len=length) :: val, stat=stat)
if (stat /= success) return
if (length > 0) then
call get_environment_variable(var, val, status=stat)
if (stat /= success) deallocate(val)
end if
end subroutine get_variable
pure function integer_i1_to_string(val) result(string)
integer, parameter :: ik = i1
!> Integer value to create string from
integer(ik), intent(in) :: val
!> String representation of integer
character(len=:), allocatable :: string
integer, parameter :: buffer_len = range(val)+2
character(len=buffer_len) :: buffer
integer :: pos
integer(ik) :: n
character(len=1), parameter :: numbers(-9:0) = &
["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"]
if (val == 0_ik) then
string = numbers(0)
return
end if
n = sign(val, -1_ik)
buffer = ""
pos = buffer_len + 1
do while (n < 0_ik)
pos = pos - 1
buffer(pos:pos) = numbers(mod(n, 10_ik))
n = n/10_ik
end do
if (val < 0_ik) then
pos = pos - 1
buffer(pos:pos) = '-'
end if
string = buffer(pos:)
end function integer_i1_to_string
pure function integer_i2_to_string(val) result(string)
integer, parameter :: ik = i2
!> Integer value to create string from
integer(ik), intent(in) :: val
!> String representation of integer
character(len=:), allocatable :: string
integer, parameter :: buffer_len = range(val)+2
character(len=buffer_len) :: buffer
integer :: pos
integer(ik) :: n
character(len=1), parameter :: numbers(-9:0) = &
["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"]
if (val == 0_ik) then
string = numbers(0)
return
end if
n = sign(val, -1_ik)
buffer = ""
pos = buffer_len + 1
do while (n < 0_ik)
pos = pos - 1
buffer(pos:pos) = numbers(mod(n, 10_ik))
n = n/10_ik
end do
if (val < 0_ik) then
pos = pos - 1
buffer(pos:pos) = '-'
end if
string = buffer(pos:)
end function integer_i2_to_string
pure function integer_i4_to_string(val) result(string)
integer, parameter :: ik = i4
!> Integer value to create string from
integer(ik), intent(in) :: val
!> String representation of integer
character(len=:), allocatable :: string
integer, parameter :: buffer_len = range(val)+2
character(len=buffer_len) :: buffer
integer :: pos
integer(ik) :: n
character(len=1), parameter :: numbers(-9:0) = &
["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"]
if (val == 0_ik) then
string = numbers(0)
return
end if
n = sign(val, -1_ik)
buffer = ""
pos = buffer_len + 1
do while (n < 0_ik)
pos = pos - 1
buffer(pos:pos) = numbers(mod(n, 10_ik))
n = n/10_ik
end do
if (val < 0_ik) then
pos = pos - 1
buffer(pos:pos) = '-'
end if
string = buffer(pos:)
end function integer_i4_to_string
pure function integer_i8_to_string(val) result(string)
integer, parameter :: ik = i8
!> Integer value to create string from
integer(ik), intent(in) :: val
!> String representation of integer
character(len=:), allocatable :: string
integer, parameter :: buffer_len = range(val)+2
character(len=buffer_len) :: buffer
integer :: pos
integer(ik) :: n
character(len=1), parameter :: numbers(-9:0) = &
["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"]
if (val == 0_ik) then
string = numbers(0)
return
end if
n = sign(val, -1_ik)
buffer = ""
pos = buffer_len + 1
do while (n < 0_ik)
pos = pos - 1
buffer(pos:pos) = numbers(mod(n, 10_ik))
n = n/10_ik
end do
if (val < 0_ik) then
pos = pos - 1
buffer(pos:pos) = '-'
end if
string = buffer(pos:)
end function integer_i8_to_string
pure function real_sp_to_string(val) result(string)
real(sp), intent(in) :: val
character(len=:), allocatable :: string
integer, parameter :: buffer_len = 128
character(len=buffer_len) :: buffer
write(buffer, '(g0)') val
string = trim(buffer)
end function real_sp_to_string
pure function real_dp_to_string(val) result(string)
real(dp), intent(in) :: val
character(len=:), allocatable :: string
integer, parameter :: buffer_len = 128
character(len=buffer_len) :: buffer
write(buffer, '(g0)') val
string = trim(buffer)
end function real_dp_to_string
#if WITH_XDP
pure function real_xdp_to_string(val) result(string)
real(xdp), intent(in) :: val
character(len=:), allocatable :: string
integer, parameter :: buffer_len = 128
character(len=buffer_len) :: buffer
write(buffer, '(g0)') val
string = trim(buffer)
end function real_xdp_to_string
#endif
#if WITH_QP
pure function real_qp_to_string(val) result(string)
real(qp), intent(in) :: val
character(len=:), allocatable :: string
integer, parameter :: buffer_len = 128
character(len=buffer_len) :: buffer
write(buffer, '(g0)') val
string = trim(buffer)
end function real_qp_to_string
#endif
pure function complex_sp_to_string(val) result(string)
complex(sp), intent(in) :: val
character(len=:), allocatable :: string
string = "("//to_string(real(val))//", "//to_string(aimag(val))//")"
end function complex_sp_to_string
pure function complex_dp_to_string(val) result(string)
complex(dp), intent(in) :: val
character(len=:), allocatable :: string
string = "("//to_string(real(val))//", "//to_string(aimag(val))//")"
end function complex_dp_to_string
#if WITH_XDP
pure function complex_xdp_to_string(val) result(string)
complex(xdp), intent(in) :: val
character(len=:), allocatable :: string
string = "("//to_string(real(val))//", "//to_string(aimag(val))//")"
end function complex_xdp_to_string
#endif
#if WITH_QP
pure function complex_qp_to_string(val) result(string)
complex(qp), intent(in) :: val
character(len=:), allocatable :: string
string = "("//to_string(real(val))//", "//to_string(aimag(val))//")"
end function complex_qp_to_string
#endif
!> Clear error type after it has been handled.
subroutine clear_error(error)
!> Error handling
type(error_type), intent(inout) :: error
if (error%stat /= success) then
error%stat = success
end if
if (allocated(error%message)) then
deallocate(error%message)
end if
end subroutine clear_error
!> Finalizer of the error type, in case the error is not correctly cleared it will
!> be escalated at runtime in a fatal way
subroutine escalate_error(error)
!> Error handling
type(error_type), intent(inout) :: error
if (error%stat /= success) then
write(error_unit, '(a)') "[Fatal] Uncaught error"
if (allocated(error%message)) then
write(error_unit, '(a, 1x, i0, *(1x, a))') &
"Code:", error%stat, "Message:", error%message
end if
error stop
end if
end subroutine escalate_error
!> Determine whether a value is not a number
elemental function is_nan_sp(val) result(is_nan)
#if WITH_IEEE_IS_NAN
use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
#endif
!> Value to check
real(sp), intent(in) :: val
!> Value is not a number
logical :: is_nan
#if WITH_IEEE_IS_NAN
is_nan = ieee_is_nan(val)
#else
is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val))
#endif
end function is_nan_sp
!> Determine whether a value is not a number
elemental function is_nan_dp(val) result(is_nan)
#if WITH_IEEE_IS_NAN
use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
#endif
!> Value to check
real(dp), intent(in) :: val
!> Value is not a number
logical :: is_nan
#if WITH_IEEE_IS_NAN
is_nan = ieee_is_nan(val)
#else
is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val))
#endif
end function is_nan_dp
#if WITH_XDP
!> Determine whether a value is not a number
elemental function is_nan_xdp(val) result(is_nan)
#if WITH_IEEE_IS_NAN
use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
#endif
!> Value to check
real(xdp), intent(in) :: val
!> Value is not a number
logical :: is_nan
#if WITH_IEEE_IS_NAN
is_nan = ieee_is_nan(val)
#else
is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val))
#endif
end function is_nan_xdp
#endif
#if WITH_QP
!> Determine whether a value is not a number
elemental function is_nan_qp(val) result(is_nan)
#if WITH_IEEE_IS_NAN
use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
#endif
!> Value to check
real(qp), intent(in) :: val
!> Value is not a number
logical :: is_nan
#if WITH_IEEE_IS_NAN
is_nan = ieee_is_nan(val)
#else
is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val))
#endif
end function is_nan_qp
#endif
!> Initialize color output
subroutine init_color_output(use_color)
!> Enable color output
logical, intent(in) :: use_color
color = new_color_output(use_color)
end subroutine init_color_output
!> Create a new colorizer object
function new_color_output(use_color) result(new)
!> Enable color output
logical, intent(in) :: use_color
!> New instance of the colorizer
type(color_output) :: new
type(color_code), parameter :: &
reset = color_code(style=0_i1), &
bold = color_code(style=1_i1), &
dim = color_code(style=2_i1), &
italic = color_code(style=3_i1), &
underline = color_code(style=4_i1), &
blink = color_code(style=5_i1), &
reverse = color_code(style=7_i1), &
hidden = color_code(style=8_i1)
type(color_code), parameter :: &
black = color_code(fg=0_i1), &
red = color_code(fg=1_i1), &
green = color_code(fg=2_i1), &
yellow = color_code(fg=3_i1), &
blue = color_code(fg=4_i1), &
magenta = color_code(fg=5_i1), &
cyan = color_code(fg=6_i1), &
white = color_code(fg=7_i1)
type(color_code), parameter :: &
bg_black = color_code(bg=0_i1), &
bg_red = color_code(bg=1_i1), &
bg_green = color_code(bg=2_i1), &
bg_yellow = color_code(bg=3_i1), &
bg_blue = color_code(bg=4_i1), &
bg_magenta = color_code(bg=5_i1), &
bg_cyan = color_code(bg=6_i1), &
bg_white = color_code(bg=7_i1)
if (use_color) then
new%reset = reset
new%bold = bold
new%dim = dim
new%italic = italic
new%underline = underline
new%blink = blink
new%reverse = reverse
new%hidden = hidden
new%black = black
new%red = red
new%green = green
new%yellow = yellow
new%blue = blue
new%magenta = magenta
new%cyan = cyan
new%white = white
new%bg_black = bg_black
new%bg_red = bg_red
new%bg_green = bg_green
new%bg_yellow = bg_yellow
new%bg_blue = bg_blue
new%bg_magenta = bg_magenta
new%bg_cyan = bg_cyan
new%bg_white = bg_white
end if
end function new_color_output
!> Add two escape sequences, attributes in the right value override the left value ones.
pure function add_color(lval, rval) result(code)
!> First escape code
type(color_code), intent(in) :: lval
!> Second escape code
type(color_code), intent(in) :: rval
!> Combined escape code
type(color_code) :: code
code = color_code( &
style=merge(rval%style, lval%style, rval%style >= 0), &
fg=merge(rval%fg, lval%fg, rval%fg >= 0), &
bg=merge(rval%bg, lval%bg, rval%bg >= 0))
end function add_color
!> Concatenate an escape code with a string and turn it into an actual escape sequence
pure function concat_color_left(lval, code) result(str)
!> String to add the escape code to
character(len=*), intent(in) :: lval
!> Escape sequence
type(color_code), intent(in) :: code
!> Concatenated string
character(len=:), allocatable :: str
str = lval // escape_color(code)
end function concat_color_left
!> Concatenate an escape code with a string and turn it into an actual escape sequence
pure function concat_color_right(code, rval) result(str)
!> String to add the escape code to
character(len=*), intent(in) :: rval
!> Escape sequence
type(color_code), intent(in) :: code
!> Concatenated string
character(len=:), allocatable :: str
str = escape_color(code) // rval
end function concat_color_right
!> Transform a color code into an actual ANSI escape sequence
pure function escape_color(code) result(str)
!> Color code to be used
type(color_code), intent(in) :: code
!> ANSI escape sequence representing the color code
character(len=:), allocatable :: str
character, parameter :: chars(0:9) = &
["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"]
if (anycolor(code)) then
str = achar(27) // "[0" ! Always reset the style
if (code%style > 0 .and. code%style < 10) str = str // ";" // chars(code%style)
if (code%fg >= 0 .and. code%fg < 10) str = str // ";3" // chars(code%fg)
if (code%bg >= 0 .and. code%bg < 10) str = str // ";4" // chars(code%bg)
str = str // "m"
else
str = ""
end if
end function escape_color
!> Check whether the code describes any color or is just a stub
pure function anycolor(code)
!> Escape sequence
type(color_code), intent(in) :: code
!> Any color / style is active
logical :: anycolor
anycolor = code%fg >= 0 .or. code%bg >= 0 .or. code%style >= 0
end function anycolor
end module testdrive
fortran-testdrive-0.6.0/meson.build 0000664 0001750 0001750 00000006415 15201524466 017540 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
project(
'test-drive',
'fortran',
version: '0.6.0',
license: 'Apache-2.0 OR MIT',
meson_version: '>=0.53',
default_options: [
'buildtype=debugoptimized',
'default_library=both',
],
)
install = not (meson.is_subproject() and get_option('default_library') == 'static')
# General configuration information
lib_deps = []
subdir('config')
# Collect source of the project
srcs = []
subdir('src')
# MCTC library target
testdrive_lib = library(
meson.project_name(),
sources: srcs,
version: meson.project_version(),
dependencies: lib_deps,
install: install,
)
# Export dependency for other projects and test suite
testdrive_inc = testdrive_lib.private_dir_include()
testdrive_dep = declare_dependency(
link_with: testdrive_lib,
include_directories: testdrive_inc,
dependencies: lib_deps,
)
# Package the license files
testdrive_lic = files(
'LICENSE-Apache',
'LICENSE-MIT',
)
if install
# Distribute the license files in share/licenses/
install_data(
testdrive_lic,
install_dir: get_option('datadir')/'licenses'/meson.project_name()
)
module_id = meson.project_name() / fc_id + '-' + fc.version()
meson.add_install_script(
'config'/'install-mod.py',
get_option('includedir') / module_id,
)
pkg = import('pkgconfig')
pkg.generate(
testdrive_lib,
description: 'The simple testing framework',
subdirs: ['', module_id],
)
cmake_data = configuration_data({
'PROJECT_NAME': meson.project_name(),
'PROJECT_VERSION': meson.project_version(),
'PACKAGE_INIT': 'cmake_minimum_required(VERSION 3.9...3.31 FATAL_ERROR)',
'CMAKE_SIZEOF_VOID_P': '8',
'CMAKE_INSTALL_PREFIX': get_option('prefix'),
'CMAKE_INSTALL_INCLUDEDIR': get_option('includedir'),
'CMAKE_INSTALL_LIBDIR': get_option('libdir'),
'TESTDRIVE_WITH_QP': with_qp ? 'ON' : 'OFF',
'TESTDRIVE_WITH_XDP': with_xdp ? 'ON' : 'OFF',
'TESTDRIVE_WITH_IEEE_IS_NAN': with_ieee_is_nan ? 'ON' : 'OFF',
'module-dir': module_id,
})
cmake_files = [
configure_file(
input: files('config'/'template-config.cmake'),
output: meson.project_name() + '-config.cmake',
configuration: cmake_data,
),
configure_file(
input: files('config'/'template-version.cmake'),
output: meson.project_name() + '-config-version.cmake',
configuration: cmake_data,
),
configure_file(
input: files('config'/'template-targets.cmake'),
output: meson.project_name() + '-targets.cmake',
configuration: cmake_data,
),
]
install_data(
cmake_files,
install_dir: get_option('libdir')/'cmake'/meson.project_name()
)
endif
# add the testsuite
if get_option('testing').auto() ? not meson.is_subproject() : get_option('testing').enabled()
subdir('test')
endif
fortran-testdrive-0.6.0/test/ 0000775 0001750 0001750 00000000000 15201524466 016347 5 ustar alastair alastair fortran-testdrive-0.6.0/test/test_check.F90 0000664 0001750 0001750 00000133564 15201524466 020757 0 ustar alastair alastair ! This file is part of test-drive.
! SPDX-Identifier: Apache-2.0 OR MIT
!
! Licensed under either of Apache License, Version 2.0 or MIT license
! at your option; you may not use this file except in compliance with
! the License.
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
!# Enable support for quadruple precision
#ifndef WITH_QP
#define WITH_QP 0
#endif
!# Enable support for extended double precision
#ifndef WITH_XDP
#define WITH_XDP 0
#endif
module test_check
use, intrinsic :: ieee_arithmetic, only : ieee_value, ieee_quiet_nan
use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test, to_string
implicit none
private
public :: collect_check
!> Single precision real numbers
integer, parameter :: sp = selected_real_kind(6)
!> Double precision real numbers
integer, parameter :: dp = selected_real_kind(15)
#if WITH_XDP
!> Extended double precision real numbers
integer, parameter :: xdp = selected_real_kind(18)
#endif
#if WITH_QP
!> Quadruple precision real numbers
integer, parameter :: qp = selected_real_kind(33)
#endif
!> Char length for integers
integer, parameter :: i1 = selected_int_kind(2)
!> Short length for integers
integer, parameter :: i2 = selected_int_kind(4)
!> Length of default integers
integer, parameter :: i4 = selected_int_kind(9)
!> Long length for integers
integer, parameter :: i8 = selected_int_kind(18)
contains
!> Collect all exported unit tests
subroutine collect_check(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
new_unittest("success", test_success), &
new_unittest("failure", test_failure, should_fail=.true.), &
new_unittest("failure-message", test_failure_message, should_fail=.true.), &
new_unittest("failure-with-more", test_failure_with_more, should_fail=.true.), &
new_unittest("skipped", test_skipped), &
new_unittest("expression", test_expression), &
new_unittest("expression-fail", test_expression_fail, should_fail=.true.), &
new_unittest("expression-message", test_expression_message, should_fail=.true.), &
new_unittest("expression-with-more", test_expression_with_more, should_fail=.true.), &
new_unittest("real-single-abs", test_rsp_abs), &
new_unittest("real-single-rel", test_rsp_rel), &
new_unittest("real-single-nan", test_rsp_nan, should_fail=.true.), &
new_unittest("real-single-abs-fail", test_rsp_abs_fail, should_fail=.true.), &
new_unittest("real-single-rel-fail", test_rsp_rel_fail, should_fail=.true.), &
new_unittest("real-single-abs-message", test_rsp_abs_message, should_fail=.true.), &
new_unittest("real-single-nan-message", test_rsp_nan_message, should_fail=.true.), &
new_unittest("real-double-abs", test_rdp_abs), &
new_unittest("real-double-rel", test_rdp_rel), &
new_unittest("real-double-nan", test_rdp_nan, should_fail=.true.), &
new_unittest("real-double-abs-fail", test_rdp_abs_fail, should_fail=.true.), &
new_unittest("real-double-rel-fail", test_rdp_rel_fail, should_fail=.true.), &
new_unittest("real-double-abs-message", test_rdp_abs_message, should_fail=.true.), &
new_unittest("real-double-nan-message", test_rdp_nan_message, should_fail=.true.), &
new_unittest("real-xdouble-abs", test_rxdp_abs), &
new_unittest("real-xdouble-rel", test_rxdp_rel), &
new_unittest("real-xdouble-nan", test_rxdp_nan, should_fail=.true.), &
new_unittest("real-xdouble-abs-fail", test_rxdp_abs_fail, should_fail=.true.), &
new_unittest("real-xdouble-rel-fail", test_rxdp_rel_fail, should_fail=.true.), &
new_unittest("real-xdouble-abs-message", test_rxdp_abs_message, should_fail=.true.), &
new_unittest("real-xdouble-nan-message", test_rxdp_nan_message, should_fail=.true.), &
new_unittest("real-quadruple-abs", test_rqp_abs), &
new_unittest("real-quadruple-rel", test_rqp_rel), &
new_unittest("real-quadruple-nan", test_rqp_nan, should_fail=.true.), &
new_unittest("real-quadruple-abs-fail", test_rqp_abs_fail, should_fail=.true.), &
new_unittest("real-quadruple-rel-fail", test_rqp_rel_fail, should_fail=.true.), &
new_unittest("real-quadruple-abs-message", test_rqp_abs_message, should_fail=.true.), &
new_unittest("real-quadruple-nan-message", test_rqp_nan_message, should_fail=.true.), &
new_unittest("complex-single-abs", test_csp_abs), &
new_unittest("complex-single-rel", test_csp_rel), &
new_unittest("complex-single-nan", test_csp_nan, should_fail=.true.), &
new_unittest("complex-single-abs-fail", test_csp_abs_fail, should_fail=.true.), &
new_unittest("complex-single-rel-fail", test_csp_rel_fail, should_fail=.true.), &
new_unittest("complex-single-abs-message", test_csp_abs_message, should_fail=.true.), &
new_unittest("complex-single-nan-message", test_csp_nan_message, should_fail=.true.), &
new_unittest("complex-double-abs", test_cdp_abs), &
new_unittest("complex-double-rel", test_cdp_rel), &
new_unittest("complex-double-nan", test_cdp_nan, should_fail=.true.), &
new_unittest("complex-double-abs-fail", test_cdp_abs_fail, should_fail=.true.), &
new_unittest("complex-double-rel-fail", test_cdp_rel_fail, should_fail=.true.), &
new_unittest("complex-double-abs-message", test_cdp_abs_message, should_fail=.true.), &
new_unittest("complex-double-nan-message", test_cdp_nan_message, should_fail=.true.), &
new_unittest("complex-xdouble-abs", test_cxdp_abs), &
new_unittest("complex-xdouble-rel", test_cxdp_rel), &
new_unittest("complex-xdouble-nan", test_cxdp_nan, should_fail=.true.), &
new_unittest("complex-xdouble-abs-fail", test_cxdp_abs_fail, should_fail=.true.), &
new_unittest("complex-xdouble-rel-fail", test_cxdp_rel_fail, should_fail=.true.), &
new_unittest("complex-xdouble-abs-message", test_cxdp_abs_message, should_fail=.true.), &
new_unittest("complex-xdouble-nan-message", test_cxdp_nan_message, should_fail=.true.), &
new_unittest("complex-quadruple-abs", test_cqp_abs), &
new_unittest("complex-quadruple-rel", test_cqp_rel), &
new_unittest("complex-quadruple-nan", test_cqp_nan, should_fail=.true.), &
new_unittest("complex-quadruple-abs-fail", test_cqp_abs_fail, should_fail=.true.), &
new_unittest("complex-quadruple-rel-fail", test_cqp_rel_fail, should_fail=.true.), &
new_unittest("complex-quadruple-abs-message", test_cqp_abs_message, should_fail=.true.), &
new_unittest("complex-quadruple-nan-message", test_cqp_nan_message, should_fail=.true.), &
new_unittest("integer-char", test_i1), &
new_unittest("integer-char-fail", test_i1_fail, should_fail=.true.), &
new_unittest("integer-char-message", test_i1_message, should_fail=.true.), &
new_unittest("integer-char-with-more", test_i1_with_more, should_fail=.true.), &
new_unittest("integer-short", test_i2), &
new_unittest("integer-short-fail", test_i2_fail, should_fail=.true.), &
new_unittest("integer-short-message", test_i2_message, should_fail=.true.), &
new_unittest("integer-short-with-more", test_i2_with_more, should_fail=.true.), &
new_unittest("integer-default", test_i4), &
new_unittest("integer-default-fail", test_i4_fail, should_fail=.true.), &
new_unittest("integer-default-message", test_i4_message, should_fail=.true.), &
new_unittest("integer-default-with-more", test_i4_with_more, should_fail=.true.), &
new_unittest("integer-long", test_i8), &
new_unittest("integer-long-fail", test_i8_fail, should_fail=.true.), &
new_unittest("integer-long-message", test_i8_message, should_fail=.true.), &
new_unittest("integer-long-with-more", test_i8_with_more, should_fail=.true.), &
new_unittest("logical-default-true", test_l4_true), &
new_unittest("logical-default-false", test_l4_false), &
new_unittest("logical-default-fail", test_l4_fail, should_fail=.true.), &
new_unittest("logical-default-message", test_l4_message, should_fail=.true.), &
new_unittest("logical-default-with-more", test_l4_with_more, should_fail=.true.), &
new_unittest("character", test_char), &
new_unittest("character-fail", test_char_fail, should_fail=.true.), &
new_unittest("character-message", test_char_message, should_fail=.true.), &
new_unittest("character-with-more", test_char_with_more, should_fail=.true.), &
new_unittest("character-with-more", test_char_with_more, should_fail=.true.), &
new_unittest("string-i1", test_string_i1), &
new_unittest("string-i2", test_string_i2), &
new_unittest("string-i4", test_string_i4), &
new_unittest("string-i8", test_string_i8), &
new_unittest("real-single-absrel-relpass-absfail", test_rsp_absrel_relpass_absfail), &
new_unittest("real-single-absrel-relfail-abspass", test_rsp_absrel_relfail_abspass), &
new_unittest("real-single-absrel-fail", test_rsp_absrel_fail, should_fail=.true.), &
new_unittest("real-double-absrel-relpass-absfail", test_rdp_absrel_relpass_absfail), &
new_unittest("real-double-absrel-relfail-abspass", test_rdp_absrel_relfail_abspass), &
new_unittest("real-double-absrel-fail", test_rdp_absrel_fail, should_fail=.true.), &
new_unittest("complex-single-absrel-relpass-absfail", test_csp_absrel_relpass_absfail), &
new_unittest("complex-single-absrel-relfail-abspass", test_csp_absrel_relfail_abspass), &
new_unittest("complex-single-absrel-fail", test_csp_absrel_fail, should_fail=.true.), &
new_unittest("complex-double-absrel-relpass-absfail", test_cdp_absrel_relpass_absfail), &
new_unittest("complex-double-absrel-relfail-abspass", test_cdp_absrel_relfail_abspass), &
new_unittest("complex-double-absrel-fail", test_cdp_absrel_fail, should_fail=.true.), &
new_unittest("real-xdouble-absrel-relpass-absfail", test_rxdp_absrel_relpass_absfail), &
new_unittest("real-xdouble-absrel-relfail-abspass", test_rxdp_absrel_relfail_abspass), &
new_unittest("real-xdouble-absrel-fail", test_rxdp_absrel_fail, should_fail=.true.), &
new_unittest("real-quadruple-absrel-relpass-absfail", test_rqp_absrel_relpass_absfail), &
new_unittest("real-quadruple-absrel-relfail-abspass", test_rqp_absrel_relfail_abspass), &
new_unittest("real-quadruple-absrel-fail", test_rqp_absrel_fail, should_fail=.true.), &
new_unittest("complex-xdouble-absrel-relpass-absfail", test_cxdp_absrel_relpass_absfail), &
new_unittest("complex-xdouble-absrel-relfail-abspass", test_cxdp_absrel_relfail_abspass), &
new_unittest("complex-xdouble-absrel-fail", test_cxdp_absrel_fail, should_fail=.true.), &
new_unittest("complex-quadruple-absrel-relpass-absfail", test_cqp_absrel_relpass_absfail), &
new_unittest("complex-quadruple-absrel-relfail-abspass", test_cqp_absrel_relfail_abspass), &
new_unittest("complex-quadruple-absrel-fail", test_cqp_absrel_fail, should_fail=.true.) &
]
end subroutine collect_check
subroutine test_success(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, 0)
end subroutine test_success
subroutine test_failure(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, 7)
end subroutine test_failure
subroutine test_failure_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, 4, "Custom message describing the error")
end subroutine test_failure_message
subroutine test_failure_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, 3, more="with an additional descriptive message here")
end subroutine test_failure_with_more
subroutine test_skipped(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call skip_test(error, "This test is always skipped")
end subroutine test_skipped
subroutine test_expression(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, index("info!", "!") > 0)
end subroutine test_expression
subroutine test_expression_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, index("info!", "?") > 0)
end subroutine test_expression_fail
subroutine test_expression_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, index("info!", "!") == 0, 'index("info!", "!") == 0')
end subroutine test_expression_message
subroutine test_expression_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, index("info!", "?") /= 0, more='index("info!", "?")')
end subroutine test_expression_with_more
subroutine test_rsp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 3.3_sp
call check(error, val, 3.3_sp, thr=sqrt(epsilon(val)))
end subroutine test_rsp_abs
subroutine test_rsp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, 3.3_sp, rel=.true.)
end subroutine test_rsp_nan
subroutine test_rsp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 3.3_sp
call check(error, val, 3.3_sp, rel=.true.)
end subroutine test_rsp_rel
subroutine test_rsp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 1.0_sp
call check(error, val, 2.0_sp)
end subroutine test_rsp_abs_fail
subroutine test_rsp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 1.0_sp
call check(error, val, 1.5_sp, rel=.true.)
end subroutine test_rsp_rel_fail
subroutine test_rsp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 1.0_sp
call check(error, val, 1.5_sp, message="Actual value is not 1.5")
end subroutine test_rsp_abs_message
subroutine test_rsp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, message="Actual value is not a number")
end subroutine test_rsp_nan_message
subroutine test_rdp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 3.3_dp
call check(error, val, 3.3_dp, thr=sqrt(epsilon(val)))
end subroutine test_rdp_abs
subroutine test_rdp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 3.3_dp
call check(error, val, 3.3_dp, rel=.true.)
end subroutine test_rdp_rel
subroutine test_rdp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, 3.3_dp, rel=.true.)
end subroutine test_rdp_nan
subroutine test_rdp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 1.0_dp
call check(error, val, 2.0_dp)
end subroutine test_rdp_abs_fail
subroutine test_rdp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 1.0_dp
call check(error, val, 1.5_dp, rel=.true.)
end subroutine test_rdp_rel_fail
subroutine test_rdp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 1.0_dp
call check(error, val, 1.5_dp, message="Actual value is not 1.5")
end subroutine test_rdp_abs_message
subroutine test_rdp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, message="Actual value is not a number")
end subroutine test_rdp_nan_message
subroutine test_rxdp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 3.3_xdp
call check(error, val, 3.3_xdp, thr=sqrt(epsilon(val)))
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_abs
subroutine test_rxdp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 3.3_xdp
call check(error, val, 3.3_xdp, rel=.true.)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_rel
subroutine test_rxdp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, 3.3_xdp, rel=.true.)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_nan
subroutine test_rxdp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 1.0_xdp
call check(error, val, 2.0_xdp)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_abs_fail
subroutine test_rxdp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 1.0_xdp
call check(error, val, 1.5_xdp, rel=.true.)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_rel_fail
subroutine test_rxdp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 1.0_xdp
call check(error, val, 1.5_xdp, message="Actual value is not 1.5")
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_abs_message
subroutine test_rxdp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, message="Actual value is not a number")
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_nan_message
subroutine test_rqp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 3.3_qp
call check(error, val, 3.3_qp, thr=sqrt(epsilon(val)))
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_abs
subroutine test_rqp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 3.3_qp
call check(error, val, 3.3_qp, rel=.true.)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_rel
subroutine test_rqp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, 3.3_qp, rel=.true.)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_nan
subroutine test_rqp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 1.0_qp
call check(error, val, 2.0_qp)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_abs_fail
subroutine test_rqp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 1.0_qp
call check(error, val, 1.5_qp, rel=.true.)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_rel_fail
subroutine test_rqp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 1.0_qp
call check(error, val, 1.5_qp, message="Actual value is not 1.5")
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_abs_message
subroutine test_rqp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = ieee_value(val, ieee_quiet_nan)
call check(error, val, message="Actual value is not a number")
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_nan_message
subroutine test_csp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(3.3_sp, 1.0_sp, sp)
call check(error, val, cmplx(3.3_sp, 1.0_sp, sp), thr=sqrt(epsilon(abs(val))))
end subroutine test_csp_abs
subroutine test_csp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(ieee_value(0.0_sp, ieee_quiet_nan), &
& ieee_value(0.0_sp, ieee_quiet_nan), sp)
call check(error, val, cmplx(3.3_sp, 1.0_sp, sp), rel=.true.)
end subroutine test_csp_nan
subroutine test_csp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(3.3_sp, 1.0_sp, sp)
call check(error, val, cmplx(3.3_sp, 1.0_sp, sp), rel=.true.)
end subroutine test_csp_rel
subroutine test_csp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(1.0_sp, 2.0_sp, sp)
call check(error, val, cmplx(2.0_sp, 1.0_sp, sp))
end subroutine test_csp_abs_fail
subroutine test_csp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(1.0_sp, 1.5_sp, sp)
call check(error, val, cmplx(1.5_sp, 1.0_sp, sp), rel=.true.)
end subroutine test_csp_rel_fail
subroutine test_csp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(1.0_sp, 1.5_sp, sp)
call check(error, val, cmplx(1.5_sp, 1.0_sp, sp), message="Actual value is not 1.5+1.0i")
end subroutine test_csp_abs_message
subroutine test_csp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(ieee_value(0.0_sp, ieee_quiet_nan), 0.0_sp, sp)
call check(error, val, message="Actual value is not a number")
end subroutine test_csp_nan_message
subroutine test_cdp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(3.3_dp, 1.0_dp, dp)
call check(error, val, cmplx(3.3_dp, 1.0_dp, dp), thr=sqrt(epsilon(real(val))))
end subroutine test_cdp_abs
subroutine test_cdp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(3.3_dp, 1.0_dp, dp)
call check(error, val, cmplx(3.3_dp, 1.0_dp, dp), rel=.true.)
end subroutine test_cdp_rel
subroutine test_cdp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(ieee_value(0.0_dp, ieee_quiet_nan), 0.0_dp, dp)
call check(error, val, cmplx(3.3_dp, 1.0_dp, dp), rel=.true.)
end subroutine test_cdp_nan
subroutine test_cdp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(1.0_dp, 2.0_dp, dp)
call check(error, val, cmplx(2.0_dp, 1.0_dp, dp))
end subroutine test_cdp_abs_fail
subroutine test_cdp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(1.0_dp, 1.5_dp, dp)
call check(error, val, cmplx(1.5_dp, 1.0_dp, dp), rel=.true.)
end subroutine test_cdp_rel_fail
subroutine test_cdp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(1.0_dp, 1.5_dp, dp)
call check(error, val, cmplx(1.5_dp, 1.0_dp, dp), message="Actual value is not 1.5+1.0i")
end subroutine test_cdp_abs_message
subroutine test_cdp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(ieee_value(0.0_dp, ieee_quiet_nan), 0.0_dp, dp)
call check(error, val, message="Actual value is not a number")
end subroutine test_cdp_nan_message
subroutine test_cxdp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(3.3_xdp, 1.0_xdp, xdp)
call check(error, val, cmplx(3.3_xdp, 1.0_xdp, xdp), thr=sqrt(epsilon(real(val))))
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_abs
subroutine test_cxdp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(3.3_xdp, 1.0_xdp, xdp)
call check(error, val, cmplx(3.3_xdp, 1.0_xdp, xdp), rel=.true.)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_rel
subroutine test_cxdp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(ieee_value(0.0_xdp, ieee_quiet_nan), 0.0_xdp, xdp)
call check(error, val, cmplx(3.3_xdp, 1.0_xdp, xdp), rel=.true.)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_nan
subroutine test_cxdp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(1.0_xdp, 2.0_xdp, xdp)
call check(error, val, cmplx(2.0_xdp, 1.0_xdp, xdp))
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_abs_fail
subroutine test_cxdp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(1.0_xdp, 1.5_xdp, xdp)
call check(error, val, cmplx(1.5_xdp, 1.0_xdp, xdp), rel=.true.)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_rel_fail
subroutine test_cxdp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(1.0_xdp, 1.5_xdp, xdp)
call check(error, val, cmplx(1.5_xdp, 1.0_xdp, xdp), message="Actual value is not 1.5+1.0i")
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_abs_message
subroutine test_cxdp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(ieee_value(0.0_xdp, ieee_quiet_nan), 0.0_xdp, xdp)
call check(error, val, message="Actual value is not a number")
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_nan_message
subroutine test_cqp_abs(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(3.3_qp, 1.0_qp, qp)
call check(error, val, cmplx(3.3_qp, 1.0_qp, qp), thr=sqrt(epsilon(real(val))))
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_abs
subroutine test_cqp_rel(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(3.3_qp, 1.0_qp, qp)
call check(error, val, cmplx(3.3_qp, 1.0_qp, qp), rel=.true.)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_rel
subroutine test_cqp_nan(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(ieee_value(0.0_qp, ieee_quiet_nan), 0.0_qp, qp)
call check(error, val, cmplx(3.3_qp, 1.0_qp, qp), rel=.true.)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_nan
subroutine test_cqp_abs_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(1.0_qp, 2.0_qp, qp)
call check(error, val, cmplx(2.0_qp, 1.0_qp, qp))
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_abs_fail
subroutine test_cqp_rel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(1.0_qp, 1.5_qp, qp)
call check(error, val, cmplx(1.5_qp, 1.0_qp, qp), rel=.true.)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_rel_fail
subroutine test_cqp_abs_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(1.0_qp, 1.5_qp, qp)
call check(error, val, cmplx(1.5_qp, 1.0_qp, qp), message="Actual value is not 1.5+1.0i")
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_abs_message
subroutine test_cqp_nan_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(ieee_value(0.0_qp, ieee_quiet_nan), 0.0_qp, qp)
call check(error, val, message="Actual value is not a number")
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_nan_message
subroutine test_i1(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i1) :: val
val = 3_i1
call check(error, val, 3_i1)
end subroutine test_i1
subroutine test_i1_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i1) :: val
val = 3_i1
call check(error, val, -4_i1)
end subroutine test_i1_fail
subroutine test_i1_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i1) :: val
val = -3_i1
call check(error, val, 7_i1, "Actual value is not seven")
end subroutine test_i1_message
subroutine test_i1_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i1) :: val
val = 0_i1
call check(error, val, 3_i1, more="with an additional descriptive message here")
end subroutine test_i1_with_more
subroutine test_i2(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i2) :: val
val = 3_i2
call check(error, val, 3_i2)
end subroutine test_i2
subroutine test_i2_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i2) :: val
val = 3_i2
call check(error, val, -4_i2)
end subroutine test_i2_fail
subroutine test_i2_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i2) :: val
val = -3_i2
call check(error, val, 7_i2, "Actual value is not seven")
end subroutine test_i2_message
subroutine test_i2_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i2) :: val
val = 0_i2
call check(error, val, 3_i2, more="with an additional descriptive message here")
end subroutine test_i2_with_more
subroutine test_i4(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i4) :: val
val = 3_i4
call check(error, val, 3_i4)
end subroutine test_i4
subroutine test_i4_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i4) :: val
val = 3_i4
call check(error, val, -4_i4)
end subroutine test_i4_fail
subroutine test_i4_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i4) :: val
val = -3_i4
call check(error, val, 7_i4, "Actual value is not seven")
end subroutine test_i4_message
subroutine test_i4_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i4) :: val
val = 0_i4
call check(error, val, 3_i4, more="with an additional descriptive message here")
end subroutine test_i4_with_more
subroutine test_i8(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i8) :: val
val = 3_i8
call check(error, val, 3_i8)
end subroutine test_i8
subroutine test_i8_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i8) :: val
val = 3_i8
call check(error, val, -4_i8)
end subroutine test_i8_fail
subroutine test_i8_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i8) :: val
val = -3_i8
call check(error, val, 7_i8, "Actual value is not seven")
end subroutine test_i8_message
subroutine test_i8_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer(i8) :: val
val = 0_i8
call check(error, val, 3_i8, more="with an additional descriptive message here")
end subroutine test_i8_with_more
subroutine test_l4_true(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, .true., .true.)
end subroutine test_l4_true
subroutine test_l4_false(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, .false., .false.)
end subroutine test_l4_false
subroutine test_l4_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, .true., .false.)
end subroutine test_l4_fail
subroutine test_l4_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, .false., .true., "Logical value is not true")
end subroutine test_l4_message
subroutine test_l4_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, .true., .false., more="with an additional descriptive message")
end subroutine test_l4_with_more
subroutine test_char(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
character(len=:), allocatable :: val
val = "positive"
call check(error, val, "positive")
end subroutine test_char
subroutine test_char_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
character(len=:), allocatable :: val
val = "positive"
call check(error, val, "negative")
end subroutine test_char_fail
subroutine test_char_message(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
character(len=:), allocatable :: val
val = "positive"
call check(error, val, "negative", "Character string should be negative")
end subroutine test_char_message
subroutine test_char_with_more(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
character(len=:), allocatable :: val
val = "positive"
call check(error, val, "negative", more="with an additional descriptive message")
end subroutine test_char_with_more
subroutine test_string_i1(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, to_string(-huge(1_i1) - 1_i1), "-128")
end subroutine test_string_i1
subroutine test_string_i2(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, to_string(-huge(1_i2) - 1_i2), "-32768")
end subroutine test_string_i2
subroutine test_string_i4(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, to_string(-huge(1_i4) - 1_i4), "-2147483648")
end subroutine test_string_i4
subroutine test_string_i8(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, to_string(-huge(1_i8) - 1_i8), "-9223372036854775808")
end subroutine test_string_i8
subroutine test_rsp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 1.005_sp
call check(error, val, 1.0_sp, thr_abs=1.0e-4_sp, thr_rel=1.0e-2_sp)
end subroutine test_rsp_absrel_relpass_absfail
subroutine test_rsp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 1.05e-3_sp
call check(error, val, 1.0e-3_sp, thr_abs=1.0e-4_sp, thr_rel=1.0e-2_sp)
end subroutine test_rsp_absrel_relfail_abspass
subroutine test_rsp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(sp) :: val
val = 1.02_sp
call check(error, val, 1.0_sp, thr_abs=1.0e-4_sp, thr_rel=1.0e-2_sp)
end subroutine test_rsp_absrel_fail
subroutine test_rdp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 1.005_dp
call check(error, val, 1.0_dp, thr_abs=1.0e-8_dp, thr_rel=1.0e-2_dp)
end subroutine test_rdp_absrel_relpass_absfail
subroutine test_rdp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 1.05e-3_dp
call check(error, val, 1.0e-3_dp, thr_abs=1.0e-4_dp, thr_rel=1.0e-2_dp)
end subroutine test_rdp_absrel_relfail_abspass
subroutine test_rdp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
real(dp) :: val
val = 1.02_dp
call check(error, val, 1.0_dp, thr_abs=1.0e-8_dp, thr_rel=1.0e-2_dp)
end subroutine test_rdp_absrel_fail
subroutine test_csp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(1.004_sp, 1.003_sp, sp)
call check(error, val, cmplx(1.0_sp, 1.0_sp, sp), thr_abs=1.0e-4_sp, thr_rel=1.0e-2_sp)
end subroutine test_csp_absrel_relpass_absfail
subroutine test_csp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(1.05e-3_sp, 1.05e-3_sp, sp)
call check(error, val, cmplx(1.0e-3_sp, 1.0e-3_sp, sp), thr_abs=1.0e-4_sp, thr_rel=1.0e-2_sp)
end subroutine test_csp_absrel_relfail_abspass
subroutine test_csp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(sp) :: val
val = cmplx(1.02_sp, 1.02_sp, sp)
call check(error, val, cmplx(1.0_sp, 1.0_sp, sp), thr_abs=1.0e-4_sp, thr_rel=1.0e-2_sp)
end subroutine test_csp_absrel_fail
subroutine test_cdp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(1.004_dp, 1.003_dp, dp)
call check(error, val, cmplx(1.0_dp, 1.0_dp, dp), thr_abs=1.0e-8_dp, thr_rel=1.0e-2_dp)
end subroutine test_cdp_absrel_relpass_absfail
subroutine test_cdp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(1.05e-3_dp, 1.05e-3_dp, dp)
call check(error, val, cmplx(1.0e-3_dp, 1.0e-3_dp, dp), thr_abs=1.0e-4_dp, thr_rel=1.0e-2_dp)
end subroutine test_cdp_absrel_relfail_abspass
subroutine test_cdp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
complex(dp) :: val
val = cmplx(1.02_dp, 1.02_dp, dp)
call check(error, val, cmplx(1.0_dp, 1.0_dp, dp), thr_abs=1.0e-8_dp, thr_rel=1.0e-2_dp)
end subroutine test_cdp_absrel_fail
subroutine test_rxdp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 1.005_xdp
call check(error, val, 1.0_xdp, thr_abs=1.0e-8_xdp, thr_rel=1.0e-2_xdp)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_absrel_relpass_absfail
subroutine test_rxdp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 1.05e-3_xdp
call check(error, val, 1.0e-3_xdp, thr_abs=1.0e-4_xdp, thr_rel=1.0e-2_xdp)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_absrel_relfail_abspass
subroutine test_rxdp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
real(xdp) :: val
val = 1.02_xdp
call check(error, val, 1.0_xdp, thr_abs=1.0e-8_xdp, thr_rel=1.0e-2_xdp)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_rxdp_absrel_fail
subroutine test_rqp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 1.005_qp
call check(error, val, 1.0_qp, thr_abs=1.0e-8_qp, thr_rel=1.0e-2_qp)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_absrel_relpass_absfail
subroutine test_rqp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 1.05e-3_qp
call check(error, val, 1.0e-3_qp, thr_abs=1.0e-4_qp, thr_rel=1.0e-2_qp)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_absrel_relfail_abspass
subroutine test_rqp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
real(qp) :: val
val = 1.02_qp
call check(error, val, 1.0_qp, thr_abs=1.0e-8_qp, thr_rel=1.0e-2_qp)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_rqp_absrel_fail
subroutine test_cxdp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(1.004_xdp, 1.003_xdp, xdp)
call check(error, val, cmplx(1.0_xdp, 1.0_xdp, xdp), thr_abs=1.0e-8_xdp, thr_rel=1.0e-2_xdp)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_absrel_relpass_absfail
subroutine test_cxdp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(1.05e-3_xdp, 1.05e-3_xdp, xdp)
call check(error, val, cmplx(1.0e-3_xdp, 1.0e-3_xdp, xdp), thr_abs=1.0e-4_xdp, thr_rel=1.0e-2_xdp)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_absrel_relfail_abspass
subroutine test_cxdp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_XDP
complex(xdp) :: val
val = cmplx(1.02_xdp, 1.02_xdp, xdp)
call check(error, val, cmplx(1.0_xdp, 1.0_xdp, xdp), thr_abs=1.0e-8_xdp, thr_rel=1.0e-2_xdp)
#else
call skip_test(error, "Extended double precision is not enabled")
#endif
end subroutine test_cxdp_absrel_fail
subroutine test_cqp_absrel_relpass_absfail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(1.004_qp, 1.003_qp, qp)
call check(error, val, cmplx(1.0_qp, 1.0_qp, qp), thr_abs=1.0e-8_qp, thr_rel=1.0e-2_qp)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_absrel_relpass_absfail
subroutine test_cqp_absrel_relfail_abspass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(1.05e-3_qp, 1.05e-3_qp, qp)
call check(error, val, cmplx(1.0e-3_qp, 1.0e-3_qp, qp), thr_abs=1.0e-4_qp, thr_rel=1.0e-2_qp)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_absrel_relfail_abspass
subroutine test_cqp_absrel_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
#if WITH_QP
complex(qp) :: val
val = cmplx(1.02_qp, 1.02_qp, qp)
call check(error, val, cmplx(1.0_qp, 1.0_qp, qp), thr_abs=1.0e-8_qp, thr_rel=1.0e-2_qp)
#else
call skip_test(error, "Quadruple precision is not enabled")
#endif
end subroutine test_cqp_absrel_fail
end module test_check
fortran-testdrive-0.6.0/test/meson.build 0000664 0001750 0001750 00000001563 15201524466 020516 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
tests = [
'check',
'select',
]
test_srcs = files(
'main.f90',
)
foreach t : tests
test_srcs += files('test_@0@.F90'.format(t.underscorify()))
endforeach
tester = executable(
'tester',
sources: test_srcs,
dependencies: testdrive_dep,
)
test('all tests', tester)
foreach t : tests
test(t, tester, args: t)
endforeach
fortran-testdrive-0.6.0/test/main.f90 0000664 0001750 0001750 00000004666 15201524466 017627 0 ustar alastair alastair ! This file is part of test-drive.
! SPDX-Identifier: Apache-2.0 OR MIT
!
! Licensed under either of Apache License, Version 2.0 or MIT license
! at your option; you may not use this file except in compliance with
! the License.
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
!> Driver for unit testing
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type, &
& select_suite, run_selected, get_argument, junit_output, junit_header, &
& init_color_output
use test_check, only : collect_check
use test_select, only : collect_select
implicit none
integer :: stat, is
character(len=:), allocatable :: suite_name, test_name
type(testsuite_type), allocatable :: testsuites(:)
character(len=*), parameter :: fmt = '("#", *(1x, a))'
type(junit_output) :: junit
stat = 0
call junit_header(junit, "testdrive")
testsuites = [ &
new_testsuite("check", collect_check), &
new_testsuite("select", collect_select) &
]
call get_argument(1, suite_name)
call get_argument(2, test_name)
call init_color_output(.true.)
if (allocated(suite_name)) then
is = select_suite(testsuites, suite_name)
if (is > 0 .and. is <= size(testsuites)) then
if (allocated(test_name)) then
write(error_unit, fmt) "Suite:", testsuites(is)%name
call run_selected(testsuites(is)%collect, test_name, error_unit, stat, junit=junit)
if (stat < 0) then
error stop 1
end if
else
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat, junit=junit)
end if
else
write(error_unit, fmt) "Available testsuites"
do is = 1, size(testsuites)
write(error_unit, fmt) "-", testsuites(is)%name
end do
error stop 1
end if
else
do is = 1, size(testsuites)
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat, junit=junit)
end do
end if
if (stat > 0) then
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop 1
end if
end program tester
fortran-testdrive-0.6.0/test/export/ 0000775 0001750 0001750 00000000000 15201524466 017670 5 ustar alastair alastair fortran-testdrive-0.6.0/test/export/meson.build 0000664 0001750 0001750 00000000205 15201524466 022027 0 ustar alastair alastair project('test-test', 'fortran')
executable(
'test-test',
sources: ['example.f90'],
dependencies: [dependency('test-drive')],
) fortran-testdrive-0.6.0/test/export/example.f90 0000664 0001750 0001750 00000001151 15201524466 021641 0 ustar alastair alastair program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
implicit none
integer :: stat, is
type(testsuite_type), allocatable :: testsuites(:)
character(len=*), parameter :: fmt = '("#", *(1x, a))'
stat = 0
allocate(testsuites(0))
do is = 1, size(testsuites)
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat)
end do
if (stat > 0) then
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop
end if
end program tester
fortran-testdrive-0.6.0/test/export/CMakeLists.txt 0000664 0001750 0001750 00000000321 15201524466 022424 0 ustar alastair alastair cmake_minimum_required(VERSION 3.18)
project(test-test Fortran)
find_package(test-drive CONFIG REQUIRED)
add_executable(test-test "example.f90")
target_link_libraries(test-test PUBLIC test-drive::test-drive) fortran-testdrive-0.6.0/test/test_select.F90 0000664 0001750 0001750 00000007560 15201524466 021155 0 ustar alastair alastair ! This file is part of test-drive.
! SPDX-Identifier: Apache-2.0 OR MIT
!
! Licensed under either of Apache License, Version 2.0 or MIT license
! at your option; you may not use this file except in compliance with
! the License.
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
module test_select
use, intrinsic :: ieee_arithmetic, only : ieee_value, ieee_quiet_nan
use testdrive, only : new_unittest, unittest_type, error_type, check, &
& run_testsuite, new_testsuite, testsuite_type, select_suite, run_selected
implicit none
private
public :: collect_select
contains
!> Collect all exported unit tests
subroutine collect_select(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
new_unittest("always-pass", always_pass), &
new_unittest("always-fail", always_fail, should_fail=.true.), &
new_unittest("run-good-suite", test_run_good_suite), &
new_unittest("run-bad-suite", test_run_bad_suite), &
new_unittest("run-selected", test_run_selected), &
new_unittest("select-missing", test_select_missing) &
]
end subroutine collect_select
subroutine always_pass(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, 0)
end subroutine always_pass
subroutine always_fail(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
call check(error, 1, "Always failing test")
end subroutine always_fail
!> Stub test suite collector defining passing unit tests
subroutine stub_collect(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
new_unittest("always-pass", always_pass), &
new_unittest("always-fail", always_fail, should_fail=.true.) &
]
end subroutine stub_collect
!> Bad test suite collector defining flaky unit tests
subroutine stub_collect_bad(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
new_unittest("always-pass", always_pass, should_fail=.true.), &
new_unittest("always-fail", always_fail) &
]
end subroutine stub_collect_bad
subroutine test_run_good_suite(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer :: unit, stat
open(status='scratch', newunit=unit)
stat = 7
call run_testsuite(stub_collect, unit, stat)
call check(error, stat, 7)
close(unit)
end subroutine test_run_good_suite
subroutine test_run_bad_suite(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer :: unit, stat
open(status='scratch', newunit=unit)
stat = 3
call run_testsuite(stub_collect_bad, unit, stat)
call check(error, stat, 5)
close(unit)
end subroutine test_run_bad_suite
subroutine test_run_selected(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer :: unit, stat
open(status='scratch', newunit=unit)
stat = 1
call run_selected(stub_collect, "always-fail", unit, stat)
call check(error, stat, 1)
close(unit)
end subroutine test_run_selected
subroutine test_select_missing(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer :: unit, stat
open(status='scratch', newunit=unit)
call run_selected(stub_collect, "not-available", unit, stat)
call check(error, stat < 0)
close(unit)
end subroutine test_select_missing
end module test_select
fortran-testdrive-0.6.0/test/CMakeLists.txt 0000664 0001750 0001750 00000002256 15201524466 021114 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# Unit testing
set(
tests
"check"
"select"
)
set(
test-srcs
"main.f90"
)
foreach(t IN LISTS tests)
string(MAKE_C_IDENTIFIER ${t} t)
list(APPEND test-srcs "test_${t}.F90")
endforeach()
add_executable(
"${PROJECT_NAME}-tester"
"${test-srcs}"
)
target_link_libraries(
"${PROJECT_NAME}-tester"
PRIVATE
"${PROJECT_NAME}-lib"
)
target_compile_definitions(
"${PROJECT_NAME}-tester"
PRIVATE
"WITH_QP=$"
"WITH_XDP=$"
)
add_test("${PROJECT_NAME}/all-tests" "${PROJECT_NAME}-tester")
foreach(t IN LISTS tests)
add_test("${PROJECT_NAME}/${t}" "${PROJECT_NAME}-tester" "${t}")
endforeach()
fortran-testdrive-0.6.0/README.md 0000664 0001750 0001750 00000026116 15201524466 016655 0 ustar alastair alastair # The simple testing framework
[](LICENSE-Apache)
[](https://github.com/fortran-lang/test-drive/releases/latest)
[](https://github.com/fortran-lang/test-drive/actions)
[](https://codecov.io/gh/fortran-lang/test-drive)
This project offers a lightweight, procedural unit testing framework based on nothing but standard Fortran.
Integration with [meson](https://mesonbuild.com), [cmake](https://cmake.org) and [Fortran package manager (fpm)](https://github.com/fortran-lang/fpm) is available.
Alternatively, the [``testdrive.F90``](src/testdrive.F90) source file can be redistributed in the project's testsuite as well.
## Usage
Testsuites are defined by a ``collect_interface`` returning a set of ``unittest_type`` objects.
To create a new test use the ``new_unittest`` constructor, which requires a test identifier and a procedure with a ``test_interface`` compatible signature.
The error status is communicated by the allocation status of an ``error_type``.
The necessary boilerplate code to setup the test entry point is just
```fortran
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
use test_suite1, only : collect_suite1
use test_suite2, only : collect_suite2
implicit none
integer :: stat, is
type(testsuite_type), allocatable :: testsuites(:)
character(len=*), parameter :: fmt = '("#", *(1x, a))'
stat = 0
testsuites = [ &
new_testsuite("suite1", collect_suite1), &
new_testsuite("suite2", collect_suite2) &
]
do is = 1, size(testsuites)
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat)
end do
if (stat > 0) then
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop
end if
end program tester
```
Every test is defined in a separate module using a ``collect`` function, which is exported and added to the ``testsuites`` array in the test runner.
All tests have a simple interface with just an allocatable ``error_type`` as output to provide the test results.
```fortran
module test_suite1
use testdrive, only : new_unittest, unittest_type, error_type, check
implicit none
private
public :: collect_suite1
contains
!> Collect all exported unit tests
subroutine collect_suite1(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
new_unittest("valid", test_valid), &
new_unittest("invalid", test_invalid, should_fail=.true.) &
]
end subroutine collect_suite1
subroutine test_valid(error)
type(error_type), allocatable, intent(out) :: error
! ...
end subroutine test_valid
subroutine test_invalid(error)
type(error_type), allocatable, intent(out) :: error
! ...
end subroutine test_invalid
end module test_suite1
```
### Checking test conditions
The procedures defining the tests can contain any Fortran code required for checking the correctness of the project.
An easy way to do so is provided by the generic ``check`` function.
```f90
subroutine test_valid(error)
type(error_type), allocatable, intent(out) :: error
call check(error, 1 + 2 == 3)
if (allocated(error)) return
! equivalent to the above
call check(error, 1 + 2, 3)
if (allocated(error)) return
end subroutine test_valid
```
After each check, the status of the error should be checked.
Uncaught errors will not be silently dropped, instead the error will be caught, its message displayed and the run aborted.
Possible ways to use check are listed below
| available checks | arguments |
| -------------------- | -------------------------------------------------------------- |
| logical check | *error*, *logical*, ... |
| status check | *error*, *integer*, ... |
| logical comparison | *error*, *logical*, *logical*, ... |
| integer comparison | *error*, *integer*, ... |
| character comparison | *error*, *character*, *character*, ... |
| real comparison | *error*, *real*, *real*, ..., thr=*real*, rel=*logical* |
| real combined check | *error*, *real*, *real*, *thr_abs*, *thr_rel*, ... |
| real NaN check | *error*, *real*, ... |
| complex comparison | *error*, *complex*, *complex*, ..., thr=*real*, rel=*logical* |
| complex combined check | *error*, *complex*, *complex*, *thr_abs*, *thr_rel*, ... |
| complex NaN check | *error*, *complex*, ... |
Each check will generate a meaningful error message based on the available arguments, but can also be provided with a custom error message instead.
The combined check uses a pytest-style tolerance: `|actual - expected| <= max(thr_abs, thr_rel * |expected|)`, where both the absolute and relative threshold should be positive tolerances.
This passes if *either* the absolute or relative threshold is satisfied.
To generate custom checks the ``test_failed`` procedure is available to generate error messages
```f90
subroutine test_custom(error)
type(error_type), allocatable, intent(out) :: error
! ...
if (.not.cond) then
call test_failed(error, "Custom check failed")
return
end if
! ...
if (.not.cond) then
call test_failed(error, "Custom check failed", "Additional context")
return
end if
end subroutine test_custom
```
To conditionally skip a test use the ``skip_test`` procedure.
It uses the same signature as ``test_failed``, but will mark the respective test as skipped, this is useful to disable tests based on conditional compilation, *e.g.* by using a preprocessor or a different submodule.
An uncaught skipped test will fail regardless, therefore make sure to not run any other checks afterwards.
### Integration in build systems
Finally, for usage with *fpm* it is beneficial to have a single test driver which can run all tests.
While this brings the disadvantage of always having to run the complete testsuite, the main driver can provide the flexibility to select the suite and also the unit test using the boilerplate code shown here:
```f90
!> Driver for unit testing
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type, &
& select_suite, run_selected, get_argument
use test_suite1, only : collect_suite1
use test_suite2, only : collect_suite2
implicit none
integer :: stat, is
character(len=:), allocatable :: suite_name, test_name
type(testsuite_type), allocatable :: testsuites(:)
character(len=*), parameter :: fmt = '("#", *(1x, a))'
stat = 0
testsuites = [ &
new_testsuite("suite1", collect_suite1), &
new_testsuite("suite2", collect_suite2) &
]
call get_argument(1, suite_name)
call get_argument(2, test_name)
if (allocated(suite_name)) then
is = select_suite(testsuites, suite_name)
if (is > 0 .and. is <= size(testsuites)) then
if (allocated(test_name)) then
write(error_unit, fmt) "Suite:", testsuites(is)%name
call run_selected(testsuites(is)%collect, test_name, error_unit, stat)
if (stat < 0) then
error stop 1
end if
else
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat)
end if
else
write(error_unit, fmt) "Available testsuites"
do is = 1, size(testsuites)
write(error_unit, fmt) "-", testsuites(is)%name
end do
error stop 1
end if
else
do is = 1, size(testsuites)
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat)
end do
end if
if (stat > 0) then
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop 1
end if
end program tester
```
From *fpm* this allows to run all tests using just the *fpm test* command, but also to debug an individual test in a debugger.
For example to run *broken-test* in *large-suite* with ``gdb`` use
```
fpm test --runner gdb -- large-suite broken-test
```
To make this approach feasible for meson the tests can be created as individual suites.
A usual layout of the test directory like
```
test
├── main.f90
├── meson.build
├── test_suite1.f90
├── test_suite2.f90
└── ...
```
Can use the following snippet to automatically create individual tests running complete suites inside the driver.
Resolution to the unit tests is possible but usually not desired, because the individual runtime of the tests will be short compared to the overhead to start the actual test.
```meson
testdrive_dep = dependency('test-drive', fallback: ['test-drive', 'testdrive_dep'])
tests = [
'suite1',
'suite2',
# ...
]
test_srcs = files(
'main.f90',
)
foreach t : tests
test_srcs += files('test_@0@.f90'.format(t.underscorify()))
endforeach
tester = executable(
'tester',
sources: test_srcs,
dependencies: [proj_dep, testdrive_dep],
)
test('all tests', tester)
foreach t : tests
test(t, tester, args: t)
endforeach
```
Similar for a CMake based build the tests can be generated automatically for the layout shown below.
```
test
├── CMakeLists.txt
├── main.f90
├── test_suite1.f90
├── test_suite2.f90
└── ...
```
The CMake file in the test directory should look similar to the one shown here
```cmake
if(NOT TARGET "test-drive::test-drive")
find_package("test-drive" REQUIRED)
endif()
# Unit testing
set(
tests
"suite1"
"suite2"
)
set(
test-srcs
"main.f90"
)
foreach(t IN LISTS tests)
string(MAKE_C_IDENTIFIER ${t} t)
list(APPEND test-srcs "test_${t}.f90")
endforeach()
add_executable(
"${PROJECT_NAME}-tester"
"${test-srcs}"
)
target_link_libraries(
"${PROJECT_NAME}-tester"
PRIVATE
"${PROJECT_NAME}-lib"
"test-drive::test-drive"
)
foreach(t IN LISTS tests)
add_test("${PROJECT_NAME}/${t}" "${PROJECT_NAME}-tester" "${t}")
endforeach()
```
## License
This project is free software: you can redistribute it and/or modify it under the terms of the [Apache License, Version 2.0](LICENSE-Apache) or [MIT license](LICENSE-MIT) at your opinion.
Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an _as is_ basis, without warranties or conditions of any kind, either express or implied. See the License for the specific language governing permissions and limitations under the License.
Unless you explicitly state otherwise, any contribution intentionally submitted for inclusion in this project by you, as defined in the Apache-2.0 license, shall be dual licensed as above, without any additional terms or conditions.
fortran-testdrive-0.6.0/config/ 0000775 0001750 0001750 00000000000 15201524466 016635 5 ustar alastair alastair fortran-testdrive-0.6.0/config/meson.build 0000664 0001750 0001750 00000004353 15201524466 021004 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
os = host_machine.system()
fc = meson.get_compiler('fortran')
fc_id = fc.get_id()
ca = [] # compile args
la = [] # link args
if fc_id == 'gcc'
ca += [
'-ffree-line-length-none',
'-fbacktrace',
]
if os == 'windows'
la += ['-Wl,--allow-multiple-definition']
endif
elif fc_id == 'intel-cl' or fc_id == 'intel-llvm-cl'
ca += [
'/traceback',
'/fpp',
]
elif fc_id == 'intel' or fc_id == 'intel-llvm'
ca += [
'-traceback',
]
elif fc_id == 'pgi' or fc_id == 'nvidia_hpc'
ca += [
'-Mbackslash',
'-Mallocatable=03',
'-traceback',
]
elif fc_id == 'flang'
ca += [
'-Mbackslash',
'-Mallocatable=03',
]
endif
add_project_arguments(fc.get_supported_arguments(ca), language: 'fortran')
add_project_link_arguments(fc.get_supported_arguments(la), language: 'fortran')
if get_option('openmp')
omp_dep = dependency('openmp')
lib_deps += omp_dep
endif
if get_option('qp').auto()
with_qp = fc.compiles('''
integer, parameter :: qp = selected_real_kind(33)
complex(qp) :: x
end
''')
else
with_qp = get_option('qp').allowed()
endif
if get_option('xdp').auto()
with_xdp = fc.compiles('''
integer, parameter :: xdp = &
& merge(-1, selected_real_kind(18), &
& selected_real_kind(18) == selected_real_kind(33))
complex(xdp) :: x
end
''')
else
with_xdp = get_option('xdp').allowed()
endif
with_ieee_is_nan = fc.compiles('''
use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
logical :: x
x = ieee_is_nan(0.0)
end
''')
add_project_arguments(
'-DWITH_QP=@0@'.format(with_qp.to_int()),
'-DWITH_XDP=@0@'.format(with_xdp.to_int()),
'-DWITH_IEEE_IS_NAN=@0@'.format(with_ieee_is_nan.to_int()),
language: 'fortran',
)
fortran-testdrive-0.6.0/config/template-targets.cmake 0000664 0001750 0001750 00000001222 15201524466 023116 0 ustar alastair alastair set(CMAKE_IMPORT_FILE_VERSION 1)
set(
TESTDRIVE_INCLUDEDIRS
"@CMAKE_INSTALL_PREFIX@/@CMAKE_INSTALL_INCLUDEDIR@"
"@CMAKE_INSTALL_PREFIX@/@CMAKE_INSTALL_INCLUDEDIR@/@module-dir@"
)
find_library(
TESTDRIVE_LIBRARIES
"@PROJECT_NAME@"
PATHS "@CMAKE_INSTALL_PREFIX@/@CMAKE_INSTALL_LIBDIR@"
NO_DEFAULT_PATH
)
add_library(@PROJECT_NAME@::@PROJECT_NAME@-lib INTERFACE IMPORTED)
add_library(@PROJECT_NAME@::@PROJECT_NAME@ ALIAS @PROJECT_NAME@::@PROJECT_NAME@-lib)
target_link_libraries(@PROJECT_NAME@::@PROJECT_NAME@-lib INTERFACE ${TESTDRIVE_LIBRARIES})
target_include_directories(@PROJECT_NAME@::@PROJECT_NAME@-lib INTERFACE ${TESTDRIVE_INCLUDEDIRS}) fortran-testdrive-0.6.0/config/install-mod.py 0000664 0001750 0001750 00000002477 15201524466 021444 0 ustar alastair alastair #!/usr/bin/env python3
# This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
from os import environ, listdir, makedirs
from os.path import join, isdir, exists
from sys import argv
from shutil import copy
build_dir = environ["MESON_BUILD_ROOT"]
if "MESON_INSTALL_DESTDIR_PREFIX" in environ:
install_dir = environ["MESON_INSTALL_DESTDIR_PREFIX"]
else:
install_dir = environ["MESON_INSTALL_PREFIX"]
include_dir = argv[1] if len(argv) > 1 else "include"
module_dir = join(install_dir, include_dir)
modules = []
for d in listdir(build_dir):
bd = join(build_dir, d)
if isdir(bd):
for f in listdir(bd):
if f.endswith(".mod"):
modules.append(join(bd, f))
if not exists(module_dir):
makedirs(module_dir)
for mod in modules:
print("Installing", mod, "to", module_dir)
copy(mod, module_dir)
fortran-testdrive-0.6.0/config/template-version.cmake 0000664 0001750 0001750 00000004314 15201524466 023137 0 ustar alastair alastair set(PACKAGE_VERSION @PROJECT_VERSION@)
if(PACKAGE_VERSION VERSION_LESS PACKAGE_FIND_VERSION)
set(PACKAGE_VERSION_COMPATIBLE FALSE)
else()
if("@PROJECT_VERSION@" MATCHES "^([0-9]+)\\.")
set(CVF_VERSION_MAJOR "${CMAKE_MATCH_1}")
if(NOT CVF_VERSION_MAJOR VERSION_EQUAL 0)
string(REGEX REPLACE "^0+" "" CVF_VERSION_MAJOR "${CVF_VERSION_MAJOR}")
endif()
else()
set(CVF_VERSION_MAJOR "@PROJECT_VERSION@")
endif()
if(PACKAGE_FIND_VERSION_RANGE)
# both endpoints of the range must have the expected major version
math (EXPR CVF_VERSION_MAJOR_NEXT "${CVF_VERSION_MAJOR} + 1")
if (NOT PACKAGE_FIND_VERSION_MIN_MAJOR STREQUAL CVF_VERSION_MAJOR
OR ((PACKAGE_FIND_VERSION_RANGE_MAX STREQUAL "INCLUDE" AND NOT PACKAGE_FIND_VERSION_MAX_MAJOR STREQUAL CVF_VERSION_MAJOR)
OR (PACKAGE_FIND_VERSION_RANGE_MAX STREQUAL "EXCLUDE" AND NOT PACKAGE_FIND_VERSION_MAX VERSION_LESS_EQUAL CVF_VERSION_MAJOR_NEXT)))
set(PACKAGE_VERSION_COMPATIBLE FALSE)
elseif(PACKAGE_FIND_VERSION_MIN_MAJOR STREQUAL CVF_VERSION_MAJOR
AND ((PACKAGE_FIND_VERSION_RANGE_MAX STREQUAL "INCLUDE" AND PACKAGE_VERSION VERSION_LESS_EQUAL PACKAGE_FIND_VERSION_MAX)
OR (PACKAGE_FIND_VERSION_RANGE_MAX STREQUAL "EXCLUDE" AND PACKAGE_VERSION VERSION_LESS PACKAGE_FIND_VERSION_MAX)))
set(PACKAGE_VERSION_COMPATIBLE TRUE)
else()
set(PACKAGE_VERSION_COMPATIBLE FALSE)
endif()
else()
if(PACKAGE_FIND_VERSION_MAJOR STREQUAL CVF_VERSION_MAJOR)
set(PACKAGE_VERSION_COMPATIBLE TRUE)
else()
set(PACKAGE_VERSION_COMPATIBLE FALSE)
endif()
if(PACKAGE_FIND_VERSION STREQUAL PACKAGE_VERSION)
set(PACKAGE_VERSION_EXACT TRUE)
endif()
endif()
endif()
# if the installed or the using project don't have CMAKE_SIZEOF_VOID_P set, ignore it:
if("${CMAKE_SIZEOF_VOID_P}" STREQUAL "" OR "@CMAKE_SIZEOF_VOID_P@" STREQUAL "")
return()
endif()
# check that the installed version has the same 32/64bit-ness as the one which is currently searching:
if(NOT CMAKE_SIZEOF_VOID_P STREQUAL "@CMAKE_SIZEOF_VOID_P@")
math(EXPR installedBits "8 * @CMAKE_SIZEOF_VOID_P@")
set(PACKAGE_VERSION "${PACKAGE_VERSION} (${installedBits}bit)")
set(PACKAGE_VERSION_UNSUITABLE TRUE)
endif()
fortran-testdrive-0.6.0/config/CMakeLists.txt 0000664 0001750 0001750 00000006375 15201524466 021410 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
option(BUILD_SHARED_LIBS "Whether the libraries built should be shared" FALSE)
option(TESTDRIVE_BUILD_TESTING "Enable testing for this project" ON)
set(
module-dir
"${PROJECT_NAME}/${CMAKE_Fortran_COMPILER_ID}-${CMAKE_Fortran_COMPILER_VERSION}"
)
set(module-dir "${module-dir}" PARENT_SCOPE)
# Set build type as CMake does not provide defaults
if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES)
set(
CMAKE_BUILD_TYPE "RelWithDebInfo"
CACHE STRING "Build type to be used."
FORCE
)
message(
STATUS
"Setting build type to '${CMAKE_BUILD_TYPE}' as none was specified."
)
endif()
if(NOT DEFINED TESTDRIVE_WITH_QP AND DEFINED WITH_QP)
set(TESTDRIVE_WITH_QP ${WITH_QP})
endif()
if(NOT DEFINED TESTDRIVE_WITH_XDP AND DEFINED WITH_XDP)
set(TESTDRIVE_WITH_XDP ${WITH_XDP})
endif()
if(NOT DEFINED TESTDRIVE_WITH_IEEE_IS_NAN AND DEFINED WITH_IEEE_IS_NAN)
set(TESTDRIVE_WITH_IEEE_IS_NAN ${WITH_IEEE_IS_NAN})
endif()
include(CheckFortranSourceCompiles)
if(NOT DEFINED TESTDRIVE_WITH_QP)
check_fortran_source_compiles(
"integer, parameter :: qp = selected_real_kind(33); complex(qp) :: x; end"
TESTDRIVE_WITH_QP
SRC_EXT "F90"
)
set(TESTDRIVE_WITH_QP ${TESTDRIVE_WITH_QP} PARENT_SCOPE)
endif()
if(NOT DEFINED TESTDRIVE_WITH_XDP)
check_fortran_source_compiles(
"
integer, parameter :: xdp = merge(-1, selected_real_kind(18), selected_real_kind(18) == selected_real_kind(33))
complex(xdp) :: x
end
"
TESTDRIVE_WITH_XDP
SRC_EXT "F90"
)
set(TESTDRIVE_WITH_XDP ${TESTDRIVE_WITH_XDP} PARENT_SCOPE)
endif()
if(NOT DEFINED TESTDRIVE_WITH_IEEE_IS_NAN)
check_fortran_source_compiles(
"use, intrinsic :: ieee_arithmetic, only : ieee_is_nan; logical :: x; x = ieee_is_nan(0.0); end"
TESTDRIVE_WITH_IEEE_IS_NAN
SRC_EXT "F90"
)
set(TESTDRIVE_WITH_IEEE_IS_NAN ${TESTDRIVE_WITH_IEEE_IS_NAN} PARENT_SCOPE)
endif()
include(CMakePackageConfigHelpers)
configure_package_config_file(
"${CMAKE_CURRENT_SOURCE_DIR}/template-config.cmake"
"${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config.cmake"
INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}"
)
write_basic_package_version_file(
"${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config-version.cmake"
VERSION "${PROJECT_VERSION}"
COMPATIBILITY SameMinorVersion
)
install(
FILES
"${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config.cmake"
"${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config-version.cmake"
DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}"
)
configure_file(
"${CMAKE_CURRENT_SOURCE_DIR}/template.pc"
"${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc"
@ONLY
)
install(
FILES
"${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc"
DESTINATION "${CMAKE_INSTALL_LIBDIR}/pkgconfig"
)
fortran-testdrive-0.6.0/config/template-config.cmake 0000664 0001750 0001750 00000000504 15201524466 022714 0 ustar alastair alastair @PACKAGE_INIT@
set("TESTDRIVE_WITH_QP" @TESTDRIVE_WITH_QP@)
set("TESTDRIVE_WITH_XDP" @TESTDRIVE_WITH_XDP@)
set("TESTDRIVE_WITH_IEEE_IS_NAN" @TESTDRIVE_WITH_IEEE_IS_NAN@)
enable_language("Fortran")
if(NOT TARGET "@PROJECT_NAME@::@PROJECT_NAME@")
include("${CMAKE_CURRENT_LIST_DIR}/@PROJECT_NAME@-targets.cmake")
endif()
fortran-testdrive-0.6.0/config/template.pc 0000664 0001750 0001750 00000000442 15201524466 020774 0 ustar alastair alastair prefix=@CMAKE_INSTALL_PREFIX@
libdir=${prefix}/@CMAKE_INSTALL_LIBDIR@
includedir=${prefix}/@CMAKE_INSTALL_INCLUDEDIR@
Name: @PROJECT_NAME@
Description: @PROJECT_DESCRIPTION@
Version: @PROJECT_VERSION@
Libs: -L${libdir} -l@PROJECT_NAME@
Cflags: -I${includedir} -I${includedir}/@module-dir@
fortran-testdrive-0.6.0/.codecov.yml 0000664 0001750 0001750 00000000116 15201524466 017611 0 ustar alastair alastair fixes:
- "/home/runner/work/test-drive/test-drive::"
ignore:
- "test/**"
fortran-testdrive-0.6.0/fpm.toml 0000664 0001750 0001750 00000000402 15201524466 017043 0 ustar alastair alastair name = "test-drive"
version = "0.6.0"
license = "Apache-2.0 OR MIT"
maintainer = ["@awvwgk"]
author = ["Sebastian Ehlert"]
copyright = "2020-2021 Sebastian Ehlert"
description = "The simple testing framework"
keywords = ["testing-framework", "unit-testing"]
fortran-testdrive-0.6.0/LICENSE-Apache 0000664 0001750 0001750 00000026136 15201524466 017564 0 ustar alastair alastair
Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
1. Definitions.
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
END OF TERMS AND CONDITIONS
APPENDIX: How to apply the Apache License to your work.
To apply the Apache License to your work, attach the following
boilerplate notice, with the fields enclosed by brackets "[]"
replaced with your own identifying information. (Don't include
the brackets!) The text should be enclosed in the appropriate
comment syntax for the file format. We also recommend that a
file or class name and description of purpose be included on the
same "printed page" as the copyright notice for easier
identification within third-party archives.
Copyright [yyyy] [name of copyright owner]
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
fortran-testdrive-0.6.0/.gitignore 0000664 0001750 0001750 00000000463 15201524466 017363 0 ustar alastair alastair # Prerequisites
*.d
# Compiled Object files
*.slo
*.lo
*.o
*.obj
# Precompiled Headers
*.gch
*.pch
# Compiled Dynamic libraries
*.so
*.dylib
*.dll
# Fortran module files
*.mod
*.smod
# Compiled Static libraries
*.lai
*.la
*.a
*.lib
# Executables
*.exe
*.out
*.app
# Directories
/build*/
/_*/
/docs*/
fortran-testdrive-0.6.0/meson_options.txt 0000664 0001750 0001750 00000001735 15201524466 021033 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
option(
'openmp',
type: 'boolean',
value: false,
yield: true,
description: 'use OpenMP parallelisation',
)
option(
'xdp',
type: 'feature',
value: 'auto',
description: 'Support extended double precision',
)
option(
'qp',
type: 'feature',
value: 'auto',
description: 'Support quadruple precision',
)
option(
'testing',
type: 'feature',
value: 'auto',
description: 'Enable testing of test-drive library',
)
fortran-testdrive-0.6.0/CMakeLists.txt 0000664 0001750 0001750 00000006111 15201524466 020127 0 ustar alastair alastair # This file is part of test-drive.
# SPDX-Identifier: Apache-2.0 OR MIT
#
# Licensed under either of Apache License, Version 2.0 or MIT license
# at your option; you may not use this file except in compliance with
# the License.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
cmake_minimum_required(VERSION 3.9...3.31)
get_directory_property(is-subproject PARENT_DIRECTORY)
project(
"test-drive"
LANGUAGES "Fortran"
VERSION "0.6.0"
DESCRIPTION "The simple testing framework"
)
# Follow GNU conventions for installing directories
include(GNUInstallDirs)
# General configuration information
add_subdirectory("config")
# Collect source of the project
set(srcs)
add_subdirectory("src")
# We need the module directory before we finish the configure stage
if(NOT EXISTS "${PROJECT_BINARY_DIR}/include")
make_directory("${PROJECT_BINARY_DIR}/include")
endif()
# Testing library target
add_library(
"${PROJECT_NAME}-lib"
"${srcs}"
)
set_target_properties(
"${PROJECT_NAME}-lib"
PROPERTIES
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME "${PROJECT_NAME}"
VERSION "${PROJECT_VERSION}"
SOVERSION "${PROJECT_VERSION_MAJOR}"
Fortran_MODULE_DIRECTORY "${PROJECT_BINARY_DIR}/include"
)
target_include_directories(
"${PROJECT_NAME}-lib"
PUBLIC
$
$
)
target_compile_definitions(
"${PROJECT_NAME}-lib"
PRIVATE
"WITH_QP=$"
"WITH_XDP=$"
"WITH_IEEE_IS_NAN=$"
)
# Export targets for other projects
add_library("${PROJECT_NAME}" INTERFACE)
add_library("${PROJECT_NAME}:${PROJECT_NAME}" ALIAS "${PROJECT_NAME}")
target_link_libraries("${PROJECT_NAME}" INTERFACE "${PROJECT_NAME}-lib")
install(
TARGETS
"${PROJECT_NAME}"
"${PROJECT_NAME}-lib"
EXPORT
"${PROJECT_NAME}-targets"
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}"
)
install(
EXPORT
"${PROJECT_NAME}-targets"
NAMESPACE
"${PROJECT_NAME}::"
DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}"
)
install(
DIRECTORY
"${PROJECT_BINARY_DIR}/include/"
DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}/${module-dir}"
)
# Package license files
install(
FILES
"LICENSE-Apache"
"LICENSE-MIT"
DESTINATION "${CMAKE_INSTALL_DATADIR}/licenses/${PROJECT_NAME}"
)
# add the testsuite
include(CTest)
if(DEFINED TEST_DRIVE_BUILD_TESTING AND NOT DEFINED TESTDRIVE_BUILD_TESTING)
message(WARNING "TEST_DRIVE_BUILD_TESTING is deprecated, use TESTDRIVE_BUILD_TESTING instead")
set(TESTDRIVE_BUILD_TESTING ${TEST_DRIVE_BUILD_TESTING})
endif()
if(NOT DEFINED TESTDRIVE_BUILD_TESTING AND DEFINED BUILD_TESTING)
set(TESTDRIVE_BUILD_TESTING ${BUILD_TESTING})
endif()
if(TESTDRIVE_BUILD_TESTING)
add_subdirectory("test")
endif()
fortran-testdrive-0.6.0/.github/ 0000775 0001750 0001750 00000000000 15201524466 016730 5 ustar alastair alastair fortran-testdrive-0.6.0/.github/workflows/ 0000775 0001750 0001750 00000000000 15201524466 020765 5 ustar alastair alastair fortran-testdrive-0.6.0/.github/workflows/build.yml 0000664 0001750 0001750 00000011233 15201524466 022607 0 ustar alastair alastair name: CI
on: [push, pull_request]
env:
BUILD_DIR: _build
jobs:
build:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [ubuntu-24.04, macos-15, macos-15-intel]
build: [meson, cmake]
build-type: [debug]
compiler: [gcc]
version: [13]
include:
- os: ubuntu-latest
build: fpm
build-type: debug
compiler: gcc
version: 12
- os: ubuntu-latest
build: meson
build-type: coverage
compiler: gcc
version: 10
- os: ubuntu-latest
build: meson
build-type: debug
compiler: gcc
version: 9
- os: ubuntu-latest
build: meson
build-type: debug
compiler: gcc
version: 11
- os: ubuntu-latest
build: meson
build-type: debug
compiler: intel-classic
version: 2021.6
- os: macos-15-intel
build: meson
build-type: debug
compiler: intel-classic
version: 2021.6
defaults:
run:
shell: bash
steps:
- name: Checkout code
uses: actions/checkout@v5
- name: Setup python
uses: actions/setup-python@v5
with:
python-version: '3.10'
cache: 'pip'
- name: Install python dependencies
if: ${{ ! contains(matrix.os, 'windows') }}
run: pip install -r requirements.txt
- name: Setup fortran
uses: fortran-lang/setup-fortran@v1
with:
compiler: ${{ matrix.compiler }}
version: ${{ matrix.version }}
- name: Setup fpm
if: ${{ matrix.build == 'fpm' }}
uses: fortran-lang/setup-fpm@v3
with:
fpm-version: 'v0.2.0'
- name: Configure build (meson)
if: ${{ matrix.build == 'meson' }}
run: >-
meson setup ${{ env.BUILD_DIR }}
--buildtype=debug
--prefix=$PWD/_dist
--libdir=lib
--warnlevel=0
-Db_coverage=${{ env.COVERAGE }}
${{ env.MESON_ARGS }}
env:
COVERAGE: ${{ matrix.build-type == 'coverage' }}
MESON_ARGS: ${{ matrix.compiler == 'intel-classic' && '-Dfortran_link_args=-qopenmp' || '' }}
- name: Configure build (CMake)
if: ${{ matrix.build == 'cmake' }}
run: >-
cmake -B${{ env.BUILD_DIR }}
-GNinja
-DCMAKE_BUILD_TYPE=Debug
-DCMAKE_INSTALL_PREFIX=$PWD/_dist
-DCMAKE_INSTALL_LIBDIR=lib
- name: Build library (fpm)
if: ${{ matrix.build == 'fpm' }}
run: fpm build
- name: Build library
if: ${{ matrix.build != 'fpm' }}
run: ninja -C ${{ env.BUILD_DIR }}
- name: Run unit tests (fpm)
if: ${{ matrix.build == 'fpm' }}
run: fpm test
- name: Run unit tests (meson)
if: ${{ matrix.build == 'meson' }}
run: meson test -C ${{ env.BUILD_DIR }} --print-errorlogs --no-rebuild --num-processes 2 -t 2
- name: Run unit tests (ctest)
if: ${{ matrix.build == 'cmake' }}
run: ctest --output-on-failure --parallel 2
working-directory: ${{ env.BUILD_DIR }}
- name: Create coverage report
if: ${{ matrix.build == 'meson' && matrix.build-type == 'coverage' }}
run: ninja -C ${{ env.BUILD_DIR }} coverage
- name: Install project
if: ${{ matrix.build != 'fpm' }}
run: |
ninja -C ${{ env.BUILD_DIR }} install
echo "PROJECT_PREFIX=$PWD/_dist" >> $GITHUB_ENV
- name: Discover installed files (CMake)
if: ${{ matrix.build != 'fpm' }}
run: |
cmake -S test/export -B ${{ env.BUILD_DIR }}/discover-cmake -G Ninja -DCMAKE_PREFIX_PATH=$PWD/_dist/lib/cmake
cmake --build ${{ env.BUILD_DIR }}/discover-cmake
- name: Discover installed files (Meson)
if: ${{ matrix.build != 'fpm' }}
run: |
meson setup ${{ env.BUILD_DIR }}/discover-meson test/export --pkg-config-path=$PWD/_dist/lib/pkgconfig
meson compile -C ${{ env.BUILD_DIR }}/discover-meson
- name: Create package
if: ${{ matrix.build == 'meson' }}
run: |
tar cvf ${{ env.OUTPUT }} _dist
xz -T0 ${{ env.OUTPUT }}
echo "PROJECT_OUTPUT=${{ env.OUTPUT }}.xz" >> $GITHUB_ENV
env:
OUTPUT: test-drive-${{ matrix.compiler }}-${{ matrix.version }}-${{ matrix.os }}.tar
- name: Upload package
if: ${{ matrix.build == 'meson' && matrix.build-type != 'coverage' }}
uses: actions/upload-artifact@v4
with:
name: ${{ env.PROJECT_OUTPUT }}
path: ${{ env.PROJECT_OUTPUT }}
- name: Upload coverage report
if: ${{ matrix.build == 'meson' && matrix.build-type == 'coverage' }}
uses: codecov/codecov-action@v3