From fc45eb81258ade4c0985caa749fc8f07bb09ff57 Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Thu, 29 Sep 2005 00:18:44 +0000 Subject: [PATCH] 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 | 41 ++++++++++++++ collects/honu/examples/BoundedStack.honu | 26 ++++----- collects/honu/examples/point-test.ss | 4 -- collects/honu/test.ss | 34 ++---------- collects/honu/top.ss | 59 +++++++++++++++++++-- 5 files changed, 113 insertions(+), 51 deletions(-) create mode 100644 collects/honu/examples/BoundedStack-test.ss diff --git a/collects/honu/examples/BoundedStack-test.ss b/collects/honu/examples/BoundedStack-test.ss new file mode 100644 index 0000000000..3064536e8e --- /dev/null +++ b/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))) diff --git a/collects/honu/examples/BoundedStack.honu b/collects/honu/examples/BoundedStack.honu index 6b7bb75363..92354da5b1 100644 --- a/collects/honu/examples/BoundedStack.honu +++ b/collects/honu/examples/BoundedStack.honu @@ -324,22 +324,22 @@ class ConsList(Any car, List cdr) : List impl List { // -Stack empty = emptyBoundedStack(5); -Stack s1 = empty.push(new IntegerC(value = 5)); -Stack s2 = s1.push(new IntegerC(value = 3)); -Stack s3 = s2.push(new IntegerC(value = 10)); -Stack s4 = s3.push(new IntegerC(value = 20)); -Stack s5 = s4.push(new IntegerC(value = 40)); +// Stack empty = emptyBoundedStack(5); +// Stack s1 = empty.push(new IntegerC(value = 5)); +// Stack s2 = s1.push(new IntegerC(value = 3)); +// Stack s3 = s2.push(new IntegerC(value = 10)); +// Stack s4 = s3.push(new IntegerC(value = 20)); +// Stack s5 = s4.push(new IntegerC(value = 40)); // use foreach + don't care(about binding) syntax -_ = s5.foreach(void fun(Any x) { - cond { - x isa Integer => printLine(intToString((x : Integer).value)); - else printLine("Unknown type of value"); - }; - }); +// _ = s5.foreach(void fun(Any x) { +// cond { +// x isa Integer => printLine(intToString((x : Integer).value)); +// else printLine("Unknown type of value"); +// }; +// }); // Now try adding something to s5! -Stack s6 = s5.push(new IntegerC(value = 50)); \ No newline at end of file +// Stack s6 = s5.push(new IntegerC(value = 50)); diff --git a/collects/honu/examples/point-test.ss b/collects/honu/examples/point-test.ss index 24cbf1b388..8ce2b31953 100644 --- a/collects/honu/examples/point-test.ss +++ b/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<%> diff --git a/collects/honu/test.ss b/collects/honu/test.ss index b648a9203a..98150d5e95 100644 --- a/collects/honu/test.ss +++ b/collects/honu/test.ss @@ -1,38 +1,10 @@ (module test mzscheme - (require (lib "contract.ss") - "top.ss" + (require (lib "class.ss") "utils.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")) + (provide (all-from (lib "class.ss"))) - (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))] - [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)) + (define/p mixin? null?) ) diff --git a/collects/honu/top.ss b/collects/honu/top.ss index 4f04c13f1a..f059ad95bb 100644 --- a/collects/honu/top.ss +++ b/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)) + )