mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-01-12 16:40:27 +00:00
Code Issues 1 Releases Wiki Activity

primitive tests working. issues remain with polymorphic.

Browse Source
This commit is contained in:
Mike Beller 2020-06-04 12:46:58 -04:00
parent 81d301a42b
commit 7658ea8335
2 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/boot/boot.janet
View File

@ -695,8 +695,8 @@
(defn compare-reduce- [op & xs]
(var r true)
(loop [i :range [0 (- (length xs) 1)]
c (compare (xs i) (xs (+ i 1)))
ok (op c 0)
:let [c (compare (xs i) (xs (+ i 1)))
ok (op c 0)]
:when (not ok)]
(set r false)
(break))
@ -705,27 +705,27 @@
(defn compare=
"Equivalent of '=' but using compare function instead of primitive comparator"
[& xs]
(compare-reduce := xs))
(compare-reduce- := xs))
(defn compare<
"Equivalent of '<' but using compare function instead of primitive comparator"
[& xs]
(compare-reduce :< xs))
(compare-reduce- :< xs))
(defn compare<=
"Equivalent of '<=' but using compare function instead of primitive comparator"
[& xs]
(compare-reduce :<= xs))
(compare-reduce- :<= xs))
(defn compare>
"Equivalent of '>' but using compare function instead of primitive comparator"
[& xs]
(compare-reduce :> xs))
(compare-reduce- :> xs))
(defn compare>=
"Equivalent of '>=' but using compare function instead of primitive comparator"
[& xs]
(compare-reduce :>= xs))
(compare-reduce- :>= xs))
###
###

15
test/suite0.janet
View File

@ -337,9 +337,12 @@
## Polymorphic comparison -- Issue #272
# confirm delegation to primitive comparators:
(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
(assert (= 0 (compare 1 1)) "compare integers (1)")
(assert (< 0 (compare 1 2)) "compare integers (2)")
(assert (> 0 (compare "foo" "bar")) "compare strings (1)")
(assert (= -1 (compare 1 2)) "compare integers (2)")
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
@ -368,18 +371,18 @@
(fn [self other]
(case (type other)
:number (compare-primitive (self :v) other))
:table (when (= (get self :type) :mynum)
:table (when (= (get other :type) :mynum)
(compare-primitive (self :v) (other :v))))})
(let [n3 (table/setproto @{:v 3} mynum)]
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
(assert (< 0 (compare n3 4)) "compare object to num (2)")
(assert (> 0 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
(assert (= -1 (compare n3 4)) "compare object to num (2)")
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
(assert (compare< 2 n3 4) "compare< poly")
(assert (compare> 4 n3 2) "compare> poly")
(assert (compare<= 2 3 n3 4) "compare<= poly")
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
(assert (deep= (sorted [4 5 n3 2] compare<) @[2 n3 4 5])))
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
(end-suite)