fortbite Public

Watch 0 Fork 0 Star 0
Fortran · 6424 bytes Raw Blame History
1 !> Test framework module for FORTBITE
2 !> Provides utilities for unit testing
3 module test_framework
4 use iso_fortran_env, only: real64, output_unit, error_unit
5 implicit none
6 private
7
8 public :: test_suite, test_case, assert_equals, assert_true, assert_false
9 public :: assert_near, run_test_suite, init_test_suite, add_test_case
10
11 !> Test case type
12 type :: test_case
13 character(len=100) :: name = ''
14 logical :: passed = .true.
15 character(len=200) :: failure_message = ''
16 end type test_case
17
18 !> Test suite type
19 type :: test_suite
20 character(len=100) :: name = ''
21 type(test_case) :: tests(100)
22 integer :: test_count = 0
23 integer :: passed_count = 0
24 integer :: failed_count = 0
25 integer :: current_test_index = 0
26 end type test_suite
27
28 contains
29
30 !> Initialize a test suite
31 function init_test_suite(name) result(suite)
32 character(len=*), intent(in) :: name
33 type(test_suite) :: suite
34
35 suite%name = trim(name)
36 suite%test_count = 0
37 suite%passed_count = 0
38 suite%failed_count = 0
39 suite%current_test_index = 0
40 end function init_test_suite
41
42 !> Add a test case to the suite
43 subroutine add_test_case(suite, name)
44 type(test_suite), intent(inout) :: suite
45 character(len=*), intent(in) :: name
46
47 suite%test_count = suite%test_count + 1
48 if (suite%test_count > size(suite%tests)) then
49 write(error_unit, *) 'ERROR: Too many test cases!'
50 return
51 end if
52
53 suite%current_test_index = suite%test_count
54 suite%tests(suite%test_count)%name = trim(name)
55 suite%tests(suite%test_count)%passed = .true.
56 suite%tests(suite%test_count)%failure_message = ''
57 end subroutine add_test_case
58
59 !> Run all tests in a suite
60 subroutine run_test_suite(suite)
61 type(test_suite), intent(inout) :: suite
62 integer :: i
63
64 write(output_unit, '(A)') repeat('=', 60)
65 write(output_unit, '(A,A)') 'Running Test Suite: ', trim(suite%name)
66 write(output_unit, '(A)') repeat('=', 60)
67
68 suite%passed_count = 0
69 suite%failed_count = 0
70
71 do i = 1, suite%test_count
72 if (suite%tests(i)%passed) then
73 suite%passed_count = suite%passed_count + 1
74 write(output_unit, '(A,A,A)') '✓ ', trim(suite%tests(i)%name), ' ... PASSED'
75 else
76 suite%failed_count = suite%failed_count + 1
77 write(output_unit, '(A,A,A)') '✗ ', trim(suite%tests(i)%name), ' ... FAILED'
78 if (len_trim(suite%tests(i)%failure_message) > 0) then
79 write(output_unit, '(A,A)') ' ', trim(suite%tests(i)%failure_message)
80 end if
81 end if
82 end do
83
84 write(output_unit, '(A)') repeat('-', 60)
85 write(output_unit, '(A,I0,A,I0,A,I0,A)') 'Results: ', &
86 suite%passed_count, ' passed, ', &
87 suite%failed_count, ' failed, ', &
88 suite%test_count, ' total'
89 write(output_unit, '(A)') repeat('=', 60)
90 end subroutine run_test_suite
91
92 !> Assert that two real values are equal
93 subroutine assert_equals(suite, actual, expected, message)
94 type(test_suite), intent(inout) :: suite
95 real(real64), intent(in) :: actual, expected
96 character(len=*), intent(in), optional :: message
97
98 character(len=200) :: fail_msg
99 integer :: idx
100
101 idx = suite%current_test_index
102 if (idx < 1 .or. idx > suite%test_count) return
103
104 if (abs(actual - expected) > epsilon(1.0_real64)) then
105 write(fail_msg, '(A,G0,A,G0)') 'Expected: ', expected, ', Got: ', actual
106 if (present(message)) then
107 fail_msg = trim(message) // ' - ' // trim(fail_msg)
108 end if
109 suite%tests(idx)%passed = .false.
110 suite%tests(idx)%failure_message = trim(fail_msg)
111 end if
112 end subroutine assert_equals
113
114 !> Assert that two real values are approximately equal
115 subroutine assert_near(suite, actual, expected, tolerance, message)
116 type(test_suite), intent(inout) :: suite
117 real(real64), intent(in) :: actual, expected, tolerance
118 character(len=*), intent(in), optional :: message
119
120 character(len=200) :: fail_msg
121 integer :: idx
122
123 idx = suite%current_test_index
124 if (idx < 1 .or. idx > suite%test_count) return
125
126 if (abs(actual - expected) > tolerance) then
127 write(fail_msg, '(A,G0,A,G0,A,G0)') 'Expected: ', expected, &
128 ' (±', tolerance, '), Got: ', actual
129 if (present(message)) then
130 fail_msg = trim(message) // ' - ' // trim(fail_msg)
131 end if
132 suite%tests(idx)%passed = .false.
133 suite%tests(idx)%failure_message = trim(fail_msg)
134 end if
135 end subroutine assert_near
136
137 !> Assert that a condition is true
138 subroutine assert_true(suite, condition, message)
139 type(test_suite), intent(inout) :: suite
140 logical, intent(in) :: condition
141 character(len=*), intent(in), optional :: message
142
143 integer :: idx
144
145 idx = suite%current_test_index
146 if (idx < 1 .or. idx > suite%test_count) return
147
148 if (.not. condition) then
149 suite%tests(idx)%passed = .false.
150 if (present(message)) then
151 suite%tests(idx)%failure_message = trim(message)
152 else
153 suite%tests(idx)%failure_message = 'Assertion failed: Expected true, got false'
154 end if
155 end if
156 end subroutine assert_true
157
158 !> Assert that a condition is false
159 subroutine assert_false(suite, condition, message)
160 type(test_suite), intent(inout) :: suite
161 logical, intent(in) :: condition
162 character(len=*), intent(in), optional :: message
163
164 integer :: idx
165
166 idx = suite%current_test_index
167 if (idx < 1 .or. idx > suite%test_count) return
168
169 if (condition) then
170 suite%tests(idx)%passed = .false.
171 if (present(message)) then
172 suite%tests(idx)%failure_message = trim(message)
173 else
174 suite%tests(idx)%failure_message = 'Assertion failed: Expected false, got true'
175 end if
176 end if
177 end subroutine assert_false
178
179 end module test_framework