rename contracts in tests

.travis.yml

@@ -5,20 +5,19 @@ language: c
 env:
 - TESTS=unit PLT_TR_CONTRACTS=1 PATH=~/racket/bin:$PATH
 - TESTS=unit VARIANT=cs PATH=~/racket/bin:$PATH
-- TESTS=int  VARIANT=cs PATH=~/racket/bin:$PATH
-- TESTS=int  PATH=~/racket/bin:$PATH
-- TESTS=math  PATH=~/racket/bin:$PATH
+- TESTS=int PATH=~/racket/bin:$PATH
+- TESTS=int VARIANT=cs PATH=~/racket/bin:$PATH
+- TESTS=math PATH=~/racket/bin:$PATH
 - TESTS=math VARIANT=cs PATH=~/racket/bin:$PATH
-- TESTS=extra VARIANT=cs PATH=~/racket/bin:$PATH
 - TESTS=extra PATH=~/racket/bin:$PATH
+- TESTS=extra VARIANT=cs PATH=~/racket/bin:$PATH
 
 matrix:
   allow_failures:
-  - TESTS=unit VARIANT=cs PATH=~/racket/bin:$PATH
-  - TESTS=int  VARIANT=cs PATH=~/racket/bin:$PATH
-  - TESTS=math VARIANT=cs PATH=~/racket/bin:$PATH
-  - TESTS=extra VARIANT=cs PATH=~/racket/bin:$PATH
-
+    - env: TESTS=unit VARIANT=cs PATH=~/racket/bin:$PATH
+    - env: TESTS=int VARIANT=cs PATH=~/racket/bin:$PATH
+    - env: TESTS=math VARIANT=cs PATH=~/racket/bin:$PATH
+    - env: TESTS=extra VARIANT=cs PATH=~/racket/bin:$PATH
 
 services:
 - xvfb

typed-racket-test/fail/async-channel-contract.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred #rx"expected: Integer.*given: \"not an integer\"")
+(exn-pred #rx"expected: exact-integer?.*given: \"not an integer\"")
 #lang racket/load
 
 ;; Test typed-untyped interaction with channels

typed-racket-test/fail/cast-mod1.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred exn:fail:contract? #rx".*produced: 3" #rx".*promised: String.*" #rx"6\\.0")
+(exn-pred exn:fail:contract? #rx".*produced: 3" #rx".*promised: string?.*" #rx"6\\.0")
 
 #lang typed/racket/base
 

typed-racket-test/fail/cast-mod2.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred exn:fail:contract? #rx".*produced: 3" #rx".*promised: String.*" )
+(exn-pred exn:fail:contract? #rx".*produced: 3" #rx".*promised: string?.*" )
 
 #lang typed/racket/base
 

typed-racket-test/fail/channel-contract.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred #rx"expected: Integer.*blaming: top-level")
+(exn-pred #rx"expected: exact-integer?.*blaming: top-level")
 #lang racket/load
 
 ;; Test typed-untyped interaction with channels

typed-racket-test/fail/class-contract-1.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred #rx"expected: String.*given: 'not-a-string")
+(exn-pred #rx"expected: string?.*given: 'not-a-string")
 #lang racket
 
 ;; Ensure contracts for inner work correctly

typed-racket-test/fail/union-or-exclusive.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred exn:fail:contract? "Real")
+(exn-pred exn:fail:contract? "real?")
 #lang typed/racket #:no-optimize
 
 

typed-racket-test/fail/unit-typed-untyped-1.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred #rx"u: broke its own contract\n  promised: Integer")
+(exn-pred #rx"u: broke its own contract\n  promised: exact-integer?")
 #lang racket
 
 (module untyped racket

typed-racket-test/fail/unit-typed-untyped-2.rkt

@@ -1,5 +1,5 @@
 #;
-(exn-pred #rx"u: contract violation\n  expected: Integer")
+(exn-pred #rx"u: contract violation\n  expected: exact-integer?")
 #lang racket
 
 (module typed typed/racket

typed-racket-test/succeed/cast-mod.rkt

@@ -15,13 +15,13 @@
 
 (check-equal? ((cast pos-fx-sub1 (Number -> Number)) 5) 4)
 
-(check-exn #rx"expected: Positive-Fixnum\n *given: 0.5"
+(check-exn #rx"expected: fixnum\\?\n *given: 0.5"
            (λ () ((cast pos-fx-sub1 (Number -> Number)) 0.5) 4))
 
-(check-exn #rx"expected: Positive-Fixnum\n *given: \"hello\""
+(check-exn #rx"expected: fixnum\\?\n *given: \"hello\""
            (λ () ((cast pos-fx-sub1 (String -> String)) "hello")))
 
-(check-exn #rx"expected: Positive-Fixnum\n *given: \"hello\""
+(check-exn #rx"expected: fixnum\\?\n *given: \"hello\""
            (λ () ((cast pos-fx-sub1 (Any -> Any)) "hello")))
 
 (test-case "cast on mutator functions"
@@ -48,7 +48,7 @@
   (define b4 (cast b3 (Boxof (U Integer String))))
   (check-equal? (unbox b1) 42)
   (check-equal? (unbox b4) 42)
-  (check-exn #rx"expected: Integer\n *given: \"hi\""
+  (check-exn #rx"expected: exact-integer\\?\n *given: \"hi\""
              (λ () (set-box! b2 "hi")))
   (check-equal? (unbox b1) 42
                 "if the previous test hadn't errored, this would be \"hi\" with type Integer")
@@ -64,7 +64,7 @@
   (define v4 (cast v3 (Vectorof (U Integer String))))
   (check-equal? (vector-ref v1 0) 42)
   (check-equal? (vector-ref v4 0) 42)
-  (check-exn #rx"expected: Integer\n *given: \"hi\""
+  (check-exn #rx"expected: exact-integer\\?\n *given: \"hi\""
              (λ () (vector-set! v2 0 "hi")))
   (check-equal? (vector-ref v1 0) 42
                 "if the previous test hadn't errored, this would be \"hi\" with type Integer")
@@ -82,7 +82,7 @@
   (define s4 (cast s3 (s (U Integer String))))
   (check-equal? (s-i s1) 42)
   (check-equal? (s-i s4) 42)
-  (check-exn #rx"expected: Integer\n *given: \"hi\""
+  (check-exn #rx"expected: exact-integer\\?\n *given: \"hi\""
              (λ () (set-s-i! s2 "hi")))
   (check-equal? (s-i s1) 42
                 "if the previous test hadn't errored, this would be \"hi\" with type Integer")

typed-racket-test/succeed/cast-top-level.rkt

@@ -22,13 +22,13 @@
 
 (check-equal? ((cast pos-fx-sub1 (Number -> Number)) 5) 4)
 
-(check-exn #rx"expected: Positive-Fixnum\n *given: 0.5"
+(check-exn #rx"expected: fixnum\\?\n *given: 0.5"
            (λ () ((cast pos-fx-sub1 (Number -> Number)) 0.5) 4))
 
-(check-exn #rx"expected: Positive-Fixnum\n *given: \"hello\""
+(check-exn #rx"expected: fixnum\\?\n *given: \"hello\""
            (λ () ((cast pos-fx-sub1 (String -> String)) "hello")))
 
-(check-exn #rx"expected: Positive-Fixnum\n *given: \"hello\""
+(check-exn #rx"expected: fixnum\\?\n *given: \"hello\""
            (λ () ((cast pos-fx-sub1 (Any -> Any)) "hello")))
 
 (test-case "cast on mutator functions"
@@ -52,7 +52,7 @@
   (define b1 (box 42))
   (define b2 (cast b1 (Boxof String)))
   (check-equal? (unbox b1) 42)
-  (check-exn #rx"expected: Integer\n *given: \"hi\""
+  (check-exn #rx"expected: exact-integer\\?\n *given: \"hi\""
              (λ () (set-box! b2 "hi")))
   (check-equal? (unbox b1) 42
                 "if the previous test hadn't errored, this would be \"hi\" with type Integer"))
@@ -62,7 +62,7 @@
   (define v1 (vector 42))
   (define v2 (cast v1 (Vectorof String)))
   (check-equal? (vector-ref v1 0) 42)
-  (check-exn #rx"expected: Integer\n *given: \"hi\""
+  (check-exn #rx"expected: exact-integer\\?\n *given: \"hi\""
              (λ () (vector-set! v2 0 "hi")))
   (check-equal? (vector-ref v1 0) 42
                 "if the previous test hadn't errored, this would be \"hi\" with type Integer"))
@@ -74,7 +74,7 @@
   (define s1 (s 42))
   (define s2 (cast s1 (s String)))
   (check-equal? (s-i s1) 42)
-  (check-exn #rx"expected: Integer\n *given: \"hi\""
+  (check-exn #rx"expected: exact-integer\\?\n *given: \"hi\""
              (λ () (set-s-i! s2 "hi")))
   (check-equal? (s-i s1) 42
                 "if the previous test hadn't errored, this would be \"hi\" with type Integer"))

typed-racket-test/unit-tests/contract-tests.rkt

@@ -2,7 +2,8 @@
 
 (require "test-utils.rkt"
          (for-syntax racket/base
-                     syntax/parse)
+                     syntax/parse
+                     syntax/srcloc)
          (for-template racket/base)
          (private type-contract)
          (rep type-rep values-rep)
@@ -80,19 +81,25 @@
 (define-syntax-rule (t-int arg ...)
   (t-int/check arg ... check-not-exn))
 
-(define (check-re re)
+(define (check-re re loc)
   (λ (thunk)
-    (check-exn
-     (λ (e)
-       (and (exn:fail? e)
-            (regexp-match? re (exn-message e))))
-     thunk)))
+    (with-check-info* (list (make-check-location loc))
+                      (lambda ()
+      (check-exn
+       (λ (e)
+         (and (exn:fail? e)
+              (regexp-match? re (exn-message e))))
+       thunk)))))
 
 ;; (t-int/fail type (-> any any) any #:msg regexp)
 ;; Like t-int, but checks failing cases. Takes a regexp for checking
 ;; the exception message.
-(define-syntax-rule (t-int/fail arg ... #:msg re)
-  (t-int/check arg ... (check-re re)))
+(define-syntax (t-int/fail stx)
+  (syntax-parse stx
+   [(_ arg ... #:msg re)
+    (with-syntax ([loc (build-source-location-list stx)])
+      (quasisyntax/loc stx
+        (t-int/check arg ...  (check-re re 'loc))))]))
 
 ;; tests typed-untyped interaction
 (define-syntax (t-int/check stx)
@@ -330,7 +337,7 @@
    (t (-class #:method ([m (-polydots (x) (->... (list) (x x) -Void))])))
    (t (-class #:method ([m (-polyrow (x) (list null null null null)
                                      (-> (-class #:row (-v x)) -Void))])))
-              
+
    ;; units
    ;; These tests do not have sufficient coverage because more
    ;; coverage requires a proper set up of the signature environment.
@@ -342,7 +349,7 @@
          (unit/sc null null null (list integer/sc number/sc)))
    (t-sc (-unit null null null (-values (list)))
          (unit/sc null null null null))
-                            
+
    ;; typed/untyped interaction tests
    (t-int (-poly (a) (-> a a))
           (λ (f) (f 1))
@@ -370,7 +377,7 @@
                  (thread (λ () (channel-put ch 'bad)))
                  ch)
                #:untyped
-               #:msg #rx"promised: String.*produced: 'bad")
+               #:msg #rx"promised: string?.*produced: 'bad")
    (t-int/fail (make-Evt (-> -String -String))
                (λ (x) ((sync x) 'bad))
                (let ([ch (make-channel)])
@@ -379,7 +386,7 @@
                     (channel-put ch (λ (x) (string-append x "x")))))
                  ch)
                #:typed
-               #:msg #rx"expected: String.*given: 'bad")
+               #:msg #rx"expected: string?.*given: 'bad")
    (t-int/fail (make-Evt -String)
                (λ (x) (channel-put x "bad"))
                (make-channel)
@@ -475,7 +482,7 @@
                  (λ (c) (c "bad"))
                  (λ (_) 1)
                  #:typed
-                 #:msg #rx"expected: Integer.*given: \"bad\"")
+                 #:msg #rx"expected: exact-integer?.*given: \"bad\"")
      (t-int/fail (-> int<=42 int<=42)
                  (λ (c) (c 43))
                  (λ (_) 1)
@@ -623,7 +630,7 @@
                  (λ (c) (c "foo"))
                  (λ (_) 42)
                  #:typed
-                 #:msg #rx"expected: Integer.*given: .*\"foo\"")
+                 #:msg #rx"expected: exact-integer?.*given: .*\"foo\"")
      (t-int/fail (-> int=42 int=42)
                  (λ (c) (c 41))
                  (λ (_) 42)
@@ -663,7 +670,7 @@
                  (λ (c) (c "foo"))
                  (λ (_) -1)
                  #:typed
-                 #:msg #rx"expected: Integer.*given: .*\"foo\"")
+                 #:msg #rx"expected: exact-integer?.*given: .*\"foo\"")
      (t-int/fail (-> int<=0or>=100 int<=0or>=100)
                  (λ (c) (c 42))
                  (λ (_) -1)
@@ -678,9 +685,9 @@
            "proposition contract generation not supported for non-flat types")
    (t/fail (-refine/fresh p (-pair Univ Univ) (-not-type (-car-of  (-id-path p)) (-vec Univ)))
            "proposition contract generation not supported for non-flat types")
-   
+
    ;; dependent functions // typed
-   
+
    ;; identity on Integers
    (t-int (dep-> ([x : -Int])
                  (-refine/fresh n -Int (-eq (-lexp n) (-lexp x))))
@@ -733,15 +740,15 @@
                (λ (c) (c 1 0))
                (λ (x y) #t)
                #:typed
-               #:msg #rx"expected:.*(and/c Natural.*).*given:.*0")
+               #:msg #rx"expected:.*(and/c natural?.*).*given:.*0")
    (t-int/fail (-poly (a) (dep-> ([v : (-vec a)]
                                   [n : (-refine/fresh n -Nat (-leq (-lexp n)
                                                                    (-lexp (-vec-len-of (-id-path v)))))])
                                  a))
                (λ (c) (c (vector 1 2) -1))
                (λ (v n) (vector-ref v n))
                #:typed
-               #:msg #rx"expected:.*(and/c Natural.*).*given:.*-1")
+               #:msg #rx"expected:.*(and/c natural?.*).*given:.*-1")
 
    ;; dependent functions // untyped