Testing.ark

# internal, do not use
(let _make_suite (fun (name) {
  (mut active false)
  (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 (case_name) {
    # keep track of the current case we're in
    (set case_desc case_name)
    (append! cases case_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)))))

  (let set_active (fun (bool)
    (set active bool)))

  (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?
    &active
    &set_active) ()) }))

# internal, do not use
(mut _suite nil)

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

  # run test
  (_callable)
  (let _end_time (time))
  (_suite.set_active false)

  # no newline, yet
  (puts _name)

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

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

  (puts (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
(macro test:case (_desc _body) {
  (mut _old_pointer testing:_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
  (testing:_suite.add_case _desc)

  {
    _body }
  (testing:_suite.pop_case)
  (testing:_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 (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)
      ""
      (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)
      (format (+ "{: <" (toString _indent_case_len) "}") "")
      ""))

  # Add the error message
  (_suite.register_failure (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
      (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 (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
(macro test:expect (_cond ..._desc) {
  {
    (set testing:_cond_res ($as-is _cond))
    (if (!= true testing:_cond_res)
      (testing:_report_error true testing:_cond_res "true" ($repr _cond) _desc)
      (testing:_report_success)) } })

(mut _cond_res nil)
(mut _expr_res nil)
(mut _expected_res nil)
(mut _unexpected_res nil)
(mut _value_res nil)

# @brief Compare two values that should be equal and generate a test case
# @param _expr computed value to test
# @param _expected expected value
# @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
(macro test:eq (_expr _expected ..._desc) {
  {
    (set testing:_expected_res ($as-is _expected))
    (set testing:_expr_res ($as-is _expr))
    (if (= testing:_expected_res testing:_expr_res)
      (testing:_report_success)
      (testing:_report_error testing:_expected_res testing:_expr_res ($repr _expected) ($repr _expr) _desc)) } })

# @brief Compare two values that should **not** be equal and generate a test case
# @param _value tested value
# @param _unexpected the value we don't want
# @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
(macro test:neq (_value _unexpected ..._desc) {
  {
    (set testing:_unexpected_res ($as-is _unexpected))
    (set testing:_value_res ($as-is _value))
    (if (!= testing:_unexpected_res testing:_value_res)
      (testing:_report_success)
      (testing:_report_error testing:_unexpected_res testing:_value_res ($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 {
#     (testing:_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
(macro test:suite (_name _body) {
  (assert (or (nil? testing:_suite) (not testing:_suite.active)) "Can not nest multiple test suites together!")
  (set testing:_suite (testing:_make_suite ($repr _name)))

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