syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Detect and repair error in error-handling and -recovery.

This commit is contained in:
Tony Garnock-Jones 2018-11-02 12:15:04 +00:00
parent bc4fb5ef94
commit 7f14dd900c
2 changed files with 39 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
syndicate/dataspace.rkt
View File

@ -269,7 +269,13 @@
(define a (current-actor))
((current-actor-crash-logger) a e)
(abandon-queued-work! a)
(terminate-actor! a))]) ;; TODO: tracing
;; v Supply #f for `emit-patches?` here
;; because we are in an uncertain limbo after
;; discarding previously-queued actions.
;; Instead of emitting patches to orderly
;; tear down assertions from endpoints, we
;; rely on the recorded `cleanup-changes`.
(terminate-actor! a #f))]) ;; TODO: tracing
(call-with-syndicate-prompt
(lambda ()
body ...))
@ -437,12 +443,12 @@
(define v (actor-pending-scripts ac))
(vector-set! v priority (enqueue (vector-ref v priority) thunk-with-context)))
(define (retract-facet-assertions-and-subscriptions! f)
(define (retract-facet-assertions-and-subscriptions! f emit-patches?)
(define ac (facet-actor f))
(define ds (actor-dataspace ac))
(push-script! ac (lambda ()
(for [((eid ep) (in-hash (facet-endpoints f)))]
(destroy-endpoint! ds ac f ep))
(destroy-endpoint! ds ac f ep emit-patches?))
(hash-clear! (facet-endpoints f)))))
(define (abandon-queued-work! ac)
@ -452,15 +458,16 @@
(vector-set! scripts i (make-queue)))))
;; Abruptly terminates an entire actor, without running stop-scripts etc.
(define (terminate-actor! the-actor)
(push-script! the-actor (lambda () (for [(a (in-bag (actor-adhoc-assertions the-actor)))]
(retract! the-actor a))))
(define (terminate-actor! the-actor emit-patches?)
(when emit-patches?
(push-script! the-actor (lambda () (for [(a (in-bag (actor-adhoc-assertions the-actor)))]
(retract! the-actor a)))))
(let ((f (actor-root-facet the-actor)))
(when f
(let abort-facet! ((f f))
(set-facet-live?! f #f)
(for [(child (in-set (facet-children f)))] (abort-facet! child))
(retract-facet-assertions-and-subscriptions! f))))
(retract-facet-assertions-and-subscriptions! f emit-patches?))))
(push-script! the-actor (lambda () (enqueue-action! the-actor (quit)))))
;; Cleanly terminates a facet and its children, running stop-scripts etc.
@ -483,13 +490,13 @@
(for [(script (in-list (reverse (facet-stop-scripts f))))]
(script)))))
(retract-facet-assertions-and-subscriptions! f)
(retract-facet-assertions-and-subscriptions! f #t)
(push-script! #:priority *gc-priority* ac
(lambda ()
(if parent
(when (facet-inert? parent) (terminate-facet! parent))
(terminate-actor! ac))))))
(terminate-actor! ac #t))))))
(define (stop-facet! f stop-script)
(define ac (facet-actor f))
@ -523,13 +530,13 @@
(when ep
(define ac (facet-actor f))
(define ds (actor-dataspace ac))
(destroy-endpoint! ds ac f ep)
(destroy-endpoint! ds ac f ep #t)
(hash-remove! eps eid)))
(define (destroy-endpoint! ds ac f ep)
(define (destroy-endpoint! ds ac f ep emit-patches?)
(match-define (endpoint eid assertion handler _update-fn) ep)
(dataflow-forget-subject! (dataspace-dataflow ds) (list f eid))
(retract! ac assertion)
(when emit-patches? (retract! ac assertion))
(when handler (dataspace-unsubscribe! ds handler)))
(define (enqueue-action! ac action)

20
syndicate/test/core/death-during-turn.rkt Normal file
View File

@ -0,0 +1,20 @@
#lang imperative-syndicate/test-implementation
;; An error signalled mid-turn must cause previous actions to be
;; discarded; discarded actions must not be observed by peers.
(test-case
[(message-struct set-box (new-value))
(assertion-struct box-state (value))
(spawn (field [current-value 0])
(assert (box-state (current-value)))
(on (message (set-box $new-value)) (current-value new-value))
(begin/dataflow (when (= (current-value) 3)
(error 'box "aiee"))))
(spawn (on (asserted (box-state $v)) ;; must not see 3 here.
(printf "~v\n" v)
(send! (set-box (+ v 1)))))]
(expected-output (list "0"
"1"
"2")))