summaryrefslogtreecommitdiffstats
path: root/tests/010
diff options
context:
space:
mode:
Diffstat (limited to 'tests/010')
-rw-r--r--tests/010/cons.tl14
-rw-r--r--tests/010/eof-status.expected2
-rw-r--r--tests/010/eof-status.txr3
-rw-r--r--tests/010/hash.tl94
-rw-r--r--tests/010/json.tl194
-rw-r--r--tests/010/qquote.tl42
-rw-r--r--tests/010/range.tl103
-rw-r--r--tests/010/seq.expected36
-rw-r--r--tests/010/seq.txr63
-rw-r--r--tests/010/span-var.txr39
-rw-r--r--tests/010/tree.tl264
-rw-r--r--tests/010/vec.tl53
12 files changed, 903 insertions, 4 deletions
diff --git a/tests/010/cons.tl b/tests/010/cons.tl
new file mode 100644
index 00000000..de293652
--- /dev/null
+++ b/tests/010/cons.tl
@@ -0,0 +1,14 @@
+(load "../common")
+
+(let ((x (list* 1 2 3 4)))
+ (mtest
+ (set x (delcons x x)) (2 3 . 4)
+ (set x (delcons x x)) (3 . 4)
+ (set x (delcons x x)) 4
+ (set x (delcons x x)) 4))
+
+(let ((x (list* 1 2 3 4 5)))
+ (mtest
+ (delcons (cdr x) x) (1 3 4 . 5)
+ (delcons (cddr x) x) (1 3 . 5)
+ (delcons (cdr x) x) (1 . 5)))
diff --git a/tests/010/eof-status.expected b/tests/010/eof-status.expected
new file mode 100644
index 00000000..2b636133
--- /dev/null
+++ b/tests/010/eof-status.expected
@@ -0,0 +1,2 @@
+a="a"
+status="5"
diff --git a/tests/010/eof-status.txr b/tests/010/eof-status.txr
new file mode 100644
index 00000000..0da9c633
--- /dev/null
+++ b/tests/010/eof-status.txr
@@ -0,0 +1,3 @@
+@(next (open-command "echo a; exit 5"))
+@a
+@(eof status)
diff --git a/tests/010/hash.tl b/tests/010/hash.tl
new file mode 100644
index 00000000..d6a8542b
--- /dev/null
+++ b/tests/010/hash.tl
@@ -0,0 +1,94 @@
+(load "../common")
+
+(mtest
+ (uni #H(() ("a") ("b")) #H(() ("b") ("c"))) (("a") ("b") ("c"))
+ (diff #H(() ("a") ("b")) #H(() ("b") ("c"))) (("a"))
+ (isec #H(() ("a") ("b")) #H(() ("b") ("c"))) (("b")))
+
+(mtest
+ [group-by identity '(1 1 2 2 3 3 3)] #H(() (1 (1 1)) (2 (2 2)) (3 (3 3 3)))
+ (group-by (op mod @1 3) (range 0 10)) #H(() (0 (0 3 6 9))
+ (1 (1 4 7 10))
+ (2 (2 5 8)))
+ [group-map (op mod @1 3) sum (range 0 10)] #H(() (0 18) (1 22) (2 15)))
+
+(mtest
+ [group-reduce (hash) identity (do inc @1)
+ "fourscoreandsevenyearsago" 0] #H(() (#\a 3) (#\c 1) (#\d 1)
+ (#\e 4) (#\f 1) (#\g 1)
+ (#\n 2) (#\o 3) (#\r 3)
+ (#\s 3) (#\u 1) (#\v 1)
+ (#\y 1))
+ [group-reduce (hash) evenp + (range 1 10) 0] #H(() (t 30) (nil 25)))
+
+(mtest
+ (hash-props) #H(())
+ (hash-props 1 2) #H(() (1 2))
+ (hash-props 1 2 'a 'b) #H(() (1 2) (a b))
+ (hash-props 1) :error
+ (hash-props 1 2 'a) :error)
+
+;; Test that growing a hash table works while iterators
+;; are referencing it.
+(let ((h (hash-list (range 0 199))))
+ (let ((i (hash-begin h)))
+ (each ((x 200..1000))
+ (set [h x] x))
+ (each ((x 0..1000))
+ (vtest [h x] x))))
+
+;; Test that when an iterator is created which references
+;; a table which is then resized, and from which all
+;; entries are subsequently deleted, when the iterator
+;; then marches, it will not see the deleted entries.
+(let ((h (hash-list (range 0 199))))
+ (let ((i (hash-begin h)))
+ (each ((x 200..1000))
+ (set [h x] x))
+ (each ((x 0..1000))
+ (del [h x]))
+ (test (hash-next i) nil)))
+
+;; Test that when an iterator is created which references
+;; a table which is then resized, and from which values
+;; are never deleted, the iterator will visit all the
+;; original items that existed when it was created.
+(let ((h (hash-list (range 0 199))))
+ (let ((i (hash-begin h)))
+ (each ((x 200..1000))
+ (set [h x] x))
+ (let ((items (build (whilet ((cell (hash-next i)))
+ (add (car cell))))))
+ (test (diff 0..200 items) nil))))
+
+(test [hash-map square '(1 2 3)]
+ #H(() (1 1) (2 4) (3 9)))
+
+(let ((h1 #H(() (a 1) (b 2) (c 3) (d 4)))
+ (h2 #H(() (b -2) (c -3) (d -4) (e -5))))
+ (mtest
+ (hash-uni h1 h2) #H(() (a 1) (b 2) (c 3) (d 4) (e -5))
+ [hash-uni h1 h2 +] #H(() (a 1) (b 0) (c 0) (d 0) (e -5))
+ [hash-uni h1 h2 + -] #H(() (a -1) (b -4) (c -6) (d -8) (e -5))
+ [hash-uni h1 h2 + : -] #H(() (a 1) (b 4) (c 6) (d 8) (e 5))
+ [hash-uni h1 h2 + - -] #H(() (a -1) (b 0) (c 0) (d 0) (e 5)))
+ (mtest
+ [hash-join h1 h2 +] :error
+ [hash-join h1 h2 + 0] :error
+ [hash-join h1 h2 + : 0] :error
+ [hash-join h1 h2 + 0 0] #H(() (a 1) (b 0) (c 0) (d 0) (e -5)))
+ (mtest
+ (hash-diff h1 h2) #H(() (a 1))
+ (hash-diff h2 h1) #H(() (e -5)))
+ (mtest
+ (hash-symdiff h1 h2) #H(() (a 1) (e -5))
+ (hash-symdiff h2 h1) #H(() (a 1) (e -5)))
+ (mtest
+ (hash-isec h1 h2) #H(() (b 2) (c 3) (d 4))
+ [hash-isec h1 h2 +] #H(() (b 0) (c 0) (d 0))))
+
+(mtest
+ (eql (hash-equal "abc") (hash-equal "abc")) t
+ (eql (hash-equal (expt 2 128)) (hash-equal (expt 2 128))) t
+ (eql (hash-eql "abc") (hash-eql "abc")) nil
+ (eql (hash-eql (expt 2 128)) (hash-eql (expt 2 128))) t)
diff --git a/tests/010/json.tl b/tests/010/json.tl
new file mode 100644
index 00000000..d419295f
--- /dev/null
+++ b/tests/010/json.tl
@@ -0,0 +1,194 @@
+(load "../common")
+
+(mtest
+ #J0 0.0
+ #J"abc" "abc"
+ #Jtrue t
+ #Jfalse nil
+ #Jnull null)
+
+(mtest
+ #J1 1.0
+ #J 1 1.0
+ #J123 123.0
+ #J0.123 0.123
+ #J1.123 1.123
+ #J1E3 1000.0
+ #J1.1E3 1100.0
+ #J1.1E+3 1100.0
+ #J1.1E+03 1100.0
+ #J1.1e3 1100.0
+ #J1.1e+3 1100.0
+ #J1.1e+03 1100.0)
+
+(mtest
+ #J"" ""
+ #J"\u0000" "\xdc00"
+ #J"\u0001" "\x1"
+ #J"a\u0000b" "a\xdc00;b"
+ #J"a\u0001b" "a\x1;b"
+ #J"\b\t\n\f\r" "\b\t\n\f\r"
+ #J"\/\\\"" "/\\\"")
+
+(when (> (sizeof wchar) 2)
+ (let ((chr (read "\"\\x10437\"")))
+ (vtest #J"\ud801\udc37" `@chr`)
+ (vtest #J"a\ud801\udc37b" `a@{chr}b`)))
+
+(mtest
+ #J[] #()
+ #J[ ] #()
+ #J[ ] #()
+ #J [ ] #()
+ #J[null] #(null)
+ #J[false] #(nil)
+ #J[true] #(t)
+ #J["abc"] #("abc")
+ #J[1,2,3] #(1.0 2.0 3.0)
+ #J[ 1 , 2 , 3 ] #(1.0 2.0 3.0)
+ #J[[]] #(#())
+ #J[[],[]] #(#() #())
+ #J[ [] , [] ] #(#() #())
+ #J[[1],[2],3] #(#(1.0) #(2.0) 3.0))
+
+(mtest
+ #J{} #H(())
+ #J{ } #H(())
+ #J{ } #H(())
+ #J { } #H(())
+ #J{true:true} #H(() (t t)))
+ #J{ true : true } #H(() (t t))
+ #J{ {} : {} } #H(() (#H(()) #H(())))
+ #J{ "a" : 1.0 } #H(() (a 1.0))
+ #J{ "a" : 1.0, "b" : [null] } #H(() (a 1.0) (b #(null)))
+
+(mtest
+ #J[
+ ] #()
+ #J[1,
+ 2,
+ 3] #(1.0 2.0 3.0)
+ #J{"foo":
+ "bar"}
+ #H(() ("foo" "bar")))
+
+(let ((*print-circle* t))
+ (mstest
+ #J[#1="abc", #1#] "#(#1=\"abc\" #1#)"
+ #2=#J[1, #2#] "#1=#(1.0 #J#1#)"
+ #J#3=[1, #3#] "#1=#(1.0 #1#)"
+ #4=#J{#4#:#4#} "#1=#H(() (#2=#J#1# #2#))"
+ #J#5={#5#:#5#} "#1=#H(() (#1# #1#))")
+
+ (let ((chash #J{"foo":#6="bar", "xyzzy":#6#}))
+ (mtest
+ [chash "xyzzy"] "bar"
+ (eq [chash "foo"] [chash "xyzzy"]) t)))
+
+(mtest
+ ^#J~(+ 1.0 1) #J2
+ ^#J[1, ~(+ 2.0 2)] #J[1, 4]
+ ^#J[1, ~(+ 2.0 2), 3] #J[1, 4, 3]
+ (eval ^^#J~#(1.0 ,*(list 2.0 3.0) 4.0)) #J[1, 2, 3, 4]
+ ^#J[1, ~*(list 2.0 3.0), 4] #J[1, 2, 3, 4]
+ #J^[1, ~(+ 2.0 2)] #(1.0 4.0)
+ #J^[1, ~(+ 2.0 2), 3] #(1.0 4.0 3.0)
+ ^#J{~(join "abc" "def") : "ghi"} #J{"abcdef":"ghi"}
+ #J^{~(join "abc" "def") : "ghi"} #H(() ("abcdef" "ghi")))
+
+;; get-json
+(mtest
+ (get-json "0") 0.0
+ (get-json "\"abc\"") "abc"
+ (get-json "true") t
+ (get-json "false") nil
+ (get-json "null") null
+ (get-json "[1,2,3]") #(1.0 2.0 3.0)
+ (get-json "{\"a\":\"b\"}") #H(() ("a" "b")))
+
+(mtest
+ (get-json "0 \n") 0.0
+ (get-json "\"abc\" \n") "abc"
+ (get-json "true \n") t
+ (get-json "false \n") nil
+ (get-json "null \n") null
+ (get-json "[1,2,3] \n") #(1.0 2.0 3.0)
+ (get-json "{\"a\":\"b\"} \n") #H(() ("a" "b")))
+
+(mtest
+ (get-json "0,") :error
+ (get-json "\"abc\",") :error
+ (get-json "true,") :error
+ (get-json "false,") :error
+ (get-json "null,") :error
+ (get-json "[1,2,3],") :error
+ (get-json "{\"a\":\"b\"},") :error)
+
+(mtest
+ (tojson #(1.0 "abc" t)) "[1,\"abc\",true]"
+ (tojson "<!--") "\"<\\u0021--\""
+ (tojson "a<!--b") "\"a<\\u0021--b\""
+ (tojson "<!-") "\"<!-\""
+ (tojson "-->") "\"-\\u002D>\""
+ (tojson "a-->b") "\"a-\\u002D>b\""
+ (tojson "->") "\"->\""
+ (tojson "</") "\"</\""
+ (tojson "</scrip") "\"</scrip\""
+ (tojson "</script") "\"<\\/script\""
+ (tojson "a</scriptb") "\"a<\\/scriptb\"")
+
+(mtest
+ (get-jsons "") nil
+ (get-jsons "true") (t)
+ (get-jsons "1 1 [2] {3:4}") (1.0 1.0 #(2.0) #H(() (3.0 4.0))))
+
+(mtest
+ (get-json "{ , }") :error
+ (get-json "{ 1:2, }") :error
+ (get-json "{ 1:2, 3:4, }") :error
+ (get-json "[ , ]") :error
+ (get-json "[ 1, ]") :error
+ (get-json "[ 1, 2, ]") :error)
+
+(let ((*read-bad-json* t))
+ (mtest
+ (get-json "{ , }") :error
+ (get-json "{ 1:2, }") #H(() (1.0 2.0))
+ (get-json "{ 1:2, 3:4, }") #H(() (1.0 2.0) (3.0 4.0))
+ (get-json "[ , ]") :error
+ (get-json "[ 1, ]") #(1.0)
+ (get-json "[ 1, 2, ]") #(1.0 2.0)))
+
+(mtest
+ (with-out-string-stream (s) (put-json nil s)) "false"
+ (with-out-string-stream (s) (put-jsons nil s)) ""
+ (with-out-string-stream (s) (put-jsons '(1.0 t nil) s)) "1\ntrue\nfalse\n")
+
+(with-temp-file (name s "json")
+ (mtest
+ (file-put-json name #(1.0 2.0 3.0)) t
+ (file-get-string name) "[1,2,3]\n"
+ (file-get-json name) #(1.0 2.0 3.0)
+ (file-append-json name #H(() ("a" t))) t
+ (file-get-string name) "[1,2,3]\n{\"a\":true}\n"
+ (file-get-jsons name) (#(1.0 2.0 3.0)
+ #H(() ("a" t)))
+ (file-put-jsons name '(1.0 t null)) t
+ (file-get-jsons name) (1.0 t null)
+ (file-get-string name) "1\ntrue\nnull\n")
+ (if (path-executable-to-me-p "/bin/sh")
+ (mtest
+ (command-put-json `cat > @name` #(#() #())) t
+ (file-get-string name) "[[],[]]\n"
+ (command-get-json `cat @name`) #(#() #())
+ (command-put-jsons `cat > @name` '(#() 1.0 nil)) t
+ (file-get-string name) "[]\n1\nfalse\n"
+ (command-get-jsons `cat @name`) (#() 1.0 nil))))
+
+(mtest
+ (tojson 1) "1"
+ (tojson 123123123123123123123123123123) "123123123123123123123123123123"
+ (tojson '(1 2 3 4 5)) "[1,2,3,4,5]")
+
+(test
+ (get-json "[1, 2, ; foo\n 3]") #(1.0 2.0 3.0))
diff --git a/tests/010/qquote.tl b/tests/010/qquote.tl
new file mode 100644
index 00000000..26d5417b
--- /dev/null
+++ b/tests/010/qquote.tl
@@ -0,0 +1,42 @@
+(let ((nullsym nil)
+ (sym 's)
+ (atom "abc")
+ (cons '(x y z))
+ (dwim '[]))
+ (tree-bind (x y (op arg)) ^(a b @,nullsym)
+ (assert (eq op 'sys:var))
+ (assert (eq arg nullsym)))
+ (tree-bind (x y (op arg)) ^(a b @,sym)
+ (assert (eq op 'sys:var))
+ (assert (eq arg sym)))
+ (tree-bind (x y . (op arg)) ^(a b . @,sym)
+ (assert (eq op 'sys:var))
+ (assert (eq arg sym)))
+ (tree-bind (x y (op arg)) ^(a b @,atom)
+ (assert (eq op 'sys:var))
+ (assert (eq arg atom)))
+ (tree-bind (x y . (op arg)) ^(a b . @,atom)
+ (assert (eq op 'sys:var))
+ (assert (eq arg atom)))
+ (tree-bind (x y (op arg)) ^(a b @,cons)
+ (assert (eq op 'sys:expr))
+ (assert (eq arg cons)))
+ (tree-bind (x y . (op arg)) ^(a b . @,cons)
+ (assert (eq op 'sys:expr))
+ (assert (eq arg cons)))
+ (tree-bind (x y (op arg)) ^(a b @,dwim)
+ (assert (eq op 'sys:expr))
+ (assert (eq arg dwim)))
+ (tree-bind (x y . (op arg)) ^(a b . @,dwim)
+ (assert (eq op 'sys:expr))
+ (assert (eq arg dwim)))
+ (tree-bind (x y (op arg . tail)) ^(a b (sys:expr ,sym . foo))
+ (assert (eq op 'sys:expr))
+ (assert (eq arg sym))
+ (assert (eq tail 'foo)))
+ (tree-bind (x y (op arg0 arg1)) ^(a b (sys:expr ,sym foo))
+ (assert (eq op 'sys:expr))
+ (assert (eq arg0 sym))
+ (assert (eq arg1 'foo)))
+ (tree-bind (x y (op)) ^(a b (sys:expr))
+ (assert (eq op 'sys:expr))))
diff --git a/tests/010/range.tl b/tests/010/range.tl
new file mode 100644
index 00000000..4cc9ee95
--- /dev/null
+++ b/tests/010/range.tl
@@ -0,0 +1,103 @@
+(load "../common")
+
+(mtest
+ (range 1 1) (1)
+ (range 1.0 1.0) (1.0)
+ (range #\a #\a) (#\a)
+ (range #R(1 1) #R(1 1)) (#R(1 1)))
+
+(mtest
+ (range 0 4) (0 1 2 3 4)
+ (range 4 0) (4 3 2 1 0)
+ (range 0.0 4.0) (0.0 1.0 2.0 3.0 4.0)
+ (range 4.0 0.0) (4.0 3.0 2.0 1.0 0.0)
+ (range #\a #\c) (#\a #\b #\c)
+ (range #\c #\a) (#\c #\b #\a)
+ (range #R(0 0) #R(4 4)) (#R(0 0) #R(1 1) #R(2 2) #R(3 3) #R(4 4))
+ (range #R(4 4) #R(0 0)) (#R(4 4) #R(3 3) #R(2 2) #R(1 1) #R(0 0)))
+
+(mtest
+ (len (range 1 1 "")) :error
+ (len (range 1 2 "")) :error)
+
+(mtest
+ (range 0 4 2) (0 2 4)
+ (range 4 0 -2) (4 2 0)
+ (range 0.0 4.0 2) (0.0 2.0 4.0)
+ (range 4.0 0.0 -2) (4.0 2.0 0.0)
+ (range #\a #\e 2) (#\a #\c #\e)
+ (range #\e #\a -2) (#\e #\c #\a)
+ (range #R(0 0) #R(4 4) 2) (#R(0 0) #R(2 2) #R(4 4))
+ (range #R(4 4) #R(0 0) -2) (#R(4 4) #R(2 2) #R(0 0))
+ (range 1 32 (op * 2)) (1 2 4 8 16 32))
+
+(mtest
+ (range* 1 1) nil
+ (range* 1.0 1.0) nil
+ (range* #\a #\a) nil
+ (range* #R(1 1) #R(1 1)) nil)
+
+(mtest
+ (range* 0 4) (0 1 2 3)
+ (range* 4 0) (4 3 2 1)
+ (range* 0.0 4.0) (0.0 1.0 2.0 3.0)
+ (range* 4.0 0.0) (4.0 3.0 2.0 1.0)
+ (range* #\a #\c) (#\a #\b)
+ (range* #\c #\a) (#\c #\b)
+ (range* #R(0 0) #R(4 4)) (#R(0 0) #R(1 1) #R(2 2) #R(3 3))
+ (range* #R(4 4) #R(0 0)) (#R(4 4) #R(3 3) #R(2 2) #R(1 1)))
+
+(mtest
+ (len (range* 1 1 "")) 0
+ (len (range* 1 2 "")) :error)
+
+(mtest
+ (range* 0 4 2) (0 2)
+ (range* 4 0 -2) (4 2)
+ (range* 0.0 4.0 2) (0.0 2.0)
+ (range* 4.0 0.0 -2) (4.0 2.0)
+ (range* #\a #\e 2) (#\a #\c)
+ (range* #\e #\a -2) (#\e #\c)
+ (range* #R(0 0) #R(4 4) 2) (#R(0 0) #R(2 2))
+ (range* #R(4 4) #R(0 0) -2) (#R(4 4) #R(2 2))
+ (range* 1 32 (op * 2)) (1 2 4 8 16))
+
+(mtest
+ (range 0 1.25 0.5) (0 0.5 1.0)
+ (range* 0 1.25 0.5) (0 0.5 1.0))
+
+(mtest
+ (range "A" "A") nil
+ (range "A" "A" 0) :error
+ (range "A" "A" -2) :error)
+
+(mtest
+ (range "A" "C") ("A" "B" "C")
+ (range "A" "C" 2) ("A" "C")
+ (range "A" "D" 2) ("A" "C")
+ (range "A" "E" 2) ("A" "C" "E")
+ (range "A" "C" 3) ("A")
+ (range "A" "E" 3) ("A" "D"))
+
+(mtest
+ (range* "A" "C") ("A" "B")
+ (range* "A" "C" 2) ("A")
+ (range* "A" "D" 2) ("A" "C")
+ (range* "A" "E" 2) ("A" "C")
+ (range* "A" "C" 3) ("A")
+ (range* "A" "E" 3) ("A" "D"))
+
+(mtest
+ [range "ABCD" nil rest] ("ABCD" "BCD" "CD" "D" nil)
+ [range* "ABCD" nil rest] ("ABCD" "BCD" "CD" "D"))
+
+(defstruct udnum nil
+ v
+ (:method + (me arg) (new udnum v (+ me.v arg)))
+ (:method > (me arg) (> me.v arg))
+ (:method < (me arg) (< me.v arg))
+ (:method = (me arg) (= me.v arg)))
+
+(mtest
+ (range (new udnum v 0) (new udnum v 3)) (#S(udnum v 0) #S(udnum v 1) #S(udnum v 2) #S(udnum v 3))
+ (range* (new udnum v 0) (new udnum v 3)) (#S(udnum v 0) #S(udnum v 1) #S(udnum v 2)))
diff --git a/tests/010/seq.expected b/tests/010/seq.expected
index 9c4d860d..691e6ac4 100644
--- a/tests/010/seq.expected
+++ b/tests/010/seq.expected
@@ -14,3 +14,39 @@ exception!
38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18
17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1)
#((8 . #\g) (6 . #\f)) #((7 . #\h) (5 . #\e) (4 . #\d) (3 . #\c) (2 . #\b) (1 . #\a))
+"bdf"
+"aceg"
+"g"
+"abcdef"
+"abcdefg"
+""
+"abcdefg"
+""
+"aceg"
+"bdf"
+(1 3 5)
+(0 2 4 6)
+(0 1 2 3 4 5 6)
+nil
+(0 1 2 3 4 5 6)
+nil
+(0 2 4 6)
+(1 3 5)
+#(1 3 5)
+#(0 2 4 6)
+#(0 1 2 3 4 5 6)
+#()
+#(0 1 2 3 4 5 6)
+#()
+#(0 2 4 6)
+#(1 3 5)
+#b'bbddff'
+#b'aaccee99'
+#b'99'
+#b'aabbccddeeff'
+#b'aabbccddeeff99'
+#b''
+#b'aabbccddeeff99'
+#b''
+#b'aaccee99'
+#b'bbddff'
diff --git a/tests/010/seq.txr b/tests/010/seq.txr
index 080b01ad..18f5c198 100644
--- a/tests/010/seq.txr
+++ b/tests/010/seq.txr
@@ -14,7 +14,62 @@
(format t "~s ~s\n" (del [*s* 1]) *s*)
(format t "~s ~s\n" (del [*s* -1]) *s*)
(catch (pr (del [*s* 3]) *s*) (t (x) (caught x)))
- (pr [sort *v* >])
- (pr [sort *v2* > cdr])
- (pr [sort (range 1 100) >])
- (pr2 (del [*v2* 1..3]) *v2*))
+ (pr [nsort *v* >])
+ (pr [nsort *v2* > cdr])
+ (pr [nsort (range 1 100) >])
+ (pr2 (del [*v2* 1..3]) *v2*)
+ (let ((s (copy "abcdefg")))
+ (pr (del [s '(1 3 5)]))
+ (pr s))
+ (let ((s (copy "abcdefg")))
+ (pr (del [s '(6)]))
+ (pr s))
+ (let ((s (copy "abcdefg")))
+ (pr (del [s '(0 1 2 3 4 5 6)]))
+ (pr s))
+ (let ((s (copy "abcdefg")))
+ (pr (del [s '(-7 -6 -5 -4 -3 -2 -1)]))
+ (pr s))
+ (let ((s (copy "abcdefg")))
+ (pr (del [s '(-7 -5 -3 -1)]))
+ (pr s))
+ (let ((s (list 0 1 2 3 4 5 6)))
+ (pr (del [s '(1 3 5)]))
+ (pr s))
+ (let ((s (list 0 1 2 3 4 5 6)))
+ (pr (del [s '(0 1 2 3 4 5 6)]))
+ (pr s))
+ (let ((s (list 0 1 2 3 4 5 6)))
+ (pr (del [s '(-7 -6 -5 -4 -3 -2 -1)]))
+ (pr s))
+ (let ((s (list 0 1 2 3 4 5 6)))
+ (pr (del [s '(-7 -5 -3 -1)]))
+ (pr s))
+ (let ((s (vec 0 1 2 3 4 5 6)))
+ (pr (del [s '(1 3 5)]))
+ (pr s))
+ (let ((s (vec 0 1 2 3 4 5 6)))
+ (pr (del [s '(0 1 2 3 4 5 6)]))
+ (pr s))
+ (let ((s (vec 0 1 2 3 4 5 6)))
+ (pr (del [s '(-7 -6 -5 -4 -3 -2 -1)]))
+ (pr s))
+ (let ((s (vec 0 1 2 3 4 5 6)))
+ (pr (del [s '(-7 -5 -3 -1)]))
+ (pr s))
+ (let ((s (copy #b'aabbccddeeff99')))
+ (pr (del [s '(1 3 5)]))
+ (pr s))
+ (let ((s (copy #b'aabbccddeeff99')))
+ (pr (del [s '(6)]))
+ (pr s))
+ (let ((s (copy #b'aabbccddeeff99')))
+ (pr (del [s '(0 1 2 3 4 5 6)]))
+ (pr s))
+ (let ((s (copy #b'aabbccddeeff99')))
+ (pr (del [s '(-7 -6 -5 -4 -3 -2 -1)]))
+ (pr s))
+ (let ((s (copy #b'aabbccddeeff99')))
+ (pr (del [s '(-7 -5 -3 -1)]))
+ (pr s))
+ )
diff --git a/tests/010/span-var.txr b/tests/010/span-var.txr
new file mode 100644
index 00000000..036acc6a
--- /dev/null
+++ b/tests/010/span-var.txr
@@ -0,0 +1,39 @@
+@(define fun (x y))
+@(bind x "x")
+@y
+@y
+@y
+@(end)
+@(next :list '("a" "a" "a" "b" "c"))
+@{z (fun x "a")}
+@(require (equal x "x"))
+@(require (equal z '("a" "a" "a")))
+@(define fun2 (x y))@(bind x "x")@y@(end)
+@(next :string "ab")
+@{w (fun2 x "a")}@y
+@(require (equal w "a"))
+@(require (equal y "b"))
+@(next :list '("a" "a" "a" "b" "c"))
+@(bind d ("d"))
+@(cases)
+@ {d (fun "x" "a")}
+@ {require (not "get here")}
+@(or)
+@ (require "get here")
+@(end)
+@(next :string "ab")
+@(cases)
+@ {d (fun2 "x" "a")}
+@ {require (not "get here")}
+@(or)
+@ (require "get here")
+@(end)
+@(bind n "123")
+@(next :string "123456")
+@(cases)
+@ {n /\d+/}
+@ {require (not "get here")}
+@(or)
+@ {m /\d+/}
+@ (require (equal m "123456"))
+@(end)
diff --git a/tests/010/tree.tl b/tests/010/tree.tl
new file mode 100644
index 00000000..9d00fda6
--- /dev/null
+++ b/tests/010/tree.tl
@@ -0,0 +1,264 @@
+(load "../common")
+
+(defvarl tr (tree))
+(defvarl keys '(0 6 8 11 10 2 16 3 17 7 19 12 15 13 18 4 14 5 1 9))
+
+(test tr #T(()))
+
+(mtest
+ (treep tr) t
+ (treep 42) nil)
+
+(mtest
+ (len #T()) 0
+ (len #T(() 1)) 1
+ (len #T(() 1 2)) 2
+ (len #T(() 1 2 3)) 3
+ (len #T(() 1 1 1)) 3)
+
+(each ((n keys))
+ (tree-insert tr n))
+
+(mtest
+ (tree-lookup tr 0) 0
+ (tree-lookup tr 1) 1
+ (tree-lookup tr 2) 2
+ (tree-lookup tr 3) 3
+ (tree-lookup tr 4) 4
+ (tree-lookup tr 5) 5
+ (tree-lookup tr 6) 6
+ (tree-lookup tr 7) 7
+ (tree-lookup tr 8) 8
+ (tree-lookup tr 9) 9
+ (tree-lookup tr 10) 10
+ (tree-lookup tr 11) 11
+ (tree-lookup tr 12) 12
+ (tree-lookup tr 13) 13
+ (tree-lookup tr 14) 14
+ (tree-lookup tr 15) 15
+ (tree-lookup tr 16) 16
+ (tree-lookup tr 17) 17
+ (tree-lookup tr 18) 18
+ (tree-lookup tr 19) 19)
+
+(mtest
+ [tr 0] 0
+ [tr 5] 5
+ [tr 19] 19)
+
+(mtest
+ [tr 0..3] (0 1 2)
+ [tr 3..5] (3 4)
+ [tr -2..0] ()
+ [tr -2..4] (0 1 2 3)
+ [tr :..4] (0 1 2 3)
+ [tr 18..100] (18 19)
+ [tr 18..:] (18 19)
+ [tr 100..200] ())
+
+(vtest
+ [tr :..:] (range 0 19))
+
+(vtest (build (for* ((i (tree-begin tr))
+ (n (tree-next i)))
+ (n)
+ ((set n (tree-next i)))
+ (add (key n))))
+ (range 0 19))
+
+(vtest (build (for* ((j (tree-begin tr))
+ (i (progn (tree-next j) (tree-next j) (tree-reset j tr)))
+ (n (tree-next i)))
+ (n)
+ ((set n (tree-next i)))
+ (add (key n))))
+ (range 0 19))
+
+(vtest (build (for* ((j (tree-begin tr))
+ (i (progn (tree-next j) (tree-next j) (tree-reset j tr)))
+ (n (tree-peek i)))
+ ((and n (eq (tree-next i) n)))
+ ((set n (tree-peek i)))
+ (add (key n))))
+ (range 0 19))
+
+(defvarl trc (copy-search-tree tr))
+
+(vtest trc tr)
+
+(tree-clear trc)
+
+(test trc #T(()))
+
+(test (tree-delete tr 6) 6)
+
+(vtest (build (for* ((i (tree-begin tr 6))
+ (n (tree-next i)))
+ (n)
+ ((set n (tree-next i)))
+ (add (key n))))
+ (range 7 19))
+
+(vtest (build (for* ((i (tree-begin tr 0))
+ (n (tree-next i)))
+ (n)
+ ((set n (tree-next i)))
+ (add (key n))))
+ (rlist 0..5 7..19))
+
+(vtest (build (for* ((i (tree-begin tr 8))
+ (n (tree-next i)))
+ (n)
+ ((set n (tree-next i)))
+ (add (key n))))
+ (range 8 19))
+
+(vtest (build (for* ((i (tree-reset (tree-begin #T(())) tr 8))
+ (n (tree-next i)))
+ (n)
+ ((set n (tree-next i)))
+ (add (key n))))
+ (range 8 19))
+
+(test (let* ((t0 (tree-begin tr))
+ (t1 (progn (tree-next t0) (copy-tree-iter t0))))
+ (tree-next t0)
+ (tree-next t0)
+ (list (key (tree-next t1))
+ (key (tree-next t1))
+ (key (tree-next t1))))
+ (1 2 3))
+
+(test (let* ((t0 (tree-begin tr))
+ (t1 (progn (tree-next t0) (copy-tree-iter t0)))
+ (t2 (replace-tree-iter (tree-begin tr) t0)))
+ (tree-next t0)
+ (tree-next t0)
+ (list (key (tree-next t1))
+ (key (tree-next t1))
+ (key (tree-next t2))
+ (key (tree-next t2))))
+ (1 2 1 2))
+
+(test (tree-next (tree-begin tr 20)) nil)
+
+(test (tree-next (tree-begin #T(()) 0)) nil)
+(test (key (tree-next (tree-begin #T(() 1) 1))) 1)
+
+(mtest
+ (tree-delete tr 0) 0
+ (tree-delete tr 1) 1
+ (tree-delete tr 2) 2
+ (tree-delete tr 3) 3
+ (tree-delete tr 4) 4
+ (tree-delete tr 5) 5
+ (tree-delete tr 7) 7
+ (tree-delete tr 8) 8
+ (tree-delete tr 9) 9
+ (tree-delete tr 10) 10
+ (tree-delete tr 11) 11
+ (tree-delete tr 12) 12
+ (tree-delete tr 13) 13
+ (tree-delete tr 14) 14
+ (tree-delete tr 15) 15
+ (tree-delete tr 16) 16
+ (tree-delete tr 17) 17
+ (tree-delete tr 18) 18
+ (tree-delete tr 19) 19)
+
+(set *tree-fun-whitelist* [list* '= '< 'to *tree-fun-whitelist*])
+
+(let ((tr [tree '(1 2 3) identity < =]))
+ (mtest
+ tr #T((identity < =) 1 2 3)
+ (copy-search-tree tr) #T((identity < =) 1 2 3)
+ (make-similar-tree tr) #T((identity < =))))
+
+(test
+ (collect-each ((el (tree-begin #T(() 1 2 3 4 5) 2 5)))
+ (* 10 el))
+ (20 30 40))
+
+(mtest
+ (uni #T(() "a" "b") #T(() "b" "c")) ("a" "b" "c")
+ (diff #T(() "a" "b") #T(() "b" "c")) ("a")
+ (isec #T(() "a" "b") #T(() "b" "c")) ("b"))
+
+(defstruct (item label key) ()
+ label
+ key
+ (:method equal (it) it.key))
+
+(defun make-items ()
+ (vec (new (item 'a 1))
+ (new (item 'b 2))
+ (new (item 'c 2))
+ (new (item 'd 2))
+ (new (item 'e 2))
+ (new (item 'f 3))))
+
+(let* ((items (make-items))
+ (tr (tree items : : : t)))
+ (each ((it items))
+ (vtest (tree-delete tr it) it))
+ (test tr #T(())))
+
+(let* ((items (make-items))
+ (tr (tree items : : : t)))
+ (each ((it items))
+ (let* ((tn (tree-lookup-node tr it.key))
+ (iu (key tn)))
+ (vtest (tree-delete-specific-node tr tn) tn)
+ (each ((iv tr))
+ (test (eq iv.label iu.label) nil))))
+ (test tr #T(())))
+
+(let* ((items (make-items))
+ (tr (tree items : : : t)))
+ (vtest (vec-list [mapcar .label tr]) [mapcar .label items]))
+
+(let ((tr (tree)))
+ (mtest
+ (tree-insert tr 1) #N(1 nil nil)
+ (tree-insert tr 1) #N(1 nil nil)
+ (tree-insert tr 1) #N(1 nil nil))
+ (tree-insert tr 2)
+ (test (tree-count tr) 2)
+ (tree-insert tr 1 t)
+ (test (tree-count tr) 3))
+
+(mtest
+ (tree-min-node (tree)) nil
+ (tree-min-node (tree '(1))) #N(1 nil nil)
+ (tree-min-node (tree '(1 2 3))) #N(1 nil nil))
+
+(mtest
+ (tree-min (tree)) nil
+ (tree-min (tree '(1))) 1
+ (tree-min (tree '(1 2 3))) 1)
+
+(let ((tr (tree '(1 2 3 4 5 6 7 8 9 10))))
+ (mtest
+ (tree-count tr) 10
+ (tree-del-min tr) 1
+ (tree-del-min tr) 2
+ (tree-del-min tr) 3
+ (tree-count tr) 7
+ (tree-del-min tr) 4
+ (tree-count tr) 6
+ (tree-del-min tr) 5
+ (tree-del-min tr) 6
+ (tree-del-min tr) 7
+ (tree-del-min tr) 8
+ (tree-count tr) 2
+ (tree-del-min tr) 9
+ (tree-count tr) 1
+ (tree-del-min tr) 10
+ (tree-count tr) 0
+ (tree-del-min tr) nil))
+
+(let* ((tr [tree '(#R(1 10) #R(11 20) #R(21 30)) to])
+ (node (tree-lookup-node tr 10)))
+ (test node #N(#R(1 10) nil nil))
+ (tree-delete-specific-node tr node)
+ (test tr #T((to) #R(11 20) #R(21 30))))
diff --git a/tests/010/vec.tl b/tests/010/vec.tl
new file mode 100644
index 00000000..f7b182c1
--- /dev/null
+++ b/tests/010/vec.tl
@@ -0,0 +1,53 @@
+(load "../common")
+
+(let ((v0 (vec))
+ (v3 (vec 1 2 3)))
+ (mtest
+ v0 #()
+ v3 #(1 2 3)
+ (fill-vec v0 nil) #()
+ (fill-vec v0 nil -1 -1) :error
+ (fill-vec v0 nil 1 1) :error
+ (fill-vec v3 nil 0 0) #(1 2 3)
+ (fill-vec v3 nil 1 1) #(1 2 3)
+ (fill-vec v3 nil 2 2) #(1 2 3)
+ (fill-vec v3 nil 3 3) #(1 2 3)
+ (fill-vec v3 nil -3 -3) #(1 2 3)
+ (fill-vec v3 nil 4 0) :error
+ (fill-vec v3 nil 4 4) :error
+ (fill-vec v3 nil 0 4) :error
+ (fill-vec v3 nil -1 0) #(1 2 3)
+ (fill-vec v3 nil 1 0) #(1 2 3)
+ (fill-vec v3 nil 2 1) #(1 2 3)
+ (fill-vec v3 nil 3 2) #(1 2 3)
+ (fill-vec v3 nil -4 -3) :error
+ (fill-vec v3 nil -3 -4) :error
+ (fill-vec v3 nil) #(nil nil nil)
+ (fill-vec v3 1 0 1) #(1 nil nil)
+ (fill-vec v3 2 1 2) #(1 2 nil)
+ (fill-vec v3 3 2 3) #(1 2 3)
+ (fill-vec v3 0 1) #(1 0 0)
+ (fill-vec v3 2 -1) #(1 0 2)
+ (fill-vec v3 3 -3) #(3 3 3))
+ (fill-vec v3 0 -2 -1) #(3 0 3))
+
+(mtest
+ (nested-vec) nil
+ (nested-vec-of 0 4) #(0 0 0 0)
+ (nested-vec-of 0 4 3) #(#(0 0 0)
+ #(0 0 0)
+ #(0 0 0)
+ #(0 0 0))
+ (nested-vec-of 'a 4 3 2) #(#(#(a a) #(a a) #(a a))
+ #(#(a a) #(a a) #(a a))
+ #(#(a a) #(a a) #(a a))
+ #(#(a a) #(a a) #(a a)))
+ (nested-vec-of 'a 1 1 1) #(#(#(a)))
+ (nested-vec-of 'a 1 1 0) #(#(#()))
+ (nested-vec-of 'a 1 0 1) #(#())
+ (nested-vec-of 'a 1 0) #(#())
+ (nested-vec-of 'a 0 1) #()
+ (nested-vec-of 'a 0) #()
+
+ (nested-vec-of 'a 4 0 1) #(#() #() #() #())
+ (nested-vec-of 'a 4 0) #(#() #() #() #()))
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-18 10:32:08 +0000