From 0671945a8d39c87dfe3536291a06bf2dc00f241d Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
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+))])]