|
| 1 | +# internal, do not use |
| 2 | +(let _runner (fun (_name _callable) { |
| 3 | + (mut _passed 0) |
| 4 | + (mut _failed 0) |
| 5 | + (mut _failures []) |
| 6 | + (let _case_desc "") |
| 7 | + (mut _cases []) |
| 8 | + (mut _case_pointer 0) |
| 9 | + (mut display_cases_success false) |
| 10 | + |
| 11 | + (let _start_time (time)) |
| 12 | + # run test |
| 13 | + (_callable) |
| 14 | + (let _end_time (time)) |
| 15 | + |
| 16 | + # no newline, yet |
| 17 | + (puts _name) |
| 18 | + (if (> _passed 0) |
| 19 | + (puts (str:format " - {} ✅" _passed))) |
| 20 | + (if (> _failed 0) |
| 21 | + (puts (str:format ", {} ❌" _failed))) |
| 22 | + |
| 23 | + (puts (str:format " in {:2.3f}ms\n" (* 1000 (- _end_time _start_time)))) |
| 24 | + |
| 25 | + (mut _i 0) |
| 26 | + (let _failures_count (len _failures)) |
| 27 | + (while (< _i _failures_count) { |
| 28 | + (print " " (@ _failures _i)) |
| 29 | + (set _i (+ 1 _i))}) |
| 30 | + |
| 31 | + [_passed _failed]})) |
| 32 | + |
| 33 | +(let _test_desc (fun (_desc) |
| 34 | + (if (empty? _desc) |
| 35 | + "" |
| 36 | + (str:format " for test '{}'" (head _desc))))) |
| 37 | + |
| 38 | +# internal, do not use |
| 39 | +# Has a _case_desc which also exists (empty) inside _runner so that tests without a |
| 40 | +# case won't crash the testing library when trying to access the case name. |
| 41 | +# Add the test name to a pile so that we can nicely print all the case names later. |
| 42 | +# Update the pointer to current case to its old value later on |
| 43 | +(let _case (fun (_case_desc _callable) { |
| 44 | + (let _old_pointer _case_pointer) |
| 45 | + (append! _cases _case_desc) |
| 46 | + (_callable) |
| 47 | + (pop! _cases -1) |
| 48 | + (set _case_pointer _old_pointer)})) |
| 49 | + |
| 50 | +# @brief Create a test case with a label to help with debugging when one or more tests fail |
| 51 | +# @details Test cases can be nested. |
| 52 | +# @param _desc a description for the test, a string |
| 53 | +# @param _body test to execute |
| 54 | +# =begin |
| 55 | +# (test:suite name { |
| 56 | +# (test:expect (my_function 1 2 3)) |
| 57 | +# (test:case "a description" { |
| 58 | +# (test:expect (return_true) "return true"}) |
| 59 | +# (test:eq 1 2 "1 is 2, this should fail")}) |
| 60 | +# =end |
| 61 | +# @author https://github.com/SuperFola |
| 62 | +($ test:case (_desc _body) |
| 63 | + (_case _desc (fun () {_body}))) |
| 64 | + |
| 65 | +# internal, do not use |
| 66 | +# Until _case_pointer isn't at the end of the pile (where our failing test case's is), |
| 67 | +# iterate on the list, writing the case name in a cascade pattern. |
| 68 | +# This way if we have CASE A>CASE B>CASE C and no test crashed in A nor in A>B, |
| 69 | +# we are still able to display the cascade A>B>C with the correct indentation. |
| 70 | +(let _add_case (fun () { |
| 71 | + (let _target_len (len _cases)) |
| 72 | + (while (< _case_pointer _target_len) { |
| 73 | + (mut _indent (* 2 _case_pointer)) |
| 74 | + (mut _fmt (if (> _indent 0) (+ "{: <" (toString _indent) "}{}") "{}{}")) |
| 75 | + (append! _failures (str:format _fmt "" (@ _cases _case_pointer))) |
| 76 | + (set _case_pointer (+ 1 _case_pointer))})})) |
| 77 | + |
| 78 | +# internal, do not use |
| 79 | +# This can only be used within a (nested or not) call to test:suite |
| 80 | +# because it updates _failed and _failures, which are defined by |
| 81 | +# test:suite call to _runner |
| 82 | +(let _report_error (fun (_lhs _rhs _lhs_repr _rhs_repr _desc) { |
| 83 | + (set _failed (+ 1 _failed)) |
| 84 | + |
| 85 | + # If we have a case description AND the pointer isn't up to date, display the case(s)' names |
| 86 | + (if (and (not (empty? _case_desc)) (!= _case_pointer (len _cases))) |
| 87 | + (_add_case)) |
| 88 | + |
| 89 | + # Compute global indent for the failing test resume |
| 90 | + (let _indent_case_len (* 2 (len _cases))) |
| 91 | + (let _indent (if (> _indent_case_len 0) |
| 92 | + (str:format (+ "{: <" (toString _indent_case_len) "}") "") |
| 93 | + "")) |
| 94 | + # Add the error message |
| 95 | + (append! _failures (str:format "{}expected '{}' but got '{}'{}" _indent _lhs_repr _rhs_repr (_test_desc _desc))) |
| 96 | + |
| 97 | + (let _rhs_start (+ (len _lhs_repr) (len "expected ''"))) |
| 98 | + (let _lhs_align (len _lhs_repr)) |
| 99 | + (let _rhs_align (len _rhs_repr)) |
| 100 | + (let _show_expected (!= _lhs_repr (toString _lhs))) |
| 101 | + (let _show_real (!= _rhs_repr (toString _rhs))) |
| 102 | + |
| 103 | + (if _show_real |
| 104 | + (append! _failures |
| 105 | + (str:format |
| 106 | + (+ "{}{: <" (toString (len "expected ")) "}" "{: <" (toString _rhs_start) "}{:~<" (toString _rhs_align) "} {}") |
| 107 | + _indent |
| 108 | + # to position one char before the first ' surrounding the expected value |
| 109 | + "" |
| 110 | + # writes the | right under the first ' surrounding the expected value |
| 111 | + (if _show_expected "|" "") |
| 112 | + # begins the \~~~~ under the real value |
| 113 | + (if _show_real "\\" "") |
| 114 | + (if _show_real _rhs "")))) |
| 115 | + (if _show_expected |
| 116 | + (append! _failures |
| 117 | + (str:format |
| 118 | + (+ "{}{: <" (toString (len "expected ")) "}\\ {}") |
| 119 | + _indent |
| 120 | + "" |
| 121 | + _lhs)))})) |
| 122 | + |
| 123 | +# internal, do not use |
| 124 | +# This can only be used within a (nested or not) call to test:suite |
| 125 | +# because it updates _passed, which is defined by test:suite call to _runner |
| 126 | +(let _report_success (fun () { |
| 127 | + (set _passed (+ 1 _passed)) |
| 128 | + (if display_cases_success |
| 129 | + (_add_case)) |
| 130 | +})) |
| 131 | + |
| 132 | +# @brief Given a value or function call returning a boolean, generate a test case |
| 133 | +# @param _cond the value to test for truthiness |
| 134 | +# @param _desc an optional description (string) for the test |
| 135 | +# =begin |
| 136 | +# (test:suite name { |
| 137 | +# (test:expect (my_function 1 2 3)) |
| 138 | +# (test:expect (return_true) "return true"}) |
| 139 | +# =end |
| 140 | +# @author https://github.com/SuperFola |
| 141 | +($ test:expect (_cond ..._desc) { |
| 142 | + (if (!= true _cond) |
| 143 | + { |
| 144 | + (set _failed (+ 1 _failed)) |
| 145 | + (append! _failures (str:format "{} returned {}{}" ($repr _cond) _cond) (_test_desc _desc))} |
| 146 | + (_report_success))}) |
| 147 | + |
| 148 | +# @brief Compare two values that should be equal and generate a test case |
| 149 | +# @param _expected expected value |
| 150 | +# @param _expr computed value to test |
| 151 | +# @param _desc an optional description (string) for the test |
| 152 | +# =begin |
| 153 | +# (test:suite name { |
| 154 | +# (test:eq 6 (my_function 1 2 3)) |
| 155 | +# (test:eq 5 (foo) "foo should return 5")}) |
| 156 | +# =end |
| 157 | +# @author https://github.com/SuperFola |
| 158 | +($ test:eq (_expected _expr ..._desc) { |
| 159 | + (if (= _expected _expr) |
| 160 | + (_report_success) |
| 161 | + (_report_error _expected _expr ($repr _expected) ($repr _expr) _desc))}) |
| 162 | + |
| 163 | +# @brief Compare two values that should **not** be equal and generate a test case |
| 164 | +# @param _unexpected the value we don't want |
| 165 | +# @param _value tested value |
| 166 | +# @param _desc an optional description (string) for the test |
| 167 | +# =begin |
| 168 | +# (test:suite name { |
| 169 | +# (test:neq 0 (my_function 1 2 3))}) |
| 170 | +# =end |
| 171 | +# @author https://github.com/SuperFola |
| 172 | +($ test:neq (_unexpected _value ..._desc) { |
| 173 | + (if (!= _unexpected _value) |
| 174 | + (_report_success) |
| 175 | + (_report_error _unexpected _value ($repr _unexpected) ($repr _value) _desc))}) |
| 176 | + |
| 177 | +# @brief Generate the code for a test suite |
| 178 | +# @details Create two variables: _name-output (a list: [successes, failures]) and _name-status (boolean, true on success) |
| 179 | +# @param _name test name, as an identifier |
| 180 | +# @param _body body of the test, a begin block |
| 181 | +# =begin |
| 182 | +# (test:suite name { |
| 183 | +# (set display_cases_success true) # default: false, when true, display all the cases names on success and failures |
| 184 | +# (test:eq 6 (my_function 1 2 3)) |
| 185 | +# (test:eq 128 (* 8 16))}) |
| 186 | +# =end |
| 187 | +# @author https://github.com/SuperFola |
| 188 | +($ test:suite (_name _body) { |
| 189 | + (let (symcat _name "-output") (_runner ($repr _name) (fun () {_body}))) |
| 190 | + (let (symcat _name "-status") (= 0 (@ (symcat _name "-output") 1)))}) |
0 commit comments