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

changes noticed by Matthew

Browse Source 
svn: r6980
This commit is contained in:
Robby Findler 2007-07-29 18:56:32 +00:00
parent 23d245c09f
commit 67dd80eb78
2 changed files with 4 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/mzlib/private/contract.ss
View File

@ -808,7 +808,6 @@ improve method arity mismatch contract violation error messages?
not/c
=/c >=/c <=/c </c >/c between/c
integer-in
exact-integer-in
real-in
natural-number/c
string/len
@ -1305,8 +1304,8 @@ improve method arity mismatch contract violation error messages?
[(_ 'sym x-exp)
(identifier? #'sym)
#'(let ([x x-exp])
(unless (number? x)
(error 'sym "expected a number, got ~e" x)))]))
(unless (real? x)
(error 'sym "expected a real number, got ~e" x)))]))
(define (=/c x)
(check-unary-between/c '=/c x)
@ -1479,23 +1478,13 @@ improve method arity mismatch contract violation error messages?
(x . >= . 0)))))
(define (integer-in start end)
(unless (and (integer? start)
(integer? end))
(error 'integer-in "expected two integers as arguments, got ~e and ~e" start end))
(flat-named-contract
`(integer-in ,start ,end)
(λ (x)
(and (integer? x)
(<= start x end)))))
(define (exact-integer-in start end)
(unless (and (integer? start)
(exact? start)
(integer? end)
(exact? end))
(error 'integer-in "expected two exact integers as arguments, got ~e and ~e" start end))
(flat-named-contract
`(exact-integer-in ,start ,end)
`(integer-in ,start ,end)
(λ (x)
(and (integer? x)
(exact? x)

5
collects/tests/mzscheme/contract-test.ss
View File

@ -4133,9 +4133,7 @@ so that propagation occurs.
(test-flat-contract '(>/c 5) 10 5)
(test-flat-contract '(integer-in 0 10) 0 11)
(test-flat-contract '(integer-in 0 10) 10 3/2)
(test-flat-contract '(exact-integer-in 0 10) 0 11)
(test-flat-contract '(exact-integer-in 0 10) 10 3/2)
(test-flat-contract '(exact-integer-in 0 10) 1 1.0)
(test-flat-contract '(integer-in 0 10) 1 1.0)
(test-flat-contract '(real-in 1 10) 3/2 20)
(test-flat-contract '(string/len 3) "ab" "abc")
(test-flat-contract 'natural-number/c 5 -1)
@ -4355,7 +4353,6 @@ so that propagation occurs.
(test-name '(>/c 5) (>/c 5))
(test-name '(between/c 5 6) (between/c 5 6))
(test-name '(integer-in 0 10) (integer-in 0 10))
(test-name '(exact-integer-in 0 10) (exact-integer-in 0 10))
(test-name '(real-in 1 10) (real-in 1 10))
(test-name '(string/len 3) (string/len 3))
(test-name 'natural-number/c natural-number/c)