Skip to content
Newer
Older
100644 98 lines (85 sloc) 2.61 KB
093840d @jeapostrophe Re Tony
authored
1 #lang racket
2
3 #|
4
5 Threads with exit status
6
7 |#
8 (require racket/async-channel)
9
10 (struct *thread* (real-thread exit-ch exit-status-box) #:mutable)
11 (struct thread-ans ())
12 (struct thread-ans:exn thread-ans (x))
13 (struct thread-ans:val thread-ans (x))
14
15 (define (new-thread thnk)
16 (define t
17 (thread
18 (lambda ()
19 (with-handlers
20 ([void
21 (lambda (x)
22 (async-channel-put ch (thread-ans:exn x)))])
23 (async-channel-put ch (thread-ans:val (thnk)))))))
24 (define ch (make-async-channel 1))
25 (*thread* t ch (box #f)))
26
27 (define (update-thread! thd)
28 (match-define (*thread* t ch stb) thd)
29 (cond
30 ;; It is dead, but we haven't got the answer
31 [(and (thread-dead? t) ch)
32 ;; Get the value
33 (set-box! stb (async-channel-get ch))
34 ;; Destroy the channel
35 (set-*thread*-exit-ch! thd #f)]
36 ;; It is dead, we have got the answer
37 [(and (thread-dead? t) (not ch))
38 (void)]
39 ;; It is not dead, so keep running
40 [(not (thread-dead? t))
41 (void)])
42 thd)
43
44 (define (thread-died-with-exception? thd)
45 (match-define (*thread* t ch stb) (update-thread! thd))
46 (cond
47 [(not (thread-dead? t))
48 (error 'hasnt-died-yet)]
49 [(thread-ans:exn? (unbox stb))
50 #t]
51 [(thread-ans:val? (unbox stb))
52 #f]))
53
54 (define (thread-exception thd)
55 (match-define (*thread* t ch stb) (update-thread! thd))
56 (cond
57 [(not (thread-dead? t))
58 (error 'hasnt-died-yet)]
59 [(thread-ans:exn? (unbox stb))
60 (thread-ans:exn-x (unbox stb))]
61 [(thread-ans:val? (unbox stb))
62 (error 'didnt-raise)]))
63
64 (define (thread-result thd)
65 (match-define (*thread* t ch stb) (update-thread! thd))
66 (cond
67 [(not (thread-dead? t))
68 (error 'hasnt-died-yet)]
69 [(thread-ans:exn? (unbox stb))
70 (error 'raised)]
71 [(thread-ans:val? (unbox stb))
72 (thread-ans:val-x (unbox stb))]))
73
74 (define (*thread*-wait thd)
75 (match-define (*thread* t ch stb) thd)
76 (thread-wait t))
77
78 (require tests/eli-tester)
79
80 (test
81 (let ()
82 (define t (new-thread (lambda () (semaphore-wait (make-semaphore)))))
83 (test (thread-died-with-exception? t) => (error 'hasnt-died-yet)
84 (thread-exception t) => (error 'hasnt-died-yet)
85 (thread-result t) => (error 'hasnt-died-yet)))
86 (let ()
87 (define t (new-thread (lambda () (raise 1))))
88 (test (*thread*-wait t) => (void)
89 (thread-died-with-exception? t) => #t
90 (thread-exception t) => 1
91 (thread-result t) => (error 'raised)))
92 (let ()
93 (define t (new-thread (lambda () 1)))
94 (test (*thread*-wait t) => (void)
95 (thread-died-with-exception? t) => #f
96 (thread-exception t) => (error 'didnt-raise)
97 (thread-result t) => 1)))
Something went wrong with that request. Please try again.