From 0ad4118f6f83c20eae7c77dcf1dd0818c49798b5 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 11 Apr 2006 13:53:53 +0000 Subject: [PATCH] fixed image.ss to handle the case when positive and negative infinity are supplied to overlay/xy and also limited one-of/c's inputs svn: r2659 --- collects/htdp/image.ss | 3 ++- collects/mzlib/private/contract.ss | 13 ++++++++++++- collects/tests/mzscheme/htdp-image.ss | 2 ++ 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/collects/htdp/image.ss b/collects/htdp/image.ss index 0a7354eb7b..747e64c4ea 100644 --- a/collects/htdp/image.ss +++ b/collects/htdp/image.ss @@ -76,7 +76,7 @@ plt/collects/tests/mzscheme/image-test.ss (define (check name p? v desc arg-posn) (check-arg name (p? v) desc arg-posn v)) (define (check-coordinate name val arg-posn) (check name number? val "number" arg-posn)) - (define (check-integer-coordinate name val arg-posn) (check name integer? val "integer" arg-posn)) + (define (check-integer-coordinate name val arg-posn) (check name nii? val "integer" arg-posn)) (define (check-size name val arg-posn) (check name posi? val "positive exact integer" arg-posn)) (define (check-size/0 name val arg-posn) (check name nnosi? val "non-negative exact integer" arg-posn)) (define (check-image name val arg-posn) (check name image? val "image" arg-posn)) @@ -85,6 +85,7 @@ plt/collects/tests/mzscheme/image-test.ss (define (posi? i) (and (number? i) (integer? i) (positive? i) (exact? i))) (define (nnosi? i) (and (number? i) (integer? i) (exact? i) (or (zero? i) (positive? i)))) + (define (nii? x) (and (integer? x) (not (= x +inf.0)) (not (= x -inf.0)))) (define (check-sizes who w h) diff --git a/collects/mzlib/private/contract.ss b/collects/mzlib/private/contract.ss index db8d1d6fd7..6217f11a5a 100644 --- a/collects/mzlib/private/contract.ss +++ b/collects/mzlib/private/contract.ss @@ -938,7 +938,18 @@ add struct contracts for immutable structs? (apply string-append (map (lambda (x) (format "~e " x)) ss)))) (make-one-of/c ss)) - (define (one-of/c . elems) (make-one-of/c elems)) + (define atomic-value? + (let ([undefined (letrec ([x x]) x)]) + (λ (x) + (or (char? x) (symbol? x) (boolean? x) + (null? x) (keyword? x) (number? x) + (void? x) (eq? x undefined))))) + + (define (one-of/c . elems) + (unless (andmap atomic-value? elems) + (error 'one-of/c "expected chars, symbols, booleans, null, keywords, numbers, void, or undefined, got ~e" + elems)) + (make-one-of/c elems)) (define-struct/prop one-of/c (elems) ((pos-proj-prop flat-pos-proj) diff --git a/collects/tests/mzscheme/htdp-image.ss b/collects/tests/mzscheme/htdp-image.ss index 27a67e2634..beb01e7e2e 100644 --- a/collects/tests/mzscheme/htdp-image.ss +++ b/collects/tests/mzscheme/htdp-image.ss @@ -1063,5 +1063,7 @@ snips as arguments (circle 50 'outline 'blue)) "third") (err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) 10 10 #f) "fourth") +(err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) 10 +inf.0 #f) "third") +(err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) -inf.0 +inf.0 #f) "second") (report-errs) \ No newline at end of file