Positively assert detected failures during continuous interest

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)