Regression test for sandboxed evaluation

qi-lib/flow/core/passes.rkt

@@ -6,7 +6,10 @@
 (provide (for-syntax define-and-register-pass
                      run-passes))
 
-(begin-for-syntax
+(module macro-debug racket/base
+  ;; See tests/compiler/rules/full-cycle.rkt for an explanation
+  ;; re: sandboxed evaluation, submodules and test coverage.
+  (provide my-emit-local-step)
 
   (define my-emit-local-step
     ;; See "Breaking Out of the Sandbox"
@@ -15,7 +18,11 @@
                             (make-keyword-procedure
                              (lambda (kws kw-args . rest)
                                (void))))))
-      (dynamic-require 'macro-debugger/emit 'emit-local-step)))
+      (dynamic-require 'macro-debugger/emit 'emit-local-step))))
+
+(require (for-syntax 'macro-debug))
+
+(begin-for-syntax
 
   ;; Could be a list but for future extensibility a custom struct is
   ;; probably a better idea.

qi-lib/flow/extended/forms.rkt

@@ -15,7 +15,8 @@
          syntax/parse/define
          "expander.rkt"
          "../../macro.rkt"
-         "../space.rkt"
+         (only-in "../space.rkt"
+                  define-for-qi)
          "impl.rkt")
 
 ;;; Predicates

qi-test/info.rkt

@@ -6,5 +6,6 @@
 (define build-deps '("rackunit-lib"
                      "adjutor"
                      "math-lib"
+                     "sandbox-lib"
                      "qi-lib"))
 (define clean '("compiled" "tests/compiled" "tests/private/compiled"))

qi-test/tests/compiler/rules/full-cycle.rkt

@@ -11,22 +11,15 @@
          rackunit/text-ui
          syntax/macro-testing
          qi/flow/core/deforest
+         qi/flow/core/compiler
          "private/deforest-util.rkt"
          (submod qi/flow/extended/expander invoke))
 
 (begin-for-syntax
-  (require syntax/parse/define
-           (for-template qi/flow/core/compiler)
-           (for-syntax racket/base))
-
-  ;; A macro that accepts surface syntax, expands it, and then applies the
-  ;; indicated optimization passes.
-  (define-syntax-parser test-compile~>
-    [(_ stx)
-     #'(expand-flow stx)]
-    [(_ stx pass ... passN)
-     #'(passN
-        (test-compile~> stx pass ...))]))
+  ;; A function that expands and compiles surface syntax
+  (define (qi-compile stx)
+    (compile-flow
+     (expand-flow stx))))
 
 
 (define tests
@@ -39,9 +32,8 @@
     (test-true "normalize → deforest"
                (deforested?
                  (phase1-eval
-                  (test-compile~> #'(~>> (filter odd?) values (map sqr))
-                                  normalize-pass
-                                  deforest-pass)))))))
+                  (qi-compile
+                   #'(~>> (filter odd?) values (map sqr)))))))))
 
 (module+ main
   (void

qi-test/tests/flow.rkt

@@ -11,6 +11,7 @@
          racket/string
          racket/function
          racket/format
+         racket/sandbox
          (except-in "private/util.rkt"
                     add-two)
          syntax/macro-testing)
@@ -1657,7 +1658,29 @@
                 (thunk
                  ((☯ (== _ _ _))
                   3)))
-      (test-equal? "relay-_" ((☯ _) 3) 3))))))
+      (test-equal? "relay-_" ((☯ _) 3) 3))))
+
+   (test-suite
+    "regression tests"
+    (test-suite
+     "sandboxed evaluation"
+     (test-not-exn "Plays well with sandboxed evaluation"
+                   ;; See "Breaking Out of the Sandbox"
+                   ;; https://github.com/drym-org/qi/wiki/Qi-Meeting-Mar-29-2024
+                   ;;
+                   ;; This test reproduces the bug and the fix fixes it. Yet,
+                   ;; coverage does not show the lambda in `my-emit-local-step`
+                   ;; as being covered. This could be because the constructed
+                   ;; sandbox evaluator "covering" the code doesn't count as
+                   ;; coverage by the main evaluator running the test?
+                   ;; We address this by putting `my-emit-local-step` in a
+                   ;; submodule, which, by default, are ignored by coverage.
+                   (lambda ()
+                     (let ([eval (make-evaluator
+                                  'racket/base
+                                  '(require qi))])
+                       (eval
+                        '(☯ add1)))))))))
 
 (module+ main
   (void (run-tests tests)))