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

Fix the unit contract tests due to changes in contract violation reports.

Browse Source
This commit is contained in:
Stevie Strickland 2011-07-03 00:46:25 -04:00
parent de9aec3051
commit d3ebf21d97
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/units/test-unit-contracts.rktl
View File

@ -7,16 +7,20 @@
(define (match-blame re msg) (define (match-blame re msg)
(or (regexp-match? (format "blaming ~a" re) msg) (or (regexp-match? (format "blaming ~a" re) msg)
(regexp-match? (format "self-contract violation:.*from ~a" re) msg))) (regexp-match? (format "self-contract violation:.*blaming ~a" re) msg)))
(define (match-obj re msg) (define (match-obj re msg)
(regexp-match? (string-append "contract on " re " from") msg)) (or (regexp-match? (format "~a: contract violation" re) msg)
(regexp-match? (format "~a: self-contract violation" re) msg)))
(define (get-ctc-err msg) (define (get-ctc-err msg)
(cond (cond
[(regexp-match #rx"contract violation: ([^\n]*)\n" msg) [(regexp-match #rx"contract violation, ([^\n]*)\n" msg)
=> =>
(λ (x) (cadr x))] (λ (x) (cadr x))]
[(regexp-match #rx"self-contract violation, ([^\n]*)\n" msg)
=>
(lambda (x) (cadr x))]
[else (error 'test-contract-error [else (error 'test-contract-error
(format "no specific error in message: \"~a\"" msg))])) (format "no specific error in message: \"~a\"" msg))]))