ref: a70379d7e4b822f532fb0a8ccdd1624a90b64a68
dir: /test/unittest.sl/
(defmacro (assert-fail expr . what)
`(assert (trycatch (begin ,expr NIL)
(λ (e) ,(if (not what) t
`(eq? (car e) ',(car what)))))))
(def (every-int n)
(list (fixnum n) (s8 n) (u8 n) (s16 n) (u16 n) (s32 n) (u32 n)
(s64 n) (u64 n) (float n) (double n) (bignum n)))
(def (every-sint n)
(list (fixnum n) (s8 n) (s16 n) (s32 n) (s64 n) (float n) (double 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 0x80000000))
(test-square (every-sint 0x80000000))
(test-square (every-sint -0x80000000))
(assert (= (* 128 0x02000001) 0x100000080))
(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(0x80000000)) 0))
(assert (> (- #s32(0x80000000)) 0))
(assert (< (- #u64(0x8000000000000000)) 0))
(assert (< (- #s64(0x8000000000000000)) 0))
; fixnum versions
(assert (= (- -536870912) 536870912))
(assert (= (- -2305843009213693952) 2305843009213693952))
(assert (not (equal? #s64(0x8000000000000000) #u64(0x8000000000000000))))
(assert (equal? (+ #s64(0x4000000000000000) #s64(0x4000000000000000))
#u64(0x8000000000000000)))
(assert (equal? (* 2 #s64(0x4000000000000000))
#u64(0x8000000000000000)))
(assert (equal? (u64 (double -123)) #u64(0xffffffffffffff85)))
(assert (equal? (str 'sym #byte(65) #rune(945) "blah") "symA\u03B1blah"))
(assert (= (length (str #\x0)) 1))
(assert (> 9223372036854775808 9223372036854775807))
(assert (fixnum? (- (aref "0" 0) #\0)))
(assert (= (ash #bignum(1) -9999) 0))
; number boundaries
(load "number-boundaries.sl")
; bignum
(assert (> 0x10000000000000000 0x8fffffffffffffff))
(assert (< 0x8fffffffffffffff 0x10000000000000000))
(assert (bignum? (ash 2 59)))
(def (bignum-on-32? x) (if #.(fixnum? 0xffffffff) (not (bignum? x)) (bignum? x)))
(assert (bignum-on-32? (- (ash 2 59) 1)))
(assert (bignum? 1606938044258990275541962092341162602522202993782792835301376))
(assert (bignum? 0xfffffffffffffffff))
(assert (bignum-on-32? 0xfffffffffffffff))
(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 (= 0xfffffffffffffffff (logior 0xaaaaaaaaaaaaaaaaa 0x55555555555555555)))
(assert (= 0xaaaaaaaaaaaaaaaaa (logxor 0xfffffffffffffffff 0x55555555555555555)))
(assert (= 0xaaaaaaaaaaaaaaaaa (logxor 0xfffffffffffffffff 0x55555555555555555)))
(assert (= 0xaaaaaaaaa (logand 0xaaaaaaaaaaaaaaaaa 0x55555555fffffffff)))
(assert (= 0 (logand 0 0x55555555555555555)))
(assert (= 602394779747 (ash 11112222333344445555666677778888 -64)))
(assert (= 204984321473364576635441321909950327706185271083008
(ash 11112222333344445555666677778888 64)))
; NaNs
(assert (nan? +nan.0))
(assert (nan? -nan.0))
(assert (nan? (float +nan.0)))
(assert (nan? (float -nan.0)))
(assert (equal? +nan.0 +nan.0))
(assert (equal? -nan.0 -nan.0))
(assert (equal? (float +nan.0) (float +nan.0)))
(assert (equal? (float -nan.0) (float -nan.0)))
(assert (not (= +nan.0 +nan.0)))
(assert (not (= +nan.0 -nan.0)))
(assert (not (= -nan.0 -nan.0)))
(assert (not (= (float +nan.0) (float +nan.0))))
(assert (not (= (float +nan.0) (float -nan.0))))
(assert (not (= (float -nan.0) (float -nan.0))))
(assert (equal? (< +nan.0 3) (> 3 +nan.0)))
(assert (equal? (< +nan.0 (double 3)) (> (double 3) +nan.0)))
(assert (equal? (< +nan.0 3) (> (double 3) +nan.0)))
(assert (equal? (< +nan.0 (double 3)) (> 3 +nan.0)))
(assert (equal? (< +nan.0 3) (< +nan.0 (double 3))))
(assert (equal? (> +nan.0 3) (> +nan.0 (double 3))))
(assert (equal? (< 3 +nan.0) (> +nan.0 (double 3))))
(assert (equal? (> 3 +nan.0) (> (double 3) +nan.0)))
(assert (not (>= +nan.0 +nan.0)))
(assert (not (<= -nan.0 -nan.0)))
(assert (not (>= (float +nan.0) (float +nan.0))))
(assert (not (<= (float -nan.0) (float -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))))
; comparing numbers and runes
(assert (< 9 #\newline))
(assert (not (< 10 #\newline)))
(assert (= 10 #\newline))
(assert (> 11 #\newline))
; -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 float
(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))
; this crashed once
(for 1 10 (λ (i) 0))
; 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)))
; 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 (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? (typeof "") '(arr byte)))
(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))
; 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-fail (eval '(append 1)))
(assert-fail (eval '(append NIL 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)))
;; infinite list
(def a '(1))
(set-cdr! a a)
(assert (equal? (length a) +inf.0))
(eq? (cdr a) a)
;; unbinding
(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)))
;; 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)))
;; 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? (fixnum #\l) (aref #("hello") 0 2)))
(assert (equal? (fixnum #\o) (aref #("hello") 0 (1+ 3))))
(assert-fail (aref #("hello") 0 5))
(assert-fail (aref #("hello") 1 0))
(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 (sizeof in)))
(unpacked2 (arr-alloc 'byte (sizeof in) 0)))
(io-close s)
(assert (< (sizeof packed) (sizeof in)))
(assert (equal? in unpacked))
(assert (eq? unpacked2 (lz-unpack packed :to unpacked2)))
(assert (equal? in unpacked2))
(princ "lz packing at level " level ": " (sizeof in) " → " (sizeof 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 (sizeof s)))
(assert (eq? 21 (length s)))
(assert (eq? 11 (str-length s)))
(assert (eq? 11 (str-length s 0)))
(assert (eq? 10 (str-length s 2)))
(assert (eq? 9 (str-length s 3)))
(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"»)))
(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ž))
(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 (byte #\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 0xfffffffffffffffffffffffffffffffff 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 (= 0xfffffffffffffffffffffffffffffffff (str->num "fffffffffffffffffffffffffffffffff" 16)))
(assert (= (length (byte #\f)) 1))
(assert (= (length #\я) 2))
(assert (= (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)) 4))
(assert-fail (= (length (bignum 0)) 0))
(assert (eq? (sym 'blah) 'blah))
(assert (eq? (sym "hi" "there" 'symbol 123) 'hitheresymbol123))
(assert-fail (exit "error" 2))
(assert (int-valued? 1.0))
(assert (int-valued? -1.0))
(assert (int-valued? 1.0f))
(assert (int-valued? -1.0f))
(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))
(let ((b (buffer)))
(write ta b)
(assert (equal? (io->str b) "#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))
(rdouble (table))
(rfloat (table)))
(dotimes (i 100)
(put! ru32 (rand-u32) 1)
(put! ru64 (rand-u64) 1)
(put! rdouble (rand-double) 1)
(put! rfloat (rand-float) 1))
(assert (< 50 (length ru32)))
(assert (< 50 (length ru64)))
(assert (< 50 (length rdouble)))
(assert (< 50 (length rfloat))))
;; 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))))
(princ "all tests pass")
(newline)