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

Fix unit contract tests to cope with contract error message changes.

Browse Source
This commit is contained in:
Stevie Strickland 2012-05-16 11:37:17 -04:00
parent b0409dd232
commit 3d8c1e200a
1 changed files with 3 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,18 +7,18 @@
(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:.*blaming: ~a" re) msg))) (regexp-match? (format "broke it's contract:.*blaming: ~a" re) msg)))
(define (match-obj re msg) (define (match-obj re msg)
(or (regexp-match? (format "~a: contract violation" re) msg) (or (regexp-match? (format "~a: contract violation" re) msg)
(regexp-match? (format "~a: self-contract violation" re) msg))) (regexp-match? (format "~a: broke it's contract" re) msg)))
(define (get-ctc-err msg) (define (get-ctc-err msg)
(cond (cond
[(regexp-match #rx"contract violation\n *([^\n]*)\n" msg) [(regexp-match #rx"contract violation\n *([^\n]*)\n" msg)
=> =>
(λ (x) (cadr x))] (λ (x) (cadr x))]
[(regexp-match #rx"self-contract violation\n *([^\n]*)\n" msg) [(regexp-match #rx"broke it's contract\n *([^\n]*)\n" msg)
=> =>
(lambda (x) (cadr x))] (lambda (x) (cadr x))]
[else (error 'test-contract-error [else (error 'test-contract-error