fix handling of choice evt returned by a guard evt

Closes PR 14195

Merge to v6.0
This commit is contained in:
Matthew Flatt 2013-11-24 08:13:08 -07:00
parent f4ed053620
commit 90388d1549
2 changed files with 33 additions and 2 deletions

View File

@ -241,6 +241,28 @@
(test 0.15 sync/timeout 18
(choice-evt (make-delay 0.2) (make-delay 0.15))))
;;check flattening of choice evts returned by a guard:
(let ()
(define s1 (make-semaphore))
(define s2 (make-semaphore))
(define s3 (make-semaphore))
(define s4 (make-semaphore))
(define evt1 (choice-evt s1 s2))
(define evt2 (choice-evt s3 s4))
(thread (lambda ()
(sync (system-idle-evt))
(semaphore-post
(list-ref (list s1 s2 s3 s4)
(random 4)))))
(test #t
semaphore?
(sync (guard-evt
(lambda ()
(choice-evt evt1 evt2))))))
;; ----------------------------------------
;; Wrapped waitables

View File

@ -5947,6 +5947,7 @@ void scheme_clear_thread_sync(Scheme_Thread *p)
/*========================================================================*/
static void syncing_needs_wakeup(Scheme_Object *s, void *fds);
static Evt_Set *make_evt_set(const char *name, int argc, Scheme_Object **argv, int delta, int flatten);
typedef struct Evt {
MZTAG_IF_REQUIRED
@ -6168,7 +6169,15 @@ static void set_sync_target(Syncing *syncing, int i, Scheme_Object *target,
if (SCHEME_EVTSETP(target) && retry) {
/* Flatten the set into this one */
Evt_Set *wts = (Evt_Set *)target;
Evt_Set *wts;
if (SCHEME_EVTSET_UNFLATTENEDP(target)) {
Scheme_Object *a[1];
a[0] = target;
wts = make_evt_set("sync", 1, a, 0, 1);
} else
wts = (Evt_Set *)target;
if (wts->argc == 1) {
/* 1 thing in set? Flattening is easy! */
evt_set->argv[i] = wts->argv[0];
@ -6486,7 +6495,7 @@ static int evt_set_flatten(Evt_Set *e, int pos, Scheme_Object **args, Evt **ws)
return pos;
}
Evt_Set *make_evt_set(const char *name, int argc, Scheme_Object **argv, int delta, int flatten)
static Evt_Set *make_evt_set(const char *name, int argc, Scheme_Object **argv, int delta, int flatten)
{
Evt *w, **iws, **ws;
Evt_Set *evt_set, *subset;