From 35c7cf2bc3e4b58f215315759ab1757f786cbee2 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 15 Nov 2016 05:57:16 -0800
Subject: New arithmetic tests.

* Makefile (TXR_DBG_OPTS): Suppress for new directory
tests/016.

* tests/016/arith.tl: New file.

* tests/016/arith.expected: New file.
---
 Makefile                 |  1 +
 tests/016/arith.expected |  0
 tests/016/arith.tl       | 41 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 42 insertions(+)
 create mode 100644 tests/016/arith.expected
 create mode 100644 tests/016/arith.tl

diff --git a/Makefile b/Makefile
index cec9605d..6ffe34ec 100644
--- a/Makefile
+++ b/Makefile
@@ -318,6 +318,7 @@ tst/tests/012/%: TXR_DBG_OPTS :=
 tst/tests/013/%: TXR_DBG_OPTS :=
 tst/tests/014/%: TXR_DBG_OPTS :=
 tst/tests/015/%: TXR_DBG_OPTS :=
+tst/tests/016/%: TXR_DBG_OPTS :=
 
 .PRECIOUS: tst/%.out
 tst/%.out: %.txr
diff --git a/tests/016/arith.expected b/tests/016/arith.expected
new file mode 100644
index 00000000..e69de29b
diff --git a/tests/016/arith.tl b/tests/016/arith.tl
new file mode 100644
index 00000000..f1f34c4f
--- /dev/null
+++ b/tests/016/arith.tl
@@ -0,0 +1,41 @@
+(load "../common.tl")
+
+(for ((i 0) (j 1))
+     ((< i 512))
+     ((inc i) (inc j j))
+  (let ((k (expt 2 i)))
+    (vtest j k)))
+
+(for ((h 0) (i 1) (j 1) (c 0))
+     ((< c 100))
+     ((inc c)
+      (pset h i
+            i j
+            j (+ i j)))
+  (vtest h (- j i)))
+
+(defvarl p100 '(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79
+                83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163
+                167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251
+                257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349
+                353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443
+                449 457 461 463 467 479 487 491 499 503 509 521 523 541))
+
+(vtest [reduce-left * p100] (lcm . p100))
+
+(for ((prod [reduce-left * p100])
+      (l100 p100))
+     (l100)
+     ((set prod (trunc prod (pop l100))))
+  (vtest prod (lcm . l100)))
+
+(each ((i (range 0 (length p100))))
+  (let* ((a [apply * [p100 0..i]])
+         (b [apply * [p100 i..:]])
+         (c (* a b)))
+    (vtest (trunc c a) b)
+    (vtest (trunc c b) a)
+    (vtest (mod c a) 0)
+    (vtest (mod c b) 0)
+    (vtest (mod (pred c) a) (pred a))
+    (vtest (mod (pred c) b) (pred b))))
-- 
cgit v1.2.3