Added subroutine that parses ctest command line args to determine typ…

…e of test.

If the test is a memcheck test, the memcheck assert handler is used, else the standard assert handler is used.

cmake/Obs2Ioda_Functions.cmake

@@ -78,7 +78,7 @@ function(add_memcheck_ctest target)
         message(STATUS "Adding memory check for test: ${target}")
         set(VALGRIND_COMMAND valgrind --leak-check=full --error-exitcode=1 --undef-value-errors=no)
         add_test(NAME ${target}_memcheck
-                 COMMAND ${VALGRIND_COMMAND} $<TARGET_FILE:${target}>)
+                 COMMAND ${VALGRIND_COMMAND} $<TARGET_FILE:${target}> memcheck)
     else ()
         message(STATUS "Valgrind not found")
         message(STATUS "Memory check for test: ${target} will not be added")

obs2ioda-v2/src/test/fortran_test_framework_mod.f90

@@ -2,6 +2,10 @@ module fortran_test_framework_mod
     implicit none
 
     public :: assertEqual
+    public :: assert_interface
+    public :: determine_test_type
+    public :: assert
+    public :: assert_memcheck
 
     interface assertEqual
         module procedure assertEqual_integer
@@ -19,6 +23,23 @@ end subroutine assert_interface
 
 contains
 
+    subroutine determine_test_type(test_type)
+        implicit none
+        character(len = *), intent(out) :: test_type
+        integer n_args
+        character(len = 64) :: arg
+        integer :: i
+
+        test_type = "standard"
+        n_args = command_argument_count()
+        do i = 1, n_args
+            call get_command_argument(i, arg)
+            if (arg == "memcheck") then
+                test_type = "memcheck"
+            end if
+        end do
+    end subroutine determine_test_type
+
     ! Subroutine: assert
     ! Performs a basic assertion by evaluating a condition and printing a message.
     ! Exits the program with an error status if the condition is not met.
@@ -42,24 +63,44 @@ subroutine assert(condition, message, status)
         end if
     end subroutine assert
 
+    ! Subroutine: assert_memcheck
+    ! An assertion handler used for memcheck tests. Unlike `assert`, this subroutine does not terminate
+    ! the program on failure.
+    !
+    ! Arguments:
+    ! - condition (logical, in): The condition to evaluate.
+    ! - message (character, in): The message associated with the assertion (not used in this mock).
+    ! - status (integer, out): The status code set based on the condition (0 for success, 1 for failure).
+    subroutine assert_memcheck(condition, message, status)
+        logical, intent(in) :: condition
+        character(len = *), intent(in) :: message
+        integer, intent(out) :: status
+
+        if (.not. condition) then
+            status = 1
+            write(*, '(A)') "Failed: " // message
+        else
+            status = 0
+            write(*, '(A)') "Success: " // message
+        end if
+    end subroutine assert_memcheck
+
     ! Subroutine: assertEqual_integer
     ! Asserts that two integer values are equal, using a custom or default assertion handler.
     !
     ! Arguments:
     ! - expected (integer, in): The expected value.
     ! - actual (integer, in): The actual value.
     ! - status (integer, out): Status code (0 for success, 1 for failure).
-    ! - assert_procedure (procedure, optional): Custom procedure to handle assertion logic.
+    ! - assert_procedure (procedure): Custom procedure to handle assertion logic.
     subroutine assertEqual_integer(expected, actual, status, assert_procedure)
         implicit none
         integer, intent(in) :: expected, actual
         integer, intent(out) :: status
-        procedure(assert_interface), optional :: assert_procedure
+        procedure(assert_interface) :: assert_procedure
         procedure(assert_interface), pointer :: assert_handler => assert
 
-        if (present(assert_procedure)) then
-            assert_handler => assert_procedure
-        end if
+        assert_handler => assert_procedure
 
         call assert_handler(&
                 expected == actual, "expected=" // trim(adjustl(itoa(expected))) // &
@@ -75,17 +116,15 @@ end subroutine assertEqual_integer
     ! - expected (character, in): The expected string value.
     ! - actual (character, in): The actual string value.
     ! - status (integer, out): Status code (0 for success, 1 for failure).
-    ! - assert_procedure (procedure, optional): Custom procedure to handle assertion logic.
+    ! - assert_procedure (procedure): Custom procedure to handle assertion logic.
     subroutine assertEqual_string(expected, actual, status, assert_procedure)
         implicit none
         character(len = *), intent(in) :: expected, actual
         integer, intent(out) :: status
-        procedure(assert_interface), optional :: assert_procedure
+        procedure(assert_interface) :: assert_procedure
         procedure(assert_interface), pointer :: assert_handler => assert
 
-        if (present(assert_procedure)) then
-            assert_handler => assert_procedure
-        end if
+        assert_handler => assert_procedure
 
         call assert_handler(&
                 expected == actual, "expected='" // trim(expected) // "' actual='" // &
@@ -101,17 +140,15 @@ end subroutine assertEqual_string
     ! - expected (logical, in): The expected logical value.
     ! - actual (logical, in): The actual logical value.
     ! - status (integer, out): Status code (0 for success, 1 for failure).
-    ! - assert_procedure (procedure, optional): Custom procedure to handle assertion logic.
+    ! - assert_procedure (procedure): Custom procedure to handle assertion logic.
     subroutine assertEqual_logical(expected, actual, status, assert_procedure)
         implicit none
         logical, intent(in) :: expected, actual
         integer, intent(out) :: status
-        procedure(assert_interface), optional :: assert_procedure
+        procedure(assert_interface) :: assert_procedure
         procedure(assert_interface), pointer :: assert_handler => assert
 
-        if (present(assert_procedure)) then
-            assert_handler => assert_procedure
-        end if
+        assert_handler => assert_procedure
 
         call assert_handler(&
                 expected .eqv. actual, "expected=" // trim(logical_to_string(expected)) // &

test/fortran/CMakeLists.txt

@@ -9,4 +9,5 @@ set(Test_fortran_test_framework_LIBRARY_DEPENDENCIES
 add_fortran_ctest(fortran_test_framework
                   "${Test_fortran_test_framework_SOURCES}"
                   "${Test_fortran_test_framework_LIBRARY_DEPENDENCIES}"
-)
+)
+add_memcheck_ctest(Test_fortran_test_framework)

test/fortran/Test_fortran_test_framework_driver.f90

@@ -1,8 +1,20 @@
 program Test_fortran_test_framework_driver
     use Test_fortran_test_framework_mod
+    use fortran_test_framework_mod, only : assert, assert_memcheck, determine_test_type
     implicit none
+    integer n_args
+    character(len = 64) :: test_type, arg
+    integer :: i
+    procedure(assert_interface), pointer :: assert_proc
 
-    call test_assertEqual_string()
-    call test_assertEqual_logical()
-    call test_assertEqual_integer()
+    call determine_test_type(test_type)
+
+    if (trim(test_type) == "standard") then
+        assert_proc => assert
+    else
+        assert_proc => assert_memcheck
+    end if
+    call test_assertEqual_integer(assert_proc)
+    call test_assertEqual_logical(assert_proc)
+    call test_assertEqual_string(assert_proc)
 end program

test/fortran/Test_fortran_test_framework_mod.f90

@@ -1,5 +1,5 @@
 module Test_fortran_test_framework_mod
-    use fortran_test_framework_mod, only : assertEqual, assert
+    use fortran_test_framework_mod, only : assertEqual, assert_interface
     implicit none
 
 contains
@@ -29,49 +29,61 @@ end subroutine assert_mock
     ! Subroutine: test_assertEqual_integer
     ! Tests the `assertEqual` subroutine with integer values.
     !
+    ! Arguments:
+    ! - assert_proc (procedure): The assertion procedure to use for testing.
+    !
     ! Behavior:
     ! - Asserts equality of integers using both the mock assertion handler (`assert_mock`)
     !   and the default `assert` procedure.
     ! - Verifies correct handling of equal and unequal integer values.
-    subroutine test_assertEqual_integer()
+    subroutine test_assertEqual_integer(assert_proc)
+        procedure(assert_interface) :: assert_proc
         integer :: status
         call assertEqual(1, 1, status, assert_mock)
-        call assertEqual(0, status, status, assert)
+        call assertEqual(0, status, status, assert_proc)
 
         call assertEqual(1, 2, status, assert_mock)
-        call assertEqual(1, status, status, assert)
+        call assertEqual(1, status, status, assert_proc)
     end subroutine test_assertEqual_integer
 
     ! Subroutine: test_assertEqual_logical
     ! Tests the `assertEqual` subroutine with logical values.
     !
+    ! Arguments:
+    ! - assert_proc (procedure): The assertion procedure to use for testing.
+    !
     ! Behavior:
     ! - Asserts equality of logical values (`.true.` and `.false.`) using both the mock
     !   assertion handler (`assert_mock`) and the default `assert` procedure.
     ! - Verifies correct handling of equal and unequal logical values.
-    subroutine test_assertEqual_logical()
+    subroutine test_assertEqual_logical(assert_proc)
+        procedure(assert_interface) :: assert_proc
         integer :: status
         call assertEqual(.true., .true., status, assert_mock)
-        call assertEqual(0, status, status, assert)
+        call assertEqual(0, status, status, assert_proc)
 
         call assertEqual(.true., .false., status, assert_mock)
-        call assertEqual(1, status, status, assert)
+        call assertEqual(1, status, status, assert_proc)
     end subroutine test_assertEqual_logical
 
     ! Subroutine: test_assertEqual_string
     ! Tests the `assertEqual` subroutine with string values.
     !
+    ! Arguments:
+    ! - assert_proc (procedure): The assertion procedure to use for testing.
+    !
     ! Behavior:
     ! - Asserts equality of strings using both the mock assertion handler (`assert_mock`)
     !   and the default `assert` procedure.
     ! - Verifies correct handling of equal and unequal string values.
-    subroutine test_assertEqual_string()
+    subroutine test_assertEqual_string(assert_proc)
+        procedure(assert_interface) :: assert_proc
         integer :: status
         call assertEqual("a", "a", status, assert_mock)
-        call assertEqual(0, status, status, assert)
+        call assertEqual(0, status, status, assert_proc)
 
         call assertEqual("a", "b", status, assert_mock)
-        call assertEqual(1, status, status, assert)
+        call assertEqual(1, status, status, assert_proc)
     end subroutine test_assertEqual_string
 
 end module Test_fortran_test_framework_mod