From 9e923e1c63acc3399346c93a07859c3e238f39b7 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Mon, 25 Mar 2019 12:16:30 +0000
Subject: [PATCH] Failing test case: need visibility-restriction in broker
 clients

---
 syndicate/test/broker/nesting-confusion.rkt | 103 ++++++++++++++++++++
 1 file changed, 103 insertions(+)
 create mode 100644 syndicate/test/broker/nesting-confusion.rkt

diff --git a/syndicate/test/broker/nesting-confusion.rkt b/syndicate/test/broker/nesting-confusion.rkt
new file mode 100644
index 0000000..01117c9
--- /dev/null
+++ b/syndicate/test/broker/nesting-confusion.rkt
@@ -0,0 +1,103 @@
+#lang imperative-syndicate/test-implementation
+;; Analogous to the `core/nesting-confusion.rkt` test case.
+
+(require (only-in imperative-syndicate/lang activate))
+(require imperative-syndicate/broker)
+
+(assertion-struct researcher (name topic))
+
+(define test-address (broker-loopback-connection "test"))
+
+(define no-mention-of-discard
+  (lambda ()
+    (not (memf (lambda (line) (string-contains? line "#s(discard)"))
+               (collected-lines)))))
+
+(define-syntax-rule (correct-topics-and-researchers)
+  (expected-output (set "Added researcher: Alice"
+                        "Added researcher: Eve"
+                        "Added researcher: Tony"
+                        "Added topic: Bicycling"
+                        "Added topic: Computering"
+                        "Added topic: Cryptography"
+                        "Added topic: Evil")))
+
+(test-case
+    [(activate imperative-syndicate/broker)
+
+     (spawn #:name 'tony
+            (assert (server-envelope "test" (researcher "Tony" "Computering")))
+            (assert (server-envelope "test" (researcher "Tony" "Bicycling"))))
+     (spawn #:name 'alice
+            (assert (server-envelope "test" (researcher "Alice" "Cryptography")))
+            (assert (server-envelope "test" (researcher "Alice" "Bicycling"))))
+     (spawn #:name 'eve
+            (assert (server-envelope "test" (researcher "Eve" "Cryptography")))
+            (assert (server-envelope "test" (researcher "Eve" "Computering")))
+            (assert (server-envelope "test" (researcher "Eve" "Evil"))))
+
+     (spawn #:name 'all-topics
+            (during (broker-connected test-address)
+              (during (from-broker test-address (researcher _ $topic))
+                (on-start (printf "Added topic: ~a\n" topic))
+                (on-stop (printf "Removed topic: ~a\n" topic)))))
+     (spawn #:name 'all-researchers
+            (during (broker-connected test-address)
+              (during (from-broker test-address (researcher $name _))
+                (on-start (printf "Added researcher: ~a\n" name))
+                (on-stop (printf "Removed researcher: ~a\n" name)))))]
+  no-crashes
+  no-mention-of-discard
+  (correct-topics-and-researchers))
+
+;;---------------------------------------------------------------------------
+
+(assertion-struct claim (detail))
+
+(define (asserts-then-retractions)
+  (and (equal? (length (collected-lines)) 4)
+       (equal? (list->set (take (collected-lines) 2)) (set "Specific claim asserted"
+                                                           "Nonspecific claim 123 asserted"))
+       (equal? (list->set (drop (collected-lines) 2)) (set "Specific claim retracted"
+                                                           "Nonspecific claim 123 retracted"))))
+
+(test-case
+    [(activate imperative-syndicate/broker)
+
+     (spawn #:name 'claimant
+            (assert (server-envelope "test" (claim 123)))
+            (on-start (for [(i 100)] (flush!)) (stop-current-facet)))
+     (spawn #:name 'monitor
+            (during (broker-connected test-address)
+              (during (from-broker test-address (claim 123))
+                (on-start (printf "Specific claim asserted\n"))
+                (on-stop (printf "Specific claim retracted\n")))
+              (during (from-broker test-address (claim $detail))
+                (on-start (printf "Nonspecific claim ~v asserted\n" detail))
+                (on-stop (printf "Nonspecific claim ~v retracted\n" detail)))))]
+  no-crashes
+  asserts-then-retractions)
+
+;;---------------------------------------------------------------------------
+
+(test-case
+    [(activate imperative-syndicate/broker)
+
+     (spawn #:name 'inner-monitor
+            (during (broker-connected test-address)
+              (during (from-broker test-address (claim $detail))
+                (on-start (printf "Inner saw claim asserted\n"))
+                (on-stop (printf "Inner saw claim retracted\n")))))
+     (spawn #:name 'claimant
+            (assert (server-envelope "test" (claim 123)))
+            (on-start (printf "Outer claimant started\n"))
+            (on-stop (printf "Outer claimant stopped\n"))
+            (on-start (for [(i 100)] (flush!))
+                      (printf "Stopping outer claimant\n")
+                      (stop-current-facet)))]
+  no-crashes
+  (expected-output (list "Outer claimant started"
+                         "Inner saw claim asserted"
+                         "Stopping outer claimant"
+                         "Outer claimant stopped"
+                         "Inner saw claim retracted")))