From 275b60310f74c9370b41f6191a1fc43cfb140d73 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 2 Oct 2017 14:31:58 +0100 Subject: [PATCH] Positively assert detected failures during continuous interest --- .../examples/actor/rpc-with-error.rkt | 24 ++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/racket/syndicate/examples/actor/rpc-with-error.rkt b/racket/syndicate/examples/actor/rpc-with-error.rkt index dcbafec..d09620f 100644 --- a/racket/syndicate/examples/actor/rpc-with-error.rkt +++ b/racket/syndicate/examples/actor/rpc-with-error.rkt @@ -4,6 +4,7 @@ (require/activate syndicate/drivers/timestate) (assertion-struct function (argument result)) +(assertion-struct failed (argument)) (spawn #:name 'division-server (during/spawn (observe (function `(divide ,$n ,$d) _)) @@ -15,12 +16,30 @@ (react (assert (function `(divide ,n ,d) (/ n d))) (on-start (printf "S: Computed ~a/~a\n" n d)))))) +(spawn #:name 'failure-signaller + (during/spawn (observe (function $req _)) + (on-start (printf "F: Noticed request ~a\n" req)) + (on-stop (printf "F: Forgetting request ~a\n" req)) + (on (retracted (advertise (function req _))) + (printf "F: Noticed failure for ~a\n" req) + (react (assert (failed req)) + (on-start (printf "F: Asserted failure for ~a\n" req)) + (on-stop (printf "F: Retracting failure for ~a\n" req)))))) + (define (invert d #:on-answer [ks void] #:on-error [kf void]) (define req `(divide 1 ,d)) (printf "C: Requesting ~a\n" req) (on (asserted (advertise (function req _))) (printf "C: Answer in progress!\n")) + (stop-when (asserted (failed req)) + ;; Indirectly detect error: relies on failure-signaller. + ;; We could comment out the next stop-when clause and rely + ;; entirely on this one -- both here and in the cache. + ;; Anywhere there's a client. + (printf "C: Received failure-detection signal!\n") + (kf)) (stop-when (retracted (advertise (function req _))) + ;; Directly detect error (printf "C: No answer was supplied!\n") (kf)) (stop-when (asserted (function req $answer)) @@ -42,7 +61,10 @@ (react (invert 0 #:on-error (lambda () - (printf "C: Done!\n")))))))))) + (react (invert 0 + #:on-error + (lambda () + (printf "C: Done!\n"))))))))))))) (spawn (on (asserted (observe (function $req _))) (printf "X: Noticed request ~a\n" req)