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

Revert this all the way back to where it was, I'll fix it up in a sec.

Browse Source 
svn: r11713

original commit: 14ef34e8e38e32029783d8207a684859fba7e3c0
This commit is contained in:
Stevie Strickland 2008-09-13 02:03:34 +00:00
parent 44116e67e9
commit 4c6ee3623e
1 changed files with 18 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

186
collects/tests/mzscheme/contract-mzlib-test.ss
View File

@ -81,7 +81,7 @@ of the contract library does not change over time.
(equal? (equal?
blame blame
(cond (cond
[(regexp-match #rx"(^| )(.*) broke" msg) [(regexp-match #rx"(^| )([^ ]*) broke" msg)
=> =>
(λ (x) (caddr x))] (λ (x) (caddr x))]
[else (format "no blame in error message: \"~a\"" msg)]))) [else (format "no blame in error message: \"~a\"" msg)])))
@ -103,8 +103,8 @@ of the contract library does not change over time.
(and (exn? exn) (and (exn? exn)
(,has-proper-blame? (exn-message exn)))))))))) (,has-proper-blame? (exn-message exn))))))))))
(define (test/pos-blame name expression) (test/spec-failed name expression "module pos")) (define (test/pos-blame name expression) (test/spec-failed name expression "pos"))
(define (test/neg-blame name expression) (test/spec-failed name expression "module neg")) (define (test/neg-blame name expression) (test/spec-failed name expression "neg"))
(define (test/well-formed stx) (define (test/well-formed stx)
(contract-eval (contract-eval
@ -126,7 +126,7 @@ of the contract library does not change over time.
(contract-eval `(,test #t flat-contract? ,contract)) (contract-eval `(,test #t flat-contract? ,contract))
(test/spec-failed (format "~a fail" name) (test/spec-failed (format "~a fail" name)
`(contract ,contract ',fail 'pos 'neg) `(contract ,contract ',fail 'pos 'neg)
"module pos") "pos")
(test/spec-passed/result (test/spec-passed/result
(format "~a pass" name) (format "~a pass" name)
`(contract ,contract ',pass 'pos 'neg) `(contract ,contract ',pass 'pos 'neg)
@ -1577,50 +1577,42 @@ of the contract library does not change over time.
'(let () '(let ()
(define/contract i integer? #t) (define/contract i integer? #t)
i) i)
"definition i") "i")
(test/spec-failed (test/spec-failed
'define/contract3 'define/contract3
'(let () '(let ()
(define/contract i (-> integer? integer?) (lambda (x) #t)) (define/contract i (-> integer? integer?) (lambda (x) #t))
(i 1)) (i 1))
"definition i") "i")
(test/spec-failed (test/spec-failed
'define/contract4 'define/contract4
'(let () '(let ()
(define/contract i (-> integer? integer?) (lambda (x) 1)) (define/contract i (-> integer? integer?) (lambda (x) 1))
(i #f)) (i #f))
"the top level") "<<unknown>>")
(test/spec-failed (test/spec-failed
'define/contract5 'define/contract5
'(let () '(let ()
(define/contract (i x) (-> integer? integer?) 1) (define/contract i (-> integer? integer?) (lambda (x) (i #t)))
(i #f)) (i 1))
"the top level") "<<unknown>>")
(test/spec-passed (test/spec-passed
'define/contract6 'define/contract6
'(let () '(let ()
(define/contract (i x) (-> integer? integer?) (define/contract contracted-func
(cond
[(not (integer? x)) 1]
[else (i #f)]))
(i 1)))
(test/spec-passed
'define/contract7
'(let ()
(define/contract (contracted-func label t)
(string? string? . -> . string?) (string? string? . -> . string?)
t) (lambda (label t)
t))
(contracted-func (contracted-func
"I'm a string constant with side effects" "I'm a string constant with side effects"
"ans"))) "ans")))
(test/spec-passed (test/spec-passed
'define/contract8 'define/contract7
'(let () '(let ()
(eval '(module contract-test-suite-define1 mzscheme (eval '(module contract-test-suite-define1 mzscheme
(require mzlib/contract) (require mzlib/contract)
@ -1628,149 +1620,7 @@ of the contract library does not change over time.
x)) x))
(eval '(require 'contract-test-suite-define1)))) (eval '(require 'contract-test-suite-define1))))
(test/spec-failed
'define/contract9
'(let ()
(define/contract (a n)
(-> number? number?)
(define/contract (b m)
(-> number? number?)
(+ m 1))
(b (zero? n)))
(a 5))
"function a")
(test/spec-failed
'define/contract10
'(let ()
(define/contract (a n)
(-> number? number?)
(define/contract (b m)
(-> number? number?)
#t)
(b (add1 n)))
(a 5))
"function b")
(test/spec-passed
'define/contract11
'(let ()
(define/contract (f n)
(-> number? number?)
(+ n 1))
(define/contract (g b m)
(-> boolean? number? number?)
(if b (f m) (f #t)))
(g #t 3)))
(test/spec-failed
'define/contract12
'(let ()
(define/contract (f n)
(-> number? number?)
(+ n 1))
(define/contract (g b m)
(-> boolean? number? number?)
(if b (f m) (f #t)))
(g #f 3))
"function g")
(test/spec-failed
'define/contract13
'(begin
(eval '(module foo-dc13 mzscheme
(require mzlib/contract)
(define/contract (foo-dc13 n)
(-> number? number?)
(+ n 1))
(foo-dc13 #t)))
(eval '(require 'foo-dc13)))
"module foo-dc13")
(test/spec-failed
'define/contract14
'(begin
(eval '(module foo-dc14 mzscheme
(require mzlib/contract)
(provide foo-dc14)
(define/contract (foo-dc14 n)
(-> number? number?)
(+ n 1))))
(eval '(module bar-dc14 mzscheme
(require 'foo-dc14)
(foo-dc14 #t)))
(eval '(require 'bar-dc14)))
"module bar-dc14")
(test/spec-failed
'define/contract15
'(begin
(eval '(module foo-dc15 mzscheme
(require mzlib/contract)
(provide foo-dc15)
(define/contract (foo-dc15 n)
(-> number? number?)
(+ n 1))))
(eval '(require 'foo-dc15))
(eval '(foo-dc15 #t)))
"the top level")
(test/spec-passed
'with-contract1
'(let ()
(with-contract odd-even
([odd? (-> number? boolean?)]
[even? (-> number? boolean?)])
(define (odd? n)
(if (zero? n) #f (even? (sub1 n))))
(define (even? n)
(if (zero? n) #t (odd? (sub1 n)))))
(odd? 5)))
(test/spec-failed
'with-contract2
'(let ()
(with-contract odd-even
([odd? (-> number? boolean?)]
[even? (-> number? boolean?)])
(define (odd? n)
(if (zero? n) #f (even? (sub1 n))))
(define (even? n)
(if (zero? n) #t (odd? (sub1 n)))))
(odd? #t))
"the top level")
(test/spec-failed
'with-contract3
'(let ()
(with-contract odd-even
([odd? (-> number? boolean?)]
[even? (-> number? boolean?)])
(define (odd? n)
(if (zero? n) n (even? (sub1 n))))
(define (even? n)
(if (zero? n) #t (odd? (sub1 n)))))
(odd? 4))
"region odd-even")
;; Functions within the same with-contract region can call
;; each other however they want, so here we have even?
;; call odd? with a boolean, even though its contract in
;; the odd-even contract says it only takes numbers.
(test/spec-passed
'with-contract4
'(let ()
(with-contract odd-even
([odd? (-> number? boolean?)]
[even? (-> number? boolean?)])
(define (odd? n)
(cond
[(not (number? n)) #f]
[(zero? n) #f]
[else (even? (sub1 n))]))
(define (even? n)
(if (zero? n) #t (odd? (zero? n)))))
(odd? 5)))
; ;
; ;
@ -4793,7 +4643,7 @@ so that propagation occurs.
(provide/contract (x integer?)))) (provide/contract (x integer?))))
(eval '(require 'contract-test-suite3)) (eval '(require 'contract-test-suite3))
(eval 'x)) (eval 'x))
"module 'contract-test-suite3") "'contract-test-suite3")
(test/spec-passed (test/spec-passed
'provide/contract4 'provide/contract4
@ -4970,7 +4820,7 @@ so that propagation occurs.
(make-s 1 2) (make-s 1 2)
[s-a #f]))) [s-a #f])))
(eval '(require 'pc11b-n))) (eval '(require 'pc11b-n)))
"module 'n") 'n)
|# |#
(test/spec-passed (test/spec-passed
@ -5038,7 +4888,7 @@ so that propagation occurs.
(define i #f) (define i #f)
(provide/contract [i integer?]))) (provide/contract [i integer?])))
(eval '(require 'pos))) (eval '(require 'pos)))
"module 'pos") "'pos")
;; this is really a positive violation, but name the module `neg' just for an addl test ;; this is really a positive violation, but name the module `neg' just for an addl test
(test/spec-failed (test/spec-failed
@ -5049,7 +4899,7 @@ so that propagation occurs.
(define i #f) (define i #f)
(provide/contract [i integer?]))) (provide/contract [i integer?])))
(eval '(require 'neg))) (eval '(require 'neg)))
"module 'neg") "'neg")
;; this test doesn't pass yet ... waiting for support from define-struct ;; this test doesn't pass yet ... waiting for support from define-struct