Fix "out"-related bug in monolithic implementation
This commit is contained in:
parent
0a6cce2d3d
commit
de1dc5aa8e
|
@ -0,0 +1,34 @@
|
||||||
|
#lang prospect-monolithic
|
||||||
|
;; Check that nested-world assertions are properly retracted.
|
||||||
|
;; Should print two "Got SCN:" tries - one nonempty, and one empty.
|
||||||
|
|
||||||
|
#;(spawn (lambda (e s)
|
||||||
|
(match e
|
||||||
|
[(message 'die) (quit)]
|
||||||
|
[_ #f]))
|
||||||
|
(void)
|
||||||
|
(scn/union
|
||||||
|
(subscription 'die)
|
||||||
|
(subscription (observe 'die))))
|
||||||
|
|
||||||
|
(spawn-network
|
||||||
|
(spawn (lambda (e s)
|
||||||
|
(match e
|
||||||
|
[(message (at-meta 'die)) (quit)]
|
||||||
|
[_ #f]))
|
||||||
|
(void)
|
||||||
|
(scn/union
|
||||||
|
(subscription 'die #:meta-level 1)
|
||||||
|
(subscription (observe 'die) #:meta-level 1))))
|
||||||
|
|
||||||
|
(spawn (lambda (e s)
|
||||||
|
(match e
|
||||||
|
[(scn g)
|
||||||
|
(printf "Got SCN:\n")
|
||||||
|
(pretty-print-trie g)
|
||||||
|
(transition s (if (trie-non-empty? g)
|
||||||
|
(message 'die)
|
||||||
|
'()))]
|
||||||
|
[_ #f]))
|
||||||
|
(void)
|
||||||
|
(scn (subscription (observe 'die))))
|
|
@ -74,7 +74,9 @@
|
||||||
(values (for/list [(pid (tset->list affected-pids))]
|
(values (for/list [(pid (tset->list affected-pids))]
|
||||||
(cons pid (scn (biased-intersection new-routing-table (mux-interests-of new-m pid)))))
|
(cons pid (scn (biased-intersection new-routing-table (mux-interests-of new-m pid)))))
|
||||||
(and (not (meta-label? label))
|
(and (not (meta-label? label))
|
||||||
(drop-scn (scn (strip-interests new-routing-table))))))
|
(drop-scn (scn (trie-subtract (strip-interests new-routing-table)
|
||||||
|
(mux-interests-of new-m 'meta)
|
||||||
|
#:combiner (lambda (a b) #f)))))))
|
||||||
|
|
||||||
(define (compute-affected-pids routing-table cover)
|
(define (compute-affected-pids routing-table cover)
|
||||||
(trie-match-trie cover
|
(trie-match-trie cover
|
||||||
|
|
|
@ -0,0 +1,32 @@
|
||||||
|
#lang prospect
|
||||||
|
;; Check that nested-world assertions are properly retracted.
|
||||||
|
;; Should print two "Got SCN:" patches - one adding, and one removing (observe 'die).
|
||||||
|
|
||||||
|
#;(spawn (lambda (e s)
|
||||||
|
(match e
|
||||||
|
[(message 'die) (quit)]
|
||||||
|
[_ #f]))
|
||||||
|
(void)
|
||||||
|
(patch-seq (sub 'die)
|
||||||
|
(sub (observe 'die))))
|
||||||
|
|
||||||
|
(spawn-network
|
||||||
|
(spawn (lambda (e s)
|
||||||
|
(match e
|
||||||
|
[(message (at-meta 'die)) (quit)]
|
||||||
|
[_ #f]))
|
||||||
|
(void)
|
||||||
|
(patch-seq (sub 'die #:meta-level 1)
|
||||||
|
(sub (observe 'die) #:meta-level 1))))
|
||||||
|
|
||||||
|
(spawn (lambda (e s)
|
||||||
|
(match e
|
||||||
|
[(? patch? p)
|
||||||
|
(printf "Got SCN:\n")
|
||||||
|
(pretty-print-patch p)
|
||||||
|
(transition s (if (patch/added? p)
|
||||||
|
(message 'die)
|
||||||
|
'()))]
|
||||||
|
[_ #f]))
|
||||||
|
(void)
|
||||||
|
(sub (observe 'die)))
|
Loading…
Reference in New Issue