[honu] use sandbox evaluator to test honu code

collects/honu/core/private/honu-typed-scheme.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require (rename-in typed-scheme (#%module-begin #%module-begin-typed-scheme)))
+;; (require (rename-in typed-scheme (#%module-begin #%module-begin-typed-scheme)))
 (require (for-syntax scheme/base
                      syntax/stx
                      syntax/name

collects/tests/honu/check.rkt

@@ -1,124 +1,60 @@
-#lang at-exp racket
+#lang at-exp racket/base
 
-(define (write-to-file input)
+(require racket/sandbox
-  (define file (make-temporary-file))
+         racket/port
-  (with-output-to-file file
+         rackunit
-                       #:mode 'text
+         honu/core/read)
-                       #:exists 'truncate
-                       (lambda () (printf input)))
-  file)
 
-(define (execute-racket file)
+(define honu-eval (make-parameter (lambda args (error 'honu-eval "set the honu evaluator"))))
-  (match-define [list output input id error-port status]
+(define (make-honu-evaluator)
-                (process (format "racket ~a" file)))
+  (call-with-trusted-sandbox-configuration
-  (status 'wait)
+    (lambda ()
-  (when (not (= 0 (status 'exit-code)))
+      (make-evaluator 'honu))))
-    (printf "Error: ~a\n" (read-string 1024 error-port))
-    (error 'run "couldn't run racket. error code ~a" (status 'exit-code)))
-  (define result (read-string 4096 output))
-  (close-input-port output)
-  (close-input-port error-port)
-  (close-output-port input)
-  (delete-file file)
-  result)
 
-(define (run-honu input)
+(define (honu input)
-  (define file (write-to-file input))
+  (with-input-from-string input
-  (with-handlers ([exn? (lambda (e)
+    (lambda ()
-                          (when (file-exists? file)
+      ((honu-eval) (honu-read-syntax)))))
-                            (delete-file file))
-                          (raise e))])
-    (execute-racket file)))
 
-(define (same? actual expected)
+(define input string-append)
-  ;; (printf "Expected \n'~a'\n\ngot \n'~a'\n\n" expected actual)
-  (string=? actual expected))
 
-(define (output . stuff)
+(define-syntax-rule (honu-tests checks ...)
-  ;; (printf "output '~a'\n" stuff)
+  (parameterize ([honu-eval (make-honu-evaluator)]) checks ...))
-  (apply string-append "" (append stuff (list "\n"))))
 
-(define (test name input output)
+(honu-tests
-  (printf "Running test ~a\n" name)
+  (check-equal? (honu @input{1}) 1)
-  (define final (run-honu input))
+  (check-equal? (honu @input{5}) 5)
-  (when (not (same? final output))
+  (check-equal? (honu @input{1 + 1}) (+ 1 1))
-    (printf "Not the same!\n'~a'\nvs\n'~a'\n" final output)))
+  (check-equal? (honu @input{1 + 2 * 3}) (+ 1 (* 2 3)))
+  (check-equal? (honu @input{3 * 2 + 1}) (+ (* 3 2) 1))
+  (check-equal? (honu @input{1 + 4 ^ 2 * 3}) (+ 1 (* (expt 4 2) 3)))
+  (check-equal? (honu @input{1 + 4 ^ 3 ^ 2}) (+ 1 (expt 4 (expt 3 2))))
+  (check-equal? (honu @input{4 ^ 3 ^ 2 + 1}) (+ (expt 4 (expt 3 2)) 1))
   
-(define (input . stuff)
+  (check-equal? (honu @input{
-  (apply string-append "#lang honu\n" stuff))
+                      var n = 5
+                      cond
+                      n < 10: 'x1,
+                      n > 10: 'x2
+                    })
+             'x1)
 
-(test
+  (check-equal? (honu @input{
-  "basic numbers"
+                     if (2 > 1)
-  @input{
+                       1
-  5
+                     else
-  6
+                     0
-  }
+                   })
+             1)
 
-  @output{5
+  (check-equal? (honu @input{[x + 1: x = [1, 2, 3]]}) '(2 3 4))
-  6
+  (check-equal? (honu @input{[x + y: x = [1, 2, 3], y = [4, 5, 6]]}) '(5 7 9))
-  })
+  )
 
-(test
+(honu-tests
-  "basic math"
+  (check-equal? (honu @input{function foo(x){
-  @input{
+                            x * 2
-  1 + 1
+                          }
-  1 + 2 * 3
+                          foo(5)
-  3 * 2 + 1
+                          })
-  1 + 4 ^ 2 * 3
+             10))
-  1 + 4 ^ 3 ^ 2
-  4 ^ 3 ^ 2 + 1
-  }
-
-  @output{2
-  7
-  7
-  49
-  262145
-  262145
-  })
-
-(test
-  "function call"
-  @input{
-  function foo(x){
-    x * 2
-  }
-  foo(5)
-  }
-
-  @output{10
-  })
-
-(test
-  "cond"
-  @input{
-  var n = 5
-  cond
-    n < 10: 'x1,
-    n > 10: 'x2
-  }
-
-  @output{'x1
-  })
-
-(test
-  "if"
-  @input{
-  if (2 > 1)
-    1
-  else
-    0
-  }
-
-  @output{1
-  })
-
-(test
-  "list comprehension"
-  @input{
-  [x + 1: x = [1, 2, 3]];
-  [x + y: x = [1, 2, 3], y = [4, 5, 6]]
-  }
-
-  @output{'(2 3 4)
-  '(5 7 9)})