99 lines
4.3 KiB
Racket
99 lines
4.3 KiB
Racket
#lang syndicate/test-implementation
|
|
;; See .../racket/syndicate/examples/actor/example-partial-retraction.rkt
|
|
;; TODO: deal with permissible permutations in the output
|
|
|
|
(test-case
|
|
[(struct ready (what) #:prefab)
|
|
(struct entry (key val) #:prefab)
|
|
|
|
(spawn (assert (ready 'listener))
|
|
(on (asserted (entry $key _))
|
|
(printf "key ~v asserted\n" key)
|
|
(until (retracted (entry key _))
|
|
(on (asserted (entry key $value))
|
|
(printf "add binding: ~v -> ~v\n" key value))
|
|
(on (retracted (entry key $value))
|
|
(printf "del binding: ~v -> ~v\n" key value)))
|
|
(printf "key ~v retracted\n" key)))
|
|
|
|
(spawn (assert (ready 'other-listener))
|
|
(during (entry $key _)
|
|
(printf "(other-listener) key ~v asserted\n" key)
|
|
(on-stop (printf "(other-listener) key ~v retracted\n" key))
|
|
(during (entry key $value)
|
|
(printf "(other-listener) ~v ---> ~v\n" key value)
|
|
(on-stop (printf "(other-listener) ~v -/-> ~v\n" key value)))))
|
|
|
|
(define (pause)
|
|
(displayln "pause")
|
|
(define token (gensym 'pause)) ;; FIXME:: If we use the same token every time, need epochs!
|
|
(until (asserted (ready token))
|
|
(assert (ready token))))
|
|
|
|
(spawn* (until (asserted (ready 'listener)))
|
|
(until (asserted (ready 'other-listener)))
|
|
(assert! (entry 'a 1))
|
|
(assert! (entry 'a 2))
|
|
(assert! (entry 'b 3))
|
|
(assert! (entry 'c 33))
|
|
(assert! (entry 'a 4))
|
|
(assert! (entry 'a 5))
|
|
(pause)
|
|
(retract! (entry 'a 2))
|
|
(retract! (entry 'c 33))
|
|
(assert! (entry 'a 9))
|
|
(pause)
|
|
(local-require "../../bag.rkt")
|
|
(for [(a (in-bag (current-adhoc-assertions)))]
|
|
(match a
|
|
[(entry 'a _) (retract! a)]
|
|
[_ (void)]))
|
|
;; ^ (retract! (entry 'a ?))
|
|
(pause))]
|
|
no-crashes
|
|
;; To properly test this, we need something closer to real
|
|
;; regular-expressions-with-interleave over output lines:
|
|
#;(expected-output (list "pause"
|
|
"pause")
|
|
(set "(other-listener) key 'a asserted"
|
|
"(other-listener) key 'c asserted"
|
|
"(other-listener) key 'b asserted")
|
|
(set "(other-listener) 'a ---> 4"
|
|
"(other-listener) 'a ---> 1"
|
|
"(other-listener) 'a ---> 2"
|
|
"(other-listener) 'a ---> 5"
|
|
"(other-listener) 'c ---> 33"
|
|
"(other-listener) 'b ---> 3")
|
|
(set "key 'a asserted"
|
|
"key 'c asserted"
|
|
"key 'b asserted")
|
|
(set "add binding: 'a -> 4"
|
|
"add binding: 'a -> 1"
|
|
"add binding: 'a -> 2"
|
|
"add binding: 'a -> 5"
|
|
"add binding: 'c -> 33"
|
|
"add binding: 'b -> 3")
|
|
(list "pause")
|
|
(set "del binding: 'a -> 2"
|
|
"del binding: 'c -> 33"
|
|
"add binding: 'a -> 9")
|
|
(set "key 'c retracted")
|
|
(set "(other-listener) 'a ---> 9"
|
|
"(other-listener) 'a -/-> 2"
|
|
"(other-listener) 'c -/-> 33"
|
|
"(other-listener) key 'c retracted")
|
|
(set "del binding: 'a -> 1"
|
|
"del binding: 'a -> 9"
|
|
"del binding: 'a -> 5"
|
|
"del binding: 'a -> 4")
|
|
(set "key 'a retracted")
|
|
(set "(other-listener) 'a -/-> 1"
|
|
"(other-listener) 'a -/-> 9"
|
|
"(other-listener) 'a -/-> 5"
|
|
"(other-listener) 'a -/-> 4")
|
|
(set "(other-listener) key 'a retracted")
|
|
(set "del binding: 'b -> 3")
|
|
(set "key 'b retracted")
|
|
(set "(other-listener) 'b -/-> 3")
|
|
(set "(other-listener) key 'b retracted")))
|