shithub: sl

ref: fda389be7556bff1570f891c269df504b2d4850b
dir: /test/number-boundaries.lsp/

View raw version

; NUMBER BOUNDARIES ------------------------------------------------------------
(define-macro (half-max-signed numtype)
  (list 'ash (list numtype 1)
        (list '- (list '* 8 (list 'sizeof (list 'quote numtype))) 2)))

(define-macro (high-border-signed numtype)
  (list '+ (list '- (list 'half-max-signed numtype) 1)
           (list 'half-max-signed numtype)))

(define-macro (low-border-signed numtype)
  (list '- -1 (list 'high-border-signed numtype)))

(define-macro (low-border numtype)
  (list 'if (list '< (list numtype -1) 1)
        (list 'low-border-signed numtype)
        (list numtype 0)))

(define-macro (high-border numtype)
  (list 'lognot (list 'low-border numtype)))
  ;(list numtype (list 'lognot (list 'low-border numtype))))

(define-macro (number-borders numtype)
  (list 'cons (list 'low-border numtype)
              (list 'high-border numtype)))

; TESTS ------------------------------------------------------------------------
(princ "---\n")
(princ "int8 : " (number-borders int8) "\n")
(princ "int16 : " (number-borders int16) "\n")
(princ "int32 : " (number-borders int32) "\n")
(princ "int64 : " (number-borders int64) "\n")
(princ "uint8 : " (number-borders uint8) "\n")
(princ "uint16 : " (number-borders uint16) "\n")
(princ "uint32 : " (number-borders uint32) "\n")
(princ "uint64 : " (number-borders uint64) "\n")
(princ "---\n")

; add/sub signed
(assert (= 128 (+ (high-border int8) 1)))
(assert (= 128 (+ 1 (high-border int8))))
(assert (= -129 (- (low-border int8) 1)))
(assert (= 129 (- 1 (low-border int8))))
(assert (= 32768 (+ (high-border int16) 1)))
(assert (= 32768 (+ 1 (high-border int16))))
(assert (= -32769 (- (low-border int16) 1)))
(assert (= 32769 (- 1 (low-border int16))))
(assert (= 2147483648 (+ (high-border int32) 1)))
(assert (= 2147483648 (+ 1 (high-border int32))))
(assert (= -2147483649 (- (low-border int32) 1)))
(assert (= 2147483649 (- 1 (low-border int32))))
(assert (= 9223372036854775808 (+ (high-border int64) 1)))
(assert (= 9223372036854775808 (+ 1 (high-border int64))))
(assert (= -9223372036854775809 (- (low-border int64) 1)))
(assert (= 9223372036854775809 (- 1 (low-border int64))))
(assert (= 27670116110564327421 (+ 9223372036854775807 9223372036854775807 9223372036854775807)))
(assert (= -12297829382473033728 (+ -3074457345618258432 -3074457345618258432 -3074457345618258432 -3074457345618258432)))
(assert (= 6148914691236516864 (- -3074457345618258432 -3074457345618258432 -3074457345618258432 -3074457345618258432)))

; conversions

(define-macro (int-conv- smaller bigger)
  `(let* ((h (high-border ,smaller))
          (L (low-border ,bigger))
          (l (if (= L 0) 0 (low-border ,smaller))))
     (assert (and (integer? h) (integer? l) (number? h) (number? l)))
     (assert (and (number? (,smaller h)) (number? (,smaller l))))
     (assert (and (integer? (,smaller h)) (integer? (,smaller l))))
     (assert (and (integer? (,bigger h)) (integer? (,bigger l))))
     (assert (and (number? (,bigger h)) (number? (,bigger l))))
     (assert (and (integer-valued? h) (integer-valued? l)))
     (assert (and (integer-valued? (,smaller h)) (integer-valued? (,smaller l))))
     (assert (and (integer-valued? (,bigger h)) (integer-valued? (,bigger l))))
     (assert (= h
                (,smaller h) (,bigger h)
                (,smaller (,bigger h)) (,bigger (,smaller h))))
     (assert (= l
                (,smaller l) (,bigger l)
                (,smaller (,bigger l)) (,bigger (,smaller l))))))

(define-macro (int-conv smaller . biggers)
  `(void ,@(map (λ (bigger) `(int-conv- ,smaller ,bigger)) biggers)))

(int-conv int8 int8 uint8 int16 uint16 int32 uint32 int64 uint64 bignum)
(int-conv int16 int16 uint16 int32 uint32 int64 uint64 bignum)
(int-conv int32 int32 uint32 int64 uint64 bignum)
(int-conv int64 int64 uint64 bignum)

(int-conv uint8 uint8 uint16 int16 uint32 int32 uint64 int64 bignum)
(int-conv uint16 uint16 uint32 int32 uint64 int64 bignum)
(int-conv uint32 uint64 int64 bignum)
(int-conv uint64 bignum)

(int-conv bignum bignum)

(define-macro (float-conv- type)
  `(let ((l (low-border ,type))
         (h (high-border ,type)))
     (if (member ,type (list int64 uint64))
       (assert (= 12345 (,type (double 12345))))
       (begin (assert (= l (,type (double l))))
              (assert (= h (,type (double h))))))
     (if (member ,type (list int32 uint32 int64 uint64))
       (assert (= 12345 (,type (float 12345))))
       (begin
              (assert (= l (,type (float l))))
              (assert (= h (,type (float h))))))))

(define-macro (float-conv . types)
  `(void ,@(map (λ (type) `(float-conv- ,type)) types)))

(float-conv int8 uint8 int16 uint16 int32 uint32 int64 uint64)

(assert (= (low-border int32) (bignum (double (low-border int32)))))
(assert (= (high-border int32) (bignum (double (high-border int32)))))
(assert (= (low-border int16) (bignum (float (low-border int16)))))
(assert (= (high-border int16) (bignum (float (high-border int16)))))

(assert (= (low-border int32) (double (int64 (low-border int32)))))
(assert (= (high-border int32) (double (int64 (high-border int32)))))

(assert (= 0.5f (double (float 0.5))))
(assert (= 0.5 (float (double 0.5f))))

; comparison of different types

(assert (< (uint64 (1- (high-border int64))) (int64 (high-border int64))))
(assert (< (int64 (high-border int64)) (uint64 (1+ (high-border int64)))))
(assert (< (int64 (high-border int64)) (uint64 (1+ (high-border int64)))))
(assert (< (uint64 (1- (high-border int16))) (float (high-border int16))))
(assert (< (float (high-border int16)) (uint64 (1+ (high-border int16)))))
(assert (< (uint64 (1- (high-border int64))) (bignum (high-border int64))))
(assert (> (uint64 (1+ (high-border int64))) (bignum (high-border int64))))
(assert (< (int64 (1- (high-border int64))) (bignum (high-border int64))))
(assert (> (int64 (high-border int64)) (bignum (1- (high-border int64)))))

(assert (< (uint64 0) (int64 1)))
(assert (< (int64 0) (uint64 1)))
(assert (> (uint64 0) (int64 -1)))
(assert (< (int64 -1) (uint64 0)))
(assert (< (uint64 0) (bignum 1)))
(assert (< (int64 0) (bignum 1)))
(assert (> (uint64 0) (bignum -1)))
(assert (> (int64 0) (bignum -1)))
(assert (< (int64 -1) (bignum 0)))
(assert (> (uint64 (+ 10 (high-border int64))) (int64 (low-border int64))))

(assert (= (uint64 1) (int64 1)))
(assert (= (int64 1) (uint64 1)))
(assert (/= (uint64 (high-border uint64)) (int64 -1)))
(assert (/= (int64 -1) (uint64 (high-border uint64))))

; add/sub unsigned
(assert (= 256 (+ (high-border uint8) 1)))
(assert (= 256 (+ 1 (high-border uint8))))
(assert (= -1 (- (low-border uint8) 1)))
(assert (= 1 (- 1 (low-border uint8))))
(assert (= 65536 (+ (high-border uint16) 1)))
(assert (= 65536 (+ 1 (high-border uint16))))
(assert (= -1 (- (low-border uint16) 1)))
(assert (= 1 (- 1 (low-border uint16))))
(assert (= 4294967296 (+ (high-border uint32) 1)))
(assert (= 4294967296 (+ 1 (high-border uint32))))
(assert (= -1 (- (low-border uint32) 1)))
(assert (= 1 (- 1 (low-border uint32))))
(assert (= 18446744073709551616 (+ (high-border uint64) 1)))
(assert (= 18446744073709551616 (+ 1 (high-border uint64))))
(assert (= 36893488147419103230 (+ (high-border uint64) (high-border uint64))))
(assert (= 36893488147419103231 (+ 1 (high-border uint64) (high-border uint64))))
(assert (= 36893488147419103231 (+ (high-border uint64) 1 (high-border uint64))))
(assert (= 36893488147419103231 (+ (high-border uint64) (high-border uint64) 1)))
(assert (= -1 (- (low-border uint64) 1)))
(assert (= 1 (- 1 (low-border uint64))))

; mul signed
(assert (= 18446744073709551614 (* (high-border int64) 2)))
(assert (= -18446744073709551614 (* (high-border int64) -2)))
(assert (= 18446744073709551614 (* 2 (high-border int64))))
(assert (= -18446744073709551616 (* (low-border int64) 2)))
(assert (= -18446744073709551616 (* 2 (low-border int64))))

; mul unsigned
(assert (= 36893488147419103230 (* (high-border uint64) 2)))
(assert (= 36893488147419103230 (* 2 (high-border uint64))))
(assert (= -36893488147419103230 (* (high-border uint64) -2)))
(assert (= -36893488147419103230 (* -2 (high-border uint64))))

(princ "all number boundaries tests pass")
(newline)