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

Use syntax-loc in tests.

Browse Source 
Don't check that effects match, since they may involve identifiers.
Fix tests for correct type names, Integer.

svn: r9595
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-02 17:20:05 +00:00
parent 26a180f458
commit ccd1337e31
3 changed files with 42 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-scheme/succeed/apply-append.ss Normal file
View File

@ -0,0 +1,4 @@
#lang typed-scheme
(apply append '((1 2 3) (4 5 6)))
(apply append (list (list 1 2 3) (list 4 5 6)))

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

@ -15,11 +15,12 @@
(string->symbol
(string-append
"typed-scheme/private/"
(symbol->string (syntax-e id))))))
(symbol->string (syntax-e id))))
id id))
(syntax->list #'(id ...)))])
#`(combine-in id* ...))])))
(syntax/loc stx (combine-in id* ...)))])))
(require (private planet-requires type-comparison utils))
(require (private planet-requires type-comparison utils type-utils))
(require (schemeunit))
@ -47,12 +48,20 @@
(values (lambda () (run tmps ...))
(lambda () (run/gui tmps ...))))))]))
;; FIXME - check that effects are equal
(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)))]))
(define-syntax (check-type-equal? stx)
(syntax-case stx ()
[(_ nm a b)
#`(test-check nm type-equal? a b)]))
(syntax/loc stx (test-check nm type-equal? a b))]))
(define-syntax (check-tc-result-equal? stx)
(syntax-case stx ()
[(_ nm a b)
#`(test-check nm tc-result-equal? a b)]))
(syntax/loc stx (test-check nm tc-result-equal/test? a b))]))

48
collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
View File

@ -39,11 +39,11 @@
;; check that an expression typechecks correctly
(define-syntax (tc-e stx)
(syntax-case stx ()
[(_ expr ty) #'(tc-e expr ty (list) (list))]
[(_ expr ty) (syntax/loc stx (tc-e expr ty (list) (list)))]
[(_ expr ty eff1 eff2)
#`(check-tc-result-equal? (format "~a" 'expr)
(tc-expr/expand expr)
(ret ty eff1 eff2))]))
(syntax/loc stx (check-tc-result-equal? (format "~a" 'expr)
(tc-expr/expand expr)
(ret ty eff1 eff2)))]))
(require (for-syntax syntax/kerncase))
@ -58,12 +58,12 @@
[e (local-expand #'e 'expression '())])))
;; check that typechecking this expression fails
(define-syntax (tc-err stx)
(syntax-case stx ()
(define-syntax tc-err
(syntax-rules ()
[(_ expr)
#'(test-exn (format "~a" 'expr)
exn:fail:syntax?
(lambda () (tc-expr/expand expr)))]))
(test-exn (format "~a" 'expr)
exn:fail:syntax?
(lambda () (tc-expr/expand expr)))]))
(define (typecheck-tests)
@ -102,7 +102,7 @@
[tc-e '(#t #f) (-lst* (-val #t) (-val #f))]
[tc-e (plambda: (a) ([l : (Listof a)]) (car l))
(make-Poly '(a) (-> (make-Listof (-v a)) (-v a)))]
[tc-e #{(lambda: ([l : (list-of a)]) (car l)) PROP typechecker:plambda (a)}
[tc-e #{(lambda: ([l : (Listof a)]) (car l)) PROP typechecker:plambda (a)}
(make-Poly '(a) (-> (make-Listof (-v a)) (-v a)))]
[tc-e (case-lambda: [([a : Number] [b : Number]) (+ a b)]) (-> N N N)]
[tc-e (let: ([x : Number 5]) x) N (-vet #'x) (-vef #'x)]
@ -112,7 +112,7 @@
[tc-e (values 3) -Integer]
[tc-e (values) (-values (list))]
[tc-e (values 3 #f) (-values (list -Integer (-val #f)))]
[tc-e (map #{values : (symbol -> symbol)} '(a b c)) (make-Listof Sym)]
[tc-e (map #{values @ Symbol} '(a b c)) (make-Listof Sym)]
[tc-e (letrec: ([fact : (Number -> Number) (lambda: ([n : Number]) (if (zero? n) 1 (* n (fact (- n 1)))))])
(fact 20))
N]
@ -172,10 +172,10 @@
(when (boolean? x) #t))
-Void]
[tc-e (let: ([x : Sexp 3])
[tc-e (let: ([x : Any 3])
(if (list? x)
(begin (car x) 1) 2))
N]
-Integer]
[tc-e (let: ([x : (U Number Boolean) 3])
@ -218,8 +218,8 @@
(string-append "foo" (a v))))
-String]
[tc-e (apply (plambda: (a) [x : a] x) '(5)) (-lst N)]
[tc-e (apply append (list '(1 2 3) '(4 5 6))) (-lst N)]
[tc-e (apply (plambda: (a) [x : a] x) '(5)) (-lst -Integer)]
[tc-e (apply append (list '(1 2 3) '(4 5 6))) (-lst -Integer)]
[tc-err ((case-lambda: [([x : Number]) x]
[([y : Number] [x : Number]) x])
@ -294,11 +294,11 @@
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
(if (equal? x sym) 3 x))
N]
-Integer]
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
(if (equal? sym x) 3 x))
N]
-Integer]
[tc-e (let: ([x : (Listof Symbol)'(a b c)])
(cond [(memq 'a x) => car]
@ -327,7 +327,7 @@
(error 'foo)))
(-pair Univ (-lst Univ))]
;[tc-e (cadr (cadr (list 1 (list 1 2 3) 3))) N]
[tc-e (cadr (cadr (list 1 (list 1 2 3) 3))) -Integer]
@ -339,10 +339,10 @@
[tc-e (let: ([x : Any 1]) (and x (boolean? x))) B
(list (-rem (-val #f) #'x) (-rest B #'x)) (list)]
[tc-e (let: ([x : Sexp 3])
(if (and (list? x) (not (null? x)))
[tc-e (let: ([x : Any 3])
(if (and (list? x) (not (null? x)))
(begin (car x) 1) 2))
N]
-Integer]
;; set! tests
[tc-e (let: ([x : Any 3])
@ -394,7 +394,7 @@
[tc-e (let* ([z 1]
[p? (lambda: ([x : Any]) (number? z))])
(lambda: ([x : Any]) (if (p? x) 11 12)))
(-> Univ N)]
(-> Univ -Integer)]
[tc-e (let* ([z 1]
[p? (lambda: ([x : Any]) (number? z))])
(lambda: ([x : Any]) (if (p? x) x 12)))
@ -461,7 +461,7 @@
[tc-e (let ([app apply]
[f (lambda: [x : Number] 3)])
(app f (list 1 2 3)))
N]
-Integer]
[tc-e ((lambda () (call/cc (lambda: ([k : (Number -> (U))]) (if (read) 5 (k 10))))))
N]
@ -539,7 +539,7 @@
[tc-err (let: ([x : Number #f]) (+ 1 x))]
[tc-err
(let: ([x : Sexp '(foo)])
(let: ([x : Any '(foo)])
(if (null? x) 1
(if (list? x)
(add1 x)