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

renamed string/len to string-len/c

Browse Source 
svn: r8237
This commit is contained in:
Robby Findler 2008-01-06 15:53:50 +00:00
parent b2b8315ac3
commit cda0888ab9
4 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mzlib/contract.ss
View File

@ -36,7 +36,9 @@
(except-out (all-from-out scheme/private/contract) (except-out (all-from-out scheme/private/contract)
check-between/c check-between/c
check-unary-between/c)) string-len/c
check-unary-between/c)
(rename-out [string-len/c string/len]))
;; from contract-guts.ss ;; from contract-guts.ss

8
collects/scheme/private/contract.ss
View File

@ -826,7 +826,7 @@ improve method arity mismatch contract violation error messages?
integer-in integer-in
real-in real-in
natural-number/c natural-number/c
string/len string-len/c
false/c false/c
printable/c printable/c
symbols one-of/c symbols one-of/c
@ -1216,11 +1216,11 @@ improve method arity mismatch contract violation error messages?
'false/c 'false/c
(λ (x) (not x)))) (λ (x) (not x))))
(define (string/len n) (define (string-len/c n)
(unless (number? n) (unless (number? n)
(error 'string/len "expected a number as argument, got ~e" n)) (error 'string-len/c "expected a number as argument, got ~e" n))
(flat-named-contract (flat-named-contract
`(string/len ,n) `(string-len/c ,n)
(λ (x) (λ (x)
(and (string? x) (and (string? x)
((string-length x) . < . n))))) ((string-length x) . < . n)))))

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

@ -4160,7 +4160,7 @@ so that propagation occurs.
(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 '(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/c 3) (string/len 3))
(test-name 'natural-number/c natural-number/c) (test-name 'natural-number/c natural-number/c)
(test-name 'false/c false/c) (test-name 'false/c false/c)
(test-name 'printable/c printable/c) (test-name 'printable/c printable/c)

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

@ -4389,7 +4389,7 @@ so that propagation occurs.
(test-flat-contract '(integer-in 0 10) 10 3/2) (test-flat-contract '(integer-in 0 10) 10 3/2)
(test-flat-contract '(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 '(real-in 1 10) 3/2 20)
(test-flat-contract '(string/len 3) "ab" "abc") (test-flat-contract '(string-len/c 3) "ab" "abc")
(test-flat-contract 'natural-number/c 5 -1) (test-flat-contract 'natural-number/c 5 -1)
(test-flat-contract 'false/c #f #t) (test-flat-contract 'false/c #f #t)
(test/spec-passed 'any/c '(contract any/c 1 'pos 'neg)) (test/spec-passed 'any/c '(contract any/c 1 'pos 'neg))
@ -4604,7 +4604,7 @@ so that propagation occurs.
(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 '(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/c 3) (string-len/c 3))
(test-name 'natural-number/c natural-number/c) (test-name 'natural-number/c natural-number/c)
(test-name 'false/c false/c) (test-name 'false/c false/c)
(test-name 'printable/c printable/c) (test-name 'printable/c printable/c)