Honu:

- top.ss
  - removed top: prefix from exports
  - renamed parse-file to ast-from-file to prevent name clash
  - removed test case list and run-tests
- test-cases.ss
  - added test case list and run-tests
- test-tools.ss
  - renamed from test.ss

svn: r945

collects/honu/test-cases.ss

@@ -0,0 +1,27 @@
+(module test-cases mzscheme
+
+  (require (lib "contract.ss")
+           "utils.ss"
+           "top.ss")
+  
+  (define/p examples
+    (list "examples/BoundedStack.honu"
+          "examples/EvenOddClass.honu"
+          "examples/List.honu"
+          "examples/Y.honu"
+          "examples/bind-tup-top.honu"
+          "examples/cond-test.honu"
+          "examples/even-odd.honu"
+          "examples/exprs.honu"
+          "examples/point.honu"
+          "examples/struct.honu"
+          "examples/tup-bind.honu"
+;          "examples/types-error.honu"
+          "examples/types.honu"
+;          "examples/nonexistent.honu"
+          ))
+
+  (define/c (run-tests) (-> (listof any/c))
+    (map test-file examples))
+  
+  )

collects/honu/test-tools.ss

@@ -1,4 +1,4 @@
-(module test mzscheme
+(module test-tools mzscheme
 
   (require (lib "class.ss")
            "utils.ss")

collects/honu/top.ss

@@ -18,18 +18,18 @@
            "utils.ss"
            )
 
-  (define/c top:current-tenv parameter? (make-parameter (empty-tenv)))
+  (define/c current-tenv parameter? (make-parameter (empty-tenv)))
-  (define/c top:current-lenv parameter? (make-parameter (get-builtin-lenv)))
+  (define/c current-lenv parameter? (make-parameter (get-builtin-lenv)))
 
-  (define/c (top:reset-env) (-> void?)
+  (define/c (reset-env) (-> void?)
-    (top:current-tenv (empty-tenv))
+    (current-tenv (empty-tenv))
-    (top:current-lenv (get-builtin-lenv)))
+    (current-lenv (get-builtin-lenv)))
 
   (define-syntax (with-env stx)
     (syntax-case stx ()
       [(_ BODY ...)
-       #`(parameterize ([current-type-environment (top:current-tenv)]
+       #`(parameterize ([current-type-environment (current-tenv)]
-                        [current-lexical-environment (top:current-lenv)])
+                        [current-lexical-environment (current-lenv)])
            BODY ...)]))
 
   (define-syntax (with-context stx)
@@ -38,16 +38,16 @@
        #`(parameterize ([current-compile-context honu-compile-context])
            BODY ...)]))
 
-  (define/c (top:parse-file file) (path-string? . -> . (listof honu:defn?))
+  (define/c (ast-from-file file) (path-string? . -> . (listof honu:defn?))
     (with-env
      (post-parse-program
       (add-defns-to-tenv
        (parse-port (open-input-file file) file)))))
 
-  (define/c (top:check-defns defns) ((listof honu:defn?) . -> . (listof honu:defn?))
+  (define/c (check-defns defns) ((listof honu:defn?) . -> . (listof honu:defn?))
     (with-env (typecheck defns)))
 
-  (define/c (top:translate-defns defns) ((listof honu:defn?) . -> . (syntax/c any/c))
+  (define/c (translate-defns defns) ((listof honu:defn?) . -> . (syntax/c any/c))
     (with-env
      (with-context
        (let-values
@@ -55,7 +55,7 @@
          (namespace-syntax-introduce (datum->syntax-object #f (cons 'begin syntax) #f))))))
 
   (define (lenv-names)
-    (let* ([lenv (top:current-lenv)]
+    (let* ([lenv (current-lenv)]
            [orig (get-builtin-lenv)]
            [ids '()])
       (bound-identifier-mapping-for-each
@@ -72,50 +72,25 @@
           [(tenv:mixin? entry) (syntax-e (translate-mixin-name id))]))
 
   (define (tenv-names)
-    (let* ([tenv (top:current-tenv)])
+    (let* ([tenv (current-tenv)])
       (bound-identifier-mapping-map tenv tenv:entry-mangled-name)))
 
-  (define test<%> (interface ()))
+  (define/p (eval-after-program file stx) (path-string? syntax? . -> . any)
-
+    (reset-env)
-  (define (run-test-class-from-name name)
+    (let* ([ast (ast-from-file file)]
-    (let ([def (eval name)])
+           [ast (check-defns ast)]
-      (if (and (class? def) (implementation? def test<%>))
+           [defs (translate-defns ast)])
-          (printf "WILL test ~s [~s]~n" def name)
-          (printf "WONT test ~s [~s]~n" def name))))
-
-  (define/p (top:eval-after-program file stx) (path-string? syntax? . -> . any)
-    (top:reset-env)
-    (let* ([ast (top:parse-file file)]
-           [ast (top:check-defns ast)]
-           [defs (top:translate-defns ast)])
       (eval
        #`(begin #,defs #,stx))))
 
-  (define/c (top:run-program file) (path-string? . -> . (values (listof symbol?) (listof symbol?)))
+  (define/c (run-program file) (path-string? . -> . (values (listof symbol?) (listof symbol?)))
-    (top:reset-env)
+    (reset-env)
-    (eval-syntax (top:translate-defns (top:check-defns (top:parse-file file))))
+    (eval-syntax (translate-defns (check-defns (ast-from-file file))))
     (values (tenv-names) (lenv-names)))
 
-  (define/c (top:run-programs files)
+  (define/c (run-programs files)
     ((listof path-string?) . -> . (values (listof (listof symbol?)) (listof (listof symbol?))))
-    (map-values top:run-program files))
+    (map-values run-program files))
-
-  (define/p top:examples
-    (list "examples/BoundedStack.honu"
-          "examples/EvenOddClass.honu"
-          "examples/List.honu"
-          "examples/Y.honu"
-          "examples/bind-tup-top.honu"
-          "examples/cond-test.honu"
-          "examples/even-odd.honu"
-          "examples/exprs.honu"
-          "examples/point.honu"
-          "examples/struct.honu"
-          "examples/tup-bind.honu"
-;          "examples/types-error.honu"
-          "examples/types.honu"
-;          "examples/nonexistent.honu"
-          ))
 
   (define (program-syntax file)
     (let* ([port (open-input-file file)])
@@ -127,7 +102,7 @@
                    (reverse sexps)
                    (read-loop (cons input sexps) (read-syntax file port)))))))
   
-  (define/c (top:test-file file) (path-string? . -> . any)
+  (define/c (test-file file) (path-string? . -> . any)
     (with-handlers
         ([exn:fail? (lambda (exn) `(error ,(exn-message exn)))])
       (let* ([honu-path (if (path? file) file (string->path file))]
@@ -137,13 +112,10 @@
         (unless (file-exists? test-path)
           (error 'test-file "~s not found" (path->string test-path)))
         (let* ([stx (program-syntax test-path)])
-          (top:eval-after-program
+          (eval-after-program
            honu-path
            #`(begin
-               (require (lib "test.ss" "honu"))
+               (require (lib "test-tools.ss" "honu"))
                #,stx))))))
-
+  
-  (define/c (top:run-tests) (-> (listof any/c))
-    (map top:test-file top:examples))
-
   )