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,6 +11,8 @@
          rackunit/text-ui
          syntax/macro-testing
          qi/flow/core/deforest
+         qi/flow/core/compiler
+         racket/sandbox
          "private/deforest-util.rkt"
          (submod qi/flow/extended/expander invoke))
 
@@ -21,12 +23,17 @@
 
   ;; A macro that accepts surface syntax, expands it, and then applies the
   ;; indicated optimization passes.
-  (define-syntax-parser test-compile~>
+  (define-syntax-parser test-passes~>
     [(_ stx)
      #'(expand-flow stx)]
     [(_ stx pass ... passN)
      #'(passN
-        (test-compile~> stx pass ...))]))
+        (test-passes~> stx pass ...))])
+
+  ;; A macro that expands and compiles surface syntax
+  (define-syntax-parse-rule (qi-compile stx)
+    (compile-flow
+     (expand-flow stx))))
 
 
 (define tests
@@ -39,9 +46,47 @@
     (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)))))))
+   (test-suite
+    "sandboxed evaluation"
+    (test-not-exn "Plays well with sandboxed evaluation"
+                  ;; 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 (parameterize ([sandbox-output 'string]
+                                               [sandbox-error-output 'string]
+                                               [sandbox-memory-limit #f])
+                                  (make-evaluator
+                                   'racket/base
+                                   '(require (for-syntax racket/base)
+                                             ;; necessary to recognize and expand core forms correctly
+                                             qi/flow/extended/expander
+                                             ;; necessary to correctly expand the right-threading form
+                                             qi/flow/extended/forms
+                                             syntax/macro-testing
+                                             racket/list
+                                             qi/flow/core/compiler
+                                             (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 expands and compiles surface syntax
+                                      (define-syntax-parse-rule (qi-compile stx)
+                                        (compile-flow
+                                         (expand-flow stx))))))])
+                      (eval
+                       '(phase1-eval
+                         (qi-compile
+                          #'sqr)))))))))
 
 (module+ main
   (void