1 files changed, 132 insertions, 0 deletions
diff --git a/tests/016/ud-arith.tl b/tests/016/ud-arith.tl
new file mode 100644
index 00000000..d086b9e6
--- /dev/null
+++ b/tests/016/ud-arith.tl
@@ -0,0 +1,132 @@
+(load "../common.tl")
+
+(defstruct numbase nil
+  v
+  (:method + (me arg) ^(+ ,me.v ,arg))
+  (:method - (me arg) ^(- ,me.v ,arg))
+  (:method -- (me arg) ^(- ,arg ,me.v))
+  (:method neg (me) ^(- ,me.v))
+  (:method * (me arg) ^(* ,me.v ,arg))
+  (:method / (me arg) ^(/ ,me.v ,arg))
+  (:method // (me arg) ^(/ ,arg ,me.v))
+  (:method recip (me) ^(/ ,me.v))
+  (:method abs (me) ^(abs ,me.v))
+  (:method signum (me) ^(signum ,me.v))
+  (:method trunc (me arg) ^(trunc ,me.v ,arg))
+  (:method r-trunc (me arg) ^(trunc ,arg ,me.v))
+  (:method trunc1 (me) ^(trunc ,me.v))
+  (:method mod (me arg) ^(mod ,me.v ,arg))
+  (:method r-mod (me arg) ^(mod ,arg ,me.v))
+  (:method expt (me arg) ^(expt ,me.v ,arg))
+  (:method r-expt (me arg) ^(expt ,arg ,me.v))
+  (:method exptmod (me arg1 arg2) ^(exptmod ,me.v ,arg1 ,arg2))
+  (:method isqrt (me) ^(isqrt ,me.v))
+  (:method square (me) ^(square ,me.v))
+  (:method > (me arg) ^(> ,me.v ,arg))
+  (:method < (me arg) ^(< ,me.v ,arg))
+  (:method >= (me arg) ^(>= ,me.v ,arg))
+  (:method <= (me arg) ^(<= ,me.v ,arg))
+  (:method = (me arg) ^(= ,me.v ,arg))
+  (:method zerop (me) ^(zerop ,me.v))
+  (:method plusp (me) ^(plusp ,me.v))
+  (:method minusp (me) ^(minusp ,me.v))
+  (:method evenp (me) ^(evenp ,me.v))
+  (:method oddp (me) ^(oddp ,me.v))
+  (:method floor (me arg) ^(floor ,me.v ,arg))
+  (:method r-floor (me arg) ^(floor ,arg ,me.v))
+  (:method floor1 (me) ^(floor ,me.v))
+  (:method round1 (me) ^(round ,me.v))
+  (:method ceil1 (me) ^(ceil ,me.v))
+  (:method sin (me) ^(sin ,me.v))
+  (:method cos (me) ^(cos ,me.v))
+  (:method tan (me) ^(tan ,me.v))
+  (:method asin (me) ^(asin ,me.v))
+  (:method acos (me) ^(acos ,me.v))
+  (:method atan (me) ^(atan ,me.v))
+  (:method atan2 (me arg) ^(atan2 ,me.v ,arg))
+  (:method r-atan2 (me arg) ^(atan2 ,arg ,me.v))
+  (:method log (me) ^(log ,me.v))
+  (:method log2 (me) ^(log2 ,me.v))
+  (:method log10 (me) ^(log10 ,me.v))
+  (:method exp (me) ^(exp ,me.v))
+  (:method sqrt (me) ^(sqrt ,me.v))
+  (:method logand (me arg) ^(logand ,me.v ,arg))
+  (:method logior (me arg) ^(logior ,me.v ,arg))
+  (:method lognot (me arg) ^(lognot ,me.v ,arg))
+  (:method r-lognot (me arg) ^(lognot ,arg ,me.v))
+  (:method lognot1 (me) ^(lognot ,me.v))
+  (:method logtrunc (me arg) ^(logtrunc ,me.v ,arg))
+  (:method r-logtrunc (me arg) ^(logtrunc ,arg ,me.v))
+  (:method sign-extend (me arg) ^(sign-extend ,me.v ,arg))
+  (: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)))
+
+(defvarl n (new numbase v 1))
+
+(test (+ n 0) (+ 1 0))
+(test (+ 0 n) (+ 1 0))
+(test (- n) (- 1))
+(test (- n 0) (- 1 0))
+(test (- 0 n) (- 0 1))
+(test (* n 0) (* 1 0))
+(test (* 0 n) (* 1 0))
+(test (/ n 0) (/ 1 0))
+(test (/ 0 n) (/ 0 1))
+(test (/ n) (/ 1))
+(test (abs n) (abs 1))
+(test (signum n) (signum 1))
+(test (trunc n 0) (trunc 1 0))
+(test (trunc 0 n) (trunc 0 1))
+(test (trunc n) (trunc 1))
+(test (mod n 0) (mod 1 0))
+(test (mod 0 n) (mod 0 1))
+(test (expt n 0) (expt 1 0))
+(test (expt 0 n) (expt 0 1))
+(test (exptmod n 2 3) (exptmod 1 2 3))
+(test (isqrt n) (isqrt 1))
+(test (square n) (square 1))
+(test (sys:b> n 0) (> 1 0))
+(test (sys:b> 0 n) (< 1 0))
+(test (sys:b< n 0) (< 1 0))
+(test (sys:b< 0 n) (> 1 0))
+(test (sys:b< 0 n) (> 1 0))
+(test (sys:b= n 0) (= 1 0))
+(test (sys:b= 0 n) (= 1 0))
+(test (zerop n) (zerop 1))
+(test (plusp n) (plusp 1))
+(test (minusp n) (minusp 1))
+(test (evenp n) (evenp 1))
+(test (oddp n) (oddp 1))
+(test (floor n 0) (floor 1 0))
+(test (floor 0 n) (floor 0 1))
+(test (floor n) (floor 1))
+(test (round n) (round 1))
+(test (ceil n) (ceil 1))
+(test (sin n) (sin 1))
+(test (cos n) (cos 1))
+(test (tan n) (tan 1))
+(test (asin n) (asin 1))
+(test (acos n) (acos 1))
+(test (atan n) (atan 1))
+(test (atan2 n 0) (atan2 1 0))
+(test (atan2 0 n) (atan2 0 1))
+(test (log n) (log 1))
+(test (log2 n) (log2 1))
+(test (log10 n) (log10 1))
+(test (exp n) (exp 1))
+(test (sqrt n) (sqrt 1))
+(test (logand n 0) (logand 1 0))
+(test (logand 0 n) (logand 1 0))
+(test (logior n 0) (logior 1 0))
+(test (logior 0 n) (logior 1 0))
+(test (lognot n 0) (lognot 1 0))
+(test (lognot 0 n) (lognot 0 1))
+(test (lognot n) (lognot 1))
+(test (logtrunc n 0) (logtrunc 1 0))
+(test (logtrunc 0 n) (logtrunc 0 1))
+(test (sign-extend n 2) (sign-extend 1 2))
+(test (ash n 0) (ash 1 0))
+(test (width n) (width 1))
+(test (logcount n) (logcount 1))