From 4c0e29165874ba502b8b7171fcd1b00ff6c93a80 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 4 Nov 2018 13:43:17 +0000 Subject: [PATCH] Repair longstanding, subtle bug in both old- and new-syndicate. during/spawn used not to add linkage assertions to its initial-assertion set. In addition, if a spawned actor died in its initial boot procedure, its initial assertions would never be visible. These two problems interlocked to cause a space leak in during/spawn, where monitoring facets would never be cleaned up. This change does two things: - adds linkage assertions to the initial-assertion set in during/spawn - properly briefly signals initial-assertions even when a new actor immediately crashes. Together, these repair the space leak in during/spawn with a crashy child startup procedure. --- imperative/syntax.rkt | 4 +- imperative/test/core/death-during-startup.rkt | 31 +++++++++++ racket/syndicate/actor.rkt | 7 ++- racket/syndicate/dataspace.rkt | 12 ++-- racket/syndicate/supervise.rkt | 55 ++++++++++++++++--- 5 files changed, 94 insertions(+), 15 deletions(-) create mode 100644 imperative/test/core/death-during-startup.rkt diff --git a/imperative/syntax.rkt b/imperative/syntax.rkt index 88b21f3..e4c562e 100644 --- a/imperative/syntax.rkt +++ b/imperative/syntax.rkt @@ -434,7 +434,9 @@ (w.wrapper #:linkage [(assert inst) (stop-when (retracted (observe inst)))] #:name name.N - #:assertions [assertions.exprs ...] + #:assertions [inst + (observe (observe inst)) + assertions.exprs ...] O ...)))))])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/imperative/test/core/death-during-startup.rkt b/imperative/test/core/death-during-startup.rkt new file mode 100644 index 0000000..0bbd144 --- /dev/null +++ b/imperative/test/core/death-during-startup.rkt @@ -0,0 +1,31 @@ +#lang imperative-syndicate/test-implementation +;; An error signalled during setup of a new actor's root facet must +;; cause previous actions to be discarded, but must also cause any +;; initial-assertions, including specifically linkage assertions from +;; during/spawn, to be briefly visible. + +(test-case + [(assertion-struct request (id)) + (assertion-struct response (value)) + + (spawn (during/spawn (request $id) + (printf "starting request handler\n") + (assert (response 'the-answer)) ;; must not be visible + (printf "asserted response, shouldn't be visible\n") + (error 'aieee "oh no") + (printf "NOTREACHED\n"))) + + (spawn (stop-when (asserted (observe (request _))) + (printf "service listening\n") + (react + (assert (request 101)) + (stop-when (retracted (observe (request _))) + (printf "whole service vanished\n")) + (stop-when (retracted (observe (request 101))) + (printf "specific instance vanished\n")) + (stop-when (asserted (response $v)) + (printf "response ~v\n" v)))))] + (expected-output (list "service listening" + "starting request handler" + "asserted response, shouldn't be visible" + "specific instance vanished"))) diff --git a/racket/syndicate/actor.rkt b/racket/syndicate/actor.rkt index b16eb38..0487ca9 100644 --- a/racket/syndicate/actor.rkt +++ b/racket/syndicate/actor.rkt @@ -538,7 +538,12 @@ (w.wrapper #:linkage [(assert inst) (stop-when (retracted (observe inst)))] #:name name.N - #:assertions* assertions.P + #:assertions* + (trie-union + assertions.P + (trie-union + (pattern->trie ' inst) + (pattern->trie ' (observe (observe inst))))) O ...)))))])) (define-syntax (begin/dataflow stx) diff --git a/racket/syndicate/dataspace.rkt b/racket/syndicate/dataspace.rkt index 13e5806..22eba80 100644 --- a/racket/syndicate/dataspace.rkt +++ b/racket/syndicate/dataspace.rkt @@ -197,10 +197,14 @@ initial-assertions name)) (lambda (exn) - (log-error "Spawned process in dataspace ~a died with exception:\n~a" - (current-actor-path) - (exn->string exn)) - (transition w '())))] + (create-process produced-point + w + #f + ( exn '()) + (if (trie? initial-assertions) + initial-assertions + trie-empty) + #f)))] ['quit (define-values (new-mux _label delta delta-aggregate) (mux-remove-stream (dataspace-mux w) label)) diff --git a/racket/syndicate/supervise.rkt b/racket/syndicate/supervise.rkt index 5c8e17c..e416558 100644 --- a/racket/syndicate/supervise.rkt +++ b/racket/syndicate/supervise.rkt @@ -10,6 +10,7 @@ (require "dataflow.rkt") (require "hierarchy.rkt") (require "store.rkt") +(require "trie.rkt") (require (submod "actor.rkt" implementation-details)) (require (for-syntax syntax/parse)) @@ -22,35 +23,71 @@ (syntax/loc stx (supervise* (lambda () name.N) void - (lambda () expr ...)))])) + (lambda () expr ...) + (lambda () trie-empty)))])) (define-syntax (supervise/spawn stx) (syntax-parse stx [(_ (~or (~optional (~seq #:name name-expr) #:defaults ([name-expr #'#f]) #:name "#:name") + (~optional (~seq #:assertions assertions-expr) + #:name "#:assertions") + (~optional (~seq #:assertions* assertions*-expr) + #:name "#:assertions*") (~optional (~seq #:linkage [linkage-expr ...]) #:defaults ([(linkage-expr 1) '()]) #:name "#:linkage")) ... O ...) - (syntax/loc stx + (quasisyntax/loc stx (supervise* (lambda () name-expr) (lambda () linkage-expr ... (void)) - (lambda () (spawn O ...))))])) + (lambda () (spawn O ...)) + (lambda () + #,(cond + [(attribute assertions-expr) + (when (attribute assertions*-expr) + (raise-syntax-error + 'supervise/spawn + "Both #:assertions and #:assertions* supplied" + stx)) + #'(pattern->trie ' assertions-expr)] + [(attribute assertions*-expr) + #'assertions*-expr] + [else + #'trie-empty]))))])) -(define (supervise* supervisor-name-thunk linkage-thunk actor-producing-thunk) +(define (supervise* supervisor-name-thunk + linkage-thunk + actor-producing-thunk + initial-assertions-thunk) ;; Awkward: the name applies to any and all potential supervisors ;; produced by actor spawns in actor-producing-thunk. (with-store [(current-action-transformer - (supervise-spawn supervisor-name-thunk linkage-thunk (current-action-transformer)))] + (supervise-spawn supervisor-name-thunk + linkage-thunk + initial-assertions-thunk + (current-action-transformer)))] (actor-producing-thunk))) -(define ((supervise-spawn supervisor-name-thunk linkage-thunk previous-action-transformer) ac) +(define ((supervise-spawn supervisor-name-thunk + linkage-thunk + initial-assertions-thunk + previous-action-transformer) + ac) (match (previous-action-transformer ac) - [(? actor? s) (supervise** (or (supervisor-name-thunk) (gensym 'supervisor)) linkage-thunk s)] + [(? actor? s) (supervise** (or (supervisor-name-thunk) (gensym 'supervisor)) + linkage-thunk + initial-assertions-thunk + s)] [other other])) -(define (supervise** supervisor-name linkage-thunk supervisee-spawn-action) - (actor-action #:name supervisor-name +(define (supervise** supervisor-name + linkage-thunk + initial-assertions-thunk + supervisee-spawn-action) + (actor-action + #:name supervisor-name + #:assertions* (initial-assertions-thunk) ;; will often be counterpart to linkage (react (linkage-thunk) ;; may contain e.g. linkage instructions from during/spawn