[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] 2 commits: Add simple test

[Raymond Toy]

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl


Commits:
e6b95b82 by Raymond Toy at 2018-07-04T12:21:25-07:00
Add simple test

- - - - -
3af22f92 by Raymond Toy at 2018-07-04T12:40:30-07:00
Add some timing code, but not for tests.

- - - - -


1 changed file:

- + tests/bignum.lisp


Changes:

=====================================
tests/bignum.lisp
=====================================
--- /dev/null
+++ b/tests/bignum.lisp
@@ -0,0 +1,56 @@
+;;; Tests for the bignum operations
+
+(defpackage :bignum-tests
+  (:use :cl :lisp-unit))
+
+(in-package #:bignum-tests)
+
+(define-test hd-mult
+  "Test bignum multiplier"
+  (:tag :bignum-tests)
+  (let ((rng (kernel::make-random-object :state (kernel:init-random-state)
+					 :rand 0
+					 :cached-p nil))
+	(range (ash 1 128)))
+    (flet ((gen-bignum (x sign)
+	     (do ((r (random x rng) (random x rng)))
+		 ((typep r 'bignum)
+		  (if (zerop sign)
+		      r
+		      (- r))))))
+      (dotimes (k 100)
+	(let* ((r1 (gen-bignum range (random 2 rng)))
+	       (r2 (gen-bignum range (random 2 rng)))
+	       (prod-knuth (bignum::classical-multiply-bignums r1 r2))
+	       (prod-hd (bignum::classical-multiply-bignum-hd r1 r2)))
+	  (assert-equal prod-knuth prod-hd r1 r2))))))
+
+
+;; Just for simple timing tests so we can redo the timing tests if needed.
+#+nil
+(define-test hd-timing
+  "Test execution time"
+  (:tag :bignum-tests)
+  (let ((rng (kernel::make-random-object :state
+					 (kernel:init-random-state)
+					 :rand 0 :cached-p nil))
+	(range (ash 1 128))
+	(reps 10000))
+    (flet ((gen-bignum (x sign)
+	     (do ((r (random x rng) (random x rng)))
+		 ((typep r 'bignum)
+		  (if (zerop sign)
+		      r (- r))))))
+      (let* ((r1 (gen-bignum range 1))
+	     (r2 (gen-bignum range 1)) res)
+	(time
+	 (dotimes (k reps)
+	   (declare (fixnum k)) (setf res
+				      (bignum::classical-multiply-bignums r1 r2))))
+	(print res)
+	(time
+	 (dotimes (k reps)
+	   (declare (fixnum k)) (setf res
+				      (bignum::classical-multiply-bignum-hd r1 r2))))
+	(print res)))))
+



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/90d8b4b5f6bf1e612f3e7c248696cb8d8ebc9a08...3af22f92b9c842ba7e88414ea8fa528e30c2260a

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/90d8b4b5f6bf1e612f3e7c248696cb8d8ebc9a08...3af22f92b9c842ba7e88414ea8fa528e30c2260a
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20180704/6d6344ef/attachment-0001.html>