From abb1ce71cca241f994de55bc794147d2f6a36de0 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Tue, 19 Feb 2019 13:53:27 +0100 Subject: [PATCH] update expr/c, wrap-expr/c tests for contract message change --- .../racket-test/tests/stxparse/test-exprc.rkt | 55 +++++++++++------- .../tests/syntax/contract/test-errors.rkt | 58 +++++++++++-------- 2 files changed, 68 insertions(+), 45 deletions(-) diff --git a/pkgs/racket-test/tests/stxparse/test-exprc.rkt b/pkgs/racket-test/tests/stxparse/test-exprc.rkt index 6dde3f6a93..31d8bfd819 100644 --- a/pkgs/racket-test/tests/stxparse/test-exprc.rkt +++ b/pkgs/racket-test/tests/stxparse/test-exprc.rkt @@ -5,6 +5,17 @@ ;; See also tests/syntax/contract/test-errors.rkt. +(define (check-ctc-exn rx swapped? thunk) + ((with-handlers ([(lambda (e) #t) + (lambda (e) + (check-pred exn:fail:contract:blame? e) + (define b (exn:fail:contract:blame-object e)) + (check-equal? (blame-swapped? b) swapped?) + (check-regexp-match rx (exn-message e)) + void)]) + (thunk) + (lambda () (fail "no exn raised"))))) + (define-syntax (m-str stx) (syntax-parse stx [(_ e) @@ -12,8 +23,8 @@ #'e.c])) (check-equal? (m-str "string") "string") -(check-exn #rx"m-str: contract violation.*expected: string?" - (lambda () (m-str 'not-a-string))) +(check-ctc-exn #rx"m-str: contract violation.*expected: string?" #t + (lambda () (m-str 'not-a-string))) (define-syntax (m-arr stx) (syntax-parse stx @@ -22,8 +33,8 @@ #'(f.c arg)])) (check-equal? (m-arr string->symbol "a") 'a) -(check-exn #rx"m-arr: broke its own contract.*promised: string?" - (lambda () (m-arr string->symbol 'a))) +(check-ctc-exn #rx"m-arr: contract violation.*expected: string?" #f + (lambda () (m-arr string->symbol 'a))) (define-syntax (m-app stx) (syntax-parse stx @@ -38,14 +49,14 @@ "def") "abcdef") -(check-exn #rx"m-app: broke its own contract.*promised: string?" - ;; Yes, it's m-app's fault, because it didn't protect - ;; f from bad arguments. - (lambda () - ((m-app (-> string? (-> string? string?)) - (lambda (s) (lambda (t) (string-append s t))) - "abc") - 'def))) +(check-ctc-exn #rx"m-app: contract violation.*expected: string?" #f + ;; Yes, it's m-app's fault, because it didn't protect + ;; f from bad arguments. + (lambda () + ((m-app (-> string? (-> string? string?)) + (lambda (s) (lambda (t) (string-append s t))) + "abc") + 'def))) (define-syntax (m-res stx) (syntax-parse stx @@ -58,13 +69,13 @@ (lambda (s) (lambda (t) (string-append s t)))) "abc") "def") "abcdef") -(check-exn #rx"m-res: contract violation.*expected: string?" - (lambda () - (((m-res (-> string? (-> string? string?)) - (lambda (s) (lambda (t) (string-append s t)))) - 'abc) "def"))) -(check-exn #rx"m-res: contract violation.*expected: string?" - (lambda () - (((m-res (-> string? (-> string? string?)) - (lambda (s) (lambda (t) (string-append s t)))) - "abc") 'def))) +(check-ctc-exn #rx"m-res: contract violation.*expected: string?" #t + (lambda () + (((m-res (-> string? (-> string? string?)) + (lambda (s) (lambda (t) (string-append s t)))) + 'abc) "def"))) +(check-ctc-exn #rx"m-res: contract violation.*expected: string?" #t + (lambda () + (((m-res (-> string? (-> string? string?)) + (lambda (s) (lambda (t) (string-append s t)))) + "abc") 'def))) diff --git a/pkgs/racket-test/tests/syntax/contract/test-errors.rkt b/pkgs/racket-test/tests/syntax/contract/test-errors.rkt index 5369429db3..edce99efce 100644 --- a/pkgs/racket-test/tests/syntax/contract/test-errors.rkt +++ b/pkgs/racket-test/tests/syntax/contract/test-errors.rkt @@ -3,14 +3,25 @@ racket/contract rackunit) +(define (check-ctc-exn rx swapped? thunk) + ((with-handlers ([(lambda (e) #t) + (lambda (e) + (check-pred exn:fail:contract:blame? e) + (define b (exn:fail:contract:blame-object e)) + (check-equal? (blame-swapped? b) swapped?) + (check-regexp-match rx (exn-message e)) + void)]) + (thunk) + (lambda () (fail "no exn raised"))))) + (define-syntax (m-str stx) (syntax-case stx () [(_ e) (wrap-expr/c #'string? #'e #:context stx)])) (check-equal? (m-str "string") "string") -(check-exn #rx"m-str: contract violation.*expected: string?" - (lambda () (m-str 'not-a-string))) +(check-ctc-exn #rx"m-str: contract violation.*expected: string?" #t + (lambda () (m-str 'not-a-string))) (define-syntax (m-arr stx) (syntax-case stx () @@ -19,8 +30,8 @@ #'(f* arg))])) (check-equal? (m-arr string->symbol "a") 'a) -(check-exn #rx"m-arr: broke its own contract.*promised: string?" - (lambda () (m-arr string->symbol 'a))) +(check-ctc-exn #rx"m-arr: contract violation.*expected: string?" #f + (lambda () (m-arr string->symbol 'a))) (define-syntax (m-app stx) (syntax-case stx () @@ -35,14 +46,14 @@ "def") "abcdef") -(check-exn #rx"m-app: broke its own contract.*promised: string?" - ;; Yes, it's m-app's fault, because it didn't protect - ;; f from bad arguments. - (lambda () - ((m-app (lambda (s) (lambda (t) (string-append s t))) - (-> string? (-> string? string?)) - "abc") - 'def))) +(check-ctc-exn #rx"m-app: contract violation.*expected: string?" #f + ;; Yes, it's m-app's fault, because it didn't protect + ;; f from bad arguments. + (lambda () + ((m-app (lambda (s) (lambda (t) (string-append s t))) + (-> string? (-> string? string?)) + "abc") + 'def))) (define-syntax (m-res stx) (syntax-case stx () @@ -54,16 +65,16 @@ (-> string? (-> string? string?))) "abc") "def") "abcdef") -(check-exn #rx"m-res: contract violation.*expected: string?" - (lambda () - (((m-res (lambda (s) (lambda (t) (string-append s t))) - (-> string? (-> string? string?))) - 'abc) "def"))) -(check-exn #rx"m-res: contract violation.*expected: string?" - (lambda () - (((m-res (lambda (s) (lambda (t) (string-append s t))) - (-> string? (-> string? string?))) - "abc") 'def))) +(check-ctc-exn #rx"m-res: contract violation.*expected: string?" #t + (lambda () + (((m-res (lambda (s) (lambda (t) (string-append s t))) + (-> string? (-> string? string?))) + 'abc) "def"))) +(check-ctc-exn #rx"m-res: contract violation.*expected: string?" #t + (lambda () + (((m-res (lambda (s) (lambda (t) (string-append s t))) + (-> string? (-> string? string?))) + "abc") 'def))) (let () (define fruit/c (and/c string? (or/c "orange" "peach" "strawberry"))) @@ -72,10 +83,11 @@ [(_ ing) (with-syntax ([ing.c (wrap-expr/c #'fruit/c #'ing #:context stx)]) #'(format "icy blended ~s" ing.c))])) - (check-exn + (check-ctc-exn (regexp (string-append "^smoothie: contract violation.*" "given: \"kale\".*" "in:.*\\(and/c string[?] \\(or/c \"orange\" \"peach\" \"strawberry\"\\)\\).*")) + #t (lambda () (smoothie "kale"))))