diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss
index 2d20aae9..2c40bfa8 100644
--- a/collects/tests/mred/item.ss
+++ b/collects/tests/mred/item.ss
@@ -893,6 +893,96 @@
   (instructions p "checkbox-steps.txt")
   (send f show #t))
 
+(define (radiobox-frame)
+  (define f (make-object mred:frame% null "Radiobox Test"))
+  (define p (make-object mred:vertical-panel% f))
+  (define old-list null)
+  (define commands (list wx:const-event-type-radiobox-command))
+  (define hp (make-object mred:horizontal-panel% p))
+  (define _ (send hp stretchable-in-y #f))
+  (define callback (lambda (rb e)
+		     (set! old-list (cons e old-list))
+		     (unless (= (send rb get-selection) (send e get-selection))
+		       (error "event selection mismatch"))
+		     (unless (null? (send e get-string))
+		       (error "event string mismatch"))
+		     (check-callback-event rb rb e commands #f)))
+  (define rb1-l (list "Singleton"))
+  (define rb1 (make-object mred:radio-box% hp callback "&Left" -1 -1 -1 -1
+			   rb1-l))
+  (define rb2-l (list "First" "Last"))
+  (define rb2 (make-object mred:radio-box% hp callback "&Center" -1 -1 -1 -1
+			   rb2-l))
+  (define rb3-l (list "Top" "Middle" "Bottom"))
+  (define rb3 (make-object mred:radio-box% hp callback "&Right" -1 -1 -1 -1
+			   rb3-l))
+
+  (define rbs (list rb1 rb2 rb3))
+  (define rbls (list rb1-l rb2-l rb3-l))
+  (define normal-sel (lambda (rb p) (send rb set-selection p)))
+  (define name-sel (lambda (rb p) (send rb set-string-selection (cond
+								 [(= p -1) "Negative"]
+								 [(<= 0 p (sub1 (send rb number)))
+								  (send rb get-string p)]
+								 [else "Too Big"]))))
+  (define simulate-sel (lambda (rb p)
+			 (let ([e (make-object wx:command-event% wx:const-event-type-radiobox-command)])
+			   (send e set-selection p)
+			   (send e set-event-object rb)
+			   (send rb command e))))
+
+  (define do-sel (lambda (sel n) (for-each (lambda (rb) (sel rb (n rb))) rbs)))
+  (define sel-minus (lambda (sel) (do-sel sel (lambda (rb) -1))))
+  (define sel-first (lambda (sel) (do-sel sel (lambda (rb) 0))))
+  (define sel-middle (lambda (sel) (do-sel sel (lambda (rb) (floor (/ (send rb number) 2))))))
+  (define sel-last (lambda (sel) (do-sel sel (lambda (rb) (sub1 (send rb number))))))
+  (define sel-N (lambda (sel) (do-sel sel (lambda (rb) (send rb number)))))
+  (define (make-selectors title sel)
+    (define hp2 (make-object mred:horizontal-panel% p))
+    (send hp2 stretchable-in-y #f)
+    (make-object mred:button% hp2 (lambda (b e) (sel-minus sel))
+		 (format "Select -1~a" title))
+    (make-object mred:button% hp2 (lambda (b e) (sel-first sel))
+		 (format "Select First~a" title))
+    (make-object mred:button% hp2 (lambda (b e) (sel-middle sel))
+		 (format "Select Middle ~a" title))
+    (make-object mred:button% hp2 (lambda (b e) (sel-last sel))
+		 (format "Select Last~a" title))
+    (make-object mred:button% hp2 (lambda (b e) (sel-N sel))
+		 (format "Select N~a" title)))
+  (make-selectors "" normal-sel)
+  (make-selectors " by Name" name-sel)
+  (make-selectors " by Simulate" simulate-sel)
+  (make-object mred:button% p
+	       (lambda (c e)
+		 (for-each
+		  (lambda (rb l)
+		    (let loop ([n 0][l l])
+		      (unless (null? l)
+			(let ([a (car l)]
+			      [b (send rb get-string n)])
+			  (unless (string=? a b)
+			    (error "item name mismatch: ~s != ~s" a b)))
+			(unless (= n (send rb find-string (car l)))
+			  (error "find-string failed"))
+			(loop (add1 n) (cdr l)))))
+		  rbs rbls)
+		 (for-each
+		  (lambda (rb)
+		    (unless (string=? (send rb get-string (send rb get-selection))
+				      (send rb get-string-selection))
+		      (error "get-string-selection failure")))
+		  rbs)
+		 (for-each
+		  (lambda (e)
+		    (let ([rb (send e get-event-object)])
+		      (check-callback-event rb rb e commands #t)))
+		  old-list)
+		 (printf "All Ok~n"))
+	       "Check")
+  (instructions p "radiobox-steps.txt")
+  (send f show #t))
+
 (define (choice-or-list-frame list? list-style empty?)
   (define f (make-object mred:frame% null (if list? "List Test" "Choice Test")))
   (define p (make-object mred:vertical-panel% f))