;;; 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")))