diff --git a/collects/picturing-programs/private/map-image.rkt b/collects/picturing-programs/private/map-image.rkt index 5136053ea3..1a420107c1 100644 --- a/collects/picturing-programs/private/map-image.rkt +++ b/collects/picturing-programs/private/map-image.rkt @@ -85,7 +85,8 @@ ; name->color : string-or-symbol -> maybe-color (define (name->color name) (unless (or (string? name) (symbol? name)) - (error 'name->color "argument must be a string or symbol")) + (error 'name->color + (format "expected a string or symbol, but found ~v" name))) (let [[result (send the-color-database find-color (if (string? name) name @@ -100,7 +101,7 @@ (cond [(color? thing) thing] [(eqv? thing #f) transparent] [(image-color? thing) (name->color thing)] - [else (error 'colorize (format "~v is not a color" thing))])) + [else (error 'colorize (format "expected a color, but found ~v" thing))])) ; colorize-func : (... -> broad-color) -> (... -> color) (define (colorize-func f) @@ -116,8 +117,12 @@ (define (color=? c1 c2) (let [[rc1 (colorize c1)] [rc2 (colorize c2)]] - (unless (and (color? rc1) (color? rc2)) - (error 'color=? "Expected two colors or color names as arguments")) + (unless (color? rc1) + (error 'color=? + (format "Expected a color or color name as first argument, but found ~v" c1))) + (unless (color? rc2) + (error 'color=? + (format "Expected a color or color name as second argument, but found ~v" c2))) (and (= (color-alpha rc1) (color-alpha rc2)) ; Both alphas MUST be equal. (or (= (color-alpha rc1) 0) ; If both are transparent, ignore rgb. (and (= (color-red rc1) (color-red rc2)) @@ -208,9 +213,11 @@ ; build-image : natural(width) natural(height) (nat nat -> broad-color) -> image (define (build-image w h f) (unless (natural? w) - (error 'build-image "Expected natural number as first argument")) + (error 'build-image + (format "Expected natural number as first argument, but found ~v" w))) (unless (natural? h) - (error 'build-image "Expected natural number as second argument")) + (error 'build-image + (format "Expected natural number as second argument, but found ~v" h))) (check-procedure-arity f 2 'build-image "Expected function with contract num(x) num(y) -> color as third argument") (build-image-internal w h (colorize-func f))) @@ -219,9 +226,11 @@ ; For students who don't yet know function closures. (define (build-image/extra w h f extra) (unless (natural? w) - (error 'build-image/extra "Expected natural number as first argument")) + (error 'build-image/extra + (format "Expected natural number as first argument, but found ~v" w))) (unless (natural? h) - (error 'build-image/extra "Expected natural number as second argument")) + (error 'build-image/extra + (format "Expected natural number as second argument, but found ~v" h))) (check-procedure-arity f 3 'build-image/extra "Expected function with contract num(x) num(y) any -> color as third argument") (build-image-internal w h (colorize-func (lambda (x y) (f x y extra))))) @@ -230,9 +239,11 @@ ; where each of rfunc, gfunc, bfunc is (nat(x) nat(y) -> nat) (define (build3-image w h rfunc gfunc bfunc) (unless (natural? w) - (error 'build3-image "Expected natural number as first argument")) + (error 'build3-image + (format "Expected natural number as first argument, but found ~v" w))) (unless (natural? h) - (error 'build3-image "Expected natural number as second argument")) + (error 'build3-image + (format "Expected natural number as second argument, but found ~v" h))) (check-procedure-arity rfunc 2 'build3-image "Expected function with contract num(x) num(y) -> color as third argument") (check-procedure-arity gfunc 2 'build3-image "Expected function with contract num(x) num(y) -> color as fourth argument") (check-procedure-arity bfunc 2 'build3-image "Expected function with contract num(x) num(y) -> color as fifth argument") @@ -244,9 +255,11 @@ ; where each of rfunc, gfunc, bfunc, afunc is (nat(x) nat(y) -> nat) (define (build4-image w h rfunc gfunc bfunc afunc) (unless (natural? w) - (error 'build-image "Expected natural number as first argument")) + (error 'build-image + (format "Expected natural number as first argument, but found ~v" w))) (unless (natural? h) - (error 'build-image "Expected natural number as second argument")) + (error 'build-image + (format "Expected natural number as second argument, but found ~v" h))) (check-procedure-arity rfunc 2 'build-image "Expected function with contract num(x) num(y) -> color as third argument") (check-procedure-arity gfunc 2 'build-image "Expected function with contract num(x) num(y) -> color as fourth argument") (check-procedure-arity bfunc 2 'build-image "Expected function with contract num(x) num(y) -> color as fifth argument") @@ -277,7 +290,8 @@ (define (map-image f img) (check-procedure-arity f 3 'map-image "Expected function with contract num(x) num(y) color -> color as first argument") (unless (image? img) - (error 'map-image "Expected image as second argument")) + (error 'map-image + (format "Expected image as second argument, but found ~v" img))) (map-image-internal (colorize-func f) img)) ; map-image/extra : (nat nat color X -> broad-color) image X -> image @@ -286,7 +300,8 @@ (define (map-image/extra f img extra) (check-procedure-arity f 4 'map-image/extra "Expected function with contract num(x) num(y) color other -> color as first argument") (unless (image? img) - (error 'map-image/extra "Expected image as second argument")) + (error 'map-image/extra + (format "Expected image as second argument, but found ~v" img))) (map-image-internal (colorize-func (lambda (x y c) (f x y c extra))) img)) @@ -304,7 +319,8 @@ (check-procedure-arity gfunc 5 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(g) as second argument") (check-procedure-arity bfunc 5 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument") (unless (image? pic) - (error 'map3-image "Expected image as fourth argument")) + (error 'map3-image + (format "Expected image as fourth argument, but found ~v" pic))) (map-image-internal (lambda (x y c) (make-color (rfunc x y (color-red c) (color-green c) (color-blue c)) @@ -325,7 +341,8 @@ (check-procedure-arity bfunc 6 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(b) as third argument") (check-procedure-arity afunc 6 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(alpha) as fourth argument") (unless (image? pic) - (error 'map4-image "Expected image as fifth argument")) + (error 'map4-image + "Expected image as fifth argument, but found ~v" pic)) (map-image-internal (lambda (x y c) (make-color (rfunc x y (color-red c) (color-green c) (color-blue c) (color-alpha c)) diff --git a/collects/picturing-programs/tests/map-image-bsl-tests.rkt b/collects/picturing-programs/tests/map-image-bsl-tests.rkt index b031156fe3..07d3721c8c 100644 --- a/collects/picturing-programs/tests/map-image-bsl-tests.rkt +++ b/collects/picturing-programs/tests/map-image-bsl-tests.rkt @@ -1,6 +1,6 @@ ;; The first three lines of this file were inserted by DrRacket. They record metadata ;; about the language level of this file in a form that our tools can easily process. -#reader(lib "htdp-beginner-reader.ss" "lang")((modname new.map-image-bsl-tests) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) +#reader(lib "htdp-beginner-reader.ss" "lang")((modname map-image-bsl-tests) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) (require picturing-programs) ; Test cases for primitives: @@ -24,7 +24,7 @@ (check-expect (name->color "black") (make-color 0 0 0)) (check-expect (name->color "blue") (make-color 0 0 255)) (check-expect (name->color "plaid") false) -(check-error (name->color 7) "name->color: argument must be a string or symbol") +(check-error (name->color 7) "name->color: expected a string or symbol, but found 7") (check-expect (color=? (make-color 5 10 15) (make-color 5 10 15)) true) (check-expect (color=? (make-color 5 10 15) (make-color 5 15 10)) false) @@ -36,8 +36,9 @@ (check-expect (color=? (make-color 5 10 15 255) (make-color 5 10 15)) true) (check-expect (color=? (make-color 5 10 15 0) false) true) (check-expect (color=? (make-color 5 10 15 20) false) false) -(check-error (color=? "white" 3) "colorize: 3 is not a color") -(check-error (color=? "white" "plaid") "color=?: Expected two colors or color names as arguments") +(check-error (color=? "white" 3) "colorize: expected a color, but found 3") +(check-error (color=? "plaid" "white") "color=?: Expected a color or color name as first argument, but found \"plaid\"") +(check-error (color=? "white" "plaid") "color=?: Expected a color or color name as second argument, but found \"plaid\"") ; Test cases for map3-image: ;(check-error (map3-image 5 + + pic:bloch) @@ -54,7 +55,7 @@ (check-error (map3-image + + sqrt pic:bloch) "map3-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument") (check-error (map3-image + + + 5) - "map3-image: Expected image as fourth argument") + "map3-image: Expected image as fourth argument, but found 5") ; red-id : x y r g b -> num (define (red-id x y r g b) r) @@ -113,7 +114,7 @@ (check-error (map4-image + + + sqrt pic:bloch) "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(alpha) as fourth argument") (check-error (map4-image + + + + 5) - "map4-image: Expected image as fifth argument") + "map4-image: Expected image as fifth argument, but found 5") ; red-id6 : x y r g b a -> num (define (red-id6 x y r g b a) r) ; green-id6 : x y r g b a -> num @@ -153,7 +154,7 @@ (check-error (map-image sqrt pic:bloch) "map-image: Expected function with contract num(x) num(y) color -> color as first argument") (check-error (map-image + 5) - "map-image: Expected image as second argument") + "map-image: Expected image as second argument, but found 5") ; color-id : x y color -> color (define (color-id x y c) @@ -186,7 +187,7 @@ (define ex6 (map-image kill-red bloch)) ex6 (define (return-5 x y c) 5) -(check-error (map-image return-5 bloch) "colorize: 5 is not a color") +(check-error (map-image return-5 bloch) "colorize: expected a color, but found 5") "Test cases for build3-image:" (define (x-gradient-2 x y) (min 255 (* 4 x))) @@ -195,9 +196,9 @@ "(build3-image 60 40 zero-2-args x-gradient-2 y-gradient-2) should be a 60x40 rectangle with no red, green increasing from left to right, and blue increasing from top to bottom:" (build3-image 60 40 zero-2-args x-gradient-2 y-gradient-2) (check-error (build3-image "hello" true sqrt sqrt sqrt) - "build3-image: Expected natural number as first argument") + "build3-image: Expected natural number as first argument, but found \"hello\"") (check-error (build3-image 17 true sqrt sqrt sqrt) - "build3-image: Expected natural number as second argument") + "build3-image: Expected natural number as second argument, but found true") (check-error (build3-image 17 24 sqrt sqrt sqrt) "build3-image: Expected function with contract num(x) num(y) -> color as third argument") (check-error (build3-image 17 24 x-gradient-2 sqrt sqrt) @@ -207,7 +208,7 @@ (define (return-minus-5 x y) -5) (check-error (build3-image 17 24 x-gradient-2 y-gradient-2 return-minus-5) - "make-color: expected as third argument, given: -5") + "make-color: expected an integer between 0 and 255 as third argument, given: -5") "Test cases for build4-image:" "(build4-image 50 50 x-gradient-2 x-gradient-2 zero-2-args y-gradient-2) should be a square, increasingly yellow from left to right and increasingly alpha from top to bottom. On a blue background." @@ -224,8 +225,8 @@ "(build-image 100 100 (lambda (x y) (make-color (* x 2.5) (* y 2.5) 0))):" (build-image 100 100 a-gradient) "should be a 100x100 square with a color gradient increasing in red from left to right, and in green from top to bottom" -(check-error (build-image 3.2 100 a-gradient) "build-image: Expected natural number as first argument") -(check-error (build-image 100 -2 a-gradient) "build-image: Expected natural number as second argument") +(check-error (build-image 3.2 100 a-gradient) "build-image: Expected natural number as first argument, but found 3.2") +(check-error (build-image 100 -2 a-gradient) "build-image: Expected natural number as second argument, but found -2") (check-error (build-image 100 100 sqrt) "build-image: Expected function with contract num(x) num(y) -> color as third argument")