| 1 | module test_framework |
| 2 | use iso_fortran_env, only: output_unit, error_unit |
| 3 | implicit none |
| 4 | private |
| 5 | |
| 6 | public :: test_suite, test_case, assert_equals, assert_true, assert_false |
| 7 | public :: run_tests, test_summary |
| 8 | |
| 9 | type :: test_result |
| 10 | logical :: passed = .true. |
| 11 | character(len=256) :: message = "" |
| 12 | end type test_result |
| 13 | |
| 14 | type :: test_case |
| 15 | character(len=128) :: name = "" |
| 16 | procedure(test_proc), pointer, nopass :: test_procedure => null() |
| 17 | type(test_result) :: result |
| 18 | end type test_case |
| 19 | |
| 20 | type :: test_suite |
| 21 | character(len=128) :: name = "" |
| 22 | type(test_case), allocatable :: tests(:) |
| 23 | integer :: num_tests = 0 |
| 24 | integer :: num_passed = 0 |
| 25 | integer :: num_failed = 0 |
| 26 | end type test_suite |
| 27 | |
| 28 | abstract interface |
| 29 | subroutine test_proc() |
| 30 | end subroutine test_proc |
| 31 | end interface |
| 32 | |
| 33 | ! Global test context for assertions - using static allocation |
| 34 | type(test_result), target :: global_test_result |
| 35 | logical :: test_active = .false. |
| 36 | |
| 37 | contains |
| 38 | |
| 39 | subroutine run_tests(suite) |
| 40 | type(test_suite), intent(inout) :: suite |
| 41 | integer :: i |
| 42 | |
| 43 | write(output_unit, '(A)') repeat("=", 60) |
| 44 | write(output_unit, '(A,A)') "Running test suite: ", trim(suite%name) |
| 45 | write(output_unit, '(A)') repeat("=", 60) |
| 46 | |
| 47 | suite%num_tests = size(suite%tests) |
| 48 | suite%num_passed = 0 |
| 49 | suite%num_failed = 0 |
| 50 | |
| 51 | do i = 1, suite%num_tests |
| 52 | call run_single_test(suite%tests(i)) |
| 53 | |
| 54 | if (suite%tests(i)%result%passed) then |
| 55 | suite%num_passed = suite%num_passed + 1 |
| 56 | write(output_unit, '(A,A,A)') "✓ ", trim(suite%tests(i)%name), " PASSED" |
| 57 | else |
| 58 | suite%num_failed = suite%num_failed + 1 |
| 59 | write(error_unit, '(A,A,A)') "✗ ", trim(suite%tests(i)%name), " FAILED" |
| 60 | if (len_trim(suite%tests(i)%result%message) > 0) then |
| 61 | write(error_unit, '(A,A)') " Reason: ", trim(suite%tests(i)%result%message) |
| 62 | end if |
| 63 | end if |
| 64 | end do |
| 65 | |
| 66 | call test_summary(suite) |
| 67 | end subroutine run_tests |
| 68 | |
| 69 | subroutine run_single_test(test) |
| 70 | type(test_case), intent(inout) :: test |
| 71 | |
| 72 | ! Copy test result to global for assertions |
| 73 | global_test_result%passed = .true. |
| 74 | global_test_result%message = "" |
| 75 | test_active = .true. |
| 76 | |
| 77 | ! Run the test |
| 78 | if (associated(test%test_procedure)) then |
| 79 | call test%test_procedure() |
| 80 | ! Copy result back |
| 81 | test%result = global_test_result |
| 82 | else |
| 83 | test%result%passed = .false. |
| 84 | test%result%message = "No test procedure defined" |
| 85 | end if |
| 86 | |
| 87 | ! Clean up |
| 88 | test_active = .false. |
| 89 | end subroutine run_single_test |
| 90 | |
| 91 | subroutine test_summary(suite) |
| 92 | type(test_suite), intent(in) :: suite |
| 93 | |
| 94 | write(output_unit, '(A)') repeat("-", 60) |
| 95 | write(output_unit, '(A,I0,A,I0,A,I0,A)') & |
| 96 | "Tests run: ", suite%num_tests, & |
| 97 | ", Passed: ", suite%num_passed, & |
| 98 | ", Failed: ", suite%num_failed |
| 99 | |
| 100 | if (suite%num_failed == 0) then |
| 101 | write(output_unit, '(A)') "All tests passed! ✓" |
| 102 | else |
| 103 | write(error_unit, '(A,I0,A)') "FAILURE: ", suite%num_failed, " tests failed" |
| 104 | end if |
| 105 | write(output_unit, '(A)') repeat("=", 60) |
| 106 | end subroutine test_summary |
| 107 | |
| 108 | ! Assertion utilities |
| 109 | subroutine assert_equals(expected, actual, message) |
| 110 | integer, intent(in) :: expected, actual |
| 111 | character(len=*), intent(in), optional :: message |
| 112 | character(len=256) :: fail_msg |
| 113 | |
| 114 | if (.not. test_active) return |
| 115 | |
| 116 | if (expected /= actual) then |
| 117 | global_test_result%passed = .false. |
| 118 | if (present(message)) then |
| 119 | write(fail_msg, '(A,A,I0,A,I0)') trim(message), & |
| 120 | ": Expected ", expected, " but got ", actual |
| 121 | else |
| 122 | write(fail_msg, '(A,I0,A,I0)') "Expected ", expected, " but got ", actual |
| 123 | end if |
| 124 | global_test_result%message = trim(fail_msg) |
| 125 | end if |
| 126 | end subroutine assert_equals |
| 127 | |
| 128 | subroutine assert_true(condition, message) |
| 129 | logical, intent(in) :: condition |
| 130 | character(len=*), intent(in), optional :: message |
| 131 | |
| 132 | if (.not. test_active) return |
| 133 | |
| 134 | if (.not. condition) then |
| 135 | global_test_result%passed = .false. |
| 136 | if (present(message)) then |
| 137 | global_test_result%message = trim(message) |
| 138 | else |
| 139 | global_test_result%message = "Assertion failed: expected true" |
| 140 | end if |
| 141 | end if |
| 142 | end subroutine assert_true |
| 143 | |
| 144 | subroutine assert_false(condition, message) |
| 145 | logical, intent(in) :: condition |
| 146 | character(len=*), intent(in), optional :: message |
| 147 | |
| 148 | if (.not. test_active) return |
| 149 | |
| 150 | if (condition) then |
| 151 | global_test_result%passed = .false. |
| 152 | if (present(message)) then |
| 153 | global_test_result%message = trim(message) |
| 154 | else |
| 155 | global_test_result%message = "Assertion failed: expected false" |
| 156 | end if |
| 157 | end if |
| 158 | end subroutine assert_false |
| 159 | |
| 160 | end module test_framework |