~ chicken-core (chicken-5) ab9b93a236ca4337f523672883e3d88015c10346
commit ab9b93a236ca4337f523672883e3d88015c10346
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Wed Jul 18 21:18:49 2012 +0200
Commit: Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Tue Jul 24 11:04:56 2012 +0200
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
Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>
diff --git a/library.scm b/library.scm
index f9142c39..67f859f9 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 542eed6f..4141c6f4 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
Trap