diff --git a/collects/tests/mred/testing.ss b/collects/tests/mred/testing.ss index 5364e95b..55b08736 100644 --- a/collects/tests/mred/testing.ss +++ b/collects/tests/mred/testing.ss @@ -13,6 +13,18 @@ (printf "ERROR: ~a~n" s) (set! errs (cons s errs))))) +(define-syntax mismatch + (lambda (stx) + (syntax-case stx () + [(_ expr) + (syntax + (test 'was-mismatch 'mismtach + (with-handlers ([exn:application:mismatch? + (lambda (x) + (fprintf (current-error-port) "~a~n" (exn-message x)) + 'was-mismatch)] + [not-break-exn? values]) + expr)))]))) (define-syntax st (lambda (stx) diff --git a/collects/tests/mred/windowing.ss b/collects/tests/mred/windowing.ss index 0768567e..dd28d702 100644 --- a/collects/tests/mred/windowing.ss +++ b/collects/tests/mred/windowing.ss @@ -505,6 +505,11 @@ (st #f c get-value) (containee-window-tests c #f #f parent frame 2)) + (let ([c (make-object check-box% "True" + parent void + null + #t)]) + (st #t c get-value)) (printf "Radio Box~n") (letrec ([r (make-object radio-box% @@ -567,6 +572,19 @@ (st 0 r get-selection) (containee-window-tests r #f #f parent frame 2)) + (letrec ([r (make-object radio-box%"Radio Two" + (list "O&ne" "T&wo" "T&hree") + parent + void + '(vertical) + 2)]) + (st 2 r get-selection)) + (mismatch (make-object radio-box%"Radio Two" + (list "O&ne" "T&wo" "T&hree") + parent + void + '(vertical) + 3)) (printf "Gauge~n") (letrec ([g (make-object gauge% @@ -776,6 +794,17 @@ (test-list-control c #t #f) (containee-window-tests c #f #f parent frame 2)) + (letrec ([c (make-object choice% "Choice 2" + '("A" "B" "C & D") + parent void + null + 2)]) + (st 2 c get-selection)) + (mismatch (make-object choice% "Choice 2" + '("A" "B" "C & D") + parent void + null + 3)) (let ([mk-list (lambda (style) @@ -808,6 +837,19 @@ (mk-list 'extended)) 'done-lists) + (let ([l (make-object list-box% "List Two" + '("A" "B" "C & D") + parent + void + (list 'single) + 2)]) + (st 2 l get-selection)) + (mismatch (make-object list-box% "List Two" + '("A" "B" "C & D") + parent + void + (list 'single) + 3)) (let loop ([styles '((single) (multiple) (multiple hscroll))]) (unless (null? styles) diff --git a/notes/mred/HISTORY b/notes/mred/HISTORY index 72062d4a..4a50021a 100644 --- a/notes/mred/HISTORY +++ b/notes/mred/HISTORY @@ -5,6 +5,10 @@ Added tab-panel% Added message-box/custom Added 'app, 'caution, and 'stop styles to message-box Added 'app, 'caution, and 'stop labels for message% +Added value init argument to check%, selection init argument to + radio-box%, choice%, and list-box%; in the argument order, the new + argument follows the style argument +Added checked init argument for checkable-menu-item% Mac OS X: file dialogs use given starting directory, and dialog%s with a parent frame as shown as "sheets"