From d688621a183a3683fbb7ea0b5b25b17ebd2ffd79 Mon Sep 17 00:00:00 2001
From: Jon Rafkind <rafkind@racket-lang.org>
Date: Mon, 7 May 2012 14:55:23 -0600
Subject: [PATCH] [honu] use sandbox evaluator to test honu code

---
 .../honu/core/private/honu-typed-scheme.rkt   |   2 +-
 collects/tests/honu/check.rkt                 | 174 ++++++------------
 2 files changed, 56 insertions(+), 120 deletions(-)

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