suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

subst-tests now pass

Browse Source 
svn: r13923

original commit: 4615d7573e2a3c6313bd35913dc4267db6427723
This commit is contained in:
Sam Tobin-Hochstadt 2009-03-03 20:35:18 +00:00
parent c9d49b659c
commit 2901393e97
2 changed files with 7 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-scheme/unit-tests/subst-tests.ss
View File

@ -2,14 +2,14 @@
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
(require (rep type-rep)
(private type-utils type-effect-convenience)
(types type-utils type-abbrev)
(schemeunit))
(define-syntax-rule (s img var tgt result)
(test-eq? "test" (substitute img 'var tgt) result))
(define-syntax-rule (s... imgs var tgt result)
(test-eq? "test" (substitute-dots (list . imgs) 'var tgt) result))
(test-eq? "test" (substitute-dots (list . imgs) #f 'var tgt) result))
(define (subst-tests)
(test-suite "Tests for substitution"

13
collects/tests/typed-scheme/unit-tests/test-utils.ss
View File

@ -8,9 +8,10 @@
(for-syntax scheme/base))
(require (private type-comparison type-utils)
(require (types comparison type-utils)
(schemeunit))
(provide private typecheck (rename-out [infer r:infer]) utils env rep)
(provide private typecheck (rename-out [infer r:infer]) utils env rep types)
(define (mk-suite ts)
(match (map (lambda (f) (f)) ts)
@ -38,13 +39,9 @@
(values (lambda () (run tmps ...))
(lambda () (run/gui tmps ...))))))]))
;; FIXME - check that effects are equal
;; FIXME - do something more intelligent
(define (tc-result-equal/test? a b)
(match* (a b)
[((tc-result: t1 thn1 els1) (tc-result: t2 thn2 els2))
(and (type-equal? t1 t2)
(= (length thn1) (length thn2))
(= (length els1) (length els2)))]))
(equal? a b))
(define-syntax (check-type-equal? stx)
(syntax-case stx ()