ref: 96e08ec043ae59e7eec6707c9d410caa7fd114a5
dir: /test/unittest.sl/
; (return)
(def (fr) 1 (return) 0)
(assert (void? (fr)))
(def (fr) 1 (return 2) 0)
(assert (eq? 2 (fr)))
(def (fr) 1 (return NIL) 0)
(assert (not (fr)))
(assert-fail (top-level-value 'unbound-var) unbound-error)
(set-top-level-value! 'unbound-var 0)
(assert (= 0 unbound-var))
(makunbound 'unbound-var)
(def (f)
(let ((unbound-var 1))
(set-top-level-value! 'unbound-var 0)
(cons unbound-var (top-level-value 'unbound-var))))
(def unbound-var 2)
(assert (= 2 (top-level-value 'unbound-var)))
(assert (= 2 unbound-var))
(set-top-level-value! 'unbound-var 3)
(assert (= 3 (top-level-value 'unbound-var)))
(assert (= 3 unbound-var))
(assert (equal? (cons 1 0) (f)))
(def (every-int n)
(list (fixnum n) (s8 n) (u8 n) (s16 n) (u16 n) (s32 n) (u32 n)
(p32 n) (s64 n) (u64 n) (p64 n) (f32 n) (f64 n) (bignum n)))
(def (every-sint n)
(list (fixnum n) (s8 n) (s16 n) (s32 n) (s64 n) (f32 n) (f64 n) (bignum n)))
(def (each f l)
(if (atom? l) NIL
(begin (f (car l))
(each f (cdr l)))))
(def (each^2 f l m)
(each (λ (o) (each (λ (p) (f o p)) m)) l))
(def (test-lt a b)
(each^2 (λ (neg pos)
(begin
(eval `(assert (= -1 (compare ,neg ,pos))))
(eval `(assert (= 1 (compare ,pos ,neg))))
(eval `(assert (< ,neg ,pos)))
(eval `(assert (not (< ,pos ,neg))))))
a
b))
(def (test-eq a b)
(each^2 (λ (a b)
(begin
(eval `(assert (= 0 (compare ,a ,b))))))
a
b))
(test-lt (every-sint -1) (every-int 1))
(test-lt (every-int 0) (every-int 1))
(test-eq (every-int 88) (every-int 88))
(test-eq (every-sint -88) (every-sint -88))
(def (test-square a)
(each (λ (i) (eval `(assert (>= (* ,i ,i) 0))))
a))
(test-square (every-sint -67))
(test-square (every-int 3))
(test-square (every-int #x80000000))
(test-square (every-sint #x80000000))
(test-square (every-sint #x-80000000))
(assert (= (* 128 #x02000001) #x100000080))
(assert (= (/ 1) 1))
(assert (= (/ -1) -1))
(assert (= (/ 2.0) 0.5))
(assert (= (- 4999950000 4999941999) 8001))
(assert (not (eqv? 10 #\newline)))
(assert (not (eqv? #\newline 10)))
; tricky cases involving INT32_MIN
(assert (< (- #u32(#x80000000)) 0))
(assert (> (- #s32(#x80000000)) 0))
(assert (< (- #u64(#x8000000000000000)) 0))
(assert (< (- #s64(#x8000000000000000)) 0))
; fixnum versions
(assert (= (- -536870912) 536870912))
(assert (= (- -2305843009213693952) 2305843009213693952))
(assert (not (equal? #s64(#x8000000000000000) #u64(#x8000000000000000))))
(assert (equal? (+ #s64(#x4000000000000000) #s64(#x4000000000000000))
#u64(#x8000000000000000)))
(assert (equal? (* 2 #s64(#x4000000000000000))
#u64(#x8000000000000000)))
(assert (equal? (u64 (f64 -123)) #u64(#xffffffffffffff85)))
(assert (equal? (str 'sym #utf8(65) #rune(945) "blah") "symA\u03B1blah"))
(assert (= (length (str #\x0)) 1))
(assert (> 9223372036854775808 9223372036854775807))
(assert-fail (fixnum? (- (str-rune "0" 0) #\0)))
(assert (= (ash #bignum(1) -9999) 0))
; number boundaries
(load "number-boundaries.sl")
; ptr
(assert (not (ptr? #\x)))
(assert (not (ptr? 0)))
(assert (not (ptr? (u64 #x7fffffffffffffff))))
(assert (not (ptr? "")))
(assert (not (ptr? "1 2 3")))
(assert (not (ptr? #(1 2 3))))
(assert (ptr? (ptr 0)))
(assert (ptr? (p32 0)))
(assert (ptr? (p64 0)))
(assert (ptr? (ptr #xf)))
(assert (ptr? (p32 #x7fffffff)))
(assert (ptr? (p32 #xffffffff)))
(assert (ptr? (p64 #x7fffffffffffffff)))
(assert (ptr? (p64 #xffffffffffffffff)))
(assert (= #xffffffff (p32 #xffffffff)))
(assert (= #xffffffffffffffff (p64 #xffffffffffffffff)))
(assert (not (ptr? (u64 0))))
; fixnum + unboxed
(assert (= 255 (fixnum (u8 255))))
(assert (= -128 (fixnum (s8 -128))))
(assert (= 12345 (fixnum (bignum 12345))))
(assert-fail (fixnum #\☺) type-error)
(assert-fail (fixnum "") type-error)
(assert-fail (fixnum #(1 2 3)) type-error)
; bignum
(assert (> #x10000000000000000 #x8fffffffffffffff))
(assert (< #x8fffffffffffffff #x10000000000000000))
(assert (bignum? (ash 2 59)))
(def (bignum-on-32? x) (if #.(fixnum? #xffffffff) (not (bignum? x)) (bignum? x)))
(assert (bignum-on-32? (- (ash 2 59) 1)))
(assert (bignum? 1606938044258990275541962092341162602522202993782792835301376))
(assert (bignum? #xfffffffffffffffff))
(assert (bignum-on-32? #xfffffffffffffff))
(assert (= 4764984380238568507752444984131552966909
(* 66405897020462343733 71755440315342536873)))
(assert (= 71755440315342536873
(div 4764984380238568507752444984131552966909 66405897020462343733)))
(assert (= 3203431780337 (div 576460752303423487 179951)))
(assert (= 3487 (mod 576460752303423487 18000)))
(assert (= 7 (mod 576460752303423487 10)))
(assert-fail (mod 1 0) divide-error)
(assert-fail (div 1 0) divide-error)
(assert-fail (div0 1 0) divide-error)
(assert-fail (/ 1 0) divide-error)
(assert (= 15 (logior 1 2 4 8)))
(assert (= -1 (logior 3 -1)))
(assert (= 0 (logand 1 2)))
(assert (= 12328 (logand 14826 12345)))
(assert (= 3 (logand 3 -1)))
(assert (= 2515 (logxor 14826 12345)))
(assert (= -4 (logxor 3 -1)))
(assert (= 0 (logxor 0 0)))
(assert (= -11 (lognot 10)))
(assert (eq? (s8 -11) (lognot (s8 10))))
(assert (= 10 (lognot -11)))
(assert (eq? (s8 10) (lognot (s8 -11))))
(assert (= #x0f (lognot (u8 #xf0))))
(assert (= #xf0 (lognot (u8 #x0f))))
(assert (= #xfffffffffffffffff (logior #xaaaaaaaaaaaaaaaaa #x55555555555555555)))
(assert (= #xaaaaaaaaaaaaaaaaa (logxor #xfffffffffffffffff #x55555555555555555)))
(assert (= #xaaaaaaaaaaaaaaaaa (logxor #xfffffffffffffffff #x55555555555555555)))
(assert (= #xaaaaaaaaa (logand #xaaaaaaaaaaaaaaaaa #x55555555fffffffff)))
(assert (= 0 (logand 0 #x55555555555555555)))
(assert (= 602394779747 (ash 11112222333344445555666677778888 -64)))
(assert (= 204984321473364576635441321909950327706185271083008
(ash 11112222333344445555666677778888 64)))
; const
(assert (const? T))
(assert (const? NIL))
(assert (const? 1))
(assert (const? (u32 0)))
(assert (const? (bignum 0)))
(assert (const? "hello"))
(assert (const? const?))
(assert (not (const? 'hello)))
; NaNs
(assert (nan? +nan.0))
(assert (nan? -nan.0))
(assert (nan? (f32 +nan.0)))
(assert (nan? (f32 -nan.0)))
(assert (equal? +nan.0 +nan.0))
(assert (equal? -nan.0 -nan.0))
(assert (equal? (f32 +nan.0) (f32 +nan.0)))
(assert (equal? (f32 -nan.0) (f32 -nan.0)))
(assert (not (= +nan.0 +nan.0)))
(assert (not (= +nan.0 -nan.0)))
(assert (not (= -nan.0 -nan.0)))
(assert (not (= (f32 +nan.0) (f32 +nan.0))))
(assert (not (= (f32 +nan.0) (f32 -nan.0))))
(assert (not (= (f32 -nan.0) (f32 -nan.0))))
(assert (equal? (< +nan.0 3) (> 3 +nan.0)))
(assert (equal? (< +nan.0 (f64 3)) (> (f64 3) +nan.0)))
(assert (equal? (< +nan.0 3) (> (f64 3) +nan.0)))
(assert (equal? (< +nan.0 (f64 3)) (> 3 +nan.0)))
(assert (equal? (< +nan.0 3) (< +nan.0 (f64 3))))
(assert (equal? (> +nan.0 3) (> +nan.0 (f64 3))))
(assert (equal? (< 3 +nan.0) (> +nan.0 (f64 3))))
(assert (equal? (> 3 +nan.0) (> (f64 3) +nan.0)))
(assert (not (>= +nan.0 +nan.0)))
(assert (not (<= -nan.0 -nan.0)))
(assert (not (>= (f32 +nan.0) (f32 +nan.0))))
(assert (not (<= (f32 -nan.0) (f32 -nan.0))))
; comparing strings
(assert (< "a" "b"))
(assert (< "a" "b" "c"))
(assert (> "b" "a"))
(assert (> "c" "b" "a"))
(assert (not (< "a" "a")))
(assert (not (< "a" "a" "a")))
(assert (<= "a" "a"))
(assert (<= "a" "a" "a"))
(assert (>= "a" "a"))
(assert (>= "a" "a" "a"))
(assert (>= "ab" "aa"))
(assert (>= "ab" "aa" "aa"))
; one or more than two arguments
(assert (and (> 0) (< 0) (>= 0) (<= 0)))
(assert (and (> 2 1 0) (< 0 1 2) (>= 2 1 0) (<= 0 1 2)))
(assert (and (>= 2 1 1) (<= 1 1 2)))
(assert (not (and (>= 2 1 2) (<= 2 1 2))))
; -0.0 etc.
(assert (not (equal? 0.0 0)))
(assert (equal? 0.0 0.0))
(assert (not (equal? -0.0 0.0)))
(assert (not (equal? -0.0 0)))
(assert (not (eqv? 0.0 0)))
(assert (not (eqv? -0.0 0)))
(assert (not (eqv? -0.0 0.0)))
(assert (= 0.0 -0.0))
; same but f32
(assert (not (equal? 0.0f 0)))
(assert (equal? 0.0f 0.0f))
(assert (not (equal? -0.0f 0.0f)))
(assert (not (equal? -0.0f 0)))
(assert (not (eqv? 0.0f 0)))
(assert (not (eqv? -0.0f 0)))
(assert (not (eqv? -0.0f 0.0f)))
(assert (= 0.0f -0.0f))
; and, or
(assert (equal? T (and)))
(assert (equal? NIL (or)))
(assert (equal? 1 (and '(1) 'x 1)))
(assert (equal? 1 (or NIL NIL NIL NIL NIL 1 NIL NIL NIL NIL)))
(assert (equal? 2 (if (and '(1) 'x 1) 2 0)))
(assert (equal? 2 (if (or NIL NIL NIL NIL NIL 1 NIL NIL NIL NIL) 2 0)))
(assert (equal? NIL (and '(1) 1 'x NIL)))
(assert (equal? NIL (or NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)))
(assert (equal? 0 (if (and '(1) 1 'x NIL) 2 0)))
(assert (equal? 0 (if (or NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL) 2 0)))
; bounded length tests
(assert (length> #(1) 0))
(assert (not (length> #(1) 1)))
(assert (not (length> #() 0)))
(assert (length= #() 0))
(assert (not (length= #() 1)))
(assert (not (length= #(1) 0)))
(assert (length> '(1) 0))
(assert (not (length> '(1) 1)))
(assert (not (length> '() 0)))
(assert (length= '() 0))
(assert (not (length= '() 1)))
(assert (not (length= '(1) 0)))
; proper/dotted/circular list tests
(assert (not NIL))
(assert (not (cons? NIL)))
(assert (not (not '(1))))
(assert (cons? '(1)))
(assert (list? '(1)))
(assert (proper-list? '(1)))
(assert (list? NIL))
(assert (proper-list? NIL))
(assert (list? '(1 . 2)))
(assert (not (proper-list? '(1 . 2))))
(def cl '(1 2 3))
(set-cdr! (cddr cl) cl)
(assert (cons? cl))
(assert (list? cl))
(assert (not (proper-list? cl)))
; failing applications
(assert-fail ((λ (x) x) 1 2))
(assert-fail ((λ (x) x)))
(assert-fail ((λ (x y . z) z) 1))
(assert-fail (car 'x) type-error)
(assert-fail gjegherqpfdf___trejif unbound-error)
; long argument lists
(assert (= (apply + (iota 100000)) 4999950000))
(def ones (map (λ (x) 1) (iota 80000)))
(assert (= (eval `(if (< 2 1)
(+ ,@ones)
(+ ,@(cdr ones))))
79999))
(def MAX_ARGS 255)
(def as (apply list* (map-int (λ (x) (gensym)) (+ MAX_ARGS 1))))
(def f (compile `(λ ,as ,(lastcdr as))))
(assert (equal? (apply f (iota (+ MAX_ARGS 0))) `()))
(assert (equal? (apply f (iota (+ MAX_ARGS 1))) `(,MAX_ARGS)))
(assert (equal? (apply f (iota (+ MAX_ARGS 2))) `(,MAX_ARGS ,(+ MAX_ARGS 1))))
(def as (apply list* (map-int (λ (x) (gensym)) (+ MAX_ARGS 100))))
(def ff (compile `(λ ,as (set! ,(car (last-pair as)) 42)
,(car (last-pair as)))))
(assert (equal? (apply ff (iota (+ MAX_ARGS 100))) 42))
(def ff (compile `(λ ,as (set! ,(car (last-pair as)) 42)
(λ () ,(car (last-pair as))))))
(assert (equal? ((apply ff (iota (+ MAX_ARGS 100)))) 42))
(def as (map-int (λ (x) (gensym)) 1000))
(def f (compile `(λ ,as ,(car (last-pair as)))))
(assert (equal? (apply f (iota 1000)) 999))
(def as (apply list* (map-int (λ (x) (gensym)) 995)))
(def f (compile `(λ ,as ,(lastcdr as))))
(assert (equal? (apply f (iota 994)) '()))
(assert (equal? (apply f (iota 995)) '(994)))
(assert (equal? (apply f (iota 1000)) '(994 995 996 997 998 999)))
; optional arguments
(assert (equal? ((λ ((b 0)) b)) 0))
(assert (equal? ((λ (a (b 2)) (list a b)) 1) '(1 2)))
(assert (equal? ((λ (a (b 2)) (list a b)) 1 3) '(1 3)))
(assert (equal? ((λ (a (b 2) (c 3)) (list a b c)) 1) '(1 2 3)))
(assert (equal? ((λ (a (b 2) (c 3)) (list a b c)) 1 8) '(1 8 3)))
(assert (equal? ((λ (a (b 2) (c 3)) (list a b c)) 1 8 9) '(1 8 9)))
(assert (equal? ((λ ((x 0) . r) (list x r))) '(0 NIL)))
(assert (equal? ((λ ((x 0) . r) (list x r)) 1 2 3) '(1 (2 3))))
; keyword arguments
(assert (keyword? :kw))
(assert (const? :kw))
(assert (eq? :kw ':kw))
(assert-fail (set! :kw 0) const-error)
(assert-fail (set-top-level-value! :kw 0) const-error)
(assert (not (keyword? 'kw:)))
(assert (not (keyword? 'kw)))
(assert (not (keyword? ':)))
(assert (equal? ((λ (x (a 2) (:b a) . r) (list x a b r)) 1 0 8 4 5)
'(1 0 0 (8 4 5))))
(assert (equal? ((λ (x (a 2) (:b a) . r) (list x a b r)) 0 :b 3 1)
'(0 2 3 (1))))
(def (keys4 (:a 8) (:b 3) (:c 7) (:d 6)) (list a b c d))
(assert (equal? (keys4 :a 10) '(10 3 7 6)))
(assert (equal? (keys4 :b 10) '(8 10 7 6)))
(assert (equal? (keys4 :c 10) '(8 3 10 6)))
(assert (equal? (keys4 :d 10) '(8 3 7 10)))
(assert-fail (keys4 :e 10)) ; unsupported keyword
(assert-fail (keys4 :a 1 :b)) ; keyword with no argument
(def (keys1 (:a 8)) (+ a 1))
(assert (equal? (keys1 :a 11) 12))
; cvalues and arrays
(assert (equal? (type-of "") '(arr utf8)))
(assert-fail (aref #(1) 3) bounds-error)
(def iarr (arr 's64 32 16 8 7 1))
(assert (equal? (aref iarr 0) 32))
(assert (equal? (aref iarr #s8(3)) 7))
(assert (equal? (aref (arr 'rune #\ß) 0) #\ß))
; gensyms
(assert (gensym? (gensym)))
(assert (not (gensym? 'a)))
(assert (not (eq? (gensym) (gensym))))
(assert (not (equal? (str (gensym)) (str (gensym)))))
(let ((gs (gensym))) (assert (eq? gs gs)))
(load "color.sl")
(assert (equal? (color-pairs (generate-5x5-pairs) '(a b c d e))
'((23 . a) (9 . a) (22 . b) (17 . d) (14 . d) (8 . b) (21 . e)
(19 . b) (16 . c) (13 . c) (11 . b) (7 . e) (24 . c) (20 . d)
(18 . e) (15 . a) (12 . a) (10 . e) (6 . d) (5 . c) (4 . e)
(3 . d) (2 . c) (0 . b) (1 . a))))
; hashing strange things
(assert (equal?
(hash '#0=(1 1 #0# . #0#))
(hash '#1=(1 1 #1# 1 1 #1# . #1#))))
(assert (not (equal?
(hash '#0=(1 1 #0# . #0#))
(hash '#1=(1 2 #1# 1 1 #1# . #1#)))))
(assert (equal?
(hash '#0=((1 . #0#) . #0#))
(hash '#1=((1 . #1#) (1 . #1#) . #1#))))
(assert (not (equal?
(hash '#0=((1 . #0#) . #0#))
(hash '#1=((2 . #1#) (1 . #1#) . #1#)))))
(assert (not (equal?
(hash '#0=((1 . #0#) . #0#))
(hash '#1=((1 . #1#) (2 . #1#) . #1#)))))
(assert (equal?
(hash '(#0=(#0#) 0))
(hash '(#1=(((((#1#))))) 0))))
(assert (not (equal?
(hash '(#0=(#0#) 0))
(hash '(#1=(((((#1#))))) 1)))))
(assert (equal?
(hash #0=#(1 #(2 #(#0#)) 3))
(hash #1=#(1 #(2 #(#(1 #(2 #(#1#)) 3))) 3))))
(assert (not (equal?
(hash #0=#(1 #(2 #(#0#)) 3))
(hash #1=#(1 #(2 #(#(5 #(2 #(#1#)) 3))) 3)))))
(assert (equal?
(hash #0=#(1 #0# #(2 #(#0#)) 3))
(hash #1=#(1 #1# #(2 #(#(1 #1# #(2 #(#1#)) 3))) 3))))
(assert (not (equal?
(hash #0=#(1 #0# #(2 #(#0#)) 3))
(hash #1=#(6 #1# #(2 #(#(1 #1# #(2 #(#1#)) 3))) 3)))))
(assert (equal?
(hash #(1 #(2 #(#(1 1 #(2 #(1)) 3))) 3))
(hash #(1 #(2 #(#(1 1 #(2 #(1)) 3))) 3))))
(assert (not (equal?
(hash #(6 1 #(2 #(#(3 1 #(2 #(1)) 3))) 3))
(hash #(6 1 #(2 #(#(1 1 #(2 #(1)) 3))) 3)))))
(assert (equal? (hash '#0=(1 . #0#))
(hash '#1=(1 1 . #1#))))
(assert (not (equal? (hash '#0=(1 1 . #0#))
(hash '#1=(1 #0# . #1#)))))
(assert (not (equal? (hash (iota 10))
(hash (iota 20)))))
(assert (not (equal? (hash (iota 41))
(hash (iota 42)))))
(assert (let ((ts (time->str (time-now))))
(eqv? ts (time->str (str->time ts)))))
(assert (equal? 0.0 (+ 0.0 0))) ; tests that + no longer does inexact->exact
(assert (equal? 1.0 (* 1.0 1))) ; tests that * no longer does inexact->exact
(def (with-output-to-str nada thunk)
(let ((b (buffer)))
(with-output-to b (thunk))
(io->str b)))
(let ((c #\a))
(assert (equal? (with-output-to-str NIL (λ () (print (list c c))))
"(#\\a #\\a)")))
(assert-fail (eval '(set! (car (cons 1 2)) 3)))
(assert (equal? `(a `(b c)) '(a (quasiquote (b c)))))
(assert (equal? ````x '```x))
(assert (equal? (append 1) 1))
(assert (equal? (append NIL 1) 1))
(assert (equal? (append) NIL))
(assert (equal? (append NIL) NIL))
(assert (equal? (append NIL NIL) NIL))
(assert (equal? (append '(1 2)) '(1 2)))
(assert (equal? (append '(1 2) '(3 4)) '(1 2 3 4)))
(let* {[l1 '(0 1)]
[l2 '(2 3)]
[a (append l1 l2)]}
(assert (equal? a (iota 4)))
(aset! l1 1 "hi")
(assert (equal? a (iota 4)))
(aset! l2 1 "blah")
(assert (equal? a '(0 1 2 "blah"))))
;; infinite list
(def a '(1))
(set-cdr! a a)
(assert (equal? (length a) +inf.0))
(eq? (cdr a) a)
;; unbinding
(assert-fail (makunbound :kw) const-error)
(def abc 1)
(assert (equal? (bound? 'abc) T))
(assert (equal? (eval '(+ abc 1)) 2))
(makunbound 'abc)
(assert (equal? (bound? 'abc) NIL))
(assert-fail (eval '(+ abc 1)) unbound-error)
;; c***r of empty list
(assert (not (car NIL)))
(assert (not (cdr NIL)))
(assert (not (cadr NIL)))
(assert (not (cdar NIL)))
(assert (not (caaar NIL)))
(assert (not (cdddr NIL)))
;; for-each with multiple lists
(def q NIL)
(for-each (λ (x y) (set! q (cons (+ x y) q))) #(1 2 3) #vu8(4 5 6))
(assert (equal? q '(9 7 5)))
(def q 0)
(for-each (λ (x y) (set! q (+ x y q))) '(1) '(3 9))
(assert (equal? q 4))
(for-each (λ (x y) (set! q (+ x y q))) '(1 2) '(3))
(assert (equal? q 8))
(for-each (λ (x y z) (set! q (+ x y z q))) '(1 2) '(3) '(4 5))
(assert (equal? q 16))
;; map with multiple lists
(assert (equal? (map (λ (x y z) (+ x y z)) '(1 2 3) '(4 5 6) '(7 8 9)) '(12 15 18)))
(assert (equal? (map (λ (x y) (+ x y)) '(1) '(3 9)) '(4)))
(assert (equal? (map (λ (x y) (+ x y)) '(1 2) '(3)) '(4)))
(assert (equal? (map (λ (x y z) (+ x y z)) '(1 2) '(3) '(4 5)) '(8)))
;; list copying
(assert (equal? (copy-list (iota 50)) (iota 50)))
(assert (equal? (copy-list (iota 50) 51) (iota 50)))
(assert (equal? (copy-list (iota 50) 25) (iota 25)))
(assert (not (copy-list NIL 25)))
(assert (not (copy-list NIL)))
(assert (not (copy-list (iota 50) 0)))
(let* {[l (iota 10)]
[c (copy-list l)]}
(aset! l 3 5)
(aset! c 4 23)
(assert (= (aref l 3) 5))
(assert (= (aref c 3) 3))
(assert (= (aref l 4) 4))
(assert (= (aref c 4) 23)))
(assert (equal? (subseq (iota 20) 10) '(10 11 12 13 14 15 16 17 18 19)))
(assert (equal? (subseq (iota 20) 10 15) '(10 11 12 13 14)))
(assert (equal? (subseq (apply vec (iota 20)) 10) (vec 10 11 12 13 14 15 16 17 18 19)))
(assert (equal? (subseq (apply vec (iota 20)) 10 15) (vec 10 11 12 13 14)))
(assert (equal? (subseq (apply arr (cons 'u32 (iota 20))) 10) (arr 'u32 10 11 12 13 14 15 16 17 18 19)))
(assert (equal? (subseq (apply arr (cons 'u32 (iota 20))) 10 15) (arr 'u32 10 11 12 13 14)))
(assert-fail (subseq (iota 10) 11))
(assert-fail (subseq (iota 10) 5 11))
(assert-fail (subseq (iota 10) 6 5))
(assert-fail (subseq (apply vec (iota 10)) 11))
(assert-fail (subseq (apply vec (iota 10)) 5 11))
(assert-fail (subseq (apply vec (iota 10)) 6 5))
(assert (not (subseq (iota 10) 10)))
(assert (not (subseq NIL 0)))
(assert (equal? (subseq (apply vec (iota 10)) 10) (vec)))
(assert (equal? (subseq (vec) 0) (vec)))
(assert (equal? (subseq cl 1 8) '(2 3 1 2 3 1 2)))
(assert (equal? (subseq "йцукен" 1 4) "цук"))
(assert (equal? (subseq "йцукен" 6) ""))
(assert-fail (subseq "йцукен" 7))
;; map with different return types
(assert (equal? (map 'vec + '(1 2 3) '(4 5 6) '(7 8 9)) (vec 12 15 18)))
(assert (equal? (map '(arr s32) + '(1 2 3) '(4 5 6) '(7 8 9)) (arr 's32 12 15 18)))
(def tbl (table "hi" 32 109234 "blah"))
(assert (equal? (get (map cons tbl) "hi") 32))
(assert (equal? (get (map cons tbl) 109234) "blah"))
(assert (equal? (map + (vec 1 2 3) (vec 4 5 6)) (vec 5 7 9)))
(assert-fail (map + (vec 1 2 3) '(4 5 6)))
(assert (equal? (map 'vec + (vec 1 2 3) '(4 5 6)) (vec 5 7 9)))
(assert (equal? (map 'list + (vec 1 2 3) '(4 5 6)) '(5 7 9)))
(assert (equal? (map 'str + (vec 1 2 3) '(4 5 6)) "579"))
(assert (equal? (map '(arr s16) + (vec 1 2 3) '(4 5 6)) (arr 's16 5 7 9)))
(assert-fail (map 'wrong + (vec 1 2 3)))
(assert-fail (map (vec) + (vec 1 2 3)))
(assert-fail (map (arr 'u8 1) + (vec 1 2 3)))
;; aref with multiple indices
(def a #(#(0 1 2) #(3 (4 5 6) 7)))
(assert (equal? 0 (aref a 0 0)))
(assert (equal? 0 (apply aref (list a 0 0))))
(assert (equal? 2 (aref a 0 2)))
(assert (equal? 3 (aref a (1+ 0) 0)))
(assert (equal? 7 (aref a 1 2)))
(assert (equal? 5 (aref a 1 (1+ 0) 1)))
(assert-fail (aref a 1 1 3) bounds-error)
(assert (equal? #\l (rune (aref #("hello") 0 2))))
(assert (equal? #\o (rune (aref #("hello") 0 (1+ 3)))))
(assert-fail (aref #("hello") 0 5) bounds-error)
(assert-fail (aref #("hello") 1 0) bounds-error)
(assert-fail (aref '(NIL) 0 0))
(assert-fail (apply aref '((NIL) 0 0)))
;; aset with multiple indices
(def a #(#(0 1 2) #(3 (4 5 6) 7)))
(assert (equal? 8 (apply aset! (list a 0 0 8))))
(assert (equal? 9 (aset! a 1 1 (1+ 1) 9)))
(assert (equal? "hello" (aset! a (1+ 0) 2 "hello")))
(assert-fail (aset! a 1 1 3 "nope"))
(assert (equal? a #(#(8 1 2) #(3 (4 5 9) "hello"))))
(assert-fail (aset! '(NIL) 0 0 1))
(assert-fail (apply aset! '((NIL) 0 0 1)))
;; apply with multiple args
(assert (equal? 15 (apply + 1 2 '(3 4 5))))
(assert-fail (apply + 1 2 3)) ; last arg not a list
;; make many initialized tables large enough not to be stored in-line
(for 1 100 (λ (i)
(table eq? 2 eqv? 2
equal? 2 atom? 1
not 1 nan? 1
cons? 1 sym? 1
num? 1 bound? 1
cons? 1 builtin? 1
vec? 1 fixnum? 1
cons 2 car 1
cdr 1 set-car! 2
set-cdr! 2 = 2
< 2 compare 2
aref 2 aset! 3
div0 2 'hello 4
'goodbye 5 'foo 6
'bar 7)))
;; now allocate enough to trigger GC
(for 1 8000000 (λ (i) (cons 1 2)))
;; brieflz bindings
(let* ((level 10)
(s (file "unittest.sl"))
(in (io-readall s))
(packed (lz-pack in level))
(unpacked (lz-unpack packed :size (size-of in)))
(unpacked2 (arr-alloc 'u8 (size-of in) 0)))
(io-close s)
(assert (< (size-of packed) (size-of in)))
(assert (equal? in unpacked))
(assert (eq? unpacked2 (lz-unpack packed :to unpacked2)))
(assert (equal? in unpacked2))
(princ "lz packing at level " level ": " (size-of in) " → " (size-of packed))
(newline))
;; macro vs function priority
(def (!! x y) (- x y))
(assert (eq? 3 (!! 5 2)))
(defmacro (!! x y z) (+ z (apply !! (list x y))))
(assert (eq? 4 (!! 5 2 1)))
(def s "привет\0пока")
(def s2 "hello \t \n world\n ")
(assert (eq? 21 (size-of s)))
(assert (eq? 11 (length s)))
(assert (eq? 11 (str-length s)))
(assert (eq? 11 (str-length s 0)))
(assert (eq? 10 (str-length s 2 (size-of s) nil)))
(assert (eq? 10 (str-length s 2)))
(assert (eq? 10 (str-length s 3)))
(assert (not (str-length s 3 (size-of s) nil)))
(assert (eq? 0 (str-length s 21)))
(assert-fail (str-length s -1))
(assert-fail (str-length s 22))
(assert (eq? 1 (str-length s 0 2)))
(assert (eq? 2 (str-length s 0 4)))
(assert (eq? 0 (str-length s 21 20)))
(assert (eq? 0 (str-length s 21 21)))
(assert-fail (str-length s 21 22))
(assert (equal? "акоп\0тевирп" (str-reverse s)))
(assert (equal? "" (str-reverse "")))
(assert (equal? "й" (str-reverse "й")))
(assert (equal? "wб☺🡷⁹гq" (str-reverse "qг⁹🡷☺бw")))
(assert (str-utf8? ""))
(assert (str-utf8? "wб☺🡷⁹гq"))
(assert (not (str-utf8? "\xfffe")))
(let {[b (buffer)]}
(with-output-to b (for-each print "йцукен"))
(assert (equal? (io->str b) "#\\й#\\ц#\\у#\\к#\\е#\\н")))
(let {[b (buffer)]}
(write "a\x0a\x09\\\x07\x08\x1b\x0c\x0d\x0b" b)
(assert (equal? (io->str b) «"a\n\t\\\a\b\e\f\r\v"»)))
(defmacro (print-with-length n . args)
`(with-bindings ((*print-length* ,n))
(print-to-str ,@args)))
(assert (equal? (print-with-length 2 '(1)) "(1)"))
(assert (equal? (print-with-length 2 '(1 2)) "(1 2)"))
(assert (equal? (print-with-length 2 '(1 2 3)) "(1 2 ...)"))
(assert (equal? (print-with-length 2 '(1 2 3 4)) "(1 2 ...)"))
(assert (equal? (print-with-length 2 #(1)) "#(1)"))
(assert (equal? (print-with-length 2 #(1 2)) "#(1 2)"))
(assert (equal? (print-with-length 2 #(1 2 3)) "#(1 2 ...)"))
(assert (equal? (print-with-length 2 #(1 2 3 4)) "#(1 2 ...)"))
(assert (equal? (print-with-length 2 (arr 'u8 1)) "#vu8(1)"))
(assert (equal? (print-with-length 2 (arr 'u8 1 2)) "#vu8(1 2)"))
(assert (equal? (print-with-length 2 (arr 'u8 1 2 3)) "#vu8(1 2 ...)"))
(assert (equal? (print-with-length 2 (arr 'u8 1 2 3 4)) "#vu8(1 2 ...)"))
(assert (= 10 (str-width s)))
(assert (= 0 (str-width "")))
(assert (= 1 (str-width #\q)))
(assert (= 1 (str-width #\й)))
(assert (= 0 (str-width #\nul)))
(assert-fail (str-width 123))
(assert-fail (str-width 'blah))
(assert-fail (str-width str-width))
(assert (equal? '("привет" "пока") (str-split s "\0")))
(assert (equal? '("пр" "вет" "пок" "") (str-split s "аи\0")))
(assert (equal? '("" "") (str-split "1" "1")))
(assert (equal? '("hello" "world") (str-split s2 :trim T)))
(assert (equal? '("hello" "\t" "\n" "world\n") (str-split s2 " " :trim T)))
(assert (equal? (list s2) (str-split s2 "X" :trim T)))
(assert (equal? (list s2) (str-split s2 "X")))
(assert (equal? #\а (str-rune s 10)))
(assert (equal? #\nul (str-rune s 6)))
(assert-fail (str-rune s 11))
(assert (equal? #\W (rune-upcase #\w)))
(assert (equal? #\П (rune-upcase #\п)))
(assert (equal? #\nul (rune-upcase #\nul)))
(assert (rune-upper-case? #\W))
(assert (rune-upper-case? #\П))
(assert (not (rune-upper-case? #\nul)))
(assert (not (rune-upper-case? #\w)))
(assert (not (rune-upper-case? #\п)))
(assert (not (rune-upper-case? #\nul)))
(assert (equal? #\w (rune-downcase #\W)))
(assert (equal? #\п (rune-downcase #\П)))
(assert (equal? #\nul (rune-downcase #\nul)))
(assert (rune-lower-case? #\w))
(assert (rune-lower-case? #\п))
(assert (not (rune-lower-case? #\nul)))
(assert (not (rune-lower-case? #\W)))
(assert (not (rune-lower-case? #\П)))
(assert (not (rune-lower-case? #\nul)))
(assert (rune-numeric? #\0))
(assert (rune-numeric? #\9))
(assert (not (rune-numeric? #\⁰)))
(assert (not (rune-numeric? #\q)))
(assert (rune-whitespace? #\space))
(assert (rune-whitespace? #\tab))
(assert (rune-whitespace? #\vtab))
(assert (rune-whitespace? #\newline))
(assert (rune-whitespace? #\x00a0))
(assert (rune-whitespace? #\x3000))
(assert (not (rune-whitespace? #\x200b)))
(assert (rune-alphabetic? #\q))
(assert (rune-alphabetic? #\й))
(assert (not (rune-alphabetic? #\⁰)))
(assert (not (rune-alphabetic? #\0)))
(assert (not (rune-title-case? #\DŽ)))
(assert (equal? #\Dž (rune-titlecase #\DŽ)))
(assert (rune-title-case? #\Dž))
(assert-fail (rune ""))
(def s "hello й goodbye")
(assert (= 4 (str-find s #\o)))
(assert (= 9 (str-find s #\o 5)))
(assert (= 10 (str-find s #\o 10)))
(assert (not (str-find s #\o 11)))
(assert (not (str-find s #\o 15)))
(assert (= 4 (str-find s "o")))
(assert (= 2 (str-find s "ll")))
(assert (not (str-find s "ll" 3)))
(assert (= 0 (str-find s "")))
(assert (= 7 (str-find s "" 7)))
(assert (= 6 (str-find s #\й)))
(assert (= 6 (str-find s #\й 6)))
(assert-fail (str-find s #\o -1))
(assert-fail (str-find s #\o 16))
(assert-fail (str-find s 0))
(assert-fail (str-find s (utf8 #\o)))
(assert (not (str-find "" "1")))
(assert (not (str-find "1" "11")))
(assert (equal? "1.5" (num->str 1.5)))
(assert (equal? "-3039" (num->str (s16 -12345) 16)))
(assert (equal? "111111111111111111111111111111111" (num->str 111111111111111111111111111111111)))
(assert (equal? "fffffffffffffffffffffffffffffffff" (num->str #xfffffffffffffffffffffffffffffffff 16)))
(assert-fail (num->str 1.5 16))
(assert-fail (num->str (bignum 0) 36))
(assert (= 1.5 (str->num "1.5")))
(assert (= -12345 (str->num "-3039" 16)))
(assert (= 111111111111111111111111111111111 (str->num "111111111111111111111111111111111")))
(assert (= #xfffffffffffffffffffffffffffffffff (str->num "fffffffffffffffffffffffffffffffff" 16)))
(assert (= (size-of #\я) 2))
(assert (= (size-of #\⁹) 3))
(assert (= (size-of (u8 0)) 1))
(assert (= (size-of (u16 0)) 2))
(assert (= (size-of (u32 0)) 4))
(assert (= (size-of (u64 0)) 8))
(assert-fail (= (size-of (bignum 0)) 0))
(assert-fail (= (length #\я) 2))
(assert-fail (= (length #\⁹) 3))
(assert-fail (= (length (u8 0)) 1))
(assert-fail (= (length (u16 0)) 2))
(assert-fail (= (length (u32 0)) 4))
(assert-fail (= (length (u64 0)) 8))
(assert-fail (= (length (bignum 0)) 0))
(assert (eq? (sym 'blah) 'blah))
(assert (eq? (sym "hi" "there" 'symbol 123) 'hitheresymbol123))
(assert-fail (sym) arg-error)
(assert-fail (exit "error" 2) arg-error)
(assert (not (int-valued? T)))
(assert (not (int-valued? NIL)))
(assert (not (int-valued? #\x)))
(assert (not (int-valued? -nan.0)))
(assert (not (int-valued? +inf.0)))
(assert (int-valued? 1.0))
(assert (int-valued? -1.0))
(assert (int-valued? 1.0f))
(assert (int-valued? -1.0f))
(assert (int-valued? (u8 1)))
(assert (int-valued? (p32 1)))
(assert (int-valued? (p64 #x7fffffffffff)))
(assert (int-valued? (bignum 0)))
(assert (num? 1.3))
(assert (num? -1.3))
(assert (num? 1.3f))
(assert (num? -1.3f))
(assert (not (num? #\я)))
(assert (int? 0))
(assert (int? (bignum 0)))
(assert (= 12345 (fixnum (bignum 12345))))
(assert (= -12345 (fixnum (bignum -12345))))
(assert (= 1.0 (truncate 1.3)))
(assert (= -1.0 (truncate -1.3)))
(assert (= 1.0 (truncate 1.3)))
(assert (= -1.0 (truncate -1.3)))
(assert (= 1.0 (truncate 1.3f)))
(assert (= -1.0 (truncate -1.3f)))
(assert (= 1.0 (truncate 1.3f)))
(assert (= -1.0 (truncate -1.3f)))
(assert (= 1 (truncate (bignum 1))))
(assert (= -1 (truncate (bignum -1))))
(assert (= 123 (truncate (s64 123))))
(assert (= -123 (truncate (s8 -123))))
(assert-fail (truncate "blah"))
(assert-fail (truncate 'blah))
(assert-fail (truncate truncate))
(assert (= 0 (sin 0)))
(assert (= 0 (sin 0.0)))
(assert (= 0 (sin 0.0f)))
(assert (= 0 (sin (s64 0))))
(assert (= 0 (sin (bignum 0))))
(let ((x (cos 0)))
(assert (and (>= x 0.999999999999999) (<= x 1.0))))
(assert (= 3 (sqrt 9)))
(assert (= 3 (log10 1000)))
(assert (= 0 (log 1)))
(assert (= 1 (exp 0)))
(assert (= 1 (log (exp 1))))
(assert-fail (acos acos))
(assert-fail (asin asin))
(assert-fail (atan atan))
(assert-fail (ceiling ceiling))
(assert-fail (cos cos))
(assert-fail (cosh cosh))
(assert-fail (exp exp))
(assert-fail (expt expt expt))
(assert-fail (floor floor))
(assert-fail (log log))
(assert-fail (log10 log10))
(assert-fail (sin sin))
(assert-fail (sinh sinh))
(assert-fail (sqrt sqrt))
(assert-fail (tan tan))
(assert-fail (tanh tanh))
(assert (= (length (table "hello" "goodbye" 123 456)) 2))
(assert-fail (table 1))
(assert-fail (table 1 2 3))
(def ta (table 1 2 "3" 4 'foo 'bar))
(def (with-output-to-str nada thunk)
(let ((b (buffer)))
(with-output-to b (thunk))
(io->str b)))
(assert (equal? (with-output-to-str NIL (λ () (write ta)))
"#table(1 2 \"3\" 4 foo bar)"))
(assert (table? ta))
(assert (not (table? "nope")))
(assert-fail (get ta 3))
(assert-fail (get ta "foo"))
(assert-fail (get ta 1+))
(assert (= 2 (get ta 1)))
(assert (= 4 (get ta "3")))
(assert (has? ta 'foo))
(assert (eq? 'bar (get ta 'foo)))
(assert (eq? ta (del! ta 'foo)))
(assert (not (has? ta 'foo)))
(assert-fail (get ta 'foo))
(assert-fail (del! ta 'foo))
(assert-fail (get "blah" 0))
(assert-fail (get (list 0 1) 0))
(assert (equal? (list 1 1 1) #0=(list 1 #1=1 #1#)))
(assert-fail (sleep 1 2))
(sleep)
(sleep 0)
(def t₀ (nanoseconds-monotonic))
(sleep 1)
(def t₁ (nanoseconds-monotonic))
(def Δt (- t₁ t₀))
(assert (and (< Δt 1010000000 ) (> Δt 999000000)))
(gc)
(let ((ru32 (table))
(ru64 (table))
(rf64 (table))
(rf32 (table)))
(dotimes (i 100)
(put! ru32 (rand-u32) 1)
(put! ru64 (rand-u64) 1)
(put! rf64 (rand-f64) 1)
(put! rf32 (rand-f32) 1))
(assert (< 50 (length ru32)))
(assert (< 50 (length ru64)))
(assert (< 50 (length rf64)))
(assert (< 50 (length rf32))))
;; auto gensym
(defmacro (f x)
`(let ((a# 1)) (list a# ,x)))
(defmacro (g x)
`(let ((a# 2)) (list a# ,x)))
(assert (equal? '(1 (2 3)) (f (g 3))))
; a-supplied is nil
(assert-fail (eval '(def (f (a 0 nil)) nil)))
(assert (= 0 (length NIL)))
; path-cwd
(assert (str? (path-cwd)))
(assert (path-cwd "."))
(assert-fail (path-cwd "." ".") arg-error)
(assert-fail (path-cwd "does/not/exist") io-error)
; path-exists? + delete-file
(assert (path-exists? "."))
(assert (not (path-exists? "doesnotexist.txt")))
(assert-fail (delete-file "doesnotexist.txt") io-error)
(def f (file "doesexist.txt" :write :create :truncate))
(assert (path-exists? "doesexist.txt"))
(io-close f)
(assert (path-exists? "doesexist.txt"))
(assert (delete-file "doesexist.txt"))
(assert (not (path-exists? "doesexist.txt")))
; os-getenv + os-setenv
(assert (not (os-getenv "thisenvvarisnotdefined")))
(assert (str? (os-getenv (if (equal? *os-name* "plan9") "path" "PATH"))))
(assert (not (os-getenv "thisvarisdefined")))
(assert (os-setenv "thisvarisdefined" "a value"))
(assert (equal? (os-getenv "thisvarisdefined") "a value"))
(assert (os-setenv "thisvarisdefined" NIL))
(assert (not (os-getenv "thisvarisdefined")))
(assert-fail (os-getenv))
(assert-fail (os-getenv "abc" "def"))
(assert-fail (os-setenv))
(assert-fail (os-setenv "" "def"))
(if (equal? *os-name* "plan9")
(begin (assert-fail (os-setenv ".." "def"))
(assert (not (os-getenv ".."))))
(begin (assert-fail (os-setenv "a=b" "def"))
(assert (not (os-getenv "a=b")))))