chaperone-evt: don't drop other chaperones
This commit is contained in:
parent
a70b3173b2
commit
a027e1445f
|
@ -1245,6 +1245,20 @@
|
||||||
(err/rt-test (sync (chaperone-evt evt redirect-3)))
|
(err/rt-test (sync (chaperone-evt evt redirect-3)))
|
||||||
(err/rt-test (sync (chaperone-evt evt redirect-4))))
|
(err/rt-test (sync (chaperone-evt evt redirect-4))))
|
||||||
|
|
||||||
|
;; check that evt-chaperone handling doesn't intefere with other chaperones:
|
||||||
|
(let ()
|
||||||
|
(struct e (orig)
|
||||||
|
#:property prop:input-port 0)
|
||||||
|
(define an-e (e (open-input-string "s")))
|
||||||
|
(define checked? #f)
|
||||||
|
(test #t input-port? an-e)
|
||||||
|
(sync (chaperone-struct an-e
|
||||||
|
e-orig
|
||||||
|
(lambda (self v)
|
||||||
|
(set! checked? #t)
|
||||||
|
v)))
|
||||||
|
(test #t values checked?))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; channel chaperones
|
;; channel chaperones
|
||||||
|
|
||||||
|
|
|
@ -3615,19 +3615,29 @@ static Scheme_Object *chaperone_evt(int argc, Scheme_Object *argv[])
|
||||||
return scheme_do_chaperone_evt("chaperone-evt", 0, argc, argv);
|
return scheme_do_chaperone_evt("chaperone-evt", 0, argc, argv);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int chaperone_evt_is_ready(Scheme_Object *o, Scheme_Schedule_Info *sinfo)
|
static int chaperone_evt_is_ready(Scheme_Object *obj, Scheme_Schedule_Info *sinfo)
|
||||||
{
|
{
|
||||||
|
Scheme_Object *o = obj;
|
||||||
Scheme_Chaperone *px;
|
Scheme_Chaperone *px;
|
||||||
|
int redirected = 0;
|
||||||
|
|
||||||
while (SCHEME_CHAPERONEP(o)) {
|
while (SCHEME_CHAPERONEP(o)) {
|
||||||
px = (Scheme_Chaperone *)o;
|
px = (Scheme_Chaperone *)o;
|
||||||
if (SAME_TYPE(SCHEME_TYPE(px->redirects), scheme_nack_guard_evt_type)) {
|
if (SAME_TYPE(SCHEME_TYPE(px->redirects), scheme_nack_guard_evt_type)) {
|
||||||
o = px->redirects;
|
o = px->redirects;
|
||||||
|
redirected = 1;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
o = px->prev;
|
o = px->prev;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (!redirected && SCHEME_STRUCTP(o)) {
|
||||||
|
/* No chaperone was an `evt` chaperone. Don't discard
|
||||||
|
other chaperones, because they may be relevant for
|
||||||
|
structure properties. */
|
||||||
|
return evt_struct_is_ready(obj, sinfo);
|
||||||
|
}
|
||||||
|
|
||||||
scheme_set_sync_target(sinfo, o, NULL, NULL, 0, 1, NULL);
|
scheme_set_sync_target(sinfo, o, NULL, NULL, 0, 1, NULL);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user