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