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

Moved tests for equality to unit tests

Browse Source
This commit is contained in:
Eric Dobson 2011-06-16 19:26:07 -04:00 committed by Sam Tobin-Hochstadt
parent b326269133
commit 0671945a8d
4 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/tests/typed-scheme/succeed/equality.rkt
View File

@ -1,15 +0,0 @@
#lang typed/racket
(boolean? true)
(boolean? (not 6))
(immutable? (cons 3 4))
(boolean=? #t false)
(symbol=? 'foo 'foo)
(false? 'foo)
(equal? 1 2)
(eqv? 1 2)
(eq? 1 2)
(equal?/recur 'foo 'bar eq?)

17
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -959,8 +959,25 @@
(tc-e (symbol->string 'foo) -String)
(tc-e (string->symbol (symbol->string 'foo)) -Symbol)
;Booleans
(tc-e (not #f) #:ret (ret B (-FS -top -bot)))
(tc-e (false? #f) #:ret (ret B (-FS -top -bot)))
(tc-e (not #t) #:ret (ret B (-FS -bot -top)))
(tc-e (false? #t) #:ret (ret B (-FS -bot -top)))
(tc-e (boolean? true) #:ret (ret B (-FS -top -bot)))
(tc-e (boolean? 6) #:ret (ret B (-FS -bot -top)))
(tc-e (immutable? (cons 3 4)) B)
(tc-e (boolean=? #t false) B)
(tc-e (symbol=? 'foo 'foo) B)
(tc-e (equal? 1 2) B)
(tc-e (eqv? 1 2) B)
(tc-e (eq? 1 2) B)
(tc-e (equal?/recur 'foo 'bar eq?) B)
)
(test-suite
"check-type tests"

2
collects/typed-scheme/base-env/base-env.rkt
View File

@ -208,7 +208,7 @@
;Section 3.1
[boolean? (make-pred-ty B)]
[not (-> Univ B)]
[not (make-pred-ty (-val #f))]
[equal? (-> Univ Univ B)]
[eqv? (-> Univ Univ B)]
[eq? (-> Univ Univ B)]

2
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -513,7 +513,7 @@
[((tc-result1: t) (tc-result1: t* f o))
(ret t f o)])]
;; special-case for not - flip the filters
[(#%plain-app (~or not false?) arg)
[(#%plain-app (~or false? not) arg)
(match (single-value #'arg)
[(tc-result1: t (FilterSet: f+ f-) _)
(ret -Boolean (make-FilterSet f- f+))])]