Hi all, Attached is a fix for #887. I also noticed that (max 'x) => x, which means the #:enforcing in types.db is untrue, so I've also added a check of the first value's type in the max/min procedures. The other values (in "ns") are checked by the predicate. Actually, the first value's type is checked twice now if the list is nonempty. If that's a huge deal we could change this, but it would complicate the code more and the differentiation will make the code more complicated and probably slow it down just as much as the extra check.
Cheers, Peter -- http://sjamaan.ath.cx -- "The process of preparing programs for a digital computer is especially attractive, not only because it can be economically and scientifically rewarding, but also because it can be an aesthetic experience much like composing poetry or music." -- Donald Knuth
>From f73338f1b0bc9effefc2061d613c069a9cf0032c Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Wed, 18 Jul 2012 21:18:49 +0200 Subject: [PATCH] Add check to "max" and "min" for exactness of all values including the first; add type check for first value so that the procedure really becomes "enforcing" like types.db claims. This fixes #887 --- library.scm | 17 ++++++++--------- tests/library-tests.scm | 12 ++++++++++++ 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/library.scm b/library.scm index f9142c3..67f859f 100644 --- a/library.scm +++ b/library.scm @@ -994,20 +994,19 @@ EOF (letrec ((maxmin (lambda (n1 ns pred) - (let loop ((nbest n1) (ns ns)) + (let loop ((nbest n1) (inexact (##core#inline "C_blockp" n1)) (ns ns)) (if (eq? ns '()) - nbest + (if (and inexact (not (##core#inline "C_blockp" nbest))) + (##core#inline_allocate ("C_a_i_fix_to_flo" 4) nbest) + nbest) (let ([ni (##sys#slot ns 0)]) (loop (if (pred ni nbest) - (if (and (##core#inline "C_blockp" nbest) - (##core#inline "C_flonump" nbest) - (not (##core#inline "C_blockp" ni)) ) - (##core#inline_allocate ("C_a_i_fix_to_flo" 4) ni) - ni) + ni nbest) + (or inexact (##core#inline "C_blockp" ni)) (##sys#slot ns 1) ) ) ) ) ) ) ) - (set! max (lambda (n1 . ns) (maxmin n1 ns >))) - (set! min (lambda (n1 . ns) (maxmin n1 ns <))) ) + (set! max (lambda (n1 . ns) (##sys#check-number n1 'max) (maxmin n1 ns >))) + (set! min (lambda (n1 . ns) (##sys#check-number n1 'min) (maxmin n1 ns <))) ) (define (exp n) (##core#inline_allocate ("C_a_i_exp" 4) n) ) diff --git a/tests/library-tests.scm b/tests/library-tests.scm index 542eed6..4141c6f 100644 --- a/tests/library-tests.scm +++ b/tests/library-tests.scm @@ -164,6 +164,18 @@ (assert-fail (modulo 4.0 +inf.0)) (assert-fail (modulo 4.0 +nan.0)) +(assert-fail (min 'x)) +(assert-fail (max 'x)) +(assert (eq? 1 (min 1 2))) +(assert (eq? 1 (min 2 1))) +(assert (eq? 2 (max 1 2))) +(assert (eq? 2 (max 2 1))) +;; must be flonum +(assert (fp= 1.0 (min 1 2.0))) +(assert (fp= 1.0 (min 2.0 1))) +(assert (fp= 2.0 (max 2 1.0))) +(assert (fp= 2.0 (max 1.0 2))) + ;; number->string conversion (for-each -- 1.7.9.1
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
