allow test to run if GL is unavailable

This commit is contained in:
Matthew Flatt 2012-07-15 10:36:36 -06:00
parent 73e901a262
commit 55a8445b0b

View File

@ -577,23 +577,24 @@
(define dc2 (make-object bitmap-dc% bm2)) (define dc2 (make-object bitmap-dc% bm2))
(define gl1 (send dc1 get-gl-context)) (define gl1 (send dc1 get-gl-context))
(define gl2 (send dc2 get-gl-context)) (define gl2 (send dc2 get-gl-context))
(send gl1 call-as-current (when (and gl1 gl2)
(lambda () (send gl1 call-as-current
(test 5 'alt (send gl2 call-as-current (lambda ()
(lambda () (error "not in this context!")) (test 5 'alt (send gl2 call-as-current
(wrap-evt always-evt (lambda (v) 5)))) (lambda () (error "not in this context!"))
(sync (wrap-evt always-evt (lambda (v) 5))))
(thread (sync
(lambda () (thread
(test 8 'thread/alts (lambda ()
(send gl1 call-as-current (test 8 'thread/alts
(lambda () (error "not in this thread!")) (send gl1 call-as-current
(wrap-evt always-evt (lambda (v) 8))))))) (lambda () (error "not in this thread!"))
(test 8 'reenter (send gl1 call-as-current (wrap-evt always-evt (lambda (v) 8)))))))
(lambda () 8))))) (test 8 'reenter (send gl1 call-as-current
(with-handlers ([exn? void]) (lambda () 8)))))
(send gl1 call-as-current (lambda () (error "fail")))) (with-handlers ([exn? void])
(test 12 'post-exn (send gl1 call-as-current (lambda () 12)))) (send gl1 call-as-current (lambda () (error "fail"))))
(test 12 'post-exn (send gl1 call-as-current (lambda () 12)))))
;; ---------------------------------------- ;; ----------------------------------------