From 041cebc9c0c961d9e34f7413c9ec7ed23df69b7e Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 9 Mar 2016 15:37:52 -0600 Subject: [PATCH] fix error message in ->i in the case where the dependened on contract is a first-order contract, there is a shortcircuit that incorrectly formulated the error message --- .../tests/racket/contract/arrow-i.rkt | 20 ++++++++++++++++++- .../racket/contract/private/arr-i.rkt | 2 +- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/pkgs/racket-test/tests/racket/contract/arrow-i.rkt b/pkgs/racket-test/tests/racket/contract/arrow-i.rkt index a6571eb41a..dcb928a031 100644 --- a/pkgs/racket-test/tests/racket/contract/arrow-i.rkt +++ b/pkgs/racket-test/tests/racket/contract/arrow-i.rkt @@ -1440,4 +1440,22 @@ (λ (x y) x) 'pos 'neg) 1 2) "didn't raise an error") - #t)) + #t) + + (test/spec-passed/result + 'shortcut-error-message + '(with-handlers ([exn:fail? + (λ (x) (define m + (regexp-match #rx"expected: ([^\n]*)\n" + (exn-message x))) + (if m + (list-ref m 1) + (format "ack regexp didn't match: ~s" + (exn-message x))))]) + ((contract (->i ([y () (and/c number? (>/c 1))]) any) + (λ (y) 1) + 'pos 'neg) + 1)) + "(and/c number? (>/c 1))") + + ) diff --git a/racket/collects/racket/contract/private/arr-i.rkt b/racket/collects/racket/contract/private/arr-i.rkt index 5470e974ef..03e12b9fbd 100644 --- a/racket/collects/racket/contract/private/arr-i.rkt +++ b/racket/collects/racket/contract/private/arr-i.rkt @@ -1090,7 +1090,7 @@ evaluted left-to-right.) (if (orig-ctc obj) obj (raise-predicate-blame-error-failure blame obj neg-party - (object-name orig-ctc)))] + (contract-name orig-ctc)))] [else (define ctc (if chaperone? (coerce-chaperone-contract '->i orig-ctc)