2018-08-06 18:19:39 +03:00
|
|
|
(load "Color.carp")
|
2017-10-20 18:00:47 +03:00
|
|
|
|
|
|
|
(defmodule Test
|
|
|
|
(deftype State [passed Int, failed Int])
|
2021-06-11 14:02:52 +03:00
|
|
|
(hidden State)
|
2019-06-20 10:03:03 +03:00
|
|
|
(use Color.Id)
|
2018-06-14 11:49:28 +03:00
|
|
|
(hidden handler)
|
2017-11-25 21:19:15 +03:00
|
|
|
(defn handler [state expected actual descr what op]
|
2017-10-20 18:00:47 +03:00
|
|
|
(if (op expected actual)
|
|
|
|
(do
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.colorize (Green) &(str* @"Test '" @descr @"' passed\n"))
|
2018-11-14 16:21:12 +03:00
|
|
|
(State.update-passed (State.copy state) &Int.inc))
|
2017-10-20 18:00:47 +03:00
|
|
|
(do
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.color (Red))
|
2018-06-15 17:38:34 +03:00
|
|
|
(IO.println &(str* @"Test '" @descr @"' failed:"))
|
|
|
|
(IO.print &(str* @"\tExpected " @what @": '"))
|
2017-10-20 18:00:47 +03:00
|
|
|
(IO.print &(str expected))
|
2018-06-15 17:38:34 +03:00
|
|
|
(IO.println &(str* @"', actual value: '" (str actual) @"'"))
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.color (Reset))
|
2018-11-14 16:21:12 +03:00
|
|
|
(State.update-failed (State.copy state) &Int.inc))))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-06-14 11:49:28 +03:00
|
|
|
(doc assert-op "Assert that op returns true when given x and y.")
|
2017-11-25 21:19:15 +03:00
|
|
|
(defn assert-op [state x y descr op]
|
|
|
|
(handler state x y descr "value" op))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-06-14 11:49:28 +03:00
|
|
|
(doc assert-equal "Assert that x and y are equal. Equality needs to be implemented for their type.")
|
2017-11-25 21:19:15 +03:00
|
|
|
(defn assert-equal [state x y descr]
|
|
|
|
(handler state x y descr "value" =))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-06-14 11:49:28 +03:00
|
|
|
(doc assert-not-equal "Assert that x and y are not equal. Equality needs to be implemented for their type.")
|
2017-11-25 21:19:15 +03:00
|
|
|
(defn assert-not-equal [state x y descr]
|
|
|
|
(handler state x y descr "not value" /=))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-06-14 11:49:28 +03:00
|
|
|
(doc assert-true "Assert that x is true.")
|
2017-10-20 18:00:47 +03:00
|
|
|
(defn assert-true [state x descr]
|
2017-11-25 21:19:15 +03:00
|
|
|
(assert-equal state true x descr))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-06-14 11:49:28 +03:00
|
|
|
(doc assert-false "Assert that x is false.")
|
2017-10-20 18:00:47 +03:00
|
|
|
(defn assert-false [state x descr]
|
2017-11-25 21:19:15 +03:00
|
|
|
(assert-equal state false x descr))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2020-05-12 15:53:42 +03:00
|
|
|
(doc assert-ref-equal "Assert that x and y are equal by reference. Reference equality needs to be implemented for their type.")
|
|
|
|
(defn assert-ref-equal [state x y descr]
|
|
|
|
(handler state &x &y descr "value" =))
|
|
|
|
|
|
|
|
(doc assert-just "Assert that x is a `Just`.")
|
|
|
|
(defn assert-just [state x descr]
|
|
|
|
(assert-true state (Maybe.just? x) descr))
|
|
|
|
|
|
|
|
(doc assert-nothing "Assert that x is a `Nothing`.")
|
|
|
|
(defn assert-nothing [state x descr]
|
|
|
|
(assert-true state (Maybe.nothing? x) descr))
|
|
|
|
|
|
|
|
(doc assert-success "Assert that x is a `Success`.")
|
|
|
|
(defn assert-success [state x descr]
|
|
|
|
(assert-true state (Result.success? x) descr))
|
|
|
|
|
|
|
|
(doc assert-error "Assert that x is an `Error`.")
|
|
|
|
(defn assert-error [state x descr]
|
|
|
|
(assert-true state (Result.error? x) descr))
|
|
|
|
|
2021-02-11 11:12:58 +03:00
|
|
|
(doc assert-dynamic-equal "Assert that the dynamic expressions `x` and `y` are equal.")
|
|
|
|
(defmacro assert-dynamic-equal [state x y descr]
|
|
|
|
`(Test.assert-equal %state true %(= (eval x) (eval y)) %descr))
|
|
|
|
|
|
|
|
(doc assert-dynamic-op "Assert that the dynamic expressions `x` and `y` are equal.")
|
|
|
|
(defmacro assert-dynamic-op [state x y descr op]
|
|
|
|
`(Test.assert-equal %state true %(op (eval x) (eval y)) %descr))
|
|
|
|
|
2018-06-14 11:49:28 +03:00
|
|
|
(doc reset "Reset test state.")
|
2017-10-20 18:00:47 +03:00
|
|
|
(defn reset [state]
|
|
|
|
(State.set-failed (State.set-passed state 0) 0))
|
|
|
|
|
2020-05-12 21:24:40 +03:00
|
|
|
(posix-only
|
2020-04-03 23:41:28 +03:00
|
|
|
(hidden run-child)
|
|
|
|
(defn run-child [x]
|
|
|
|
(let [pid (System.fork)
|
|
|
|
status 0]
|
|
|
|
(if (= pid 0)
|
|
|
|
(do
|
|
|
|
(x)
|
|
|
|
0)
|
|
|
|
(do
|
2021-05-27 23:04:46 +03:00
|
|
|
(ignore (System.wait (Pointer.address &status)))
|
2020-04-03 23:41:28 +03:00
|
|
|
(System.get-exit-status status)))))
|
|
|
|
|
|
|
|
(hidden handle-signal)
|
|
|
|
(defn handle-signal [x] (System.exit x))
|
|
|
|
|
|
|
|
(hidden run-child-signals)
|
|
|
|
(defn run-child-signals [x]
|
|
|
|
(let [pid (System.fork)
|
|
|
|
status 0]
|
|
|
|
(if (= pid 0)
|
|
|
|
(do
|
|
|
|
(System.signal System.signal-abort handle-signal)
|
|
|
|
(System.signal System.signal-fpe handle-signal)
|
|
|
|
(System.signal System.signal-ill handle-signal)
|
|
|
|
(System.signal System.signal-segv handle-signal)
|
|
|
|
(System.signal System.signal-term handle-signal)
|
|
|
|
(x)
|
|
|
|
0)
|
|
|
|
(do
|
2021-05-27 23:04:46 +03:00
|
|
|
(ignore (System.wait (Pointer.address &status)))
|
2020-04-03 23:41:28 +03:00
|
|
|
(System.get-exit-status status)))))
|
2018-05-23 14:57:55 +03:00
|
|
|
|
2020-04-03 23:41:28 +03:00
|
|
|
(doc assert-exit "Assert that function f exits with exit code exit-code.")
|
|
|
|
(defn assert-exit [state exit-code f descr]
|
|
|
|
(assert-equal state exit-code (run-child f) descr))
|
2018-05-23 16:13:13 +03:00
|
|
|
|
2020-04-03 23:41:28 +03:00
|
|
|
(doc assert-signal "Assert that function f aborts with OS signal signal.")
|
|
|
|
(defn assert-signal [state signal x descr]
|
|
|
|
(assert-equal state signal (run-child-signals x) descr)))
|
2018-05-23 16:13:13 +03:00
|
|
|
|
2020-04-03 23:41:28 +03:00
|
|
|
(windows-only
|
|
|
|
(defndynamic assert-exit [state exit-code f descr]
|
|
|
|
(macro-error "assert-exit is not implemented on Windows."))
|
2018-05-23 14:57:55 +03:00
|
|
|
|
2020-04-03 23:41:28 +03:00
|
|
|
(defndynamic assert-signal [state signal x descr]
|
|
|
|
(macro-error "assert-signal is not implemented on Windows.")))
|
2018-05-23 16:13:13 +03:00
|
|
|
|
2018-06-14 11:49:28 +03:00
|
|
|
(doc print-test-results "Print test results.")
|
2017-10-20 18:00:47 +03:00
|
|
|
(defn print-test-results [state]
|
2018-01-26 23:23:29 +03:00
|
|
|
(let [passed @(State.passed state)
|
|
|
|
failed @(State.failed state)]
|
2017-10-20 18:00:47 +03:00
|
|
|
(do
|
|
|
|
(IO.println "Results:")
|
|
|
|
(if (Int.> (Int.+ passed failed) 0)
|
|
|
|
(do
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.color (Green))
|
2019-10-28 20:13:40 +03:00
|
|
|
(when (Int.> passed 0) (IO.print &(String.append "\t|" &(String.allocate passed \=))))
|
|
|
|
(when (Int.= failed 0) (IO.print "|"))
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.color (Red))
|
2019-10-28 20:13:40 +03:00
|
|
|
(when (Int.= passed 0) (IO.print "\t|"))
|
|
|
|
(when (Int.> failed 0) (IO.print &(String.append &(String.allocate failed \=) "|")))
|
2017-10-20 18:00:47 +03:00
|
|
|
(IO.println ""))
|
|
|
|
())
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.color (Green))
|
2017-10-20 18:00:47 +03:00
|
|
|
(IO.print "\tPassed: ")
|
|
|
|
(IO.print &(Int.str passed))
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.color (Red))
|
2017-10-20 18:00:47 +03:00
|
|
|
(IO.print "\tFailed: ")
|
|
|
|
(IO.println &(Int.str failed))
|
2019-06-20 10:03:03 +03:00
|
|
|
(IO.color (Reset))))))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic with-test-internal [name forms]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length forms) 1)
|
2021-01-21 08:20:03 +03:00
|
|
|
`((set! %name &%(car forms)))
|
|
|
|
(cons `(set! %name &%(car forms))
|
2017-10-20 18:00:47 +03:00
|
|
|
(with-test-internal name (cdr forms)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defmacro with-test [name :rest forms]
|
2021-01-21 08:20:03 +03:00
|
|
|
`(let [%name &(Test.State.init 0 0)]
|
|
|
|
%(cons-last
|
|
|
|
`@(Test.State.failed %name)
|
2018-09-13 02:10:17 +03:00
|
|
|
(cons-last
|
2021-01-21 08:20:03 +03:00
|
|
|
`(Test.print-test-results %name)
|
|
|
|
`(do %@(with-test-internal name forms))))
|
2018-09-13 02:10:17 +03:00
|
|
|
))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-11-07 18:11:38 +03:00
|
|
|
(defmacro deftest [name :rest forms]
|
2020-04-10 17:04:44 +03:00
|
|
|
(eval
|
2021-01-21 08:20:03 +03:00
|
|
|
`(defn main []
|
|
|
|
(let [%name &(Test.State.init 0 0)]
|
|
|
|
%(cons-last
|
|
|
|
`@(Test.State.failed %name)
|
2020-04-10 17:04:44 +03:00
|
|
|
(cons-last
|
2021-01-21 08:20:03 +03:00
|
|
|
`(Test.print-test-results %name)
|
|
|
|
`(do %@(with-test-internal name forms))))))))
|