From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Rework the testing framework for number-theoretic division operators Date: Mon, 31 Jan 2011 01:19:29 -0500 Message-ID: <87aaihzjbi.fsf_-_@yeeloong.netris.org> References: <87lj221hn7.fsf@yeeloong.netris.org> <87aaiivw6t.fsf@gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1296454819 12047 80.91.229.12 (31 Jan 2011 06:20:19 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 31 Jan 2011 06:20:19 +0000 (UTC) Cc: guile-devel@gnu.org To: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Mon Jan 31 07:20:14 2011 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Pjn7U-0004bU-I3 for guile-devel@m.gmane.org; Mon, 31 Jan 2011 07:20:14 +0100 Original-Received: from localhost ([127.0.0.1]:40443 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Pjn7R-0006hE-Oz for guile-devel@m.gmane.org; Mon, 31 Jan 2011 01:20:09 -0500 Original-Received: from [140.186.70.92] (port=55725 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Pjn7D-0006h0-Sb for guile-devel@gnu.org; Mon, 31 Jan 2011 01:19:57 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Pjn7C-00039p-Dm for guile-devel@gnu.org; Mon, 31 Jan 2011 01:19:55 -0500 Original-Received: from world.peace.net ([216.204.32.208]:56293) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Pjn78-00038X-Nc; Mon, 31 Jan 2011 01:19:51 -0500 Original-Received: from ip68-9-118-38.ri.ri.cox.net ([68.9.118.38] helo=freedomincluded) by world.peace.net with esmtpa (Exim 4.69) (envelope-from ) id 1Pjn6u-0007mo-Bd; Mon, 31 Jan 2011 01:19:37 -0500 Original-Received: from mhw by freedomincluded with local (Exim 4.69) (envelope-from ) id 1Pjn6o-0000RI-2z; Mon, 31 Jan 2011 01:19:30 -0500 In-Reply-To: <87aaiivw6t.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Sun, 30 Jan 2011 23:55:06 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.1 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 216.204.32.208 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:11443 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable ludo@gnu.org (Ludovic Court=C3=A8s) writes: > There are related test failures on i686-linux-gnu: > > http://hydra.nixos.org/build/875025 I believe this patch should fix the test failures. Best, Mark --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Rework-the-testing-framework-for-number-theoretic-di.patch Content-Description: Rework the testing framework for number-theoretic division operators >From 650df0667f16cbbf3c05c8774d4d08c793605f47 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 31 Jan 2011 00:42:35 -0500 Subject: [PATCH] Rework the testing framework for number-theoretic division operators * test-suite/tests/numbers.test (test-eqv?): Remove special handling of zeroes. Zeroes are now compared like all other numbers. Exact numbers are compared with `eqv?' and inexact numbers are compared to within test-epsilon. Rework the testing framework for number-theoretic division operators: `euclidean/', `euclidean-quotient', `euclidean-remainder', `centered/', `centered-quotient', and `centered-remainder'. Previously we compared all test results against a simple scheme implementation of the same operations. However, these operations have discontinuous jumps where a tiny change in the inputs can lead to a large change in the outputs, e.g.: (euclidean/ 130.00000000000 10/7) ==> 91.0 and 0.0 (euclidean/ 129.99999999999 10/7) ==> 90.0 and 1.42857142856141 In the new testing scheme, we compare values against the simple implementations only if the input arguments contain an infinity or a NaN. In the common case of two finite arguments, we simply make sure that the outputs of all three operators (e.g. `euclidean/', `euclidean-quotient', `euclidean-remainder') equal each other, that outputs are exact iff both inputs are exact, and that the required properties of the operator are met: that Q is an integer, that R is within the specified range, and that N = Q*D + R. --- test-suite/tests/numbers.test | 194 +++++++++++++++++++---------------------- 1 files changed, 91 insertions(+), 103 deletions(-) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 01bccda..0d711b0 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -18,6 +18,7 @@ (define-module (test-suite test-numbers) #:use-module (test-suite lib) #:use-module (ice-9 documentation) + #:use-module (srfi srfi-1) ; list library #:use-module (srfi srfi-11)) ; let-values ;;; @@ -100,12 +101,9 @@ ;; ;; Like eqv?, except that inexact finite numbers need only be within -;; test-epsilon (1e-10) to be considered equal. An exception is made -;; for zeroes, however. If X is zero, then it is tested using eqv? -;; without any allowance for imprecision. In particular, 0.0 is -;; considered distinct from -0.0. For non-real complex numbers, -;; each component is tested according to these rules. The intent -;; is that the known-correct value will be the first parameter. +;; test-epsilon (1e-10) to be considered equal. For non-real complex +;; numbers, each component is tested according to these rules. The +;; intent is that the known-correct value will be the first parameter. ;; (define (test-eqv? x y) (cond ((real? x) @@ -118,7 +116,7 @@ ;; Auxiliary predicate used by test-eqv? (define (test-real-eqv? x y) - (cond ((or (exact? x) (zero? x) (nan? x) (inf? x)) + (cond ((or (exact? x) (nan? x) (inf? x)) (eqv? x y)) (else (and (inexact? y) (> test-epsilon (abs (- x y))))))) @@ -3551,6 +3549,24 @@ (hi (+ hi test-epsilon))) (<= lo x hi)))) + ;; (cartesian-product-map list '(a b) '(1 2)) + ;; ==> ((a 1) (a 2) (b 1) (b 2)) + (define (cartesian-product-map f . lsts) + (define (cartmap rev-head lsts) + (if (null? lsts) + (list (apply f (reverse rev-head))) + (append-map (lambda (x) (cartmap (cons x rev-head) (cdr lsts))) + (car lsts)))) + (cartmap '() lsts)) + + (define (cartesian-product-for-each f . lsts) + (define (cartfor rev-head lsts) + (if (null? lsts) + (apply f (reverse rev-head)) + (for-each (lambda (x) (cartfor (cons x rev-head) (cdr lsts))) + (car lsts)))) + (cartfor '() lsts)) + (define (safe-euclidean-quotient x y) (cond ((not (and (real? x) (real? y))) (throw 'wrong-type-arg)) ((zero? y) (throw 'divide-by-zero)) @@ -3560,20 +3576,19 @@ (else (throw 'unknown-problem)))) (define (safe-euclidean-remainder x y) - (- x (* y (safe-euclidean-quotient x y)))) - - (define (safe-euclidean/ x y) - (let ((q (safe-euclidean-quotient x y)) - (r (safe-euclidean-remainder x y))) - (if (not (and (eq? (exact? q) (exact? r)) - (eq? (exact? q) (and (exact? x) (exact? y))) - (test-real-eqv? r (- x (* q y))) - (or (and (integer? q) - (test-within-range? 0 (abs y) r)) - (not (finite? x)) - (not (finite? y))))) - (throw 'safe-euclidean/-is-broken (list x y q r)) - (values q r)))) + (let ((q (safe-euclidean-quotient x y))) + (- x (* y q)))) + + (define (valid-euclidean-answer? x y q r) + (if (and (finite? x) (finite? y)) + (and (eq? (exact? q) + (exact? r) + (and (exact? x) (exact? y))) + (integer? q) + (test-eqv? r (- x (* q y))) + (test-within-range? 0 (abs y) r)) + (and (test-eqv? q (safe-euclidean-quotient x y)) + (test-eqv? r (safe-euclidean-remainder x y))))) (define (safe-centered-quotient x y) (cond ((not (and (real? x) (real? y))) (throw 'wrong-type-arg)) @@ -3584,37 +3599,36 @@ (else (throw 'unknown-problem)))) (define (safe-centered-remainder x y) - (- x (* y (safe-centered-quotient x y)))) - - (define (safe-centered/ x y) - (let ((q (safe-centered-quotient x y)) - (r (safe-centered-remainder x y))) - (if (not (and (eq? (exact? q) (exact? r)) - (eq? (exact? q) (and (exact? x) (exact? y))) - (test-real-eqv? r (- x (* q y))) - (or (and (integer? q) - (test-within-range? (* -1/2 (abs y)) - (* +1/2 (abs y)) - r)) - (not (finite? x)) - (not (finite? y))))) - (throw 'safe-centered/-is-broken (list x y q r)) - (values q r)))) + (let ((q (safe-centered-quotient x y))) + (- x (* y q)))) + + (define (valid-centered-answer? x y q r) + (if (and (finite? x) (finite? y)) + (and (eq? (exact? q) + (exact? r) + (and (exact? x) (exact? y))) + (integer? q) + (test-eqv? r (- x (* q y))) + (test-within-range? (* -1/2 (abs y)) + (* +1/2 (abs y)) + r)) + (and (test-eqv? q (safe-centered-quotient x y)) + (test-eqv? r (safe-centered-remainder x y))))) (define test-numerators - (append - (list 123 125 127 130 3 5 10 123.2 125.0 - -123 -125 -127 -130 -3 -5 -10 -123.2 -125.0 - 127.2 130.0 123/7 125/7 127/7 130/7 - -127.2 -130.0 -123/7 -125/7 -127/7 -130/7 - 0 +0.0 -0.0 +inf.0 -inf.0 +nan.0 - most-negative-fixnum (1+ most-positive-fixnum) - (1- most-negative-fixnum)) - (apply append - (map (lambda (x) (list (* x (+ 1 most-positive-fixnum)) - (* x (+ 2 most-positive-fixnum)))) - '( 123 125 127 130 3 5 10 - -123 -125 -127 -130 -3 -5 -10))))) + (append (cartesian-product-map * '(1 -1) + '(123 125 127 130 3 5 10 + 123.2 125.0 127.2 130.0 + 123/7 125/7 127/7 130/7)) + (cartesian-product-map * '(1 -1) + '(123 125 127 130 3 5 10) + (list 1 + (+ 1 most-positive-fixnum) + (+ 2 most-positive-fixnum))) + (list 0 +0.0 -0.0 +inf.0 -inf.0 +nan.0 + most-negative-fixnum + (1+ most-positive-fixnum) + (1- most-negative-fixnum)))) (define test-denominators (list 10 5 10/7 127/2 10.0 63.5 @@ -3623,58 +3637,32 @@ (+ 1 most-positive-fixnum) (+ -1 most-negative-fixnum) (+ 2 most-positive-fixnum) (+ -2 most-negative-fixnum))) - (define (do-tests-1 op-name real-op safe-op) - (for-each (lambda (d) - (for-each (lambda (n) - (run-test (list op-name n d) #t - (lambda () - (test-eqv? (real-op n d) - (safe-op n d))))) - test-numerators)) - test-denominators)) - - (define (do-tests-2 op-name real-op safe-op) - (for-each (lambda (d) - (for-each (lambda (n) - (run-test (list op-name n d) #t - (lambda () - (let-values - (((q r) (safe-op n d)) - ((q1 r1) (real-op n d))) - (and (test-eqv? q q1) - (test-eqv? r r1)))))) - test-numerators)) - test-denominators)) - - (pass-if (documented? euclidean/)) - (pass-if (documented? euclidean-quotient)) - (pass-if (documented? euclidean-remainder)) - (pass-if (documented? centered/)) - (pass-if (documented? centered-quotient)) - (pass-if (documented? centered-remainder)) - - (with-test-prefix "euclidean-quotient" - (do-tests-1 'euclidean-quotient - euclidean-quotient - safe-euclidean-quotient)) - (with-test-prefix "euclidean-remainder" - (do-tests-1 'euclidean-remainder - euclidean-remainder - safe-euclidean-remainder)) (with-test-prefix "euclidean/" - (do-tests-2 'euclidean/ - euclidean/ - safe-euclidean/)) - - (with-test-prefix "centered-quotient" - (do-tests-1 'centered-quotient - centered-quotient - safe-centered-quotient)) - (with-test-prefix "centered-remainder" - (do-tests-1 'centered-remainder - centered-remainder - safe-centered-remainder)) + (pass-if (documented? euclidean/)) + (pass-if (documented? euclidean-quotient)) + (pass-if (documented? euclidean-remainder)) + + (cartesian-product-for-each + (lambda (n d) + (run-test (list 'euclidean/ n d) #t + (lambda () + (let-values (((q r) (euclidean/ n d))) + (and (test-eqv? q (euclidean-quotient n d)) + (test-eqv? r (euclidean-remainder n d)) + (valid-euclidean-answer? n d q r)))))) + test-numerators test-denominators)) + (with-test-prefix "centered/" - (do-tests-2 'centered/ - centered/ - safe-centered/))) + (pass-if (documented? centered/)) + (pass-if (documented? centered-quotient)) + (pass-if (documented? centered-remainder)) + + (cartesian-product-for-each + (lambda (n d) + (run-test (list 'centered/ n d) #t + (lambda () + (let-values (((q r) (centered/ n d))) + (and (test-eqv? q (centered-quotient n d)) + (test-eqv? r (centered-remainder n d)) + (valid-centered-answer? n d q r)))))) + test-numerators test-denominators))) -- 1.5.6.5 --=-=-=--