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

add tests for overlap

Browse Source 
fix more typecheck tests - 29 failures

svn: r14782

original commit: c19b66d5db4d25746472d17fbd6f750e3eb474ef
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-12 15:17:30 +00:00
parent d7d9932f89
commit 3d37ef204b
3 changed files with 30 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/tests/typed-scheme/unit-tests/all-tests.ss
View File

@ -31,6 +31,7 @@
type-equal-tests
restrict-tests
remove-tests
overlap-tests
parse-type-tests
type-annotation-tests
module-tests

15
collects/tests/typed-scheme/unit-tests/remove-intersect-tests.ss
View File

@ -5,6 +5,16 @@
(types convenience subtype union remove-intersect)
(schemeunit))
(define-syntax (over-tests stx)
(syntax-case stx ()
[(_ [t1 t2 res] ...)
#'(test-suite "Tests for intersect"
(test-check (format "Overlap test: ~a ~a" t1 t2) (lambda (a b) (eq? (not (not a)) b)) (overlap t1 t2) res) ...)]))
(define (overlap-tests)
(over-tests
[-Number -Integer #t]))
(define-syntax (restr-tests stx)
(syntax-case stx ()
[(_ [t1 t2 res] ...)
@ -56,7 +66,8 @@
(define-go
restrict-tests
remove-tests)
remove-tests
overlap-tests)
(define x1
(-mu list-rec
@ -68,5 +79,5 @@
(Un (-val '())
(-pair (-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x)))
(-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x))))))
(provide remove-tests restrict-tests)
(provide remove-tests restrict-tests overlap-tests)

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

@ -80,7 +80,7 @@
(define-syntax (tc-e/t stx)
(syntax-parse stx
[(_ e t) #'(tc-e e #:ret (ret t (-FS (list) (list (make-Bot)))))]))
[(_ e t) (syntax/loc stx (tc-e e #:ret (ret t (-FS (list) (list (make-Bot))))))]))
;; duplication of the mzscheme toplevel expander, necessary for expanding the rhs of defines
;; note that this ability is never used
@ -303,7 +303,7 @@
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
x)
#:proc (get-let-name x 1 (-path (Un (-val 'squarf) -Integer) #'x))]
#:proc (syntax-parser [(_ _ (_ ([(x) _]) _)) (-path (Un (-val 'squarf) -Integer) #'x)])]
[tc-e/t (if #t 1 2) -Integer]
@ -329,11 +329,13 @@
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
(if (eq? x sym) 3 x))
#:proc (get-let-name x 1 (ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x)))))]
#:proc (syntax-parser [(_ _ (_ ([(x) _]) _))
(ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x))))])]
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
(if (eq? sym x) 3 x))
#:proc (get-let-name x 1 (ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x)))))]
#:proc (syntax-parser [(_ _ (_ ([(x) _]) _))
(ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x))))])]
;; equal? as predicate for symbols
[tc-e (let: ([x : (Un 'foo Number) 'foo])
(if (equal? x 'foo) 3 x))
@ -345,11 +347,13 @@
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
(if (equal? x sym) 3 x))
#:proc (get-let-name x 0 (ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x)))))]
#:proc (syntax-parser [(_ _ (_ ([(x) _]) _))
(ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x))))])]
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
(if (equal? sym x) 3 x))
#:ret (ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x))))]
#:proc (syntax-parser [(_ _ (_ ([(x) _]) _))
(ret -Integer (-FS (list) (list (make-NotTypeFilter (-val 'squarf) null #'x) (make-TypeFilter (-val #f) null #'x))))])]
[tc-e (let: ([x : (Listof Symbol)'(a b c)])
(cond [(memq 'a x) => car]
@ -386,9 +390,9 @@
[tc-e (let: ([x : Any 1]) (and (number? x) (boolean? x)))
#:ret (ret B (-FS (list (make-Bot)) null))]
[tc-e (let: ([x : Any 1]) (and (number? x) x))
#:ret (ret (Un N (-val #f)) (-FS (list (make-TypeFilter N null #'x) (make-NotTypeFilter (-val #f) null #'x)) null))]
#:proc (get-let-name x 0 (ret (Un N (-val #f)) (-FS (list (make-TypeFilter N null #'x) (make-NotTypeFilter (-val #f) null #'x)) null)))]
[tc-e (let: ([x : Any 1]) (and x (boolean? x)))
#:ret (ret -Boolean (-FS (list (make-NotTypeFilter (-val #f) null #'x) (make-TypeFilter -Boolean null #'x)) null))]
#:proc (get-let-name x 0 (ret -Boolean (-FS (list (make-NotTypeFilter (-val #f) null #'x) (make-TypeFilter -Boolean null #'x)) null)))]
[tc-e/t (let: ([x : Any 3])
(if (and (list? x) (not (null? x)))
@ -441,19 +445,19 @@
(-> Univ N)]
[tc-e/t (let ([p? (lambda: ([x : Any]) (not (number? x)))])
(lambda: ([x : Any]) (if (p? x) 12 (add1 x))))
(-> Univ N)]
(-> Univ N : (-LFS null (list (make-LTypeFilter -Number null 0))))]
[tc-e/t (let* ([z 1]
[p? (lambda: ([x : Any]) (number? z))])
(lambda: ([x : Any]) (if (p? x) 11 12)))
(-> Univ -Integer)]
(-> Univ -Integer : (-LFS null (list (make-LBot))))]
[tc-e/t (let* ([z 1]
[p? (lambda: ([x : Any]) (number? z))])
(lambda: ([x : Any]) (if (p? x) x 12)))
(-> Univ Univ)]
(-> Univ Univ : (-LFS null (list (make-LBot))))]
[tc-e/t (let* ([z 1]
[p? (lambda: ([x : Any]) (not (number? z)))])
(lambda: ([x : Any]) (if (p? x) x 12)))
(-> Univ Univ)]
(-> Univ Univ : (-LFS (list (-not-filter (-val #f))) (list (-filter (-val #f)))) : (make-LPath null 0))]
[tc-e/t (let* ([z 1]
[p? (lambda: ([x : Any]) z)])
(lambda: ([x : Any]) (if (p? x) x 12)))