From 4fdf3720ff20272f596103cabc707494bdbd6b55 Mon Sep 17 00:00:00 2001 From: Wes Bonelli Date: Fri, 20 Oct 2023 12:03:19 -0400 Subject: [PATCH] test: add minimal unit tests for some utilities --- autotest/TestDevFeature.f90 | 28 ++++++++++ autotest/TestGenericUtils.f90 | 53 +++++++++++++++++++ autotest/TestInputOutput.f90 | 63 +++++++++++++++++++++++ autotest/TestList.f90 | 96 +++++++++++++++++++++++++++++++++++ autotest/TestSim.f90 | 58 +++++++++++++++++++++ autotest/meson.build | 5 ++ autotest/tester.f90 | 12 ++++- 7 files changed, 314 insertions(+), 1 deletion(-) create mode 100644 autotest/TestDevFeature.f90 create mode 100644 autotest/TestGenericUtils.f90 create mode 100644 autotest/TestInputOutput.f90 create mode 100644 autotest/TestList.f90 create mode 100644 autotest/TestSim.f90 diff --git a/autotest/TestDevFeature.f90 b/autotest/TestDevFeature.f90 new file mode 100644 index 00000000000..243c2e9e233 --- /dev/null +++ b/autotest/TestDevFeature.f90 @@ -0,0 +1,28 @@ +module TestDevFeature + use testdrive, only: error_type, unittest_type, new_unittest, check + use DevFeatureModule, only: dev_feature + use ConstantsModule, only: LINELENGTH + use VersionModule, only: IDEVELOPMODE + + implicit none + private + public :: collect_dev_feature + +contains + + subroutine collect_dev_feature(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + ! expect failure if in release mode, otherwise pass + new_unittest("dev_feature", test_dev_feature, & + should_fail=(IDEVELOPMODE == 0)) & + ] + end subroutine collect_dev_feature + + subroutine test_dev_feature(error) + type(error_type), allocatable, intent(out) :: error + character(len=LINELENGTH) :: errmsg + call dev_feature(errmsg) + end subroutine test_dev_feature + +end module TestDevFeature diff --git a/autotest/TestGenericUtils.f90 b/autotest/TestGenericUtils.f90 new file mode 100644 index 00000000000..5f005ab5db1 --- /dev/null +++ b/autotest/TestGenericUtils.f90 @@ -0,0 +1,53 @@ +module TestGenericUtils + use testdrive, only: error_type, unittest_type, new_unittest, check + use KindModule, only: DP + use GenericUtilitiesModule, only: is_same + + implicit none + private + public :: collect_genericutils + +contains + + subroutine collect_genericutils(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("is_same", test_is_same), & + new_unittest("is_same_both_near_0", test_is_same_both_near_0, & + should_fail=.true.), & ! expect failure for now, see below + new_unittest("is_not_same", test_is_not_same) & + ] + end subroutine collect_genericutils + + subroutine test_is_same(error) + type(error_type), allocatable, intent(out) :: error + + ! exact + call check(error, is_same(0.0_DP, 0.0_DP)) + if (allocated(error)) return + + ! inexact (within tolerance) + call check(error, is_same(1.0000_DP, 1.0001_DP, eps=0.01_DP)) + if (allocated(error)) return + end subroutine test_is_same + + subroutine test_is_same_both_near_0(error) + type(error_type), allocatable, intent(out) :: error + + ! relative comparison mode fails when a and b are close to 0 + call check(error, is_same(0.0000_DP, 0.0001_DP, eps=0.01_DP)) + if (allocated(error)) return + end subroutine test_is_same_both_near_0 + + subroutine test_is_not_same(error) + type(error_type), allocatable, intent(out) :: error + + call check(error, (.not. (is_same(1.0_DP, 1.0001_DP)))) + if (allocated(error)) return + + ! with tolerance + call check(error, (.not. is_same(1.0_DP, 1.0001_DP, eps=0.00005_DP))) + if (allocated(error)) return + end subroutine test_is_not_same + +end module TestGenericUtils diff --git a/autotest/TestInputOutput.f90 b/autotest/TestInputOutput.f90 new file mode 100644 index 00000000000..4ebc484dadb --- /dev/null +++ b/autotest/TestInputOutput.f90 @@ -0,0 +1,63 @@ +module TestInputOutput + use testdrive, only: error_type, unittest_type, new_unittest, check + use ConstantsModule, only: LINELENGTH + use InputOutputModule, only: get_node, get_ijk + implicit none + private + public :: collect_inputoutput + +contains + + subroutine collect_inputoutput(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("get_node_get_ijk", test_get_node_get_ijk) & + ] + end subroutine collect_inputoutput + + subroutine test_get_node_get_ijk(error) + type(error_type), allocatable, intent(out) :: error + integer :: ilay + integer :: irow + integer :: icol + integer :: nlay + integer :: nrow + integer :: ncol + integer :: nnum + integer :: ncls + integer :: k, i, j + + ! trivial grid with 1 cell + nnum = get_node(1, 1, 1, 1, 1, 1) + call get_ijk(nnum, 1, 1, 1, ilay, irow, icol) + call check(error, nnum == 1) + call check(error, ilay == 1) + call check(error, irow == 1) + call check(error, icol == 1) + if (allocated(error)) return + + ! small grid, 3x4x5 + nlay = 3 + nrow = 4 + ncol = 5 + ncls = nlay * nrow * ncol + do k = 1, nlay + do i = 1, nrow + do j = 1, ncol + ! node number from ijk + nnum = get_node(k, i, j, nlay, nrow, ncol) + call check(error, nnum == (k - 1) * nrow * ncol + (i - 1) * ncol + j) + if (allocated(error)) return + + ! ijk from node number + call get_ijk(nnum, nrow, ncol, nlay, irow, icol, ilay) + call check(error, ilay == k) + call check(error, irow == i) + call check(error, icol == j) + if (allocated(error)) return + end do + end do + end do + end subroutine test_get_node_get_ijk + +end module TestInputOutput diff --git a/autotest/TestList.f90 b/autotest/TestList.f90 new file mode 100644 index 00000000000..4652ecbd6dc --- /dev/null +++ b/autotest/TestList.f90 @@ -0,0 +1,96 @@ +module TestList + use testdrive, only: error_type, unittest_type, new_unittest, check + use ListModule, only: ListType, ListNodeType + + implicit none + private + public :: collect_list + + type :: IntNodeType + integer :: value + end type IntNodeType +contains + + subroutine collect_list(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("count", test_count), & + new_unittest("add", test_add), & + new_unittest("remove_node_by_index", test_remove_node_by_index) & + ] + end subroutine collect_list + + subroutine test_count(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list => null() + type(IntNodeType), pointer :: p1 => null() + class(*), pointer :: p => null() + + ! allocate + allocate (list) + allocate (p1) + + ! empty case + call check(error, list%Count() == 0) + if (allocated(error)) return + + ! one node case + p1%value = 1 + p => p1 + call list%Add(p) + call check(error, list%Count() == 1) + if (allocated(error)) return + + ! deallocate + deallocate (list) + deallocate (p1) + end subroutine test_count + + subroutine test_add(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list => null() + type(IntNodeType), pointer :: p1 => null() + class(*), pointer :: p => null() + + ! allocate + allocate (list) + allocate (p1) + + ! add a node + p1%value = 1 + p => p1 + call list%Add(p) + call check(error, list%Count() == 1) + if (allocated(error)) return + + ! deallocate + deallocate (list) + end subroutine test_add + + subroutine test_remove_node_by_index(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list => null() + type(IntNodeType), pointer :: p1 => null() + class(*), pointer :: p => null() + + ! allocate + allocate (list) + allocate (p1) + + ! add a node + p1%value = 1 + p => p1 + call list%Add(p) + call check(error, list%Count() == 1) + if (allocated(error)) return + + ! remove a node + call list%RemoveNode(1, destroyValue=.false.) + call check(error, list%Count() == 0) + + ! deallocate + deallocate (list) + deallocate (p1) + end subroutine test_remove_node_by_index + +end module TestList diff --git a/autotest/TestSim.f90 b/autotest/TestSim.f90 new file mode 100644 index 00000000000..b01b9ea93a8 --- /dev/null +++ b/autotest/TestSim.f90 @@ -0,0 +1,58 @@ +module TestSim + use testdrive, only: error_type, unittest_type, new_unittest, check + use SimModule, only: store_error, store_warning, store_note, & + initial_message, count_errors, count_notes, & + count_warnings + use ConstantsModule, only: LINELENGTH + + implicit none + private + public :: collect_sim + +contains + + subroutine collect_sim(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("store_and_count", test_store_and_count) & + ] + end subroutine collect_sim + + subroutine test_store_and_count(error) + type(error_type), allocatable, intent(out) :: error + character(len=LINELENGTH) :: ntemsg + character(len=LINELENGTH) :: wrnmsg + character(len=LINELENGTH) :: errmsg + + ! define messages + ntemsg = "NOTE" + wrnmsg = "WARNING" + errmsg = "ERROR" + + ! initialize message arrays + call initial_message() + + ! check no messages stored + call check(error, count_errors() == 0) + call check(error, count_warnings() == 0) + call check(error, count_notes() == 0) + if (allocated(error)) return + + ! todo store a note and check that it's stored + call store_note(ntemsg) + call check(error, count_notes() == 1) + if (allocated(error)) return + + ! todo store a warning and check that it's stored + call store_warning(wrnmsg) + call check(error, count_warnings() == 1) + if (allocated(error)) return + + ! store an error and check that it's stored + call store_error(errmsg, terminate=.false.) + call check(error, count_errors() == 1) + if (allocated(error)) return + + end subroutine test_store_and_count + +end module TestSim diff --git a/autotest/meson.build b/autotest/meson.build index b047db4de91..2f096525361 100644 --- a/autotest/meson.build +++ b/autotest/meson.build @@ -2,6 +2,11 @@ test_drive = dependency('test-drive', required : false) if test_drive.found() tests = [ 'ArrayHandlers', + 'DevFeature', + 'GenericUtils', + 'InputOutput', + 'List', + 'Sim' ] test_srcs = files( diff --git a/autotest/tester.f90 b/autotest/tester.f90 index 416d26bc0e5..e5fd7b264e8 100644 --- a/autotest/tester.f90 +++ b/autotest/tester.f90 @@ -3,6 +3,11 @@ program tester use testdrive, only: run_testsuite, new_testsuite, testsuite_type, & & select_suite, run_selected, get_argument use TestArrayHandlers, only: collect_arrayhandlers + use TestDevFeature, only: collect_dev_feature + use TestGenericUtils, only: collect_genericutils + use TestInputOutput, only: collect_inputoutput + use TestList, only: collect_list + use TestSim, only: collect_sim implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name @@ -11,7 +16,12 @@ program tester stat = 0 testsuites = [ & - new_testsuite("ArrayHandlers", collect_arrayhandlers) & + new_testsuite("ArrayHandlers", collect_arrayhandlers), & + new_testsuite("DevFeature", collect_dev_feature), & + new_testsuite("GenericUtils", collect_genericutils), & + new_testsuite("InputOutput", collect_inputoutput), & + new_testsuite("List", collect_list), & + new_testsuite("Sim", collect_sim) & ] call get_argument(1, suite_name)