bc: fix sync
when a guard-evt turns into choice-evt late
During the time that the procedure in a guard-evt is called by `sync`, it's possible for the `sync` evt choice to become determined. If the guard-evt procedure then returns a choice-evt, the BC implementation of `sync` could lose track of the selected evt; the selection is represented by an index, and choice-evt splicing can shift indices. Possibly related to #3004
This commit is contained in:
parent
f4a9058941
commit
9ae6d66449
|
@ -1651,6 +1651,26 @@
|
||||||
(sync s))
|
(sync s))
|
||||||
(thread-wait t))
|
(thread-wait t))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; regression test to check that when a choice evt replaces a single
|
||||||
|
;; event, an already-chosen event (perhaps represented as an index) is
|
||||||
|
;; not misinterpreted later
|
||||||
|
|
||||||
|
(for ([i (in-range 10)])
|
||||||
|
(define ch (make-channel))
|
||||||
|
(define v
|
||||||
|
(sync (guard-evt
|
||||||
|
(lambda ()
|
||||||
|
(thread (lambda () (channel-put ch 0)))
|
||||||
|
(sync (system-idle-evt))
|
||||||
|
(choice-evt
|
||||||
|
(wrap-evt always-evt (lambda (v) 1))
|
||||||
|
(wrap-evt always-evt (lambda (v) 2))
|
||||||
|
(wrap-evt always-evt (lambda (v) 3)))))
|
||||||
|
ch))
|
||||||
|
(unless (memq v '(0 1 2 3))
|
||||||
|
(error "bad sync result" v)))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -6560,7 +6560,10 @@ static void set_sync_target(Syncing *syncing, int i, Scheme_Object *target,
|
||||||
/* Inline the set (in place) */
|
/* Inline the set (in place) */
|
||||||
Scheme_Object **argv;
|
Scheme_Object **argv;
|
||||||
Evt **ws;
|
Evt **ws;
|
||||||
|
|
||||||
|
if (syncing->result > i+1)
|
||||||
|
syncing->result += wts->argc-1;
|
||||||
|
|
||||||
argv = (Scheme_Object **)splice_ptr_array((void **)evt_set->argv,
|
argv = (Scheme_Object **)splice_ptr_array((void **)evt_set->argv,
|
||||||
evt_set->argc,
|
evt_set->argc,
|
||||||
(void **)wts->argv,
|
(void **)wts->argv,
|
||||||
|
|
Loading…
Reference in New Issue
Block a user