mirror of
https://github.com/carp-lang/Carp.git
synced 2024-07-14 16:40:26 +03:00
feat: Adds Dynamic.sort & improves output of failing dynamic tests (#1411)
* feat: Adds Dynamic.sort * test: Adds tests for Dynamic.sort * refactor: Makes dynamic test handler display diff of expected vs actual instead of displaying "true" : "true" * test: Removes complex implementation of list-equal-unordered Replaces it with sort + equal. While this is less "correct", having complex untested functions within test files is undesirable. This implementation is "good enough" for lists of integers.
This commit is contained in:
parent
a9e806fee7
commit
d7ad0b2629
@ -17,9 +17,9 @@ Example:
|
||||
(= 'a (cadr x)) car
|
||||
(= 'd (cadr x)) cdr
|
||||
(macro-error "`cxr` expects either `a` or `d` symbols, got " (cadr x)))
|
||||
(if (= 1 (car x))
|
||||
(cxr (cddr x) pair)
|
||||
(cxr (cons (- (car x) 1) (cdr x)) pair)))))
|
||||
(if (= 1 (car x))
|
||||
(cxr (cddr x) pair)
|
||||
(cxr (cons (- (car x) 1) (cdr x)) pair)))))
|
||||
|
||||
(doc nthcdr "takes the `n`th tail or `cdr` of the list `pair`.")
|
||||
(defndynamic nthcdr [n pair]
|
||||
@ -313,6 +313,23 @@ Example:
|
||||
(let [r (walk-replace-finder pairs x)]
|
||||
(if (empty? r) x (cadr r))))
|
||||
form))
|
||||
(doc sort "Sorts a list using the provided predicate. It is not a stable sort.
|
||||
Example:
|
||||
```
|
||||
(sort '(1 3 4 2 5 4) <) ; => (1 2 3 4 4 5)
|
||||
(sort '(1 3 4 2 5 4) >) ; => (5 4 4 3 2 1)
|
||||
(sort '(\"one\" \"two---\" \"three\" \"four\") (fn [a b] (< (String.length a) (String.length b)))) ; => (\"one\" \"four\" \"three\" \"two---\")
|
||||
```")
|
||||
(defndynamic sort [l compare]
|
||||
(if (nil? l)
|
||||
'()
|
||||
(let [x (car l)
|
||||
xs (cdr l)
|
||||
lower-filtered (filter (fn [y] (compare y x)) xs)
|
||||
lower-sorted (Dynamic.sort lower-filtered compare)
|
||||
higher-filtered (filter (fn [y] (not (compare y x))) xs)
|
||||
higher-sorted (Dynamic.sort higher-filtered compare)]
|
||||
(append lower-sorted (append (list x) higher-sorted)))))
|
||||
|
||||
(defmodule List
|
||||
(doc pairs "makes a list of pairs out of a list `l`. If the number of
|
||||
@ -367,6 +384,5 @@ Returns `nil` on failure")
|
||||
(let [res (List.find-index (cdr l) pred)]
|
||||
(if (nil? res)
|
||||
res
|
||||
(inc res)))))
|
||||
)
|
||||
)
|
||||
(inc res)))))))
|
||||
|
||||
|
@ -18,9 +18,9 @@ Example:
|
||||
(deftype State [passed Int, failed Int])
|
||||
(hidden State)
|
||||
(use Color.Id)
|
||||
(hidden handler)
|
||||
(defn handler [state expected actual descr what op]
|
||||
(if (op expected actual)
|
||||
(hidden display-test)
|
||||
(defn display-test [state expected actual descr what is-success]
|
||||
(if is-success
|
||||
(do
|
||||
(IO.colorize (Green) &(str* @"Test '" @descr @"' passed\n"))
|
||||
(State.update-passed (State.copy state) &Int.inc))
|
||||
@ -33,6 +33,14 @@ Example:
|
||||
(IO.color (Reset))
|
||||
(State.update-failed (State.copy state) &Int.inc))))
|
||||
|
||||
(hidden handler)
|
||||
(defn handler [state expected actual descr what op]
|
||||
(display-test state expected actual descr what (op expected actual)))
|
||||
|
||||
(hidden dynhandler)
|
||||
(defndynamic dynhandler [state expected actual descr what op]
|
||||
(list 'Test.display-test state (str expected) (str actual) descr what (op expected actual)))
|
||||
|
||||
(doc assert-op "Assert that op returns true when given x and y.")
|
||||
(defn assert-op [state x y descr op]
|
||||
(handler state x y descr "value" op))
|
||||
@ -73,13 +81,13 @@ Example:
|
||||
(defn assert-error [state x descr]
|
||||
(assert-true state (Result.error? x) descr))
|
||||
|
||||
(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))
|
||||
(dynhandler state (eval x) (eval y) descr "value" op))
|
||||
|
||||
(doc assert-dynamic-equal "Assert that the dynamic expressions `x` and `y` are equal.")
|
||||
(defmacro assert-dynamic-equal [state x y descr]
|
||||
(dynhandler state (eval x) (eval y) descr "value" =))
|
||||
|
||||
(doc reset "Reset test state.")
|
||||
(defn reset [state]
|
||||
@ -170,8 +178,7 @@ Example:
|
||||
`@(Test.State.failed %name)
|
||||
(cons-last
|
||||
`(Test.print-test-results %name)
|
||||
`(do %@(with-test-internal name forms))))
|
||||
))
|
||||
`(do %@(with-test-internal name forms))))))
|
||||
|
||||
(defmacro deftest [name :rest forms]
|
||||
(eval
|
||||
|
@ -3,19 +3,8 @@
|
||||
|
||||
(doc list-equal-unordered "Checks two lists have the same values, not necessarily in the same order")
|
||||
(defndynamic list-equal-unordered [xs ys]
|
||||
(if (not (= (length xs) (length ys)))
|
||||
false
|
||||
(car (reduce (fn [state x]
|
||||
(let [keep-going (car state)
|
||||
l (cadr state)]
|
||||
(if (not keep-going)
|
||||
'(false ())
|
||||
(let [index (List.find-index l (curry = x))]
|
||||
(if (nil? index)
|
||||
'(false ())
|
||||
(list true (List.remove-nth l index)))))))
|
||||
(list true ys)
|
||||
xs))))
|
||||
(= (Dynamic.sort xs <)
|
||||
(Dynamic.sort ys <)))
|
||||
|
||||
(deftest test
|
||||
(assert-dynamic-equal test
|
||||
|
20
test/list.carp
Normal file
20
test/list.carp
Normal file
@ -0,0 +1,20 @@
|
||||
(load-and-use Test)
|
||||
|
||||
(deftest test
|
||||
(assert-dynamic-equal test
|
||||
'(1 2 3 3 4)
|
||||
(Dynamic.sort '(3 4 3 1 2) <)
|
||||
"Dynamic.sort sorts from lower to higher")
|
||||
|
||||
(assert-dynamic-equal test
|
||||
'(4 3 3 2 1)
|
||||
(Dynamic.sort '(3 4 3 1 2) >)
|
||||
"Dynamic.sort sorts from higher to lower")
|
||||
|
||||
(assert-dynamic-equal test
|
||||
'("one" "four" "three" "two---")
|
||||
(Dynamic.sort '("one" "two---" "three" "four")
|
||||
(fn [a b]
|
||||
(< (String.length a) (String.length b))))
|
||||
"Dynamic.sort sorts using predicate"))
|
||||
|
Loading…
Reference in New Issue
Block a user