ref: 439510c77f14f7484b937bf247013b8500315d3d
parent: 2140c98e1eaf198b4afb8a22dc68a3a011832ffb
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Jan 30 21:59:11 EST 2025
add more numbers-related tests
--- a/test/number-boundaries.lsp
+++ b/test/number-boundaries.lsp
@@ -57,6 +57,54 @@
(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 (= 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))
+ (begin (assert (= 12345 (,type (double 12345))))
+ (assert (= 12345 (,type (double 12345)))))
+ (begin (assert (= l (,type (double l))))
+ (assert (= h (,type (double h))))))
+ (if (member ,type (list int32 uint32 int64 uint64))
+ (begin (assert (= 12345 (,type (float 12345))))
+ (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)
+
; add/sub unsigned
(assert (= 256 (+ (high-border uint8) 1)))
(assert (= 256 (+ 1 (high-border uint8))))
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -6,10 +6,10 @@
(define (every-int n)
(list (fixnum n) (int8 n) (uint8 n) (int16 n) (uint16 n) (int32 n) (uint32 n)
- (int64 n) (uint64 n) (bignum n)))
+ (int64 n) (uint64 n) (float n) (double n) (bignum n)))
(define (every-sint n)
- (list (fixnum n) (int8 n) (int16 n) (int32 n) (int64 n) (bignum n)))
+ (list (fixnum n) (int8 n) (int16 n) (int32 n) (int64 n) (float n) (double n) (bignum n)))
(define (each f l)
(if (atom? l) ()
@@ -23,7 +23,9 @@
(each^2 (λ (neg pos)
(begin
(eval `(assert (= -1 (compare ,neg ,pos))))
- (eval `(assert (= 1 (compare ,pos ,neg))))))
+ (eval `(assert (= 1 (compare ,pos ,neg))))
+ (eval `(assert (< ,neg ,pos)))
+ (eval `(assert (not (< ,pos ,neg))))))
a
b))
@@ -124,9 +126,14 @@
(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 (/= +nan.0 +nan.0))
(assert (/= +nan.0 -nan.0))
(assert (/= -nan.0 -nan.0))
+(assert (/= (float +nan.0) (float +nan.0)))
+(assert (/= (float +nan.0) (float -nan.0)))
+(assert (/= (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)))
@@ -137,6 +144,8 @@
(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"))
@@ -173,6 +182,15 @@
(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))