mirror of
https://github.com/janet-lang/janet
synced 2024-11-14 04:34:48 +00:00
910 lines
31 KiB
Plaintext
910 lines
31 KiB
Plaintext
# Copyright (c) 2023 Calvin Rose
|
|
#
|
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
# of this software and associated documentation files (the "Software"), to
|
|
# deal in the Software without restriction, including without limitation the
|
|
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
|
# sell copies of the Software, and to permit persons to whom the Software is
|
|
# furnished to do so, subject to the following conditions:
|
|
#
|
|
# The above copyright notice and this permission notice shall be included in
|
|
# all copies or substantial portions of the Software.
|
|
#
|
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
|
# IN THE SOFTWARE.
|
|
|
|
(import ./helper :prefix "" :exit true)
|
|
(start-suite)
|
|
|
|
# Let
|
|
# 807f981
|
|
(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
|
|
(assert (= (let [[a b] @[1 2]] (+ a b)) 3) "destructured let")
|
|
(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10)
|
|
"double destructured let")
|
|
|
|
# Macros
|
|
# b305a7c
|
|
(defn dub [x] (+ x x))
|
|
(assert (= 2 (dub 1)) "defn macro")
|
|
(do
|
|
(defn trip [x] (+ x x x))
|
|
(assert (= 3 (trip 1)) "defn macro triple"))
|
|
(do
|
|
(var i 0)
|
|
(when true
|
|
(++ i)
|
|
(++ i)
|
|
(++ i)
|
|
(++ i)
|
|
(++ i)
|
|
(++ i))
|
|
(assert (= i 6) "when macro"))
|
|
|
|
# Add truthy? to core
|
|
# ded08b6
|
|
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
|
|
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
|
|
|
|
## Polymorphic comparison -- Issue #272
|
|
# 81d301a42
|
|
|
|
# confirm polymorphic comparison delegation to primitive comparators:
|
|
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
|
|
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
|
|
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
|
|
(assert (= 0 (compare 1 1)) "compare integers (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 (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
|
|
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
|
|
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
|
|
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
|
|
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
|
|
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
|
|
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0)
|
|
"compare less than or equal to reals")
|
|
(assert (compare>= 6 5 4 4 3 2 1)
|
|
"compare greater than or equal to integers")
|
|
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0)
|
|
"compare greater than or equal to reals")
|
|
(assert (compare< 1.0 nil false true
|
|
(fiber/new (fn [] 1))
|
|
"hi"
|
|
(quote hello)
|
|
:hello
|
|
(array 1 2 3)
|
|
(tuple 1 2 3)
|
|
(table "a" "b" "c" "d")
|
|
(struct 1 2 3 4)
|
|
(buffer "hi")
|
|
(fn [x] (+ x x))
|
|
print) "compare type ordering")
|
|
|
|
# test polymorphic compare with 'objects' (table/setproto)
|
|
(def mynum
|
|
@{:type :mynum :v 0 :compare
|
|
(fn [self other]
|
|
(case (type other)
|
|
:number (cmp (self :v) other)
|
|
:table (when (= (get other :type) :mynum)
|
|
(cmp (self :v) (other :v)))))})
|
|
|
|
(let [n3 (table/setproto @{:v 3} mynum)]
|
|
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
|
(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])
|
|
"polymorphic sort"))
|
|
|
|
# Add any? predicate to core
|
|
# 7478ad11
|
|
(assert (= nil (any? [])) "any? 1")
|
|
(assert (= nil (any? [false nil])) "any? 2")
|
|
(assert (= false (any? [nil false])) "any? 3")
|
|
(assert (= 1 (any? [1])) "any? 4")
|
|
(assert (nan? (any? [nil math/nan nil])) "any? 5")
|
|
(assert (= true
|
|
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
|
|
"any? 6")
|
|
|
|
(assert (= true (every? [])) "every? 1")
|
|
(assert (= true (every? [1 true])) "every? 2")
|
|
(assert (= 1 (every? [true 1])) "every? 3")
|
|
(assert (= nil (every? [nil])) "every? 4")
|
|
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
|
|
(assert (= false
|
|
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
|
|
"every? 6")
|
|
|
|
# Some higher order functions and macros
|
|
# 5e2de33
|
|
(def my-array @[1 2 3 4 5 6])
|
|
(assert (= (if-let [x (get my-array 5)] x) 6) "if-let 1")
|
|
(assert (= (if-let [y (get @{} :key)] 10 nil) nil) "if-let 2")
|
|
(assert (= (if-let [a my-array k (next a)] :t :f) :t) "if-let 3")
|
|
(assert (= (if-let [a my-array k (next a 5)] :t :f) :f) "if-let 4")
|
|
(assert (= (if-let [[a b] my-array] a) 1) "if-let 5")
|
|
(assert (= (if-let [{:a a :b b} {:a 1 :b 2}] b) 2) "if-let 6")
|
|
(assert (= (if-let [[a b] nil] :t :f) :f) "if-let 7")
|
|
|
|
# #1191
|
|
(var cnt 0)
|
|
(defmacro upcnt [] (++ cnt))
|
|
(assert (= (if-let [a true b true c true] nil (upcnt)) nil) "issue #1191")
|
|
(assert (= cnt 1) "issue #1191")
|
|
|
|
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
|
|
(def myfun (juxt + - * /))
|
|
(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
|
|
|
|
# Case statements
|
|
# 5249228
|
|
(assert
|
|
(= :six (case (+ 1 2 3)
|
|
1 :one
|
|
2 :two
|
|
3 :three
|
|
4 :four
|
|
5 :five
|
|
6 :six
|
|
7 :seven
|
|
8 :eight
|
|
9 :nine)) "case macro")
|
|
|
|
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
|
|
|
|
# Testing the seq, tabseq, catseq, and loop macros
|
|
# 547529e
|
|
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)]
|
|
(tuple (/ x 2) x))))
|
|
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
|
|
|
|
# 624be87c9
|
|
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)]
|
|
(tuple (/ x 2) x))))
|
|
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
|
|
|
|
# Looping idea
|
|
# 45f8db0
|
|
(def xs
|
|
(seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
|
|
(def txs (apply tuple xs))
|
|
|
|
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
|
|
"nested seq")
|
|
|
|
# 515891b03
|
|
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
|
|
@{0 0 1 3 2 6}))
|
|
|
|
(assert (deep= (tabseq [i :in (range 3)] i)
|
|
@{}))
|
|
|
|
# ccd874fe4
|
|
(def xs (catseq [x :range [0 3]] [x x]))
|
|
(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
|
|
|
|
# :range-to and :down-to
|
|
# e0c9910d8
|
|
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x))
|
|
"loop :range-to")
|
|
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
|
|
"loop :down-to")
|
|
|
|
# 7880d7320
|
|
(def res @{})
|
|
(loop [[k v] :pairs @{1 2 3 4 5 6}]
|
|
(put res k v))
|
|
(assert (and
|
|
(= (get res 1) 2)
|
|
(= (get res 3) 4)
|
|
(= (get res 5) 6)) "loop :pairs")
|
|
|
|
# Issue #428
|
|
# 08a3687eb
|
|
(var result nil)
|
|
(defn f [] (yield {:a :ok}))
|
|
(assert-no-error "issue 428 1"
|
|
(loop [{:a x} :in (fiber/new f)] (set result x)))
|
|
(assert (= result :ok) "issue 428 2")
|
|
|
|
# Generators
|
|
# 184fe31e0
|
|
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
|
|
(var gencount 0)
|
|
(loop [x :in gen]
|
|
(++ gencount)
|
|
(assert (pos? (% x 4)) "generate in loop"))
|
|
(assert (= gencount 75) "generate loop count")
|
|
|
|
# Even and odd
|
|
# ff163a5ae
|
|
(assert (odd? 9) "odd? 1")
|
|
(assert (odd? -9) "odd? 2")
|
|
(assert (not (odd? 10)) "odd? 3")
|
|
(assert (not (odd? 0)) "odd? 4")
|
|
(assert (not (odd? -10)) "odd? 5")
|
|
(assert (not (odd? 1.1)) "odd? 6")
|
|
(assert (not (odd? -0.1)) "odd? 7")
|
|
(assert (not (odd? -1.1)) "odd? 8")
|
|
(assert (not (odd? -1.6)) "odd? 9")
|
|
|
|
(assert (even? 10) "even? 1")
|
|
(assert (even? -10) "even? 2")
|
|
(assert (even? 0) "even? 3")
|
|
(assert (not (even? 9)) "even? 4")
|
|
(assert (not (even? -9)) "even? 5")
|
|
(assert (not (even? 0.1)) "even? 6")
|
|
(assert (not (even? -0.1)) "even? 7")
|
|
(assert (not (even? -10.1)) "even? 8")
|
|
(assert (not (even? -10.6)) "even? 9")
|
|
|
|
# Map arities
|
|
# 25ded775a
|
|
(assert (deep= (map inc [1 2 3]) @[2 3 4]))
|
|
(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
|
|
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
|
|
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000])
|
|
@[1111 2222 3333]))
|
|
(assert (deep= (map +
|
|
[1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
|
|
[10000 20000 30000])
|
|
@[11111 22222 33333]))
|
|
# 77e62a2
|
|
(assert (deep= (map +
|
|
[1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
|
|
[10000 20000 30000] [100000 200000 300000])
|
|
@[111111 222222 333333]))
|
|
|
|
# Mapping uses the shortest sequence
|
|
# a69799aa4
|
|
(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
|
|
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
|
|
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
|
|
# 77e62a2
|
|
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000] []) @[]))
|
|
|
|
# Variadic arguments to map-like functions
|
|
# 77e62a2
|
|
(assert (deep= (mapcat tuple [1 2 3 4] [5 6 7 8]) @[1 5 2 6 3 7 4 8]))
|
|
(assert (deep= (keep |(if (> $1 0) (/ $0 $1)) [1 2 3 4 5] [1 2 1 0 1])
|
|
@[1 1 3 5]))
|
|
|
|
(assert (= (count = [1 3 2 4 3 5 4 2 1] [1 2 3 4 5 4 3 2 1]) 4))
|
|
|
|
(assert (= (some not= (range 5) (range 5)) nil))
|
|
(assert (= (some = [1 2 3 4 5] [5 4 3 2 1]) true))
|
|
|
|
(assert (= (all = (range 5) (range 5)) true))
|
|
(assert (= (all not= [1 2 3 4 5] [5 4 3 2 1]) false))
|
|
|
|
# 4194374
|
|
(assert (= false (deep-not= [1] [1])) "issue #1149")
|
|
|
|
# Merge sort
|
|
# f5b29b8
|
|
# Imperative (and verbose) merge sort merge
|
|
(defn merge-sort
|
|
[xs ys]
|
|
(def ret @[])
|
|
(def xlen (length xs))
|
|
(def ylen (length ys))
|
|
(var i 0)
|
|
(var j 0)
|
|
# Main merge
|
|
(while (if (< i xlen) (< j ylen))
|
|
(def xi (get xs i))
|
|
(def yj (get ys j))
|
|
(if (< xi yj)
|
|
(do (array/push ret xi) (set i (+ i 1)))
|
|
(do (array/push ret yj) (set j (+ j 1)))))
|
|
# Push rest of xs
|
|
(while (< i xlen)
|
|
(def xi (get xs i))
|
|
(array/push ret xi)
|
|
(set i (+ i 1)))
|
|
# Push rest of ys
|
|
(while (< j ylen)
|
|
(def yj (get ys j))
|
|
(array/push ret yj)
|
|
(set j (+ j 1)))
|
|
ret)
|
|
|
|
(assert (apply <= (merge-sort @[1 3 5] @[2 4 6])) "merge sort merge 1")
|
|
(assert (apply <= (merge-sort @[1 2 3] @[4 5 6])) "merge sort merge 2")
|
|
(assert (apply <= (merge-sort @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
|
|
(assert (apply <= (merge-sort '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
|
|
|
|
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
|
|
(assert (deep= @[{:a 1} {:a 4} {:a 7}]
|
|
(sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
|
|
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
|
|
(assert (deep= @[{:a 1} {:a 4} {:a 7}]
|
|
(sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
|
|
|
|
# Sort function
|
|
# 2ca9300bf
|
|
(assert (deep=
|
|
(range 99)
|
|
(sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99)))))
|
|
"sort 5")
|
|
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
|
|
|
|
# And and or
|
|
# c16a9d846
|
|
(assert (= (and true true) true) "and true true")
|
|
(assert (= (and true false) false) "and true false")
|
|
(assert (= (and false true) false) "and false true")
|
|
(assert (= (and true true true) true) "and true true true")
|
|
(assert (= (and 0 1 2) 2) "and 0 1 2")
|
|
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
|
|
(assert (= (and 1) 1) "and 1")
|
|
(assert (= (and) true) "and with no arguments")
|
|
(assert (= (and 1 true) true) "and with trailing true")
|
|
(assert (= (and 1 true 2) 2) "and with internal true")
|
|
|
|
(assert (= (or true true) true) "or true true")
|
|
(assert (= (or true false) true) "or true false")
|
|
(assert (= (or false true) true) "or false true")
|
|
(assert (= (or false false) false) "or false true")
|
|
(assert (= (or true true false) true) "or true true false")
|
|
(assert (= (or 0 1 2) 0) "or 0 1 2")
|
|
(assert (= (or nil 1 2) 1) "or nil 1 2")
|
|
(assert (= (or 1) 1) "or 1")
|
|
(assert (= (or) nil) "or with no arguments")
|
|
|
|
# And/or checks
|
|
# 6123c41f1
|
|
(assert (= false (and false false)) "and 1")
|
|
(assert (= false (or false false)) "or 1")
|
|
|
|
# 11cd1279d
|
|
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
|
|
|
|
# bc8be266f
|
|
(def- a 100)
|
|
(assert (= a 100) "def-")
|
|
|
|
# bc8be266f
|
|
(assert (= :first
|
|
(match @[1 3 5]
|
|
@[x y z] :first
|
|
:second)) "match 1")
|
|
|
|
(def val1 :avalue)
|
|
(assert (= :second
|
|
(match val1
|
|
@[x y z] :first
|
|
:avalue :second
|
|
:third)) "match 2")
|
|
|
|
(assert (= 100
|
|
(match @[50 40]
|
|
@[x x] (* x 3)
|
|
@[x y] (+ x y 10)
|
|
0)) "match 3")
|
|
|
|
# Match checks
|
|
# 47e8f669f
|
|
(assert (= :hi (match nil nil :hi)) "match 1")
|
|
(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
|
|
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
|
|
(assert (= nil (match [1 2] [a b c] a)) "match 4")
|
|
(assert (= 2 (match [1 2] [a b] b)) "match 5")
|
|
# db631097b
|
|
(assert (= [2 :a :b] (match [1 2 :a :b] [o & rest] rest)) "match 6")
|
|
(assert (= [] (match @[:a] @[x & r] r :fallback)) "match 7")
|
|
(assert (= :fallback (match @[1] @[x y & r] r :fallback)) "match 8")
|
|
(assert (= [1 2 3 4] (match @[1 2 3 4] @[x y z & r] [x y z ;r] :fallback))
|
|
"match 9")
|
|
|
|
# Test cases for #293
|
|
# d3b9b8d45
|
|
(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
|
|
(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
|
|
(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no))
|
|
"match wildcard 3")
|
|
(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
|
|
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
|
|
(assert (= false (match {:a 1 :b 2 :c 3}
|
|
{:a a :b _ :c _ :d _} :no
|
|
{:a _ :b _ :c _} false
|
|
:no)) "match wildcard 6")
|
|
(assert (= nil (match {:a 1 :b 2 :c 3}
|
|
{:a a :b _ :c _ :d _} :no
|
|
{:a _ :b _ :c _} nil
|
|
:no)) "match wildcard 7")
|
|
# issue #529 - 602010600
|
|
(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
|
|
|
|
# quoted match test
|
|
# 425a0fcf0
|
|
(assert (= :yes (match 'john 'john :yes _ :nope)) "quoted literal match 1")
|
|
(assert (= :nope (match 'john ''john :yes _ :nope)) "quoted literal match 2")
|
|
|
|
# Some macros
|
|
# 7880d7320
|
|
(assert (= 2 (if-not 1 3 2)) "if-not 1")
|
|
(assert (= 3 (if-not false 3)) "if-not 2")
|
|
(assert (= 3 (if-not nil 3 2)) "if-not 3")
|
|
(assert (= nil (if-not true 3)) "if-not 4")
|
|
|
|
(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
|
|
|
|
# take
|
|
# 18da183ef
|
|
(assert (deep= (take 0 []) []) "take 1")
|
|
(assert (deep= (take 10 []) []) "take 2")
|
|
(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
|
|
(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
|
|
(assert (deep= (take -1 [:a :b :c]) [:c]) "take 5")
|
|
# 34019222c
|
|
(assert (deep= (take 3 (generate [x :in [1 2 3 4 5]] x)) @[1 2 3])
|
|
"take from fiber")
|
|
# NB: repeatedly resuming a fiber created with `generate` includes a `nil`
|
|
# as the final element. Thus a generate of 2 elements will create an array
|
|
# of 3.
|
|
(assert (= (length (take 4 (generate [x :in [1 2]] x))) 2)
|
|
"take from short fiber")
|
|
|
|
# take-until
|
|
# 18da183ef
|
|
(assert (deep= (take-until pos? @[]) []) "take-until 1")
|
|
(assert (deep= (take-until pos? @[1 2 3]) []) "take-until 2")
|
|
(assert (deep= (take-until pos? @[-1 -2 -3]) [-1 -2 -3]) "take-until 3")
|
|
(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
|
|
(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
|
|
(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
|
|
(assert (deep= (take-until |(= $ 115) (generate [x :in "books"] x))
|
|
@[98 111 111 107]) "take-until from fiber")
|
|
|
|
# take-while
|
|
# 18da183ef
|
|
(assert (deep= (take-while neg? @[]) []) "take-while 1")
|
|
(assert (deep= (take-while neg? @[1 2 3]) []) "take-while 2")
|
|
(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
|
|
(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
|
|
(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
|
|
(assert (deep= (take-while neg? (generate [x :in @[-1 1 -2]] x))
|
|
@[-1]) "take-while from fiber")
|
|
|
|
# drop
|
|
# 18da183ef
|
|
(assert (deep= (drop 0 []) []) "drop 1")
|
|
(assert (deep= (drop 10 []) []) "drop 2")
|
|
(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
|
|
(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
|
|
(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5")
|
|
(assert (deep= (drop -10 [1 2 3]) []) "drop 6")
|
|
(assert (deep= (drop 1 "abc") "bc") "drop 7")
|
|
(assert (deep= (drop 10 "abc") "") "drop 8")
|
|
(assert (deep= (drop -1 "abc") "ab") "drop 9")
|
|
(assert (deep= (drop -10 "abc") "") "drop 10")
|
|
|
|
# drop-until
|
|
# 75dc08f
|
|
(assert (deep= (drop-until pos? @[]) []) "drop-until 1")
|
|
(assert (deep= (drop-until pos? @[1 2 3]) [1 2 3]) "drop-until 2")
|
|
(assert (deep= (drop-until pos? @[-1 -2 -3]) []) "drop-until 3")
|
|
(assert (deep= (drop-until pos? @[-1 -2 3]) [3]) "drop-until 4")
|
|
(assert (deep= (drop-until pos? @[-1 1 -2]) [1 -2]) "drop-until 5")
|
|
(assert (deep= (drop-until |(= $ 115) "books") "s") "drop-until 6")
|
|
|
|
# take-drop symmetry #1178
|
|
(def items-list ['abcde :abcde "abcde" @"abcde" [1 2 3 4 5] @[1 2 3 4 5]])
|
|
|
|
(each items items-list
|
|
(def len (length items))
|
|
(for i 0 (+ len 1)
|
|
(assert (deep= (take i items) (drop (- i len) items)) (string/format "take-drop symmetry %q %d" items i))
|
|
(assert (deep= (take (- i) items) (drop (- len i) items)) (string/format "take-drop symmetry %q %d" items i))))
|
|
|
|
(defn squares []
|
|
(coro
|
|
(var [a b] [0 1])
|
|
(forever (yield a) (+= a b) (+= b 2))))
|
|
|
|
(def sqr1 (squares))
|
|
(assert (deep= (take 10 sqr1) @[0 1 4 9 16 25 36 49 64 81]))
|
|
(assert (deep= (take 1 sqr1) @[100]) "take fiber next value")
|
|
|
|
(def sqr2 (drop 10 (squares)))
|
|
(assert (deep= (take 1 sqr2) @[100]) "drop fiber next value")
|
|
|
|
(def dict @{:a 1 :b 2 :c 3 :d 4 :e 5})
|
|
(def dict1 (take 2 dict))
|
|
(def dict2 (drop 2 dict))
|
|
|
|
(assert (= (length dict1) 2) "take dictionary")
|
|
(assert (= (length dict2) 3) "drop dictionary")
|
|
(assert (deep= (merge dict1 dict2) dict) "take-drop symmetry for dictionary")
|
|
|
|
# Comment macro
|
|
# issue #110 - 698e89aba
|
|
(comment 1)
|
|
(comment 1 2)
|
|
(comment 1 2 3)
|
|
(comment 1 2 3 4)
|
|
|
|
# comp should be variadic
|
|
# 5c83ebd75, 02ce3031
|
|
(assert (= 10 ((comp +) 1 2 3 4)) "variadic comp 1")
|
|
(assert (= 11 ((comp inc +) 1 2 3 4)) "variadic comp 2")
|
|
(assert (= 12 ((comp inc inc +) 1 2 3 4)) "variadic comp 3")
|
|
(assert (= 13 ((comp inc inc inc +) 1 2 3 4)) "variadic comp 4")
|
|
(assert (= 14 ((comp inc inc inc inc +) 1 2 3 4)) "variadic comp 5")
|
|
(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
|
|
(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4))
|
|
"variadic comp 7")
|
|
|
|
# Function shorthand
|
|
# 44e752d73
|
|
(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
|
|
(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
|
|
(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
|
|
(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
|
|
(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
|
|
(assert (= (|4) 4) "function shorthand 6")
|
|
(assert (= (((|||4))) 4) "function shorthand 7")
|
|
(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
|
|
(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
|
|
# 5f5147652
|
|
(assert (= (|(+ $0 $99) ;(range 100)) 99) "function shorthand 10")
|
|
|
|
# 655d4b3aa
|
|
(defn idx= [x y] (= (tuple/slice x) (tuple/slice y)))
|
|
|
|
# Simple take, drop, etc. tests.
|
|
(assert (idx= (take 10 (range 100)) (range 10)) "take 10")
|
|
(assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10")
|
|
|
|
# with-vars
|
|
# 6ceaf9d28
|
|
(var abc 123)
|
|
(assert (= 356 (with-vars [abc 456] (- abc 100))) "with-vars 1")
|
|
(assert-error "with-vars 2" (with-vars [abc 456] (error :oops)))
|
|
(assert (= abc 123) "with-vars 3")
|
|
|
|
# Top level unquote
|
|
# 2487162cc
|
|
(defn constantly
|
|
[]
|
|
(comptime (math/random)))
|
|
|
|
(assert (= (constantly) (constantly)) "comptime 1")
|
|
|
|
# issue #232 - b872ee024
|
|
(assert-error "arity issue in macro" (eval '(each [])))
|
|
# c6b639b93
|
|
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
|
|
|
|
# 962cd7e5f
|
|
(var counter 0)
|
|
(when-with [x nil |$]
|
|
(++ counter))
|
|
(when-with [x 10 |$]
|
|
(+= counter 10))
|
|
|
|
(assert (= 10 counter) "when-with 1")
|
|
|
|
(if-with [x nil |$] (++ counter) (+= counter 10))
|
|
(if-with [x true |$] (+= counter 20) (+= counter 30))
|
|
|
|
(assert (= 40 counter) "if-with 1")
|
|
|
|
# a45509d28
|
|
(def a @[])
|
|
(eachk x [:a :b :c :d]
|
|
(array/push a x))
|
|
(assert (deep= (range 4) a) "eachk 1")
|
|
|
|
# issue 609 - 1fcaffe
|
|
(with-dyns [:err @""]
|
|
(tracev (def my-unique-var-name true))
|
|
(assert my-unique-var-name "tracev upscopes"))
|
|
|
|
# Prompts and Labels
|
|
# 59d288c
|
|
(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
|
|
|
|
(defn recur
|
|
[lab x y]
|
|
(when (= x y) (return lab :done))
|
|
(def res (label newlab (recur (or lab newlab) (+ x 1) y)))
|
|
(if lab :oops res))
|
|
(assert (= :done (recur nil 0 10)) "label 2")
|
|
|
|
(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10)))))
|
|
"prompt 1")
|
|
|
|
(defn- inner-loop
|
|
[i]
|
|
(if (= i 5)
|
|
(return :a 10)))
|
|
|
|
(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
|
|
|
|
(defn- inner-loop2
|
|
[i]
|
|
(try
|
|
(if (= i 5)
|
|
(error 10))
|
|
([err] (return :a err))))
|
|
|
|
(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
|
|
|
|
# chr
|
|
# issue 304 - 77343e02e
|
|
(assert (= (chr "a") 97) "chr 1")
|
|
|
|
# Reduce2
|
|
# 3eb0927a2
|
|
(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
|
|
# 65379741f
|
|
(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
|
|
(assert (= nil (reduce2 * [])) "reduce2 3")
|
|
|
|
# Accumulate
|
|
# 3eb0927a2
|
|
(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
|
|
(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
|
|
# 65379741f
|
|
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
|
|
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
|
|
|
|
# in vs get regression
|
|
# issue #340 - b63a0796f
|
|
(assert (nil? (first @"")) "in vs get 1")
|
|
(assert (nil? (last @"")) "in vs get 1")
|
|
|
|
# index-of
|
|
# 259812314
|
|
(assert (= nil (index-of 10 [])) "index-of 1")
|
|
(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
|
|
(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
|
|
(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
|
|
(assert (= nil (index-of :a {})) "index-of 5")
|
|
(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
|
|
(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
|
|
(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
|
|
(assert (= nil (index-of (chr "a") "")) "index-of 9")
|
|
(assert (= nil (index-of 10 @[])) "index-of 10")
|
|
(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
|
|
|
|
# e78a3d1
|
|
# NOTE: These is a motivation for the has-value? and has-key? functions below
|
|
|
|
# returns false despite key present
|
|
(assert (= false (index-of 8 {true 7 false 8}))
|
|
"index-of corner key (false) 1")
|
|
(assert (= false (index-of 8 @{false 8}))
|
|
"index-of corner key (false) 2")
|
|
# still returns null
|
|
(assert (= nil (index-of 7 {false 8})) "index-of corner key (false) 3")
|
|
|
|
# has-value?
|
|
(assert (= false (has-value? [] "foo")) "has-value? 1")
|
|
(assert (= true (has-value? [4 7 1 3] 4)) "has-value? 2")
|
|
(assert (= false (has-value? [4 7 1 3] 22)) "has-value? 3")
|
|
(assert (= false (has-value? @[1 2 3] 4)) "has-value? 4")
|
|
(assert (= true (has-value? @[:a :b :c] :a)) "has-value? 5")
|
|
(assert (= false (has-value? {} :foo)) "has-value? 6")
|
|
(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
|
|
(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
|
|
(assert (= true (has-value? @{:a :A :b :B} :A)) "has-value? 8")
|
|
(assert (= true (has-value? "abc" (chr "a"))) "has-value? 9")
|
|
(assert (= false (has-value? "abc" "1")) "has-value? 10")
|
|
# weird true/false corner cases, should align with "index-of corner
|
|
# key {k}" cases
|
|
(assert (= true (has-value? {true 7 false 8} 8))
|
|
"has-value? corner key (false) 1")
|
|
(assert (= true (has-value? @{false 8} 8))
|
|
"has-value? corner key (false) 2")
|
|
(assert (= false (has-value? {false 8} 7))
|
|
"has-value? corner key (false) 3")
|
|
|
|
# has-key?
|
|
(do
|
|
(var test-has-key-auto 0)
|
|
(defn test-has-key [col key expected &keys {:name name}]
|
|
``Test that has-key has the outcome `expected`, and that if
|
|
the result is true, then ensure (in key) does not fail either``
|
|
(assert (boolean? expected))
|
|
(default name (string "has-key? " (++ test-has-key-auto)))
|
|
(assert (= expected (has-key? col key)) name)
|
|
(if
|
|
# guarenteed by `has-key?` to never fail
|
|
expected (in col key)
|
|
# if `has-key?` is false, then `in` should fail (for indexed types)
|
|
#
|
|
# For dictionary types, it should return nil
|
|
(let [[success retval] (protect (in col key))]
|
|
(def should-succeed (dictionary? col))
|
|
(assert
|
|
(= success should-succeed)
|
|
(string/format
|
|
"%s: expected (in col key) to %s, but got %q"
|
|
name (if expected "succeed" "fail") retval)))))
|
|
|
|
(test-has-key [] 0 false) # 1
|
|
(test-has-key [4 7 1 3] 2 true) # 2
|
|
(test-has-key [4 7 1 3] 22 false) # 3
|
|
(test-has-key @[1 2 3] 4 false) # 4
|
|
(test-has-key @[:a :b :c] 2 true) # 5
|
|
(test-has-key {} :foo false) # 6
|
|
(test-has-key {:a :A :b :B} :a true) # 7
|
|
(test-has-key {:a :A :b :B} :A false) # 8
|
|
(test-has-key @{:a :A :b :B} :a true) # 9
|
|
(test-has-key "abc" 1 true) # 10
|
|
(test-has-key "abc" 4 false) # 11
|
|
# weird true/false corner cases
|
|
#
|
|
# Tries to mimic the corresponding corner cases in has-value? and
|
|
# index-of, but with keys/values inverted
|
|
#
|
|
# in the first two cases (truthy? (get val col)) would have given false
|
|
# negatives
|
|
(test-has-key {7 true 8 false} 8 true :name
|
|
"has-key? corner value (false) 1")
|
|
(test-has-key @{8 false} 8 true :name
|
|
"has-key? corner value (false) 2")
|
|
(test-has-key @{8 false} 7 false :name
|
|
"has-key? corner value (false) 3"))
|
|
|
|
# Regression
|
|
# issue #463 - 7e7498350
|
|
(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
|
|
|
|
# macex testing
|
|
# 7e7498350
|
|
(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
|
|
(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
|
|
(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
|
|
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4]))))
|
|
"macex1 qq bracket tuple")
|
|
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah])
|
|
"macex1 qq array")
|
|
|
|
# Sourcemaps in threading macros
|
|
# b6175e429
|
|
(defn check-threading [macro expansion]
|
|
(def expanded (macex1 (tuple macro 0 '(x) '(y))))
|
|
(assert (= expanded expansion) (string macro " expansion value"))
|
|
(def smap-x (tuple/sourcemap (get expanded 1)))
|
|
(def smap-y (tuple/sourcemap expanded))
|
|
(def line first)
|
|
(defn column [t] (t 1))
|
|
(assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
|
|
(assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
|
|
(assert (or (< (line smap-x) (line smap-y))
|
|
(and (= (line smap-x) (line smap-y))
|
|
(< (column smap-x) (column smap-y))))
|
|
(string macro " relation between x and y sourcemap")))
|
|
|
|
(check-threading '-> '(y (x 0)))
|
|
(check-threading '->> '(y (x 0)))
|
|
|
|
# keep-syntax
|
|
# b6175e429
|
|
(let [brak '[1 2 3]
|
|
par '(1 2 3)]
|
|
|
|
(tuple/setmap brak 2 1)
|
|
|
|
(assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3])
|
|
"keep-syntax brackets ignore array")
|
|
(assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3])
|
|
"keep-syntax! brackets replace array")
|
|
|
|
(assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4))
|
|
"keep-syntax! parens coerce array")
|
|
(assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3))
|
|
"keep-syntax! brackets not parens")
|
|
(assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3])
|
|
"keep-syntax! parens not brackets")
|
|
(assert (= (tuple/sourcemap brak)
|
|
(tuple/sourcemap (keep-syntax! brak @[1 2 3])))
|
|
"keep-syntax! brackets source map")
|
|
|
|
(keep-syntax par brak)
|
|
(assert (not= (tuple/sourcemap brak) (tuple/sourcemap par))
|
|
"keep-syntax no mutate")
|
|
(assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
|
|
|
|
# Curenv
|
|
# 28439d822, f7c556e
|
|
(assert (= (curenv) (curenv 0)) "curenv 1")
|
|
(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
|
|
(assert (= nil (curenv 1000000)) "curenv 3")
|
|
(assert (= root-env (curenv 1)) "curenv 4")
|
|
|
|
# Import macro test
|
|
# a31e079f9
|
|
(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
|
|
(assert (deep= ~(,import* "a" :as "b" :fresh maybe)
|
|
(macex '(import a :as b :fresh maybe))) "import macro 2")
|
|
|
|
# #477 walk preserving bracket type
|
|
# 0a1d902f4
|
|
(assert (= :brackets (tuple/type (postwalk identity '[])))
|
|
"walk square brackets 1")
|
|
(assert (= :brackets (tuple/type (walk identity '[])))
|
|
"walk square brackets 2")
|
|
|
|
# Issue #751
|
|
# 547fda6a4
|
|
(def t {:side false})
|
|
(assert (nil? (get-in t [:side :note])) "get-in with false value")
|
|
(assert (= (get-in t [:side :note] "dflt") "dflt")
|
|
"get-in with false value and default")
|
|
|
|
# Evaluate stream with `dofile`
|
|
# 9cc4e4812
|
|
(def [r w] (os/pipe))
|
|
(:write w "(setdyn :x 10)")
|
|
(:close w)
|
|
(def stream-env (dofile r))
|
|
(assert (= (stream-env :x) 10) "dofile stream 1")
|
|
|
|
# Test thaw and freeze
|
|
# 9cc0645a1
|
|
(def table-to-freeze @{:c 22 :b [1 2 3 4] :d @"test" :e "test2"})
|
|
(def table-to-freeze-with-inline-proto
|
|
@{:a @[1 2 3] :b @[1 2 3 4] :c 22 :d @"test" :e @"test2"})
|
|
(def struct-to-thaw
|
|
(struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
|
|
(table/setproto table-to-freeze @{:a @[1 2 3]})
|
|
|
|
(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
|
|
(freeze table-to-freeze)))
|
|
(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
|
|
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
|
|
|
|
# Make sure Carriage Returns don't end up in doc strings
|
|
# e528b86
|
|
(assert (not (string/find "\r"
|
|
(get ((fiber/getenv (fiber/current)) 'cond)
|
|
:doc "")))
|
|
"no \\r in doc strings")
|
|
|
|
# cff718f37
|
|
(var counter 0)
|
|
(def thunk (delay (++ counter)))
|
|
(assert (= (thunk) 1) "delay 1")
|
|
(assert (= counter 1) "delay 2")
|
|
(assert (= (thunk) 1) "delay 3")
|
|
(assert (= counter 1) "delay 4")
|
|
|
|
# maclintf
|
|
(def env (table/clone (curenv)))
|
|
((compile '(defmacro foo [] (maclintf :strict "oops")) env :anonymous))
|
|
(def lints @[])
|
|
(compile (tuple/setmap '(foo) 1 2) env :anonymous lints)
|
|
(assert (deep= lints @[[:strict 1 2 "oops"]]) "maclintf 1")
|
|
|
|
(def env (table/clone (curenv)))
|
|
((compile '(defmacro foo [& body] (maclintf :strict "foo-oops") ~(do ,;body)) env :anonymous))
|
|
((compile '(defmacro bar [] (maclintf :strict "bar-oops")) env :anonymous))
|
|
(def lints @[])
|
|
# Compile (foo (bar)), but with explicit source map values
|
|
(def bar-invoke (tuple/setmap '(bar) 3 4))
|
|
(compile (tuple/setmap ~(foo ,bar-invoke) 1 2) env :anonymous lints)
|
|
(assert (deep= lints @[[:strict 1 2 "foo-oops"]
|
|
[:strict 3 4 "bar-oops"]])
|
|
"maclintf 2")
|
|
|
|
(end-suite)
|