racket/gui: fix `slider%' range checking

Closes PR 12669
This commit is contained in:
Matthew Flatt 2012-04-02 15:25:47 -06:00
parent cb7200295e
commit 3bf5389237
2 changed files with 15 additions and 1 deletions

View File

@ -361,7 +361,17 @@
(check-callback cwho callback) (check-callback cwho callback)
(check-slider-integer cwho init-value) (check-slider-integer cwho init-value)
(check-style cwho '(vertical horizontal) '(plain vertical-label horizontal-label deleted) style) (check-style cwho '(vertical horizontal) '(plain vertical-label horizontal-label deleted) style)
(check-font cwho font))) (check-font cwho font)
(unless (<= minv maxv)
(raise-mismatch-error (who->name cwho)
(format "minumum value: ~e is greater than maximum value: " minv)
maxv))
(unless (<= minv init-value maxv)
(raise-mismatch-error (who->name cwho)
(format "minumum value: ~e and maximum value: ~e do no bound initial value: "
minv
maxv)
init-value))))
(private-field (private-field
[wx #f]) [wx #f])
(public (public

View File

@ -630,6 +630,10 @@
(containee-window-tests g #t #f parent frame 2)) (containee-window-tests g #t #f parent frame 2))
(printf "Slider\n") (printf "Slider\n")
(mismatch
(new slider% [parent parent] [label #f] [min-value 10] [max-value 9]))
(mismatch
(new slider% [parent parent] [label #f] [min-value 10] [max-value 11] [init-value 12]))
(letrec ([s (make-object slider% (letrec ([s (make-object slider%
"&Slider" "&Slider"
-2 8 -2 8