suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust the framework test suite so that queue-sexp-to-mred catches and propogates exceptions

Browse Source 
original commit: 62c961410cb8b865f3ae0feda125b3fbc75d48d2
This commit is contained in:
Robby Findler 2011-02-15 08:59:36 -06:00 committed by Robby Findler
parent a67b2a6cb0
commit 4c89ce420d
1 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/tests/framework/test-suite-utils.rkt
View File

@ -144,8 +144,11 @@
(send-sexp-to-mred (send-sexp-to-mred
`(let ([thunk (lambda () ,sexp)] ;; low tech hygiene `(let ([thunk (lambda () ,sexp)] ;; low tech hygiene
[c (make-channel)]) [c (make-channel)])
(queue-callback (lambda () (channel-put c (thunk)))) (queue-callback (lambda () (channel-put c (with-handlers ((exn:fail? (λ (x) (list 'exn x)))) (list 'normal (thunk))))))
(channel-get c))))) (let ([res (channel-get c)])
(if (eq? (list-ref res 0) 'normal)
(list-ref res 1)
(raise (list-ref res 1))))))))
(define re:tcp-read-error (regexp "tcp-read:")) (define re:tcp-read-error (regexp "tcp-read:"))
(define re:tcp-write-error (regexp "tcp-write:")) (define re:tcp-write-error (regexp "tcp-write:"))