original commit: 6068b75a80cbeb926007a8dfad795458c150e35c
This commit is contained in:
Matthew Flatt 2002-12-12 01:28:54 +00:00
parent 0c1f2f9018
commit 9d9e9aa76f
3 changed files with 62 additions and 9 deletions

View File

@ -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)

View File

@ -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

View File

@ -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 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;