.

original commit: 893c2d427df48a2d2b588f2deb6c6ebd9f007212

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)

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)

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"