[racket-dev] [plt] Push #26660: master branch updated

Please, rebase instead of merging. Thank you.


On Thu, Apr 18, 2013 at 11:42 AM, <sbloch at racket-lang.org> wrote:

> sbloch has updated `master' from 85eab5610f to 7a33712603.
>   http://git.racket-lang.org/plt/85eab5610f..7a33712603
>
> =====[ 2 Commits ]======================================================
> Directory summary:
>  100.0% collects/picturing-programs/private/
>
> ~~~~~~~~~~
>
> 6740ab5 Stephen Bloch <sbloch at adelphi.edu> 2013-04-18 12:40
> :
> | Corrected a variety of wrong-arg-type error messages for map-image,
> | build-image, et al.
> |
> | Please merge to release branch.
> :
>   M collects/picturing-programs/private/map-image.rkt | 72
> +++++++++++++++-----
>
> ~~~~~~~~~~
>
> 7a33712 Stephen Bloch <sbloch at adelphi.edu> 2013-04-18 12:41
> :
> | Merge branch 'master' of pltgit:plt
> | I'm not sure why this is non-fast-forwardable, but it apparently is.
> :
> : *** Trivial merge (omitting list) ***
> :
>
> =====[ Overall Diff ]===================================================
>
> collects/picturing-programs/private/map-image.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/picturing-programs/private/map-image.rkt
> +++ NEW/collects/picturing-programs/private/map-image.rkt
> @@ -276,9 +276,9 @@
>    (unless (natural? h)
>      (error 'build3-image
>         (format "Expected a natural number as second argument, but
> received ~v" h)))
> -  (check-procedure-arity rfunc 2 'build3-image "Expected a function with
> contract num(x) num(y) -> color as third argument")
> -  (check-procedure-arity gfunc 2 'build3-image "Expected a function with
> contract num(x) num(y) -> color as fourth argument")
> -  (check-procedure-arity bfunc 2 'build3-image "Expected a function with
> contract num(x) num(y) -> color as fifth argument")
> +  (check-procedure-arity rfunc 2 'build3-image "Expected a function with
> contract num(x) num(y) -> [0-255] as third argument")
> +  (check-procedure-arity gfunc 2 'build3-image "Expected a function with
> contract num(x) num(y) -> [0-255] as fourth argument")
> +  (check-procedure-arity bfunc 2 'build3-image "Expected a function with
> contract num(x) num(y) -> [0-255] as fifth argument")
>    (build-image-internal w h
>                          (lambda (x y)
>                            (make-color (rfunc x y) (gfunc x y) (bfunc x
> y)))))
> @@ -292,10 +292,10 @@
>    (unless (natural? h)
>      (error 'build4-image
>         (format "Expected a natural number as second argument, but
> received ~v" h)))
> -  (check-procedure-arity rfunc 2 'build-image "Expected a function with
> contract num(x) num(y) -> color as third argument")
> -  (check-procedure-arity gfunc 2 'build-image "Expected a function with
> contract num(x) num(y) -> color as fourth argument")
> -  (check-procedure-arity bfunc 2 'build-image "Expected a function with
> contract num(x) num(y) -> color as fifth argument")
> -  (check-procedure-arity afunc 2 'build-image "Expected a function with
> contract num(x) num(y) -> color as sixth argument")
> +  (check-procedure-arity rfunc 2 'build4-image "Expected a function with
> contract num(x) num(y) -> [0-255] as third argument")
> +  (check-procedure-arity gfunc 2 'build4-image "Expected a function with
> contract num(x) num(y) -> [0-255] as fourth argument")
> +  (check-procedure-arity bfunc 2 'build4-image "Expected a function with
> contract num(x) num(y) -> [0-255] as fifth argument")
> +  (check-procedure-arity afunc 2 'build4-image "Expected a function with
> contract num(x) num(y) -> [0-255] as sixth argument")
>    (build-image-internal w h
>                          (lambda (x y)
>                            (make-color (rfunc x y) (gfunc x y) (bfunc x y)
> (afunc x y)))))
> @@ -327,7 +327,7 @@
>           (map-image-internal (colorize-func f) img)]
>          [(procedure-arity-includes? f 1)            ; allow f :
> color->color as a simple case
>           (map-image-internal (colorize-func (lambda (x y c) (f c))) img)]
> -        [else (error 'map-image "Expected a function of one or three
> parameters as first argument")]))
> +        [else (error 'map-image "Expected a function of one or three
> parameters, returning a color, as first argument")]))
>
>  ; map-image/extra : (nat nat color X -> broad-color) image X -> image
>  ; Like map-image, but passes a fixed extra argument to every call of the
> function.
> @@ -340,7 +340,7 @@
>           (map-image-internal (colorize-func (lambda (x y c) (f x y c
> extra))) img)]
>          [(procedure-arity-includes? f 2)
>           (map-image-internal (colorize-func (lambda (x y c) (f c extra)))
> img)]
> -        [else (error 'map-image/extra "Expected a function taking two or
> four parameters as first argument")]))
> +        [else (error 'map-image/extra "Expected a function taking two or
> four parameters, returning a color, as first argument")]))
>
>
>
> @@ -353,9 +353,9 @@
>  ; image -> image
>  ; Note: by default, preserves alpha values from old image.
>  (define (map3-image rfunc gfunc bfunc pic)
> -  (check-procedure-arity rfunc 5 'map3-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
> -  (check-procedure-arity gfunc 5 'map3-image "Expected a 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 a function with
> contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument")
> +  (check-procedure-arity rfunc 5 'map3-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) -> [0-255] as first argument")
> +  (check-procedure-arity gfunc 5 'map3-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) -> [0-255] as second argument")
> +  (check-procedure-arity bfunc 5 'map3-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) -> [0-255] as third argument")
>    (unless (image? pic)
>      (error 'map3-image
>         (format "Expected an image as fourth argument, but received ~v"
> pic)))
> @@ -374,10 +374,10 @@
>  ;  (int(x) int(y) int(r) int(g) int(b) int(a) -> int(a))
>  ;  image -> image
>  (define (map4-image rfunc gfunc bfunc afunc pic)
> -  (check-procedure-arity rfunc 6 'map4-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(r) as first
> argument")
> -  (check-procedure-arity gfunc 6 'map4-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(g) as second
> argument")
> -  (check-procedure-arity bfunc 6 'map4-image "Expected a 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 a function with
> contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(alpha) as
> fourth argument")
> +  (check-procedure-arity rfunc 6 'map4-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) num(a) -> [0-255] as first
> argument")
> +  (check-procedure-arity gfunc 6 'map4-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) num(a) -> [0-255] as second
> argument")
> +  (check-procedure-arity bfunc 6 'map4-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) num(a) -> [0-255] as third
> argument")
> +  (check-procedure-arity afunc 6 'map4-image "Expected a function with
> contract num(x) num(y) num(r) num(g) num(b) num(a) -> [0-255] as fourth
> argument")
>    (unless (image? pic)
>      (error 'map4-image
>         "Expected an image as fifth argument, but received ~v" pic))
> @@ -428,3 +428,43 @@
>          [else (error 'fold-image/extra "Expected a function taking three
> or five parameters as first argument")]
>          ))
>
> +  (module+ test
> +           (require "book-pictures.rkt")
> +(require test-engine/racket-tests)
> +(check-error (build-image 100 100 add1)
> +"build-image: Expected a function with contract num(x) num(y) -> color as
> third argument")
> +(check-error (build-image/extra 100 100 add1 4)
> +"build-image/extra: Expected a function with contract num(x) num(y) any
> -> color as third argument")
> +(check-error (build3-image 100 100 add1 + +)
> +"build3-image: Expected a function with contract num(x) num(y) -> [0-255]
> as third argument")
> +(check-error (build3-image 100 100 + add1 +)
> +"build3-image: Expected a function with contract num(x) num(y) -> [0-255]
> as fourth argument")
> +(check-error (build3-image 100 100 + + add1)
> +"build3-image: Expected a function with contract num(x) num(y) -> [0-255]
> as fifth argument")
> +(check-error (build4-image 100 100 add1 + + +)
> +"build4-image: Expected a function with contract num(x) num(y) -> [0-255]
> as third argument")
> +(check-error (build4-image 100 100 + add1 + +)
> +"build4-image: Expected a function with contract num(x) num(y) -> [0-255]
> as fourth argument")
> +(check-error (build4-image 100 100 + + add1 +)
> +"build4-image: Expected a function with contract num(x) num(y) -> [0-255]
> as fifth argument")
> +(check-error (build4-image 100 100 + + + add1)
> +"build4-image: Expected a function with contract num(x) num(y) -> [0-255]
> as sixth argument")
> +(check-error (map3-image add1 + + pic:bloch)
> +"map3-image: Expected a function with contract num(x) num(y) num(r)
> num(g) num(b) -> [0-255] as first argument")
> +(check-error (map3-image + add1 + pic:bloch)
> +"map3-image: Expected a function with contract num(x) num(y) num(r)
> num(g) num(b) -> [0-255] as second argument")
> +(check-error (map3-image + + add1 pic:bloch)
> +"map3-image: Expected a function with contract num(x) num(y) num(r)
> num(g) num(b) -> [0-255] as third argument")
> +(check-error (map4-image add1 + + + pic:bloch)
> +"map4-image: Expected a function with contract num(x) num(y) num(r)
> num(g) num(b) num(a) -> [0-255] as first argument")
> +(check-error (map4-image + add1 + + pic:bloch)
> +"map4-image: Expected a function with contract num(x) num(y) num(r)
> num(g) num(b) num(a) -> [0-255] as second argument")
> +(check-error (map4-image + + add1 + pic:bloch)
> +"map4-image: Expected a function with contract num(x) num(y) num(r)
> num(g) num(b) num(a) -> [0-255] as third argument")
> +(check-error (map4-image + + + add1 pic:bloch)
> +"map4-image: Expected a function with contract num(x) num(y) num(r)
> num(g) num(b) num(a) -> [0-255] as fourth argument")
> +; more checks
> +;(check-error (map-image (lambda (c) c) pic:bloch)
> +;             "No, this should NOT produce an error.")
> +(test)
> +) ; end of test module
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/dev/archive/attachments/20130418/1611e5d7/attachment-0001.html>