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
This commit is contained in:
Carl Eastlund
parent
2986059cf2
commit
fc45eb8125
41
collects/honu/examples/BoundedStack-test.ss
Normal file
41
collects/honu/examples/BoundedStack-test.ss
Normal file
|
|
@ -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)))
|
||||
|
|
@ -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));
|
||||
// Stack s6 = s5.push(new IntegerC(value = 50));
|
||||
|
|
|
|||
|
|
@ -1,7 +1,3 @@
|
|||
(require (lib "class.ss"))
|
||||
|
||||
(define (mixin? obj) (null? obj))
|
||||
|
||||
(append (map interface? (list MovingPoint<%>
|
||||
Point3D<%>
|
||||
Point<%>
|
||||
|
|
|
|||
|
|
@ -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?)
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user