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

..

Browse Source 
original commit: c53e6ee932d82c68274375c48e710def981ed9e0
This commit is contained in:
Robby Findler 2000-08-21 16:49:14 +00:00
parent 984dd9daff
commit 0cac9609e5
1 changed files with 71 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/framework/main.ss
View File

@ -133,7 +133,9 @@
(regexp-match re:tcp-write-error (exn-message exn))))
(define send-sexp-to-mred
(let ([failed-last-time? #f])
(lambda (sexp)
(let/ec k
(let ([show-text
(lambda (sexp)
@ -155,8 +157,18 @@
(restart-mred))
(printf " ~a // ~a: sending to mred:~n" section-name test-name)
(show-text sexp)
(with-handlers ([(lambda (x) #t)
(lambda (x)
(cond
;; this means that mred was closed
;; so we can restart it and try again.
[(tcp-error? x)
(restart-mred)
(write sexp out-port)
(newline out-port)
(newline out-port)]
[else (raise x)]))])
(write sexp out-port)
(newline out-port))
(let ([answer
(with-handlers ([(lambda (x) #t)
(lambda (x)
@ -192,7 +204,7 @@
[(normal)
(printf " ~a // ~a: received from mred:~n" section-name test-name)
(show-text (second answer))
(eval (second answer))]))))))
(eval (second answer))]))))))))
(define test