From 603cc19976e1fb8d142e388f429916e854d0bc73 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 16 Oct 1998 14:30:54 +0000 Subject: [PATCH] .. original commit: fe78d411079e6d07585f7c8b87a82a32a5eb02c8 --- collects/tests/framework/receive-sexps.ss | 44 +++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 collects/tests/framework/receive-sexps.ss diff --git a/collects/tests/framework/receive-sexps.ss b/collects/tests/framework/receive-sexps.ss new file mode 100644 index 00000000..89b3e0ef --- /dev/null +++ b/collects/tests/framework/receive-sexps.ss @@ -0,0 +1,44 @@ +(printf "creating thread~n") +(thread + (letrec ([restart + (lambda () + (printf "initializing loop~n") + (let*-values ([(listener) (tcp-listen (require-library "receive-sexps-port.ss" "tests" "framework"))] + [(in out) (tcp-accept listener)] + [(continue) (make-semaphore 0)] + [(error) #f] + [(answer) (void)]) + (let loop () + (printf "waiting for sexp~n") + (let ([sexp (read in)]) + (printf "read sexp: ~s~n" sexp) + (if (eof-object? sexp) + (begin + (printf "restarting loop~n") + (close-input-port in) + (close-output-port out) + (restart)) + (begin + (printf "enqueing callback~n") + (queue-callback (lambda () + (printf "callback~n") + (set! error #f) + (with-handlers ([(lambda (x) #t) + (lambda (exn) + (printf "abnormal termination: ~a~n" (exn-message exn)) + (set! error exn))]) + (set! answer (eval sexp)) + (printf "normal termination~n")) + (printf "posting to continue~n") + (semaphore-post continue))) + (printf "enqueued; waiting~n") + (semaphore-wait continue) + (printf "passed continue~n") + (write + (if error + (list 'error (exn-message error)) + (list 'normal answer)) + out) + (printf "looping~n") + (loop)))))))]) + restart))