shithub: femtolisp

ref: 6e515a532e6cf52317d6cc3d26a30c4d73085395
dir: /femtolisp/unittest.lsp/

(define (every-int n)
  (list (fixnum n) (int8 n) (uint8 n) (int16 n) (uint16 n) (int32 n) (uint32 n)
        (int64 n) (uint64 n)))

(define (every-sint n)
  (list (fixnum n) (int8 n) (int16 n) (int32 n) (int64 n)))

(define (each f l)
  (if (atom l) ()
    (progn (f (car l))
           (each f (cdr l)))))

(define (each^2 f l m)
  (each (lambda (o) (each (lambda (p) (f o p)) m)) l))

(define (test-lt a b)
  (each^2 (lambda (neg pos)
            (progn
              (eval `(assert (= -1 (compare ,neg ,pos))))
              (eval `(assert (=  1 (compare ,pos ,neg))))))
          a
          b))

(define (test-eq a b)
  (each^2 (lambda (a b)
            (progn
              (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))

(define (test-square a)
  (each (lambda (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))
(assert (= (/ 2.0) 0.5))

; tricky cases involving INT_MIN
(assert (< (- #uint32(0x80000000)) 0))
(assert (> (- #int32(0x80000000)) 0))
(assert (< (- #uint64(0x8000000000000000)) 0))
(assert (> (- #int64(0x8000000000000000)) 0))

(assert (not (equal #int64(0x8000000000000000) #uint64(0x8000000000000000))))
(assert (equal (+ #int64(0x4000000000000000) #int64(0x4000000000000000))
               #uint64(0x8000000000000000)))
(assert (equal (* 2 #int64(0x4000000000000000))
               #uint64(0x8000000000000000)))

(assert (equal (string 'sym #char(65) #wchar(945) "blah") "symA\u03B1blah"))


; ok, a couple end-to-end tests as well
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
(assert (equal (fib 20) 6765))

(load "color.lsp")
(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))))

(princ "all tests pass\n")
T