Testing.ark

# internal, do not use
(let _make_suite (fun (name) {
  (mut passed 0)
  (mut failed 0)
  (mut failures [])
  (mut cases [])
  (mut case_pointer 0)
  (mut case_desc "")
  (mut display_cases_success false)

  (let toggle_display_cases_success (fun (bool)
    (set display_cases_success bool)))

  (let inc_passed (fun ()
    (set passed (+ 1 passed))))

  (let inc_failed (fun ()
    (set failed (+ 1 failed))))
  (let register_failure (fun (description) (append! failures description)))

  (let add_case (fun (name) {
    # keep track of the current case we're in
    (set case_desc name)
    (append! cases name) }))

  (let pop_case (fun () {
    (set case_desc "")
    (pop! cases -1) }))

  (let update_case_ptr (fun (val)
    (set case_pointer val)))
  (let need_case? (fun () (and (not (empty? case_desc)) (!= case_pointer (len cases)))))
  (fun (&name &passed &failed &failures &cases &case_pointer &case_desc &display_cases_success &toggle_display_cases_success &inc_passed &inc_failed &register_failure &add_case &pop_case &update_case_ptr &need_case?) ()) }))

# internal, do not use
(mut _suite nil)

# internal, do not use
(let _runner (fun (_name _callable) {
  (let _start_time (time))

  # run test
  (_callable)
  (let _end_time (time))

  # no newline, yet
  (puts _name)

  (if (> _suite.passed 0) (puts (str:format " - {} ✅" _suite.passed)))

  (if (> _suite.failed 0) (puts (str:format ", {} ❌" _suite.failed)))

  (puts (str:format " in {:2.3f}ms\n" (* 1000 (- _end_time _start_time))))

  (mut _i 0)
  (let _failures_count (len _suite.failures))

  (while (< _i _failures_count) {
    (print "  " (@ _suite.failures _i))
    (set _i (+ 1 _i)) })
  [_suite.passed _suite.failed] }))

# @brief Create a test case with a label to help with debugging when one or more tests fail
# @details Test cases can be nested.
# @param _desc a description for the test, a string
# @param _body test to execute
# =begin
# (test:suite name {
#     (test:expect (my_function 1 2 3))
#     (test:case "a description" {
#         (test:expect (return_true) "return true"})
#         (test:eq 1 2 "1 is 2, this should fail")})
# =end
# @author https://github.com/SuperFola
($ test:case (_desc _body) {
  (mut _old_pointer _suite.case_pointer)

  # Add the test name to a pile so that we can nicely print all the case names later.
  # Update the pointer to current case to its old value later on
  (_suite.add_case _desc)

  {
    _body }
  (_suite.pop_case)
  (_suite.update_case_ptr _old_pointer) })

# internal, do not use
# Until _case_pointer isn't at the end of the pile (where our failing test case's is),
# iterate on the list, writing the case name in a cascade pattern.
# This way if we have CASE A>CASE B>CASE C and no test crashed in A nor in A>B,
# we are still able to display the cascade A>B>C with the correct indentation.
(let _add_case (fun () {
  (let _target_len (len _suite.cases))

  (while (< _suite.case_pointer _target_len) {
    (mut _indent (* 2 _suite.case_pointer))

    (mut _fmt
      (if (> _indent 0)
        (+ "{: <" (toString _indent) "}{}")
        "{}{}"))
    (_suite.register_failure (str:format _fmt "" (@ _suite.cases _suite.case_pointer)))
    (_suite.update_case_ptr (+ 1 _suite.case_pointer)) }) }))

# internal, do not use
# This can only be used within a (nested or not) call to test:suite
# because it updates _failed and _failures, which are defined by
# test:suite call to _runner
(let _report_error (fun (_lhs _rhs _lhs_repr _rhs_repr _desc) {
  (let _test_desc (fun (_desc)
    (if (empty? _desc)
      ""
      (str:format " for test '{}'" (head _desc)))))

  (_suite.inc_failed)

  # If we have a case description AND the pointer isn't up to date, display the case(s)' names
  (if (_suite.need_case?) (_add_case))

  # Compute global indent for the failing test resume
  (let _indent_case_len (* 2 (len _suite.cases)))

  (let _indent
    (if (> _indent_case_len 0)
      (str:format (+ "{: <" (toString _indent_case_len) "}") "")
      ""))

  # Add the error message
  (_suite.register_failure (str:format "{}expected '{}' but got '{}'{}" _indent _lhs_repr _rhs_repr (_test_desc _desc)))

  (let _rhs_start (+ (len _lhs_repr) (len "expected ''")))
  (let _lhs_align (len _lhs_repr))
  (let _rhs_align (len _rhs_repr))
  (let _show_expected (!= _lhs_repr (toString _lhs)))
  (let _show_real (!= _rhs_repr (toString _rhs)))

  (if _show_real
    (_suite.register_failure
      (str:format
        (+ "{}{: <" (toString (len "expected ")) "}" "{: <" (toString _rhs_start) "}{:~<" (toString _rhs_align) "} {}")
        _indent
        # to position one char before the first ' surrounding the expected value
        ""
        # writes the | right under the first ' surrounding the expected value
        (if _show_expected
          "|"
          "")
        # begins the \~~~~ under the real value
        (if _show_real
          "\\"
          "")
        (if _show_real
          _rhs
          ""))))

  (if _show_expected
    (_suite.register_failure (str:format (+ "{}{: <" (toString (len "expected ")) "}\\ {}") _indent "" _lhs))) }))

# internal, do not use
# This can only be used within a (nested or not) call to test:suite
# because it updates _passed, which is defined by test:suite call to _runner
(let _report_success (fun () {
  (_suite.inc_passed)
  (if _suite.display_cases_success (_add_case)) }))

# @brief Given a value or function call returning a boolean, generate a test case
# @param _cond the value to test for truthiness
# @param _desc an optional description (string) for the test
# =begin
# (test:suite name {
#     (test:expect (my_function 1 2 3))
#     (test:expect (return_true) "return true"})
# =end
# @author https://github.com/SuperFola
($ test:expect (_cond ..._desc) {
  (if (!= true ($paste _cond))
    (_report_error true ($paste _cond) "true" ($repr _cond) _desc)
    (_report_success)) })

# @brief Compare two values that should be equal and generate a test case
# @param _expected expected value
# @param _expr computed value to test
# @param _desc an optional description (string) for the test
# =begin
# (test:suite name {
#     (test:eq 6 (my_function 1 2 3))
#     (test:eq 5 (foo) "foo should return 5")})
# =end
# @author https://github.com/SuperFola
($ test:eq (_expected _expr ..._desc) {
  (if (= ($paste _expected) ($paste _expr))
    (_report_success)
    (_report_error ($paste _expected) ($paste _expr) ($repr _expected) ($repr _expr) _desc)) })

# @brief Compare two values that should **not** be equal and generate a test case
# @param _unexpected the value we don't want
# @param _value tested value
# @param _desc an optional description (string) for the test
# =begin
# (test:suite name {
#     (test:neq 0 (my_function 1 2 3))})
# =end
# @author https://github.com/SuperFola
($ test:neq (_unexpected _value ..._desc) {
  (if (!= ($paste _unexpected) ($paste _value))
    (_report_success)
    (_report_error ($paste _unexpected) ($paste _value) ($repr _unexpected) ($repr _value) _desc)) })

# @brief Generate the code for a test suite
# @details Create two variables: _name-output (a list: [successes, failures]) and _name-status (boolean, true on success)
# @param _name test name, as an identifier
# @param _body body of the test, a begin block
# =begin
# (test:suite name {
#     (_suite.toggle_display_cases_success true)  # default: false, when true, display all the cases names on success and failures
#     (test:eq 6 (my_function 1 2 3))
#     (test:eq 128 (* 8 16))})
# =end
# @author https://github.com/SuperFola
($ test:suite (_name _body) {
  (set _suite (_make_suite ($repr _name)))

  (let ($symcat _name "-output") (_runner
      ($repr _name)
      (fun () ($paste
          {
            _body }))))
  (let ($symcat _name "-status") (= 0 (@ ($symcat _name "-output") 1))) })