#lang imperative-syndicate/test-implementation
;; 2018-11-20 Prior to the commit that introduced this test case (and
;; fixed the bug it exposed), matching a constant/literal `(discard)`
;; in an `inbound` pattern would match a visibility-restricted term,
;; so long as the captures were in the right places. After the fix,
;; `instantiate-term->value` replaces `(discard)` in the term with an
;; opaque value that cannot match any other value, meaning that only
;; patterns which completely ignore `discard`ed positions will match.
;;
;; Previously, the test-case marked (B) below yielded the correct
;; output, but (A) yielded the following incorrect output:
;;
;;     Added discarded topic: Computering
;;     Added discarded topic: Bicycling
;;     Added discarded topic: Evil
;;     Added discarded topic: Cryptography
;;     Added topic: Computering
;;     Added topic: Bicycling
;;     Added topic: Evil
;;     Added topic: Cryptography
;;
;; Now both yield the same output.

(require (only-in imperative-syndicate/pattern discard capture))

(assertion-struct researcher (name topic))

(define-syntax-rule (correct-topics)
  (expected-output (set "Added topic: Bicycling"
                        "Added topic: Computering"
                        "Added topic: Cryptography"
                        "Added topic: Evil")))

(test-case ;; (A)
    [(spawn #:name 'tony
            (assert (researcher "Tony" "Computering"))
            (assert (researcher "Tony" "Bicycling")))
     (spawn #:name 'alice
            (assert (researcher "Alice" "Cryptography"))
            (assert (researcher "Alice" "Bicycling")))
     (spawn #:name 'eve
            (assert (researcher "Eve" "Cryptography"))
            (assert (researcher "Eve" "Computering"))
            (assert (researcher "Eve" "Evil")))

     (dataspace #:name 'inner-dataspace
                (spawn #:name 'all-topics
                       (during (inbound (researcher _ $topic))
                         (on-start (printf "Added topic: ~a\n" topic))
                         (on-stop (printf "Removed topic: ~a\n" topic))))
                (spawn #:name 'all-researchers
                       (during (inbound (researcher (discard) $topic))
                         (on-start (printf "Added discarded topic: ~a\n" topic))
                         (on-stop (printf "Removed discarded topic: ~a\n" topic)))))]
  no-crashes
  (correct-topics))

(test-case ;; (B)
    [(spawn #:name 'tony
            (assert (researcher "Tony" "Computering"))
            (assert (researcher "Tony" "Bicycling")))
     (spawn #:name 'alice
            (assert (researcher "Alice" "Cryptography"))
            (assert (researcher "Alice" "Bicycling")))
     (spawn #:name 'eve
            (assert (researcher "Eve" "Cryptography"))
            (assert (researcher "Eve" "Computering"))
            (assert (researcher "Eve" "Evil")))

     (spawn #:name 'all-topics
            (during (researcher _ $topic)
              (on-start (printf "Added topic: ~a\n" topic))
              (on-stop (printf "Removed topic: ~a\n" topic))))
     (spawn #:name 'all-researchers
            (during (researcher (discard) $topic)
              (on-start (printf "Added discarded topic: ~a\n" topic))
              (on-stop (printf "Removed discarded topic: ~a\n" topic))))]
  no-crashes
  (correct-topics))