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

...

Browse Source 
original commit: ed17cf2e0383ed88cba8bfd8ab9c3d272424ad5f
This commit is contained in:
Robby Findler 1998-11-02 21:04:32 +00:00
parent 2924bf0d2d
commit 96ad62b6ee
1 changed files with 35 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
collects/tests/framework/framework-test-engine.ss
View File

@ -1,33 +1,37 @@
(printf "mred:creating thread~n")
(thread
(letrec ([restart
(lambda ()
(printf "mred:initializing loop~n")
(let*-values ([(in out) (tcp-connect "localhost" (load-relative "receive-sexps-port.ss"))]
[(continue) (make-semaphore 0)]
[(error) #f]
[(answer) (void)])
(printf "mred:made connection~n")
(let loop ()
(let ([sexp (read in)])
(if (eof-object? sexp)
(begin
(close-input-port in)
(close-output-port out)
(exit))
(begin
(queue-callback (lambda ()
(set! error #f)
(with-handlers ([(lambda (x) #t)
(lambda (exn)
(set! error exn))])
(set! answer (eval sexp)))
(semaphore-post continue)))
(semaphore-wait continue)
(write
(if error
(list 'error (exn-message error))
(list 'normal answer))
out)
(loop)))))))])
restart))
(with-handlers ([(lambda (x) #t)
(lambda (exn)
(fprintf (current-error-port) "mred: ")
(raise exn))])
(letrec ([restart
(lambda ()
(printf "mred:initializing loop~n")
(let*-values ([(in out) (tcp-connect "localhost" (load-relative "receive-sexps-port.ss"))]
[(continue) (make-semaphore 0)]
[(error) #f]
[(answer) (void)])
(printf "mred:made connection~n")
(let loop ()
(let ([sexp (read in)])
(if (eof-object? sexp)
(begin
(close-input-port in)
(close-output-port out)
(exit))
(begin
(queue-callback (lambda ()
(set! error #f)
(with-handlers ([(lambda (x) #t)
(lambda (exn)
(set! error exn))])
(set! answer (eval sexp)))
(semaphore-post continue)))
(semaphore-wait continue)
(write
(if error
(list 'error (exn-message error))
(list 'normal answer))
out)
(loop)))))))])
restart)))