summaryrefslogtreecommitdiffstats
path: root/tests/016
diff options
context:
space:
mode:
Diffstat (limited to 'tests/016')
-rw-r--r--tests/016/arith.expected0
-rw-r--r--tests/016/arith.tl341
-rw-r--r--tests/016/conv.tl50
-rw-r--r--tests/016/ud-arith.expected0
-rw-r--r--tests/016/ud-arith.tl96
5 files changed, 486 insertions, 1 deletions
diff --git a/tests/016/arith.expected b/tests/016/arith.expected
deleted file mode 100644
index e69de29b..00000000
--- a/tests/016/arith.expected
+++ /dev/null
diff --git a/tests/016/arith.tl b/tests/016/arith.tl
index 6a99b24a..d67b9908 100644
--- a/tests/016/arith.tl
+++ b/tests/016/arith.tl
@@ -71,3 +71,344 @@
(test [apply bracket '(15 10 20 30)] 1)
(test [apply bracket '(25 10 20 30)] 2)
(test [apply bracket '(30 10 20 30)] 3)
+
+(test (typeof fixnum-max) fixnum)
+(test (typeof (succ fixnum-max)) bignum)
+(test (typeof fixnum-min) fixnum)
+(test (typeof (pred fixnum-min)) bignum)
+
+(test (< fixnum-min fixnum-max) t)
+(test (< (pred fixnum-min) fixnum-min) t)
+(test (> (succ fixnum-max) fixnum-max) t)
+
+(test (ffi-put #xA5 (ffi le-int16))
+ #b'A500')
+(test (ffi-put #xA5 (ffi be-int16))
+ #b'00A5')
+(test (mequal (ffi-put #xA5 (ffi int16))
+ #b'A500'
+ #b'00A5') t)
+
+(test (ffi-put #xAABBCC (ffi le-int32))
+ #b'CCBBAA00')
+(test (ffi-put #xAABBCC (ffi be-int32))
+ #b'00AABBCC')
+(test (mequal (ffi-put #xAABBCC (ffi int32))
+ #b'CCBBAA00'
+ #b'00AABBCC') t)
+
+(test (ffi-put #xAABBCCDDEE (ffi le-int64))
+ #b'EEDDCCBBAA000000')
+(test (ffi-put #xAABBCCDDEE (ffi be-int64))
+ #b'000000AABBCCDDEE')
+(test (mequal (ffi-put #xAABBCCDDEE (ffi int64))
+ #b'EEDDCCBBAA000000'
+ #b'000000AABBCCDDEE') t)
+
+(test (ffi-get #b'A500' (ffi le-int16))
+ #xA5)
+(test (ffi-get #b'00A5' (ffi be-int16))
+ #xA5)
+
+
+(test (ffi-get #b'CCBBAA00' (ffi le-int32))
+ #xAABBCC)
+(test (ffi-get #b'00AABBCC' (ffi be-int32))
+ #xAABBCC)
+
+
+(test (ffi-get #b'EEDDCCBBAA000000' (ffi le-int64))
+ #xAABBCCDDEE)
+(test (ffi-get #b'000000AABBCCDDEE' (ffi be-int64))
+ #xAABBCCDDEE)
+
+(test (mequal (ffi-put #x-8000 (ffi int16))
+ #b'0080'
+ #b'8000') t)
+
+(test (ffi-get (ffi-put #x-8000 (ffi int16)) (ffi int16))
+ #x-8000)
+
+(test (mequal (ffi-put #x-80000000 (ffi int32))
+ #b'00000080'
+ #b'80000000') t)
+
+(test (ffi-get (ffi-put #x-80000000 (ffi int32)) (ffi int32))
+ #x-80000000)
+
+(test (mequal (ffi-put #x-8000000000000000 (ffi int64))
+ #b'0000000000000080'
+ #b'8000000000000000') t)
+
+(test (ffi-get (ffi-put #x-8000000000000000 (ffi int64)) (ffi int64))
+ #x-8000000000000000)
+
+(mtest
+ (sum #()) 0
+ (sum #(1)) 1
+ (sum #(1 2)) 3
+ (sum #(1 2 3)) 6
+ (sum #() (op * 10)) 0
+ (sum #(1) (op * 10)) 10
+ (sum #(1 2) (op * 10)) 30
+ (sum #(1 2 3) (op * 10)) 60
+ (sum 1..10) 45
+ (sum 2..10) 44)
+
+(mtest
+ (prod #()) 1
+ (prod #(1)) 1
+ (prod #(1 2)) 2
+ (prod #(1 2 3)) 6
+ (prod #() (op * 10)) 1
+ (prod #(1) (op * 10)) 10
+ (prod #(1 2) (op * 10)) 200
+ (prod #(1 2 3) (op * 10)) 6000
+ (prod 2..8) 5040
+ (prod 3..8) 2520)
+
+(mtest
+ (< 1 2) t
+ (< 2 1) nil
+ (< 1.0 2) t
+ (< 2 1.0) nil
+ (< #\c #\d) t
+ (< #\d #\c) nil
+ (< 1.0 1) nil
+ (< #R(0 0) #R(0 0)) nil
+ (< #R(0 0) #R(0 1)) t
+ (< #R(0 0) #R(1 0)) t
+ (< #R(0 0) #R(1 1)) t
+ (< #R(1 0) #R(1 0)) nil
+ (< #R(1 0) #R(1 1)) t
+ (< 1 #R(1 0)) :error
+ (< #R(1 0) 1) :error
+ (< 1.0 #R(1 0)) :error
+ (< #R(1 0) 1.0) :error
+ (< #\c #R(1 0)) :error
+ (< #R(1 0) #\c) :error
+ (< 1 "abc") :error
+ (< "abc" 1) :error
+ (< 1 nil) :error
+ (< nil 1) :error
+ (< 1 '(1 2 3)) :error
+ (< '(1 2 3) 1) :error
+ (< 1 #(1 2 3)) :error
+ (< #(1 2 3) 1) :error)
+
+(mtest
+ (< #\A 66 67.0) t
+ (> 67.0 66 #\A) t
+ (>= #\A 65.0 65) t)
+
+(mtest
+ (< "abc" "abc") nil
+ (<= "abc" "abc") t
+ (< "abc" "abcd") t
+ (< "abc" "abd") t
+ (< #(1 2 3) #(1 2 3)) nil
+ (< #(1 2 3) #(1 2 3.0)) nil
+ (< #(1 2 3) #(1 2 3 4)) t
+ (< #(1 2 3) #(1 2 4)) t
+ (< #(1 2 3) '(1 2 3)) nil
+ (< #(1 2 3) '(1 2 3.0)) nil
+ (< #(1 2 3) '(1 2 3 4)) t
+ (< #(1 2 3) '(1 2 4)) t
+ (< '(1 2 3) '(1 2 3)) nil
+ (< '(1 2 3) '(1 2 3.0)) nil
+ (< '(1 2 3) '(1 2 3 4)) t
+ (< '(1 2 3) '(1 2 4)) t
+ (< '(1 2 3) #(1 2 3)) nil
+ (< '(1 2 3) #(1 2 3.0)) nil
+ (< '(1 2 3) #(1 2 3 4)) t
+ (< '(1 2 3) #(1 2 4)) t)
+
+(let ((*print-flo-precision* 14))
+ (sstest
+ (let ((q (quantile 0.5)))
+ [q 0.02 0.5 0.74 3.39 0.83]
+ [mapcar q '(22.37 10.15 15.43 38.62 15.92
+ 34.60 10.28 1.47 0.40 0.05 11.39
+ 0.27 0.42 0.09 11.37)])
+ (0.74 0.74 2.0616666666667 4.5517592592593 4.5517592592593 9.1519618055556
+ 9.1519618055556 9.1519618055556 9.1519618055556 6.1797614914021
+ 6.1797614914021 6.1797614914021 6.1797614914021 4.2462394088036
+ 4.2462394088036)))
+
+(test
+ (let ((q (quantile 0)))
+ (cons [q] [mapcar q '(1 2 3 4 5)]))
+ (0.0 1.0 1.5 2.0 2.5 3.0))
+
+(test
+ (let ((q (quantile 0 5 0.5)))
+ [mapcar q '(1.0 2.0 3.0 4.0 5.0
+ 0.0 0.0 0.0 0.0 0.0)])
+ (1.0 1.5 2.0 2.5 3.0
+ 1.5 0.75 0.375 0.1875 0.09375))
+
+(test
+ (let ((q (quantile 0 5 0.5)))
+ [mapcar q '(0.0 0.0 0.0 0.0 0.0
+ 3.0 3.0 3.0 3.0 3.0)])
+ (0.0 0.0 0.0 0.0 0.0
+ 1.5 2.25 2.625 2.8125 2.90625))
+
+(mtest
+ (sum-each ())
+ 0
+ (sum-each ((x nil)))
+ 0
+ (sum-each ((x '(1 2 3))
+ (y '(4 5 6)))
+ (* x y))
+ 32
+ (mul-each ())
+ 1
+ (mul-each ((x nil)))
+ 1
+ (mul-each ((x '(1 2 3))
+ (y '(4 5 6)))
+ (+ x y))
+ 315
+ (sum-each* ((x '(1 2 3))
+ (y (cdr x)))
+ (* x y))
+ 8
+ (mul-each* ((x '(1 2 3))
+ (y (cdr x)))
+ (+ x y))
+ 15
+ (sum-each ((x '(1 2 3))
+ (y (cdr x)))
+ (* x y))
+ :error
+ (mul-each ((x '(1 2 3))
+ (y (cdr x)))
+ (+ x y))
+ :error)
+
+(mtest
+ (sum-each-prod ())
+ 0
+ (sum-each-prod ((x nil)))
+ 0
+ (sum-each-prod ((x '(4))) x)
+ 4
+ (sum-each-prod ((x '(1 2 3))
+ (y '(4 3 2)))
+ (* x y))
+ 54
+ (sum-each-prod* ((x '(1 2 3 4))
+ (y (cdr x)))
+ (* x y))
+ 90
+ (sum-each-prod ((x '(1 2 3 4))
+ (y (cdr x)))
+ (* x y))
+ :error)
+
+(mvtest
+ (mul-each-prod ())
+ 1
+ (mul-each-prod ((x nil)))
+ 1
+ (mul-each-prod ((x '(4))) x)
+ 4
+ (mul-each-prod ((x '(1 2 3))
+ (y '(4 3 2)))
+ (+ x y))
+ (* (+ 1 4) (+ 1 3) (+ 1 2)
+ (+ 2 4) (+ 2 3) (+ 2 2)
+ (+ 3 4) (+ 3 3) (+ 3 2))
+ (mul-each-prod* ((x '(1 2 3))
+ (y (cdr x)))
+ (+ x y))
+ (* (+ 1 2) (+ 1 3)
+ (+ 2 2) (+ 2 3)
+ (+ 3 2) (+ 3 3))
+ (sum-each-prod ((x '(1 2 3))
+ (y (cdr x)))
+ (* x y))
+ :error)
+
+(mtest
+ (each-true ()) t
+ (each-true ((a ()))) t
+ (each-true ((a ())) nil) t
+ (each-true ((a '(1 2 3))) a) 3
+ (each-true ((a '(nil 2 3))) a) nil
+ (each-true ((a '(1 2 3)) (b '(4 5 6))) (< a b)) t
+ (each-true ((a '(1 2 3)) (b '(4 0 6))) (< a b)) nil)
+
+(mtest
+ (some-true ()) nil
+ (some-true ((a ()))) nil
+ (some-true ((a ())) nil) nil
+ (some-true ((a '(1 2 3))) a) 1
+ (some-true ((a '(nil 2 3))) a) 2
+ (some-true ((a '(nil nil nil))) a) nil
+ (some-true ((a '(1 2 3)) (b '(4 5 6))) (< a b)) t
+ (some-true ((a '(1 2 3)) (b '(4 0 6))) (< a b)) t
+ (some-true ((a '(1 2 3)) (b '(0 1 2))) (< a b)) nil)
+
+(mtest
+ (each-false ()) t
+ (each-false ((a ()))) t
+ (each-false ((a ())) t) t
+ (each-false ((a '(1 2 3))) a) nil
+ (each-false ((a '(nil))) a) t
+ (each-false ((a '(nil nil))) a) t
+ (each-false ((a '(1 2 3)) (b '(4 5 6))) (> a b)) t
+ (each-false ((a '(1 2 3)) (b '(4 0 6))) (> a b)) nil)
+
+(mtest
+ (some-false ()) nil
+ (some-false ((a ()))) nil
+ (some-false ((a ())) nil) nil
+ (some-false ((a '(1 2 3))) a) nil
+ (some-false ((a '(nil 2 3))) a) t
+ (some-false ((a '(nil nil nil))) a) t
+ (some-false ((a '(1 2 3)) (b '(4 5 6))) (> a b)) t
+ (some-false ((a '(1 2 3)) (b '(4 0 6))) (> a b)) t
+ (some-false ((a '(1 2 3)) (b '(0 1 2))) (> a b)) nil)
+
+
+(mvtest
+ (gcd 0 0) 0
+ (gcd 0 1) 1
+ (gcd 1 0) 1
+ (gcd 100 0) 100
+ (gcd 0 100) 100
+ (gcd 0 (expt 10 60)) (expt 10 60)
+ (gcd (expt 10 60) 0) (expt 10 60))
+
+(defun power-set (s)
+ (mappend* (op comb s) (range 0 (len s))))
+
+(defun gcd-grind (primes)
+ (each-prod ((lp (cdr (power-set primes)))
+ (rp (cdr (power-set primes))))
+ (let ((ip (isec lp rp)))
+ (vtest (gcd (* . lp) (* . rp)) (* . ip)))))
+
+(each ((x 0..64)
+ (y 0..64))
+ (vtest (gcd (ash 1 x) (ash 1 y)) (ash 1 (min x y)))
+ (vtest (gcd (ash 3 x) (ash 5 y)) (ash 1 (min x y)))
+ (vtest (gcd (ash 6 x) (ash 15 y)) (ash 3 (min x y))))
+
+(gcd-grind '(2 3 5 7 11 13 17 19 23))
+
+(gcd-grind '(2 3 5 4294967291 4294967311 4294967357 4294967371))
+
+(test
+ (build (each-prod* ((i '(b c)) (j (cons 'a i))) (add (list i j))))
+ ((b a) (b b) (b c) (c a) (c b) (c c)))
+
+(mtest
+ (arithp #\a) t
+ (arithp 42) t
+ (arithp 3.14) t
+ (arithp (expt 2 200)) t
+ (arithp #R(nil nil)) t)
diff --git a/tests/016/conv.tl b/tests/016/conv.tl
new file mode 100644
index 00000000..34f5b7c7
--- /dev/null
+++ b/tests/016/conv.tl
@@ -0,0 +1,50 @@
+(load "../common.tl")
+
+(each ((b 2..36))
+ (mtest
+ (int-str "" b) nil
+ (int-str "$" b) nil
+ (int-str "-" b) nil
+ (int-str "+" b) nil
+ (int-str "0" b) 0
+ (int-str "00" b) 0
+ (int-str "0x" b) 0
+ (int-str "0x3" b) 0
+ (int-str "0xz" b) 0))
+
+(mtest
+ (int-str "+123") 123
+ (int-str "-123") -123
+ (int-str "0123") 123
+ (int-str "00123") 123
+ (int-str "999999999999999999999999999999") 999999999999999999999999999999
+ (int-str "+999999999999999999999999999999") 999999999999999999999999999999
+ (int-str "-999999999999999999999999999999") -999999999999999999999999999999)
+
+(let ((c #\c))
+ (mtest
+ (int-str "+123" c) 123
+ (int-str "-123" c) -123
+ (int-str "0123" c) 83
+ (int-str "00123" c) 83
+ (int-str "0x123" c) 291
+ (int-str "-0x123" c) -291
+ (int-str "+0xFFFFFFFFFFFFFFFFFFFF" c) #xFFFFFFFFFFFFFFFFFFFF
+ (int-str "-0xFFFFFFFFFFFFFFFFFFFF" c) #x-FFFFFFFFFFFFFFFFFFFF))
+
+(mtest
+ (int-str "zZz" 35) nil
+ (int-str "zZz" 36) 46655
+ (int-str "-zZz" 36) -46655
+ (int-str "+zZz" 36) 46655
+ (int-str "+0zZz" 36) 46655
+ (int-str "-0zZz" 36) -46655
+ (int-str "0zZz" 36) 46655
+ (int-str "1" 36) 1
+ (int-str "10" 36) 36
+ (int-str "100" 36) 1296
+ (int-str "zzzzzzzzzzzzzzzzzzzzzzzz" 36) 22452257707354557240087211123792674815
+ (int-str "-zzzzzzzzzzzzzzzzzzzzzzzz" 36) -22452257707354557240087211123792674815
+ (int-str "0zzzzzzzzzzzzzzzzzzzzzzzz" 36) 22452257707354557240087211123792674815
+ (int-str "-0zzzzzzzzzzzzzzzzzzzzzzzz" 36) -22452257707354557240087211123792674815
+ (int-str "+0zzzzzzzzzzzzzzzzzzzzzzzz" 36) 22452257707354557240087211123792674815)
diff --git a/tests/016/ud-arith.expected b/tests/016/ud-arith.expected
deleted file mode 100644
index e69de29b..00000000
--- a/tests/016/ud-arith.expected
+++ /dev/null
diff --git a/tests/016/ud-arith.tl b/tests/016/ud-arith.tl
index 052fcaed..8a8e50df 100644
--- a/tests/016/ud-arith.tl
+++ b/tests/016/ud-arith.tl
@@ -65,7 +65,53 @@
(:method ash (me arg) ^(ash ,me.v ,arg))
(:method bit (me arg) ^(bit ,me.v ,arg))
(:method width (me) ^(width ,me.v))
- (:method logcount (me) ^(logcount ,me.v)))
+ (:method logcount (me) ^(logcount ,me.v))
+ (:method cbrt (me) ^(cbrt ,me.v))
+ (:method erf (me) ^(erf ,me.v))
+ (:method erfc (me) ^(erfc ,me.v))
+ (:method exp10 (me) ^(exp10 ,me.v))
+ (:method exp2 (me) ^(exp2 ,me.v))
+ (:method expm1 (me) ^(expm1 ,me.v))
+ (:method gamma (me) ^(gamma ,me.v))
+ (:method j0 (me) ^(j0 ,me.v))
+ (:method j1 (me) ^(j1 ,me.v))
+ (:method lgamma (me) ^(lgamma ,me.v))
+ (:method log1p (me) ^(log1p ,me.v))
+ (:method logb (me) ^(logb ,me.v))
+ (:method nearbyint (me) ^(nearbyint ,me.v))
+ (:method rint (me) ^(rint ,me.v))
+ (:method significand (me) ^(significand ,me.v))
+ (:method tgamma (me) ^(tgamma ,me.v))
+ (:method y0 (me) ^(y0 ,me.v))
+ (:method y1 (me) ^(y1 ,me.v))
+ (:method copysign (me arg) ^(copysign ,me.v ,arg))
+ (:method drem (me arg) ^(drem ,me.v ,arg))
+ (:method fdim (me arg) ^(fdim ,me.v ,arg))
+ (:method fmax (me arg) ^(fmax ,me.v ,arg))
+ (:method fmin (me arg) ^(fmin ,me.v ,arg))
+ (:method hypot (me arg) ^(hypot ,me.v ,arg))
+ (:method jn (me arg) ^(jn ,me.v ,arg))
+ (:method ldexp (me arg) ^(ldexp ,me.v ,arg))
+ (:method nextafter (me arg) ^(nextafter ,me.v ,arg))
+ (:method remainder (me arg) ^(remainder ,me.v ,arg))
+ (:method scalb (me arg) ^(scalb ,me.v ,arg))
+ (:method scalbln (me arg) ^(scalbln ,me.v ,arg))
+ (:method yn (me arg) ^(yn ,me.v ,arg))
+ (:method r-copysign (me arg) ^(copysign ,arg ,me.v))
+ (:method r-drem (me arg) ^(drem ,arg ,me.v))
+ (:method r-fdim (me arg) ^(fdim ,arg ,me.v))
+ (:method r-fmax (me arg) ^(fmax ,arg ,me.v))
+ (:method r-fmin (me arg) ^(fmin ,arg ,me.v))
+ (:method r-hypot (me arg) ^(hypot ,arg ,me.v))
+ (:method r-jn (me arg) ^(jn ,arg ,me.v))
+ (:method r-ldexp (me arg) ^(ldexp ,arg ,me.v))
+ (:method r-nextafter (me arg) ^(nextafter ,arg ,me.v))
+ (:method r-remainder (me arg) ^(remainder ,arg ,me.v))
+ (:method r-scalb (me arg) ^(scalb ,arg ,me.v))
+ (:method r-scalbln (me arg) ^(scalbln ,arg ,me.v))
+ (:method r-yn (me arg) ^(yn ,arg ,me.v))
+ (:method tofloat (me) ^(tofloat ,me.v))
+ (:method toint (me) ^(toint ,me.v)))
(defvarl n (new numbase v 1))
@@ -138,3 +184,51 @@
(test (ash n 0) (ash 1 0))
(test (width n) (width 1))
(test (logcount n) (logcount 1))
+(test (cbrt n) (cbrt 1))
+(test (erf n) (erf 1))
+(test (erfc n) (erfc 1))
+(test (exp10 n) (exp10 1))
+(test (exp2 n) (exp2 1))
+(test (expm1 n) (expm1 1))
+(test (gamma n) (gamma 1))
+(test (j0 n) (j0 1))
+(test (j1 n) (j1 1))
+(test (lgamma n) (lgamma 1))
+(test (log1p n) (log1p 1))
+(test (logb n) (logb 1))
+(test (nearbyint n) (nearbyint 1))
+(test (rint n) (rint 1))
+(test (significand n) (significand 1))
+(test (tgamma n) (tgamma 1))
+(test (y0 n) (y0 1))
+(test (y1 n) (y1 1))
+(test (copysign n 0) (copysign 1 0))
+(test (drem n 0) (drem 1 0))
+(test (fdim n 0) (fdim 1 0))
+(test (fmax n 0) (fmax 1 0))
+(test (fmin n 0) (fmin 1 0))
+(test (hypot n 0) (hypot 1 0))
+(test (jn n 0) (jn 1 0))
+(test (ldexp n 0) (ldexp 1 0))
+(test (nextafter n 0) (nextafter 1 0))
+(test (remainder n 0) (remainder 1 0))
+(test (scalb n 0) (scalb 1 0))
+(test (scalbln n 0) (scalbln 1 0))
+(test (yn n 0) (yn 1 0))
+(test (copysign 0 n) (copysign 0 1))
+(test (drem 0 n) (drem 0 1))
+(test (fdim 0 n) (fdim 0 1))
+(test (fmax 0 n) (fmax 0 1))
+(test (fmin 0 n) (fmin 0 1))
+(test (hypot 0 n) (hypot 0 1))
+(test (jn 0 n) (jn 0 1))
+(test (ldexp 0 n) (ldexp 0 1))
+(test (nextafter 0 n) (nextafter 0 1))
+(test (remainder 0 n) (remainder 0 1))
+(test (scalb 0 n) (scalb 0 1))
+(test (scalbln 0 n) (scalbln 0 1))
+(test (yn 0 n) (yn 0 1))
+(test (tofloat n) (tofloat 1))
+(test (toint n) (toint 1))
+
+(test (arithp n) t)
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-19 02:57:51 +0000