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/90d8b4b5f6bf1e612f3e7c248... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/90d8b4b5f6bf1e612f3e7c248... You're receiving this email because of your account on gitlab.common-lisp.net.