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

fixed up printing ~s vs ~a in contract system and made the contract tests run in drdr

Browse Source
This commit is contained in:
Robby Findler 2011-05-11 21:16:46 -05:00
parent c163e75023
commit 1db3ae3476
7 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/meta/props
View File

@ -1751,10 +1751,10 @@ path/s is either such a string or a list of them.
"collects/tests/racket/compile.rktl" drdr:command-line #f
"collects/tests/racket/contmark.rktl" drdr:command-line #f
"collects/tests/racket/contract-mzlib-test.rktl" responsible (robby) drdr:command-line (racket "-qr" *)
"collects/tests/racket/contract-opt-tests.rkt" responsible (robby) drdr:command-line (racket "-f" *)
"collects/tests/racket/contract-stress-argmin.rkt" responsible (robby)
"collects/tests/racket/contract-stress-take-right.rkt" responsible (robby)
"collects/tests/racket/contract-test.rktl" responsible (robby) drdr:command-line #f
"collects/tests/racket/contract-opt-tests.rkt" responsible (robby) drdr:command-line (racket "-qr" *)
"collects/tests/racket/contract-stress-argmin.rkt" responsible (robby) drdr:command-line (racket "-qr" *)
"collects/tests/racket/contract-stress-take-right.rkt" responsible (robby) drdr:command-line (racket "-qr" *)
"collects/tests/racket/contract-test.rktl" responsible (robby) drdr:command-line (racket "-qr" *)
"collects/tests/racket/control.rktl" drdr:command-line (racket "-f" *)
"collects/tests/racket/date.rktl" drdr:command-line (racket "-f" *)
"collects/tests/racket/deep.rktl" drdr:command-line (racket "-f" *)

4
collects/racket/contract/private/basic-opters.rkt
View File

@ -22,7 +22,7 @@
(raise-blame-error
blame
val
"expected <~a>, given: ~e"
"expected <~s>, given: ~e"
(contract-name ctc)
val))))
null
@ -102,7 +102,7 @@
(raise-blame-error
blame
val
"expected <~a>, given: ~e"
"expected <~s>, given: ~e"
(contract-name ctc)
val)))
(interleave-lifts

6
collects/racket/contract/private/ds.rkt
View File

@ -246,7 +246,7 @@ it around flattened out.
(raise-blame-error
blame
val
"expected <~a>, got ~e" 'name val))
"expected <~s>, got ~e" 'name val))
(cond
[(already-there? contract/info val lazy-depth-to-look)
val]
@ -299,7 +299,7 @@ it around flattened out.
(do-selection struct (+ i 1))
(wrap-get struct (+ i 1)))]
[else
(error selector-name "expected <~a>, got ~e" 'name struct)]))
(error selector-name "expected <~s>, got ~e" 'name struct)]))
(define (lazy-contract-name ctc)
(do-contract-name 'struct/c
@ -452,7 +452,7 @@ it around flattened out.
(raise-blame-error
blame
val
"expected <~a>, got ~e"
"expected <~s>, got ~e"
(contract-name ctc)
val)]))
lifts

2
collects/racket/contract/private/misc.rkt
View File

@ -607,7 +607,7 @@
[cdr-p (cdr-proj blame)])
(λ (v)
(unless (pair? v)
(raise-blame-error blame v "expected <~a>, given: ~e" 'cons v))
(raise-blame-error blame v "expected <cons?>, given: ~e" v))
(combine v (car-p (car v)) (cdr-p (cdr v))))))
(cond
[(and (flat-contract? ctc-car) (flat-contract? ctc-cdr))

8
collects/racket/contract/private/opters.rkt
View File

@ -148,7 +148,7 @@
(raise-blame-error
blame
val
"expected <~a>, given: ~e"
"expected <~s>, given: ~e"
(contract-name ctc)
val)))
lifts3
@ -186,7 +186,7 @@
(raise-blame-error
blame
val
"expected <~a>, given: ~e"
"expected <~s>, given: ~e"
(contract-name ctc)
val)))
lifts3
@ -268,7 +268,7 @@
(raise-blame-error
blame
val
"expected <~a>, given: ~e"
"expected <~s>, given: ~e"
(contract-name ctc)
val))))
(append
@ -329,7 +329,7 @@
(raise-blame-error
blame
val
"expected <~a>, given: ~e"
"expected <~s>, given: ~e"
(contract-name ctc)
val))))
(append lifts-hdp lifts-tlp)

2
collects/racket/contract/private/prop.rkt
View File

@ -211,7 +211,7 @@
(define (((first-order-projection name first-order) b) x)
(if (first-order x)
x
(raise-blame-error b x "expected <~a>, given: ~e" name x)))
(raise-blame-error b x "expected <~s>, given: ~e" name x)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

4
collects/racket/contract/private/struct.rkt
View File

@ -36,12 +36,12 @@
(append (base-struct/c-immutables ctc) (base-struct/c-mutables ctc)))])
(λ (val fail [first-order? #f])
(unless (pred? val)
(fail "expected <~a>, got ~e" name val))
(fail "expected <~s>, got ~e" name val))
(when first-order?
(for ([p (in-list ctc/ref-pairs)])
(let ([c (car p)] [v ((cdr p) val)])
(unless (contract-first-order-passes? c v)
(fail "expected <~a>, got ~e" (contract-name c) v)))))
(fail "expected <~s>, got ~e" (contract-name c) v)))))
#t)))
(define (struct/c-first-order ctc)