suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Improved error messages to specify actual argument as well as expected

Browse Source 
type.  Still produces one check-error failure because of bug in
make-color.
(cherry picked from commit d3df33b023)
This commit is contained in:
Stephen Bloch 2011-07-10 08:42:49 -04:00 committed by Eli Barzilay
parent 2490b0711c
commit ede736ff84
2 changed files with 47 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/picturing-programs/private/map-image.rkt
View File

@ -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))

27
collects/picturing-programs/tests/map-image-bsl-tests.rkt
View File

@ -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 <integer between 0 and 255> 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")