Honu:

- top.ss
  - Added top:eval-after-program
    to evaluate a new syntax in the context of Honu definitions
  - Added previous contents of test.ss - testing is a top-level behavior
- test.ss
  - Removed top-level testing calls
  - Added bindings useful from testcase code
  - New purpose is to be auto-required from *-test.ss when *.honu is tested
- examples/point-test.ss
  - Removed now-redundant definitions
- examples/BoundedStack-test.ss
  - Wrote tests for BoundedStack, both of defined names and actual code results
- examples/BoundedStack.honu
  - Removed test results that are now in ...-test.ss

svn: r930

collects/honu/examples/BoundedStack-test.ss

@@ -0,0 +1,41 @@
+(define (push stack num)
+  (send stack BoundedStack<%>-push (new IntegerC% [value num])))
+  
+(define s0 (emptyBoundedStack 5))
+(define s1 (push s0 5))
+(define s2 (push s1 3))
+(define s3 (push s2 10))
+(define s4 (push s3 20))
+(define s5 (push s4 40))
+
+(append (map interface? (list List<%>
+                              Stack<%>
+                              BoundedStack<%>
+                              Integer<%>))
+        (map class? (list ConsList%
+                          BoundedStackC%
+                          ListStackC%
+                          IntegerC%))
+        (map
+         (lambda (object)
+           (andmap
+            (lambda (spec) (is-a? object spec))
+            (list Stack<%> BoundedStack<%> BoundedStack<%>)))
+         (list s0 s1 s2 s3 s4 s5))
+        (list
+         (not (send s0 BoundedStack<%>-isFull '()))
+         (not (send s1 BoundedStack<%>-isFull '()))
+         (not (send s2 BoundedStack<%>-isFull '()))
+         (not (send s3 BoundedStack<%>-isFull '()))
+         (not (send s4 BoundedStack<%>-isFull '()))
+         (send s5 BoundedStack<%>-isFull '()))
+        (list
+         (let* ([expected (list 5 3 10 20 40)]
+                [actual (list)])
+           (send s5 BoundedStack<%>-foreach
+                 (lambda (int)
+                   (set! actual (cons (send int Integer<%>-value-get 'Dummy) actual))))
+           (equal? expected actual))
+         (with-handlers ([exn:fail? (lambda (exn) #t)])
+           (push s5 50)
+           #f)))

collects/honu/examples/BoundedStack.honu

@@ -324,22 +324,22 @@ class ConsList(Any car, List cdr) : List impl List {
 //                                                        
 
 
-Stack empty = emptyBoundedStack(5);
+// Stack empty = emptyBoundedStack(5);
-Stack s1 = empty.push(new IntegerC(value = 5));
+// Stack s1 = empty.push(new IntegerC(value = 5));
-Stack s2 = s1.push(new IntegerC(value = 3));
+// Stack s2 = s1.push(new IntegerC(value = 3));
-Stack s3 = s2.push(new IntegerC(value = 10));
+// Stack s3 = s2.push(new IntegerC(value = 10));
-Stack s4 = s3.push(new IntegerC(value = 20));
+// Stack s4 = s3.push(new IntegerC(value = 20));
-Stack s5 = s4.push(new IntegerC(value = 40));
+// Stack s5 = s4.push(new IntegerC(value = 40));
 
 // use foreach + don't care(about binding) syntax
 
-_ = s5.foreach(void fun(Any x) {
+// _ = s5.foreach(void fun(Any x) {
-                 cond {
+//                  cond {
-                   x isa Integer => printLine(intToString((x : Integer).value));
+//                    x isa Integer => printLine(intToString((x : Integer).value));
-                   else             printLine("Unknown type of value");
+//                    else             printLine("Unknown type of value");
-                 };
+//                  };
-               });
+//                });
 
 // Now try adding something to s5!
 
-Stack s6 = s5.push(new IntegerC(value = 50));
+// Stack s6 = s5.push(new IntegerC(value = 50));

collects/honu/examples/point-test.ss

@@ -1,7 +1,3 @@
-(require (lib "class.ss"))
-
-(define (mixin? obj) (null? obj))
-
 (append (map interface? (list MovingPoint<%>
                               Point3D<%>
                               Point<%>

collects/honu/test.ss

@@ -1,38 +1,10 @@
 (module test mzscheme
 
-  (require (lib "contract.ss")
+  (require (lib "class.ss")
-           "top.ss"
            "utils.ss")
 
-  (define/p examples
+  (provide (all-from (lib "class.ss")))
-    (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 (test-file file) (path-string? . -> . any)
+  (define/p mixin? null?)
-    (with-handlers
-        ([exn:fail? (lambda (exn) `(error ,(exn-message exn)))])
-      (let* ([honu-path (if (path? file) file (string->path file))]
-             [test-path (path-replace-suffix honu-path "-test.ss")])
-        (unless (file-exists? honu-path)
-          (error 'test-file "~s not found" (path->string honu-path)))
-        (top:run-program honu-path)
-        (unless (file-exists? test-path)
-          (error 'test-file "~s not found" (path->string test-path)))
-        (load test-path))))
-
-  (define/c (run-tests) (-> (listof any/c))
-    (map test-file examples))
   
   )

collects/honu/top.ss

@@ -70,19 +70,27 @@
     (cond [(tenv:type? entry) (syntax-e (translate-iface-name (make-iface-type id id)))]
           [(tenv:class? entry) (syntax-e (translate-class-name id))]
           [(tenv:mixin? entry) (syntax-e (translate-mixin-name id))]))
-  
+
   (define (tenv-names)
     (let* ([tenv (top:current-tenv)])
       (bound-identifier-mapping-map tenv tenv:entry-mangled-name)))
 
   (define test<%> (interface ()))
-  
+
   (define (run-test-class-from-name name)
     (let ([def (eval name)])
       (if (and (class? def) (implementation? def test<%>))
           (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?)))
     (top:reset-env)
     (eval-syntax (top:translate-defns (top:check-defns (top:parse-file file))))
@@ -91,5 +99,50 @@
   (define/c (top:run-programs files)
     ((listof path-string?) . -> . (values (listof (listof symbol?)) (listof (listof symbol?))))
     (map-values top: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)])
+      #`(begin
+          #,@(let read-loop
+                 ([sexps (list)]
+                  [input (read-syntax file port)])
+               (if (eof-object? input)
+                   (reverse sexps)
+                   (read-loop (cons input sexps) (read-syntax file port)))))))
   
+  (define/c (top: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))]
+             [test-path (path-replace-suffix honu-path "-test.ss")])
+        (unless (file-exists? honu-path)
+          (error 'test-file "~s not found" (path->string honu-path)))
+        (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
+           honu-path
+           #`(begin
+               (require (lib "test.ss" "honu"))
+               #,stx))))))
+
+  (define/c (top:run-tests) (-> (listof any/c))
+    (map top:test-file top:examples))
+
   )