diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract-opt-tests.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract-opt-tests.rkt index 02dee99d7d..8c5cd17f6b 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/contract-opt-tests.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract-opt-tests.rkt @@ -3,16 +3,15 @@ rackunit rackunit/text-ui) -(define (exn:fail:contract-violation? exn) - (if (regexp-match #rx"contract violation" (exn-message exn)) #t #f)) - (define ((blame-to whom) exn) - (and (exn:fail:contract-violation? exn) - (regexp-match (regexp-quote (format "blaming ~a" whom)) - (exn-message exn)))) + (and (exn:fail:contract:blame? exn) + (regexp-match? (regexp-quote (format "blaming: ~a" whom)) + (exn-message exn)))) -(define ((match-msg msg) exn) - (regexp-match (regexp msg) (exn-message exn))) +(define ((match-msg . msgs) exn) + (and (exn:fail? exn) + (for/and ([msg (in-list msgs)]) + (regexp-match (regexp-quote msg) (exn-message exn))))) (define-simple-check (check-pred2 func thunk) (let-values ([(a b) (thunk)]) @@ -103,7 +102,7 @@ (test-exn "flat-contract 2" - (match-msg "expected a flat") + (match-msg "expected: flat-contract?") (λ () (contract (opt/c (flat-contract (λ (x y) #f))) 1 'pos 'neg))) @@ -138,13 +137,13 @@ (test-exn "between/c 2" - (match-msg "expected a real number as first") + (match-msg "expected: real?" "argument position: 1st") (λ () (contract (opt/c (between/c 'x 'b)) 1 'pos 'neg))) (test-exn "between/c 3" - (match-msg "expected a real number as second") + (match-msg "expected: real?" "argument position: 2nd") (λ () (contract (opt/c (between/c 1 'b)) 1 'pos 'neg))) @@ -206,7 +205,7 @@ (test-case "or/c name 6" - (check-name '(or/c (-> (>=/c 5) (>=/c 5)) boolean?) + (check-name '(or/c boolean? (-> (>=/c 5) (>=/c 5))) (opt/c (or/c boolean? (-> (>=/c 5) (>=/c 5)))))) (test-case diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt index 31af6ab0e5..9feabc8b42 100644 --- a/racket/collects/racket/contract/private/misc.rkt +++ b/racket/collects/racket/contract/private/misc.rkt @@ -379,12 +379,12 @@ (raise-argument-error name (format "~a" (object-name pred1?)) 0 - (list arg1 arg2))) + arg1 arg2)) (unless (pred2? arg2) (raise-argument-error name (format "~a" (object-name pred2?)) 1 - (list arg1 arg2)))) + arg1 arg2))) (define/final-prop (integer-in start end) (check-two-args 'integer-in start end exact-integer? exact-integer?) (flat-named-contract @@ -961,7 +961,10 @@ #:val-first-projection (λ (ctc) (λ (blame) any/c-neg-party-fn)) #:stronger (λ (this that) (any/c? that)) #:name (λ (ctc) 'any/c) - #:generate (λ (ctc) (λ (fuel) (λ () (random-any/c fuel)))) + #:generate (λ (ctc) + (λ (fuel) + (define env (generate-env)) + (λ () (random-any/c env fuel)))) #:first-order get-any?)) (define/final-prop any/c (make-any/c))