.
original commit: 6068b75a80cbeb926007a8dfad795458c150e35c
This commit is contained in:
parent
0c1f2f9018
commit
9d9e9aa76f
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
Loading…
Reference in New Issue
Block a user