diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp index 805dc542f3eeaf43b2e76a08568b9eb3ebb22d21..d85f8fd7691b8f82b1cfaf4868a03dd17557da9d 100644 --- a/ansi-tests/load-numbers.lsp +++ b/ansi-tests/load-numbers.lsp @@ -21,4 +21,8 @@ (load "round.lsp") (load "fround.lsp") +;;; trancdental functions go here + +(load "times.lsp") + (load "epsilons.lsp") diff --git a/ansi-tests/numbers-aux.lsp b/ansi-tests/numbers-aux.lsp index 49aa9b9ce78a6936445cbc6565c5b50959a964ea..6af32d8aec0339b4b3dbf0912e034f30cc39f42c 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -206,5 +206,19 @@ (long-float long-float-negative-epsilon) (rational 0))) - - +;;; Compute the number of digits that can be added to 1.0 in the appropriate +;;; float type, a rational representation of the smallest radix^(-k) s.t. +;;; 1.0 + radix^(-k) /= 1.0, and the float representation of that value. +;;; Note that this will in general be > <float-type>-epsilon. + +(defun find-epsilon (x) + (assert (floatp x)) + (let* ((one (float 1 x)) + (radix (float-radix one)) + (eps (/ 1 radix))) + (loop + for next-eps = (/ eps radix) + for i from 1 + until (eql one (+ one next-eps)) + do (setq eps next-eps) + finally (return (values i eps (float eps one)))))) diff --git a/ansi-tests/times-aux.lsp b/ansi-tests/times-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..2839d7f6bc23e15a43cc7d478b4fd1ea6f6ae521 --- /dev/null +++ b/ansi-tests/times-aux.lsp @@ -0,0 +1,27 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Aug 28 11:23:40 2003 +;;;; Contains: Auxiliary functions for testing the multiplication operator * + +(in-package :cl-test) + +(defun integer-times (x y) + (assert (integerp x)) + (assert (integerp y)) + (let (neg) + (when (< x 0) + (setq neg t x (- x))) + (let ((result (nat-times x y))) + (if neg (- result) result)))) + +(defun nat-times (x y) + ;; Assumes x >= 0 + (if (= x 0) + 0 + (let ((lo (if (oddp x) y 0)) + (hi (nat-times (ash x -1) y))) + (+ lo (+ hi hi))))) + +(defun rat-times (x y) + (/ (integer-times (numerator x) (numerator y)) + (integer-times (denominator x) (denominator y)))) diff --git a/ansi-tests/times.lsp b/ansi-tests/times.lsp new file mode 100644 index 0000000000000000000000000000000000000000..bc716b1fc618a19e466abd85b32057d2f2a03a7c --- /dev/null +++ b/ansi-tests/times.lsp @@ -0,0 +1,315 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Aug 28 10:41:34 2003 +;;;; Contains: Tests of the multiplication function * + +(in-package :cl-test) + +(compile-and-load "numbers-aux.lsp") +(compile-and-load "times-aux.lsp") + +(deftest *.1 + (*) + 1) + +(deftest *.2 + (loop for x in *numbers* + unless (eql x (* x)) + collect x) + nil) + +(deftest *.3 + (loop for x in *numbers* + for x1 = (* x 1) + for x2 = (* 1 x) + unless (and (eql x x1) (eql x x2) (eql x1 x2)) + collect (list x x1 x2)) + nil) + +(deftest *.4 + (loop for x in *numbers* + for x1 = (* x 0) + for x2 = (* 0 x) + unless (and (= x1 0) (= x2 0)) + collect (list x x1 x2)) + nil) + +(deftest *.5 + (loop for bound in '(1.0s0 1.0f0 1.0d0 1.0l0) + nconc + (loop for x = (random bound) + for x1 = (* x -1) + for x2 = (* -1 x) + for x3 = (* x bound) + for x4 = (* bound x) + repeat 1000 + unless (and (eql (- x) x1) (eql (- x) x2) + (eql x x3) (eql x x4)) + collect (list x x1 x2 x3 x4))) + nil) + +(deftest *.6 + (let* ((upper-bound (* 1000 1000 1000 1000)) + (lower-bound (- upper-bound)) + (spread (1+ (- upper-bound lower-bound)))) + (loop for x = (+ (random spread) lower-bound) + for y = (+ (random spread) lower-bound) + for prod = (* x y) + for prod2 = (integer-times x y) + repeat 1000 + unless (eql prod prod2) + collect (list x y prod prod2))) + nil) + +(deftest *.7 + (let* ((upper-bound (* 1000 1000 1000)) + (lower-bound (- upper-bound)) + (spread (1+ (- upper-bound lower-bound)))) + (loop for x = (+ (rationalize (random (float spread 1.0f0))) lower-bound) + for y = (+ (rationalize (random (float spread 1.0f0))) lower-bound) + for prod = (* x y) + for prod2 = (rat-times x y) + repeat 1000 + unless (eql prod prod2) + collect (list x y prod prod2))) + nil) + +;; Testing of multiplication by integer constants +(deftest *.8 + (let ((bound (isqrt most-positive-fixnum))) + (loop + for x = (random bound) + for y = (random bound) + for f = (eval `(function (lambda (z) + (declare (optimize (speed 3) (safety 0))) + (declare (type (integer 0 (,bound)) z)) + (* ,x z)))) + for prod = (funcall f y) + repeat 100 + unless (and (eql prod (* x y)) + (eql prod (integer-times x y))) + collect (progn (format t "Failed on ~A~%" (list x y prod)) + (list x y prod (* x y) (integer-times x y))))) + nil) + +(deftest *.9 + (let* ((upper-bound (* 1000 1000 1000 1000)) + (lower-bound (- upper-bound)) + (spread (1+ (- upper-bound lower-bound)))) + (flet ((%r () (+ (random spread) lower-bound))) + (loop for xr = (%r) + for xc = (%r) + for x = (complex xr xc) + for yr = (%r) + for yc = (%r) + for y = (complex yr yc) + for prod = (* x y) + repeat 10000 + unless (and (eql (realpart prod) (- (integer-times xr yr) + (integer-times xc yc))) + (eql (imagpart prod) (+ (integer-times xr yc) + (integer-times xc yr)))) + collect (list x y prod)))) + nil) + +(deftest *.10 + (let* ((upper-bound (* 1000 1000 1000 1000)) + (lower-bound (- upper-bound)) + (spread (1+ (- upper-bound lower-bound)))) + (flet ((%r () (+ (rationalize (random (float spread 1.0f0))) lower-bound))) + (loop for xr = (%r) + for xc = (%r) + for x = (complex xr xc) + for yr = (%r) + for yc = (%r) + for y = (complex yr yc) + for prod = (* x y) + repeat 10000 + unless (and (eql (realpart prod) (- (rat-times xr yr) + (rat-times xc yc))) + (eql (imagpart prod) (+ (rat-times xr yc) + (rat-times xc yr)))) + collect (list x y prod)))) + nil) + +(deftest *.11 + (let ((prod 1) (args nil)) + (loop for i from 1 to (min 256 call-arguments-limit) + do (push i args) + do (setq prod (* prod i)) + always (eql (apply #'* args) prod))) + t) + +(deftest *.12 + (loop + for x in '(1.0s0 1.0f0 1.0d0 1.0l0) + for radix = (float-radix x) + for (k eps-r eps-f) = (multiple-value-list (find-epsilon x)) + nconc + (loop for i from 1 to k + for y = (+ x (expt radix (- i))) + nconc + (loop for j from 1 to (- k i) + for z = (+ x (expt radix (- j))) + unless (eql (* y z) + (+ x + (expt radix (- i)) + (expt radix (- j)) + (expt radix (- (+ i j))))) + collect (list x i j)))) + nil) + +(deftest *.13 + (loop + for x in '(1.0s0 1.0f0 1.0d0 1.0l0) + for radix = (float-radix x) + for (k eps-r eps-f) = (multiple-value-list (find-epsilon x)) + nconc + (loop for i from 1 to k + for y = (- x (expt radix (- i))) + nconc + (loop for j from 1 to (- k i) + for z = (- x (expt radix (- j))) + unless (eql (* y z) + (+ x + (- (expt radix (- i))) + (- (expt radix (- j))) + (expt radix (- (+ i j))))) + collect (list x i j)))) + nil) + +;;; Float contagion + +(deftest *.14 + (let ((bound (- (sqrt most-positive-short-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound 2)) bound) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'short-float)) + collect (list x y p))) + nil) + +(deftest *.15 + (let ((bound (- (sqrt most-positive-single-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound 2)) bound) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'single-float)) + collect (list x y p))) + nil) + +(deftest *.16 + (let ((bound (- (sqrt most-positive-double-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound 2)) bound) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'double-float)) + collect (list x y p))) + nil) + +(deftest *.17 + (let ((bound (- (sqrt most-positive-long-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound 2)) bound) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'long-float)) + collect (list x y p))) + nil) + +(deftest *.18 + (let ((bound (- (sqrt most-positive-short-float) 1)) + (bound2 (- (sqrt most-positive-single-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound2 2)) bound2) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'single-float)) + collect (list x y p))) + nil) + +(deftest *.19 + (let ((bound (- (sqrt most-positive-short-float) 1)) + (bound2 (- (sqrt most-positive-double-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound2 2)) bound2) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'double-float)) + collect (list x y p))) + nil) + +(deftest *.20 + (let ((bound (- (sqrt most-positive-short-float) 1)) + (bound2 (- (sqrt most-positive-long-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound2 2)) bound2) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'long-float)) + collect (list x y p))) + nil) + +(deftest *.21 + (let ((bound (- (sqrt most-positive-single-float) 1)) + (bound2 (- (sqrt most-positive-double-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound2 2)) bound2) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'double-float)) + collect (list x y p))) + nil) + +(deftest *.22 + (let ((bound (- (sqrt most-positive-single-float) 1)) + (bound2 (- (sqrt most-positive-long-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound2 2)) bound2) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'long-float)) + collect (list x y p))) + nil) + +(deftest *.23 + (let ((bound (- (sqrt most-positive-double-float) 1)) + (bound2 (- (sqrt most-positive-long-float) 1))) + (loop for x = (- (random (* bound 2)) bound) + for y = (- (random (* bound2 2)) bound2) + for p = (* x y) + repeat 10000 + unless (and (eql p (* y x)) + (typep p 'long-float)) + collect (list x y p))) + nil) + +(deftest times.order.1 + (let ((i 0) x y) + (values + (* (progn (setf x (incf i)) 2) + (progn (setf y (incf i)) 3)) + i x y)) + 6 2 1 2) + +(deftest times.order.2 + (let ((i 0) x y z) + (values + (* (progn (setf x (incf i)) 2) + (progn (setf y (incf i)) 3) + (progn (setf z (incf i)) 5)) + i x y z)) + 30 3 1 2 3) +