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 not/c
=/c >=/c <=/c </c >/c between/c =/c >=/c <=/c </c >/c between/c
integer-in integer-in
exact-integer-in
real-in real-in
natural-number/c natural-number/c
string/len string/len
@ -1305,8 +1304,8 @@ improve method arity mismatch contract violation error messages?
[(_ 'sym x-exp) [(_ 'sym x-exp)
(identifier? #'sym) (identifier? #'sym)
#'(let ([x x-exp]) #'(let ([x x-exp])
(unless (number? x) (unless (real? x)
(error 'sym "expected a number, got ~e" x)))])) (error 'sym "expected a real number, got ~e" x)))]))
(define (=/c x) (define (=/c x)
(check-unary-between/c '=/c x) (check-unary-between/c '=/c x)
@ -1479,23 +1478,13 @@ improve method arity mismatch contract violation error messages?
(x . >= . 0))))) (x . >= . 0)))))
(define (integer-in start end) (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) (unless (and (integer? start)
(exact? start) (exact? start)
(integer? end) (integer? end)
(exact? end)) (exact? end))
(error 'integer-in "expected two exact integers as arguments, got ~e and ~e" start end)) (error 'integer-in "expected two exact integers as arguments, got ~e and ~e" start end))
(flat-named-contract (flat-named-contract
`(exact-integer-in ,start ,end) `(integer-in ,start ,end)
(λ (x) (λ (x)
(and (integer? x) (and (integer? x)
(exact? 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 '(>/c 5) 10 5)
(test-flat-contract '(integer-in 0 10) 0 11) (test-flat-contract '(integer-in 0 10) 0 11)
(test-flat-contract '(integer-in 0 10) 10 3/2) (test-flat-contract '(integer-in 0 10) 10 3/2)
(test-flat-contract '(exact-integer-in 0 10) 0 11) (test-flat-contract '(integer-in 0 10) 1 1.0)
(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 '(real-in 1 10) 3/2 20) (test-flat-contract '(real-in 1 10) 3/2 20)
(test-flat-contract '(string/len 3) "ab" "abc") (test-flat-contract '(string/len 3) "ab" "abc")
(test-flat-contract 'natural-number/c 5 -1) (test-flat-contract 'natural-number/c 5 -1)
@ -4355,7 +4353,6 @@ so that propagation occurs.
(test-name '(>/c 5) (>/c 5)) (test-name '(>/c 5) (>/c 5))
(test-name '(between/c 5 6) (between/c 5 6)) (test-name '(between/c 5 6) (between/c 5 6))
(test-name '(integer-in 0 10) (integer-in 0 10)) (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 '(real-in 1 10) (real-in 1 10))
(test-name '(string/len 3) (string/len 3)) (test-name '(string/len 3) (string/len 3))
(test-name 'natural-number/c natural-number/c) (test-name 'natural-number/c natural-number/c)