From 600431e2c80e42f3f7c44953b9afbe2524c6d509 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 23 Feb 2002 22:45:27 +0000
Subject: [PATCH] ..

original commit: df59652d5da2a5bbb0e1906735671e7ac905735a
---
 collects/tests/framework/spec-test.ss | 107 ++++++++++++++++++++++++--
 1 file changed, 99 insertions(+), 8 deletions(-)

diff --git a/collects/tests/framework/spec-test.ss b/collects/tests/framework/spec-test.ss
index b8ba09d..8bcc0a0 100644
--- a/collects/tests/framework/spec-test.ss
+++ b/collects/tests/framework/spec-test.ss
@@ -45,14 +45,6 @@
    '(contract (integer? . -> . integer?) (lambda (x y) x) 'pos 'neg)
    "pos")
   
-  (test/spec-failed
-   'contract-flat5
-   '(contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
-              (lambda (x) x)
-              'pos
-              'neg)
-   "pos")
-  
   (test/spec-failed
    'contract-ho1
    '((contract (integer? . -> . integer?) (lambda (x) #f) 'pos 'neg) #t)
@@ -63,6 +55,105 @@
    '((contract (integer? . -> . integer?) (lambda (x) #f) 'pos 'neg) 1)
    "pos")
   
+  (test/spec-failed
+   'contract-case->1
+   '(contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
+              (lambda (x) x)
+              'pos
+              'neg)
+   "pos")
+  
+  (test/spec-failed
+   'contract-case->2
+   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
+               (case-lambda 
+                 [(x y) 'case1]
+                 [(x) 'case2])
+               'pos
+               'neg)
+     1 2)
+   "pos")
+  
+  (test/spec-failed
+   'contract-case->3
+   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
+               (case-lambda 
+                 [(x y) 'case1]
+                 [(x) 'case2])
+               'pos
+               'neg)
+     1)
+   "pos")
+  
+  (test/spec-failed
+   'contract-case->4
+   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
+               (case-lambda 
+                 [(x y) 'case1]
+                 [(x) 'case2])
+               'pos
+               'neg)
+     'a 2)
+   "neg")
+  
+  (test/spec-failed
+   'contract-case->5
+   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
+               (case-lambda 
+                 [(x y) 'case1]
+                 [(x) 'case2])
+               'pos
+               'neg)
+     2 'a)
+   "neg")
+  
+  (test/spec-failed
+   'contract-case->6
+   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
+               (case-lambda 
+                 [(x y) 'case1]
+                 [(x) 'case2])
+               'pos
+               'neg)
+     #t)
+   "neg")
+  
+  (test/spec-failed
+   'contract-d1
+   '(contract (integer? . ->d . (lambda (x) (lambda (y) (= x y))))
+              1
+              'pos
+              'neg)
+   "pos")
+  
+  (test/spec-passed
+   'contract-d2
+   '(contract (integer? . ->d . (lambda (x) (lambda (y) (= x y))))
+              (lambda (x) x)
+              'pos
+              'neg))
+  
+  (test/spec-failed
+   'contract-d2
+   '((contract (integer? . ->d . (lambda (x) (lambda (y) (= x y))))
+               (lambda (x) (+ x 1))
+               'pos
+               'neg)
+     2)
+   "pos")
+
+  (test/spec-failed
+   'contract-d-protect-shared-state
+   '(let ([x 1])
+      ((contract (((lambda () #t) . ->d . (lambda () (let ([pre-x 1]) (lambda (res) (= x pre-x)))))
+                  . -> .
+                  (lambda (x) #t))
+                 (lambda (thnk) (thnk))
+                 'pos
+                 'neg)
+       (lambda () (set! x 2))))
+   "neg")
+  
   )