48 lines
2.0 KiB
Racket
48 lines
2.0 KiB
Racket
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
#lang syndicate/test-implementation
|
|
;; Goal: no matter the circumstances (e.g. exception in a stop
|
|
;; script), we will never retract an assertion more or fewer than the
|
|
;; correct number of times.
|
|
|
|
(test-case
|
|
[(spawn #:name 'supply
|
|
#:assertions ['marker]
|
|
(assert 'marker) ;; NB this is the change wrt the test case immediately below
|
|
(error 'test-case "Deliberate error"))
|
|
|
|
(spawn (on (asserted 'marker) (printf "marker appeared\n"))
|
|
(on (retracted 'marker) (printf "marker disappeared\n")))]
|
|
(it "should crash deliberately" (actor-died? 'supply "Deliberate error"))
|
|
(expected-output (list "marker appeared"
|
|
"marker disappeared")))
|
|
|
|
(test-case
|
|
[(spawn #:name 'supply
|
|
#:assertions ['marker]
|
|
(error 'test-case "Deliberate error"))
|
|
|
|
(spawn (on (asserted 'marker) (printf "marker appeared\n"))
|
|
(on (retracted 'marker) (printf "marker disappeared\n")))]
|
|
(it "should crash deliberately" (actor-died? 'supply "Deliberate error"))
|
|
(expected-output (list "marker appeared"
|
|
"marker disappeared")))
|
|
|
|
(test-case
|
|
;; Test cleanup after exception in stop script
|
|
[(assertion-struct layer (name))
|
|
(spawn #:name 'crasher
|
|
(define root-facet (current-facet))
|
|
(assert (layer 'outer))
|
|
(on-start (react (assert (layer 'middle))
|
|
(on-start (flush!) (flush!) (stop-facet root-facet))
|
|
(on-stop (error 'test-case "Deliberate error"))
|
|
(on-start (react (assert (layer 'inner)))))))
|
|
(spawn (on (retracted (layer $x)) (printf "~a gone\n" x)))]
|
|
(it "should crash deliberately" (actor-died? 'crasher "Deliberate error"))
|
|
;; a permutation of these lines is acceptable:
|
|
(expected-output (set "middle gone"
|
|
"inner gone"
|
|
"outer gone")))
|