Positively assert detected failures during continuous interest
This commit is contained in:
parent
ca0de7d52f
commit
275b60310f
|
@ -4,6 +4,7 @@
|
||||||
(require/activate syndicate/drivers/timestate)
|
(require/activate syndicate/drivers/timestate)
|
||||||
|
|
||||||
(assertion-struct function (argument result))
|
(assertion-struct function (argument result))
|
||||||
|
(assertion-struct failed (argument))
|
||||||
|
|
||||||
(spawn #:name 'division-server
|
(spawn #:name 'division-server
|
||||||
(during/spawn (observe (function `(divide ,$n ,$d) _))
|
(during/spawn (observe (function `(divide ,$n ,$d) _))
|
||||||
|
@ -15,12 +16,30 @@
|
||||||
(react (assert (function `(divide ,n ,d) (/ n d)))
|
(react (assert (function `(divide ,n ,d) (/ n d)))
|
||||||
(on-start (printf "S: Computed ~a/~a\n" 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 (invert d #:on-answer [ks void] #:on-error [kf void])
|
||||||
(define req `(divide 1 ,d))
|
(define req `(divide 1 ,d))
|
||||||
(printf "C: Requesting ~a\n" req)
|
(printf "C: Requesting ~a\n" req)
|
||||||
(on (asserted (advertise (function req _)))
|
(on (asserted (advertise (function req _)))
|
||||||
(printf "C: Answer in progress!\n"))
|
(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 _)))
|
(stop-when (retracted (advertise (function req _)))
|
||||||
|
;; Directly detect error
|
||||||
(printf "C: No answer was supplied!\n")
|
(printf "C: No answer was supplied!\n")
|
||||||
(kf))
|
(kf))
|
||||||
(stop-when (asserted (function req $answer))
|
(stop-when (asserted (function req $answer))
|
||||||
|
@ -42,7 +61,10 @@
|
||||||
(react (invert 0
|
(react (invert 0
|
||||||
#:on-error
|
#:on-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(printf "C: Done!\n"))))))))))
|
(react (invert 0
|
||||||
|
#:on-error
|
||||||
|
(lambda ()
|
||||||
|
(printf "C: Done!\n")))))))))))))
|
||||||
|
|
||||||
(spawn (on (asserted (observe (function $req _)))
|
(spawn (on (asserted (observe (function $req _)))
|
||||||
(printf "X: Noticed request ~a\n" req)
|
(printf "X: Noticed request ~a\n" req)
|
||||||
|
|
Loading…
Reference in New Issue