Jessica's versions of promise pipelining tests, for good measure

goblins/vat.rkt

@@ -428,6 +428,84 @@
        ((list 'err _err)
         #t))))
 
+  ;; Jessica edition of promise pipelining testing
+  (define (^borked-factory _bcom)
+    (define (^car _bcom)
+      (lambda ()
+        (format "Vroom vroom")))
+
+    (match-lambda
+      ('make-car (spawn ^car))
+      ('make-error (error "Oops! no vrooming here :("))))
+
+  (define (try-car-pipeline vat factory method-name)
+    (let ((result #f)
+          (is-borked? 'unknown))
+      (vat
+       'run
+       (lambda ()
+         (define car-vow
+           (<- factory method-name))
+         ;; mark whether or not the car ends up as borked or not
+         (on car-vow
+             (lambda (car)
+               (set! is-borked? #f))
+             #:catch
+             (lambda (some-error)
+               (set! is-borked? #t)))
+         ;; try promise pipelining with the esult
+         (on (<- car-vow)
+             (lambda (car-says)
+               (set! result (vector 'ok car-says)))
+             #:catch
+             (lambda (some-error)
+               (set! result (vector 'err some-error))))))
+      (sleep 0.05)
+      (values result is-borked?)))
+
+  (define borked-factory (a-vat 'spawn ^borked-factory))
+
+  ;; Check the initial working car.
+  (let-values (((result is-borked?)
+                (try-car-pipeline a-vat borked-factory 'make-car)))
+    (test-true
+        "Sanity check to make sure factory normally works"
+      (and (not is-borked?)
+           (match result
+             ((vector 'ok "Vroom vroom")
+              #t)
+             (_ #f)))))
+
+  (let-values (((result is-borked?)
+                (try-car-pipeline b-vat borked-factory 'make-car)))
+    (test-true
+        "Sanity check to make sure factory normally works across vats"
+      (and (not is-borked?)
+           (match result
+             ((vector 'ok "Vroom vroom")
+              #t)
+             (_ #f)))))
+
+  ;; Now check the error.
+  (let-values (((result is-borked?)
+                (try-car-pipeline a-vat borked-factory 'make-error)))
+    (test-true
+        "Check promise pipeling breaks on error on the same vat"
+      (and is-borked?
+           (match result
+             ((vector 'err _err) #t)
+             (_ #f)))))
+
+  ;; Now check that errors work across vats
+  (let-values (((result is-borked?)
+                (try-car-pipeline b-vat borked-factory 'make-error)))
+    (test-true
+        "Check promise pipeling breaks on error between vats"
+      (and is-borked?
+           (match result
+             ((vector 'err _err) #t)
+             (_ #f)))))
+
 
   (define (try-remote-on-promise . resolve-args)
     (define fulfilled-val #f)