(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))) (defmacro (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-lt (rune 0) (rune 1))(test-lt (rune 0) (rune #x10ffff))(test-eq (every-int 88) (every-int 88))(test-eq (every-sint -88) (every-sint -88))(assert (every (λ (x) (= x 0)) (every-int))) (def (test-square a) (each (λ (i) (unless (ptr? 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))(test-square (every-int #x8000000000000000))(test-square (every-sint #x8000000000000000))(test-square (every-sint #x-8000000000000000)) (assert (= (* 128 #x02000001) #x100000080)) (assert (= (/ 1) 1))(assert (= (/ -1) -1))(assert (= (/ 2.0) 0.5))(assert (= (/ 2 4 8) 0.0625)) (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)); same with INT64_MIN(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 #\x41 #rune(945) "blah") "symA\u03B1blah"))(assert (= (length (str #\x0)) 1)) (assert (> 9223372036854775808 9223372036854775807)) (assert-fail (fixnum? (- (str-rune "0" 0) #\0))) (assert (= (ash 1 -9999) 0))(assert (= (ash -1 -9999) -1))(assert (= (ash #s64(1) -9999) 0))(assert (= (ash #s64(-1) -9999) -1))(assert (= (ash #bignum(1) -9999) 0))(assert (= (ash #bignum(-1) -9999) -1)) ; 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))))(assert (= #xff (p32 (u8 #xff))))(assert (= #xff (p32 (bignum #xff))))(assert (= #xff (p64 (u8 #xff))))(assert (= #xff (p64 (bignum #xff))))(assert-fail (p32 "") type-error)(assert-fail (p64 "") type-error)(assert-fail (p32 'a) type-error)(assert-fail (p64 'b) type-error) ; no division and multiplication with pointers(assert-fail (/ (p32 1) 2) type-error)(assert-fail (/ (p64 1) 2) type-error)(assert-fail (/ 2 (p32 1)) type-error)(assert-fail (/ 2 (p64 1)) type-error)(assert-fail (div (p32 1) 2) type-error)(assert-fail (div (p64 1) 2) type-error)(assert-fail (div 2 (p32 1)) type-error)(assert-fail (div 2 (p64 1)) type-error)(assert-fail (div0 (p32 1) 2) type-error)(assert-fail (div0 (p64 1) 2) type-error)(assert-fail (div0 2 (p32 1)) type-error)(assert-fail (div0 2 (p64 1)) type-error)(assert-fail (* (p32 1) 2) type-error)(assert-fail (* (p64 1) 2) type-error)(assert-fail (* 2 (p32 1)) type-error)(assert-fail (* 2 (p64 1)) type-error) ; 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) ; conversion to f64(assert (equal? -1.0 (f64 (s8 -1))))(assert (equal? -1.0 (f64 (s16 -1))))(assert (equal? -1.0 (f64 (s32 -1))))(assert (equal? -1.0 (f64 (s64 -1)))) ; 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 (equal? (/ 1 0) +inf.0))(assert-fail (/ 2 (rune 0)) type-error)(assert-fail (/ (rune 0) 2) type-error) ; eucledian vs truncated quotinent/remainder(assert (= (mod 10 3) 1))(assert (= (mod -10 3) 2))(assert (= (mod -10 -3) 2))(assert (= (mod 10 -3) 1))(assert (= (mod0 10 3) 1))(assert (= (mod0 -10 3) -1))(assert (= (mod0 -10 -3) -1))(assert (= (mod0 10 -3) 1))(assert (= (div 10 3) 3))(assert (= (div -10 3) -4))(assert (= (div -10 -3) 4))(assert (= (div 10 -3) -3))(assert (= (div0 10 3) 3))(assert (= (div0 -10 3) -3))(assert (= (div0 -10 -3) 3))(assert (= (div0 10 -3) -3)) (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 (not (const? 'hello)))(assert (not (const? 'const?)))(assert (const? '+most-positive-fixnum+))(assert (const? '+most-negative-fixnum+))(assert (const? '+pi+))(assert (const? :kw)) ; NaNs(assert (nan? +nan.0))(assert (nan? -nan.0))(assert (nan? (f32 +nan.0)))(assert (nan? (f32 -nan.0)))(assert (not (equal? +nan.0 +nan.0)))(assert (not (equal? -nan.0 -nan.0)))(assert (not (equal? (f32 +nan.0) (f32 +nan.0))))(assert (not (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 (equal? 0.0 0))(assert (equal? 0.0 0.0))(assert (equal? -0.0 0.0))(assert (equal? -0.0 0))(assert (eqv? 0.0 0))(assert (eqv? -0.0 0))(assert (eqv? -0.0 0.0))(assert (= 0.0 -0.0)); same but f32(assert (equal? 0.0f 0))(assert (equal? 0.0f 0.0f))(assert (equal? -0.0f 0.0f))(assert (equal? -0.0f 0))(assert (eqv? 0.0f 0))(assert (eqv? -0.0f 0))(assert (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 '#0=(1 2 3 . #0#))(assert (cons? cl))(assert (list? cl))(assert (not (proper-list? cl))) ; failing applications(assert-fail ((λ (x) x) 1 2) arity-error)(assert-fail ((λ ((x 0)) x) 1 2) arity-error)(assert-fail ((λ (x (y 0)) x)) arity-error)(assert-fail ((λ (x) x)) arity-error)(assert-fail ((λ (x y . z) z) 1) arity-error)(assert-fail (car 'x) type-error)(assert-fail (cdr 1) type-error)(assert-fail (cadr 1) type-error)(assert-fail (set-car! NIL 1) type-error)(assert-fail (set-cdr! NIL 1) type-error)(assert-fail gjegherqpfdf___trejif unbound-error)(assert-fail (1) type-error)(assert-fail (apply / NIL) arity-error)(assert-fail (apply = NIL) arity-error)(assert-fail (apply eq? NIL) arity-error)(assert-fail (apply eq? '(1)) arity-error)(assert-fail (apply eq? '(1 2 3)) arity-error)(assert-fail (apply apply '(#./ ())) arity-error)(assert-fail (apply + '(1 . 2)) type-error) (assert-fail (= 1 'a) type-error)(assert-fail (= 'a 1) type-error)(assert-fail (= 0 #\nul) type-error)(assert-fail (= #\nul 0) type-error) (for-each (λ (t) (assert-fail ((fn t) "0") type-error) (assert-fail ((fn t) 'a) type-error) (assert-fail ((fn t) 0 0) arity-error)) '(fixnum s8 u8 s16 u16 s32 u32 p32 s64 u64 p64 f32 f64 bignum)) ; 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 ,(last-cdr 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 (macroexpand `(λ ,as (set! ,(car (last-pair as)) 42) ,(car (last-pair as))))))(assert (equal? (apply ff (iota (+ MAX_ARGS 100))) 42))(def ff (compile (macroexpand `(λ ,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 ,(last-cdr 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 (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 "") 'str))(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) #\ß))(assert-fail (arr 'bignum 0))(assert-fail (arr 'fixnum 0))(assert-fail (arr 'str 0))(assert-fail (arr 'io 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)))) (assert (let ((ts (time->str (time-now)))) (eqv? ts (time->str (str->time ts)))))(assert (= 0 (str->time (time->str 0))))(assert (= 0 (str->time (time->str (bignum 0)))))(assert (= 0 (str->time (time->str (s32 0))))) (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 (let ((c #\a))Lines 1–500 of 1387. Load more
(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))) (defmacro (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-lt (rune 0) (rune 1)) (test-lt (rune 0) (rune #x10ffff)) (test-eq (every-int 88) (every-int 88)) (test-eq (every-sint -88) (every-sint -88)) (assert (every (λ (x) (= x 0)) (every-int))) (def (test-square a) (each (λ (i) (unless (ptr? 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)) (test-square (every-int #x8000000000000000)) (test-square (every-sint #x8000000000000000)) (test-square (every-sint #x-8000000000000000)) (assert (= (* 128 #x02000001) #x100000080)) (assert (= (/ 1) 1)) (assert (= (/ -1) -1)) (assert (= (/ 2.0) 0.5)) (assert (= (/ 2 4 8) 0.0625)) (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)) ; same with INT64_MIN (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 #\x41 #rune(945) "blah") "symA\u03B1blah")) (assert (= (length (str #\x0)) 1)) (assert (> 9223372036854775808 9223372036854775807)) (assert-fail (fixnum? (- (str-rune "0" 0) #\0))) (assert (= (ash 1 -9999) 0)) (assert (= (ash -1 -9999) -1)) (assert (= (ash #s64(1) -9999) 0)) (assert (= (ash #s64(-1) -9999) -1)) (assert (= (ash #bignum(1) -9999) 0)) (assert (= (ash #bignum(-1) -9999) -1)) ; 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)))) (assert (= #xff (p32 (u8 #xff)))) (assert (= #xff (p32 (bignum #xff)))) (assert (= #xff (p64 (u8 #xff)))) (assert (= #xff (p64 (bignum #xff)))) (assert-fail (p32 "") type-error) (assert-fail (p64 "") type-error) (assert-fail (p32 'a) type-error) (assert-fail (p64 'b) type-error) ; no division and multiplication with pointers (assert-fail (/ (p32 1) 2) type-error) (assert-fail (/ (p64 1) 2) type-error) (assert-fail (/ 2 (p32 1)) type-error) (assert-fail (/ 2 (p64 1)) type-error) (assert-fail (div (p32 1) 2) type-error) (assert-fail (div (p64 1) 2) type-error) (assert-fail (div 2 (p32 1)) type-error) (assert-fail (div 2 (p64 1)) type-error) (assert-fail (div0 (p32 1) 2) type-error) (assert-fail (div0 (p64 1) 2) type-error) (assert-fail (div0 2 (p32 1)) type-error) (assert-fail (div0 2 (p64 1)) type-error) (assert-fail (* (p32 1) 2) type-error) (assert-fail (* (p64 1) 2) type-error) (assert-fail (* 2 (p32 1)) type-error) (assert-fail (* 2 (p64 1)) type-error) ; 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) ; conversion to f64 (assert (equal? -1.0 (f64 (s8 -1)))) (assert (equal? -1.0 (f64 (s16 -1)))) (assert (equal? -1.0 (f64 (s32 -1)))) (assert (equal? -1.0 (f64 (s64 -1)))) ; 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 (equal? (/ 1 0) +inf.0)) (assert-fail (/ 2 (rune 0)) type-error) (assert-fail (/ (rune 0) 2) type-error) ; eucledian vs truncated quotinent/remainder (assert (= (mod 10 3) 1)) (assert (= (mod -10 3) 2)) (assert (= (mod -10 -3) 2)) (assert (= (mod 10 -3) 1)) (assert (= (mod0 10 3) 1)) (assert (= (mod0 -10 3) -1)) (assert (= (mod0 -10 -3) -1)) (assert (= (mod0 10 -3) 1)) (assert (= (div 10 3) 3)) (assert (= (div -10 3) -4)) (assert (= (div -10 -3) 4)) (assert (= (div 10 -3) -3)) (assert (= (div0 10 3) 3)) (assert (= (div0 -10 3) -3)) (assert (= (div0 -10 -3) 3)) (assert (= (div0 10 -3) -3)) (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 (not (const? 'hello))) (assert (not (const? 'const?))) (assert (const? '+most-positive-fixnum+)) (assert (const? '+most-negative-fixnum+)) (assert (const? '+pi+)) (assert (const? :kw)) ; NaNs (assert (nan? +nan.0)) (assert (nan? -nan.0)) (assert (nan? (f32 +nan.0))) (assert (nan? (f32 -nan.0))) (assert (not (equal? +nan.0 +nan.0))) (assert (not (equal? -nan.0 -nan.0))) (assert (not (equal? (f32 +nan.0) (f32 +nan.0)))) (assert (not (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 (equal? 0.0 0)) (assert (equal? 0.0 0.0)) (assert (equal? -0.0 0.0)) (assert (equal? -0.0 0)) (assert (eqv? 0.0 0)) (assert (eqv? -0.0 0)) (assert (eqv? -0.0 0.0)) (assert (= 0.0 -0.0)) ; same but f32 (assert (equal? 0.0f 0)) (assert (equal? 0.0f 0.0f)) (assert (equal? -0.0f 0.0f)) (assert (equal? -0.0f 0)) (assert (eqv? 0.0f 0)) (assert (eqv? -0.0f 0)) (assert (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 '#0=(1 2 3 . #0#)) (assert (cons? cl)) (assert (list? cl)) (assert (not (proper-list? cl))) ; failing applications (assert-fail ((λ (x) x) 1 2) arity-error) (assert-fail ((λ ((x 0)) x) 1 2) arity-error) (assert-fail ((λ (x (y 0)) x)) arity-error) (assert-fail ((λ (x) x)) arity-error) (assert-fail ((λ (x y . z) z) 1) arity-error) (assert-fail (car 'x) type-error) (assert-fail (cdr 1) type-error) (assert-fail (cadr 1) type-error) (assert-fail (set-car! NIL 1) type-error) (assert-fail (set-cdr! NIL 1) type-error) (assert-fail gjegherqpfdf___trejif unbound-error) (assert-fail (1) type-error) (assert-fail (apply / NIL) arity-error) (assert-fail (apply = NIL) arity-error) (assert-fail (apply eq? NIL) arity-error) (assert-fail (apply eq? '(1)) arity-error) (assert-fail (apply eq? '(1 2 3)) arity-error) (assert-fail (apply apply '(#./ ())) arity-error) (assert-fail (apply + '(1 . 2)) type-error) (assert-fail (= 1 'a) type-error) (assert-fail (= 'a 1) type-error) (assert-fail (= 0 #\nul) type-error) (assert-fail (= #\nul 0) type-error) (for-each (λ (t) (assert-fail ((fn t) "0") type-error) (assert-fail ((fn t) 'a) type-error) (assert-fail ((fn t) 0 0) arity-error)) '(fixnum s8 u8 s16 u16 s32 u32 p32 s64 u64 p64 f32 f64 bignum)) ; 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 ,(last-cdr 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 (macroexpand `(λ ,as (set! ,(car (last-pair as)) 42) ,(car (last-pair as)))))) (assert (equal? (apply ff (iota (+ MAX_ARGS 100))) 42)) (def ff (compile (macroexpand `(λ ,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 ,(last-cdr 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 (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 "") 'str)) (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) #\ß)) (assert-fail (arr 'bignum 0)) (assert-fail (arr 'fixnum 0)) (assert-fail (arr 'str 0)) (assert-fail (arr 'io 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)))) (assert (let ((ts (time->str (time-now)))) (eqv? ts (time->str (str->time ts))))) (assert (= 0 (str->time (time->str 0)))) (assert (= 0 (str->time (time->str (bignum 0))))) (assert (= 0 (str->time (time->str (s32 0))))) (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 (let ((c #\a))