ref: 4c0aa8a8b86164bbe9ff9c5876fbf158e8481b45
parent: 160e6ca452064fc476f9e087a7a8d007d4e928b8
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sun Feb 2 14:18:52 EST 2025
more operator tests, remove conv_from_double (unused)
--- a/src/operators.c
+++ b/src/operators.c
@@ -45,28 +45,6 @@
return 0;
}
-void
-conv_from_double(void *dest, double d, numerictype_t tag)
-{- switch(tag){- case T_INT8: *(int8_t*)dest = d; break;
- case T_UINT8: *(uint8_t*)dest = d; break;
- case T_INT16: *(int16_t*)dest = d; break;
- case T_UINT16: *(uint16_t*)dest = d; break;
- case T_INT32: *(int32_t*)dest = d; break;
- case T_UINT32: *(uint32_t*)dest = d; break;
- case T_INT64:
- *(int64_t*)dest = d;
- if(d > 0 && *(int64_t*)dest < 0) // 0x8000000000000000 is a bitch
- *(int64_t*)dest = INT64_MAX;
- break;
- case T_UINT64: *(uint64_t*)dest = d; break;
- case T_MPINT: *(mpint**)dest = dtomp(d, nil); break;
- case T_FLOAT: *(float*)dest = d; break;
- case T_DOUBLE: *(double*)dest = d; break;
- }
-}
-
// FIXME sign with mpint
#define CONV_TO_INTTYPE(name, ctype) \
fl_purefn \
@@ -188,22 +166,16 @@
cmpmpint = mpnew(0);
if(atag == T_UINT64){- if(btag == T_INT64){- if(*(int64_t*)b >= 0)
- return *(uint64_t*)a < (uint64_t)*(int64_t*)b;
- return (int64_t)*(uint64_t*)a < *(int64_t*)b;
- }
+ if(btag == T_INT64)
+ return *(int64_t*)b >= 0 && *(uint64_t*)a < (uint64_t)*(int64_t*)b;
if(btag == T_DOUBLE)
- return db == db ? *(uint64_t*)a < (uint64_t)*(double*)b : 0;
+ return db >= 0 ? *(uint64_t*)a < (uint64_t)*(double*)b : 0;
if(btag == T_MPINT)
return mpcmp(uvtomp(*(uint64_t*)a, cmpmpint), *(mpint**)b) < 0;
}
if(atag == T_INT64){- if(btag == T_UINT64){- if(*(int64_t*)a >= 0)
- return (uint64_t)*(int64_t*)a < *(uint64_t*)b;
- return *(int64_t*)a < (int64_t)*(uint64_t*)b;
- }
+ if(btag == T_UINT64)
+ return *(int64_t*)a >= 0 && (uint64_t)*(int64_t*)a < *(uint64_t*)b;
if(btag == T_DOUBLE)
return db == db ? *(int64_t*)a < (int64_t)*(double*)b : 0;
if(btag == T_MPINT)
@@ -211,7 +183,7 @@
}
if(btag == T_UINT64){if(atag == T_DOUBLE)
- return da == da ? *(uint64_t*)b > (uint64_t)*(double*)a : 0;
+ return da >= 0 ? *(uint64_t*)b > (uint64_t)*(double*)a : 0;
if(atag == T_MPINT)
return mpcmp(*(mpint**)a, uvtomp(*(uint64_t*)b, cmpmpint)) < 0;
}
--- a/src/operators.h
+++ b/src/operators.h
@@ -2,7 +2,6 @@
mpint * conv_to_mpint(void *data, numerictype_t tag);
double conv_to_double(void *data, numerictype_t tag);
-void conv_from_double(void *dest, double d, numerictype_t tag);
int cmp_same_lt(void *a, void *b, numerictype_t tag);
int cmp_same_eq(void *a, void *b, numerictype_t tag);
--- a/test/number-boundaries.lsp
+++ b/test/number-boundaries.lsp
@@ -89,13 +89,11 @@
`(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)))))
+ (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)))))
+ (assert (= 12345 (,type (float 12345))))
(begin
(assert (= l (,type (float l))))
(assert (= h (,type (float h))))))))
@@ -104,6 +102,50 @@
`(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 (= (low-border int64) (double (int64 (low-border int64)))))
+(assert (= (high-border int64) (double (int64 (high-border int64)))))
+
+(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))) (double (high-border int64))))
+(assert (> (uint64 (+ (high-border int64) 3)) (double (high-border int64))))
+(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)))