From 0671945a8d39c87dfe3536291a06bf2dc00f241d Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Thu, 16 Jun 2011 19:26:07 -0400 Subject: [PATCH] Moved tests for equality to unit tests --- .../tests/typed-scheme/succeed/equality.rkt | 15 --------------- .../typed-scheme/unit-tests/typecheck-tests.rkt | 17 +++++++++++++++++ collects/typed-scheme/base-env/base-env.rkt | 2 +- collects/typed-scheme/typecheck/tc-app.rkt | 2 +- 4 files changed, 19 insertions(+), 17 deletions(-) delete mode 100644 collects/tests/typed-scheme/succeed/equality.rkt diff --git a/collects/tests/typed-scheme/succeed/equality.rkt b/collects/tests/typed-scheme/succeed/equality.rkt deleted file mode 100644 index 274fd21816..0000000000 --- a/collects/tests/typed-scheme/succeed/equality.rkt +++ /dev/null @@ -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?) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index b6d0d86ade..9f2781db7a 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -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" diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index 3dc78a87dc..44b9e4d498 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -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)] diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt index 68af74481b..96d9ceda6d 100644 --- a/collects/typed-scheme/typecheck/tc-app.rkt +++ b/collects/typed-scheme/typecheck/tc-app.rkt @@ -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+))])]