/[gcl]/gcl/ansi-tests/numbers-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/numbers-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by pfdietz, Sun Sep 7 02:32:55 2003 UTC revision 1.14 by pfdietz, Tue Sep 9 13:31:41 2003 UTC
# Line 249  Line 249 
249  ;;; Approximate equality function  ;;; Approximate equality function
250  (defun approx= (x y &optional (eps (epsilon x)))  (defun approx= (x y &optional (eps (epsilon x)))
251    (<= (abs (/ (- x y) (max (abs x) 1))) eps))    (<= (abs (/ (- x y) (max (abs x) 1))) eps))
252    
253    (defun test-log-op-with-decls (op xlo xhi ylo yhi niters
254                                      &optional
255                                      (decls '((optimize (speed 3) (safety 1)
256                                                         (debug 1)))))
257      "Test that a compiled form of the LOG* function OP computes
258       the expected result on two random integers drawn from the
259       types `(integer ,xlo ,xhi) and `(integer ,ylo ,yhi).  Try
260       niters choices.  Return a list of pairs on which the test fails."
261    
262      (assert (symbolp op))
263      (assert (integerp xlo))
264      (assert (integerp xhi))
265      (assert (integerp ylo))
266      (assert (integerp yhi))
267      (assert (integerp niters))
268      (assert (<= xlo xhi))
269      (assert (<= ylo yhi))
270    
271      (let* ((source
272              `(lambda (x y)
273                 (declare (type (integer ,xlo ,xhi) x)
274                          (type (integer ,ylo ,yhi) y)
275                          ,@ decls)
276                 (,op x y)))
277             (fn (compile nil source)))
278        (loop for i below niters
279              for x = (random-from-interval xhi xlo)
280              for y = (random-from-interval yhi ylo)
281              unless (eql (funcall (the symbol op) x y)
282                          (funcall fn x y))
283              collect (list x y))))

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26