original commit: 9f5607cbe061edfbe2bcba2fec33303f6cbc25d4
This commit is contained in:
Robby Findler 2004-06-21 03:43:24 +00:00
parent 4828f4378a
commit af2420010d
2 changed files with 33 additions and 2 deletions

View File

@ -2434,7 +2434,7 @@ add struct contracts for immutable structs?
union
and/c
not/f
>=/c <=/c </c >/c
=/c >=/c <=/c </c >/c
integer-in
real-in
natural-number?
@ -2625,6 +2625,10 @@ add struct contracts for immutable structs?
(and (box? x)
(printable? (unbox x))))))))
(define (=/c x)
(flat-named-contract
(format "(=/c ~a)" x)
(lambda (y) (and (number? y) (= y x)))))
(define (>=/c x)
(flat-named-contract
(format "(>=/c ~a)" x)

View File

@ -2194,6 +2194,15 @@
'neg)])
(for-each (lambda (x) (x 1)) ctc)))
(test/spec-passed/result
'immutable20
'(let ([ctc (contract (list-immutable/c number?)
(list-immutable 1)
'pos
'neg)])
(immutable? ctc))
#t)
(test/pos-blame
'vector-immutable1
'(contract (vector-immutableof (boolean? . -> . boolean?))
@ -2277,6 +2286,14 @@
'neg)
(vector->immutable-vector (vector 1 #t)))
(test/spec-passed/result
'vector-immutable12
'(immutable? (contract (vector-immutable/c number? boolean?)
(vector->immutable-vector (vector 1 #t))
'pos
'neg))
#t)
(test/pos-blame
'box-immutable1
'(contract (box-immutable/c (number? . -> . boolean?))
@ -2316,13 +2333,21 @@
((unbox ctc) 1)))
(test/spec-passed/result
'vector-immutable6
'box-immutable6
'(contract (box-immutable/c boolean?)
(box-immutable #t)
'pos
'neg)
(box-immutable #t))
(test/spec-passed/result
'box-immutable7
'(immutable? (contract (box-immutable/c boolean?)
(box-immutable #t)
'pos
'neg))
#t)
(test/spec-passed
'anaphoric1
@ -2374,6 +2399,7 @@
(test-flat-contract '(and/c number? integer?) 1 3/2)
(test-flat-contract '(not/f integer?) #t 1)
(test-flat-contract '(=/c 2) 2 3)
(test-flat-contract '(>=/c 5) 5 0)
(test-flat-contract '(<=/c 5) 5 10)
(test-flat-contract '(</c 5) 0 5)
@ -2524,6 +2550,7 @@
(test-name "(and/c number? (-> integer? integer?))" (and/c number? (-> integer? integer?)))
(test-name "(not/f integer?)" (not/f integer?))
(test-name "(=/c 5)" (=/c 5))
(test-name "(>=/c 5)" (>=/c 5))
(test-name "(<=/c 5)" (<=/c 5))
(test-name "(</c 5)" (</c 5))