>From f73338f1b0bc9effefc2061d613c069a9cf0032c Mon Sep 17 00:00:00 2001 From: Peter Bex 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