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

add missing require, fix opt/c test suite

Browse Source
This commit is contained in:
Robby Findler 2011-03-29 08:50:16 -05:00
parent 68f7e9f33b
commit 5b879d0680
2 changed files with 283 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,7 @@
#lang racket/base
(require "guts.rkt"
"blame.rkt"
"opt.rkt"
"base.rkt")
(require (for-syntax racket/base

31
collects/tests/racket/contract-opt-tests.rkt
View File

@ -1,28 +1,28 @@
(module contract-opt-tests mzscheme
(require mzlib/contract
#lang racket/base
(require racket/contract
rackunit
rackunit/text-ui)
(define (exn:fail:contract-violation? exn)
(if (regexp-match #rx"broke" (exn-message exn)) #t #f))
(define (exn:fail:contract-violation? exn)
(if (regexp-match #rx"contract violation" (exn-message exn)) #t #f))
(define ((blame-to whom) exn)
(define ((blame-to whom) exn)
(and (exn:fail:contract-violation? exn)
(regexp-match (format "~a broke" whom)
(regexp-match (regexp-quote (format "blaming ~a" whom))
(exn-message exn))))
(define ((match-msg msg) exn)
(define ((match-msg msg) exn)
(regexp-match (regexp msg) (exn-message exn)))
(define-simple-check (check-pred2 func thunk)
(define-simple-check (check-pred2 func thunk)
(let-values ([(a b) (thunk)])
(func a b)))
(define-simple-check (check-name expected ctc)
(define-simple-check (check-name expected ctc)
(let ((got (contract-name ctc)))
(equal? expected got)))
(define opt-tests
(define opt-tests
(test-suite
"Tests for opt/c"
@ -138,13 +138,13 @@
(test-exn
"between/c 2"
(match-msg "expected a number as first")
(match-msg "expected a real number as first")
(λ ()
(contract (opt/c (between/c 'x 'b)) 1 'pos 'neg)))
(test-exn
"between/c 3"
(match-msg "expected a number as second")
(match-msg "expected a real number as second")
(λ ()
(contract (opt/c (between/c 1 'b)) 1 'pos 'neg)))
@ -277,8 +277,7 @@
(test-case
"cons/c name 4"
(check-name '(cons/c (-> boolean? boolean?) integer?)
(opt/c (cons/c (-> boolean? boolean?) integer?))))
(opt/c (cons/c (-> boolean? boolean?) integer?))))))
))
(run-tests opt-tests))
(unless (zero? (run-tests opt-tests))
(error 'contract-opt-tests.rkt "tests failed"))