From 9d9e9aa76f123903a74c09f0353fd53ff8dddf30 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 12 Dec 2002 01:28:54 +0000
Subject: [PATCH] .

original commit: 6068b75a80cbeb926007a8dfad795458c150e35c
---
 collects/tests/mred/dc.ss     |  3 ---
 collects/tests/mred/item.ss   | 27 ++++++++++++++++++-----
 collects/tests/mred/paramz.ss | 41 +++++++++++++++++++++++++++++++++++
 3 files changed, 62 insertions(+), 9 deletions(-)

diff --git a/collects/tests/mred/dc.ss b/collects/tests/mred/dc.ss
index 8c2a1b91..79cc3ad3 100644
--- a/collects/tests/mred/dc.ss
+++ b/collects/tests/mred/dc.ss
@@ -41,14 +41,11 @@
 
   (try 'get-background)
   (try 'get-brush)
-  (try 'get-char-height)
-  (try 'get-char-width)
   (try 'get-clipping-region)
   (try 'get-font)
   (try 'get-pen)
   (try 'get-size)
   (try 'get-text-background)
-  (try 'get-text-extent "Hello")
   (try 'get-text-foreground)
   (try 'get-text-mode)
 
diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss
index 3ebf1054..eb1dac1c 100644
--- a/collects/tests/mred/item.ss
+++ b/collects/tests/mred/item.ss
@@ -283,8 +283,8 @@
       (unless (ok?)
 	(printf "bitmap failure: ~s~n" args)))))
 
-(define active-frame%
-  (class100-asi frame%
+(define (active-mixin %)
+  (class100-asi %
     (private-field
       [pre-on void]
       [click-i void]
@@ -308,6 +308,9 @@
 	       (set! click-i (add-click-intercept this ep))
 	       (set! el (add-enter/leave-note this ep)))])))
 
+(define active-frame% (active-mixin frame%))
+(define active-dialog% (active-mixin dialog%))
+
 (define (trace-mixin c%)
   (class100 c% (-name . args)
     (private-field [name -name])
@@ -509,9 +512,14 @@
 	 (list "Tab Panel" (lambda () (instantiate tab-panel% ('("Hello" "Bye") panel void) [style '(deleted)])))
 	 (list "Panel" (lambda () (instantiate panel% (panel) [style '(deleted border)]))))))
 
+(define use-dialogs? #f)
+
 (define (big-frame h-radio? v-label? null-label? stretchy? special-label-font? special-button-font? 
 		   initially-disabled? alternate-init?)
-  (define f (make-frame active-frame% "T\351ster")) ; 351 is e with '
+  (define f (make-frame (if use-dialogs?
+			    active-dialog%
+			    active-frame%)
+			"T\351ster")) ; 351 is e with '
   
   (define hp (make-object horizontal-panel% f))
   
@@ -565,7 +573,10 @@
 
 (define (med-frame plain-slider? label-h? null-label? stretchy? special-label-font? special-button-font?
 		   initially-disabled? alternate-init?)
-  (define f2 (make-frame active-frame% "Tester2"))
+  (define f2 (make-frame (if use-dialogs?
+			    active-dialog%
+			    active-frame%)
+			 "Tester2"))
 
   (define hp2 (make-object horizontal-panel% f2))
   
@@ -681,8 +692,9 @@
 
       (add-med-deleted-adds lp2))
 
-    (send f2 create-status-line)
-    (send f2 set-status-text "This is the status line")
+    (unless use-dialogs?
+      (send f2 create-status-line)
+      (send f2 set-status-text "This is the status line"))
     (send f2 show #t)
     (set! prev-frame f2)
     f2))
@@ -1863,6 +1875,9 @@
   (make-object button% "Get Instructions" clockp
 	       (lambda (b e) 
 		 (open-file "frame-steps.txt")))
+  (make-object check-box% "Use Dialogs" clockp
+	       (lambda (c e)
+		 (set! use-dialogs? (send c get-value))))
   (make-object vertical-panel% clockp) ; filler
   (let ([time (make-object message% "XX:XX:XX" clockp)])
     (make-object
diff --git a/collects/tests/mred/paramz.ss b/collects/tests/mred/paramz.ss
index 43845eff..789043a8 100644
--- a/collects/tests/mred/paramz.ss
+++ b/collects/tests/mred/paramz.ss
@@ -1,6 +1,47 @@
 
 (load-relative "loadtest.ss")
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                             Yield Tests                                    ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define s (make-semaphore))
+(define v 4)
+(queue-callback (lambda () (set! v 5)))
+(yield)
+(test v 'yield-run 5)
+(queue-callback (lambda () (set! v 6)))
+
+(semaphore-post s)
+(yield s)
+(test v 'yield-wait 5)
+(yield)
+(test v 'yield-run 6)
+
+(queue-callback (lambda () (set! v 7) (semaphore-post s)))
+(yield s)
+(test v 'yield-run-post 7)
+
+(queue-callback (lambda () 
+		  (set! v 8)
+		  (semaphore-post s)
+		  (queue-callback
+		   (lambda () (set! v 9)))))
+(yield s)
+(test v 'yield-wait-post 8)
+(yield)
+(test v 'yield-run 9)
+
+(define d (make-object dialog% "hello"))
+(thread (lambda () 
+	  (sleep 1)
+	  (queue-callback (lambda () (set! v 9)))
+	  (send d show #f)))
+(send d show #t)
+(test v 'dialog-wait 9)
+(yield)
+(test v 'dialog-run 9)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                        Parameterization Tests                              ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;