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

Fixed blame detection regexp.

Browse Source 
svn: r17742

original commit: 35a716d5d36b4995c025d3e46089e3dea7a09dc8
This commit is contained in:
Carl Eastlund 2010-01-19 07:14:17 +00:00
parent ff9748dd99
commit d9e5df35ed
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -78,13 +78,9 @@ of the contract library does not change over time.
(define (test/spec-failed name expression blame) (define (test/spec-failed name expression blame)
(let () (let ()
(define (has-proper-blame? msg) (define (has-proper-blame? msg)
(equal? (regexp-match?
blame (string-append "(^| )" (regexp-quote blame) " broke")
(cond msg))
[(regexp-match #rx"(^| )(.*) broke" msg)
=>
(λ (x) (caddr x))]
[else (format "no blame in error message: \"~a\"" msg)])))
(printf "testing: ~s\n" name) (printf "testing: ~s\n" name)
(contract-eval (contract-eval
`(,thunk-error-test `(,thunk-error-test
@ -5127,7 +5123,11 @@ so that propagation occurs.
(and (exn? x) (and (exn? x)
(regexp-match #rx"expected field name to be b, but found string?" (exn-message x))))) (regexp-match #rx"expected field name to be b, but found string?" (exn-message x)))))
(contract-eval `(,test 'pos guilty-party (with-handlers ((void values)) (contract not #t 'pos 'neg)))) (contract-eval
`(,test
'pos
(compose blame-guilty exn:fail:contract:blame-object)
(with-handlers ((void values)) (contract not #t 'pos 'neg))))
(report-errs) (report-errs)