From a8d461ea0d9aa396eed005dc4a32bf88939ceed3 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Sat, 27 Feb 2016 17:31:20 -0500 Subject: [PATCH] fix more app err msgs in tests; all tests passing --- tapl/stlc.rkt | 7 ++++++- tapl/tests/exist-tests.rkt | 4 ++-- tapl/tests/ext-stlc-tests.rkt | 24 +++++++++--------------- tapl/tests/rackunit-typechecking.rkt | 7 +++++-- tapl/tests/stlc+lit-tests.rkt | 9 ++++----- tapl/tests/stlc+overloading-tests.rkt | 2 +- tapl/tests/stlc+reco+var-tests.rkt | 3 ++- 7 files changed, 29 insertions(+), 27 deletions(-) diff --git a/tapl/stlc.rkt b/tapl/stlc.rkt index f4fda9b..ac629b4 100644 --- a/tapl/stlc.rkt +++ b/tapl/stlc.rkt @@ -101,6 +101,11 @@ [(_ e_fn e_arg ...) #:with [e_fn- (τ_in ... τ_out)] (⇑ e_fn as →) #:with ([e_arg- τ_arg] ...) (infers+erase #'(e_arg ...)) + #:fail-unless (stx-length=? #'(τ_arg ...) #'(τ_in ...)) + (mk-app-err-msg stx #:expected #'(τ_in ...) + #:given #'(τ_arg ...) + #:note "Wrong number of arguments.") #:fail-unless (typechecks? #'(τ_arg ...) #'(τ_in ...)) - (mk-app-err-msg stx #:expected #'(τ_in ...) #:given #'(τ_arg ...)) + (mk-app-err-msg stx #:expected #'(τ_in ...) + #:given #'(τ_arg ...)) (⊢ (#%app e_fn- e_arg- ...) : τ_out)]) diff --git a/tapl/tests/exist-tests.rkt b/tapl/tests/exist-tests.rkt index 452503e..223c25b 100644 --- a/tapl/tests/exist-tests.rkt +++ b/tapl/tests/exist-tests.rkt @@ -89,11 +89,11 @@ (typecheck-fail (open ([(Counter counter) <= counterADT]) (+ (proj counter new) 1)) - #:with-msg "Arguments to function \\+ have wrong type") + #:with-msg (expected "Int, Int" #:given "Counter, Int")) (typecheck-fail (open ([(Counter counter) <= counterADT]) ((λ ([x : Int]) x) (proj counter new))) - #:with-msg "Arguments to function.+have wrong type") + #:with-msg (expected "Int" #:given "Counter")) (check-type (open ([(Counter counter) <= counterADT]) ((proj counter get) ((proj counter inc) (proj counter new)))) diff --git a/tapl/tests/ext-stlc-tests.rkt b/tapl/tests/ext-stlc-tests.rkt index 3757ab5..f9cd45a 100644 --- a/tapl/tests/ext-stlc-tests.rkt +++ b/tapl/tests/ext-stlc-tests.rkt @@ -14,12 +14,10 @@ (typecheck-fail ((λ ([x : Unit]) x) 2) - #:with-msg - "Arguments to function.+have wrong type.+Given:.+Int.+Expected:.+Unit") + #:with-msg (expected "Unit" #:given "Int")) (typecheck-fail ((λ ([x : Unit]) x) void) - #:with-msg - "Arguments to function.+have wrong type.+Given:.+(→ Unit).+Expected:.+Unit") + #:with-msg (expected "Unit" #:given "(→ Unit)")) (check-type ((λ ([x : Unit]) x) (void)) : Unit) @@ -54,16 +52,14 @@ (check-type (let ([x 10] [y 20]) ((λ ([z : Int] [a : Int]) (+ a z)) x y)) : Int ⇒ 30) (typecheck-fail (let ([x #f]) (+ x 1)) - #:with-msg - "Arguments to function \\+.+have wrong type.+Given:.+Bool.+Int.+Expected:.+Int.+Int") + #:with-msg (expected "Int, Int" #:given "Bool, Int")) (typecheck-fail (let ([x 10] [y (+ x 1)]) (+ x y)) #:with-msg "x: unbound identifier") (check-type (let* ([x 10] [y (+ x 1)]) (+ x y)) : Int ⇒ 21) (typecheck-fail (let* ([x #t] [y (+ x 1)]) 1) - #:with-msg - "Arguments to function \\+.+have wrong type.+Given:.+Bool.+Int.+Expected:.+Int.+Int") + #:with-msg (expected "Int, Int" #:given "Bool, Int")) ; letrec (typecheck-fail @@ -137,8 +133,7 @@ (typecheck-fail ((λ ([x : Bool]) x) 1) - #:with-msg - "Arguments to function.+have wrong type.+Given:.+Int.+Expected:.+Bool") + #:with-msg (expected "Bool" #:given "Int")) ;(typecheck-fail (λ ([x : Bool]) x)) ; Bool is now valid type (typecheck-fail (λ ([f : Int]) (f 1 2)) @@ -152,15 +147,14 @@ (typecheck-fail (+ 1 (λ ([x : Int]) x)) - #:with-msg - "Arguments to function \\+ have wrong type.+Given:\n 1 : Int.+(→ Int Int).+Expected: 2 arguments with type.+Int\\, Int") + #:with-msg (expected "Int, Int" #:given "Int, (→ Int Int)")) (typecheck-fail (λ ([x : (→ Int Int)]) (+ x x)) - #:with-msg - "Arguments to function \\+ have wrong type.+Given:.+(→ Int Int).+Expected: 2 arguments with type.+Int\\, Int") + #:with-msg (expected "Int, Int" #:given "(→ Int Int), (→ Int Int)")) (typecheck-fail ((λ ([x : Int] [y : Int]) y) 1) - #:with-msg "Arguments to function.+have.+wrong number of arguments") + #:with-msg (expected "Int, Int" #:given "Int" + #:note "Wrong number of arguments")) (check-type ((λ ([x : Int]) (+ x x)) 10) : Int ⇒ 20) diff --git a/tapl/tests/rackunit-typechecking.rkt b/tapl/tests/rackunit-typechecking.rkt index 9aeb024..7b7e54c 100644 --- a/tapl/tests/rackunit-typechecking.rkt +++ b/tapl/tests/rackunit-typechecking.rkt @@ -4,9 +4,12 @@ (begin-for-syntax (define (add-esc s) (string-append "\\" s)) - (define escs (map add-esc '("(" ")"))) + (define escs (map add-esc '("(" ")" "[" "]"))) + (define (replace-brackets str) + (regexp-replace* "\\]" (regexp-replace* "\\[" str "(") ")")) (define (add-escs str) - (foldl (lambda (c s) (regexp-replace c s (add-esc c))) str escs)) + (replace-brackets + (foldl (lambda (c s) (regexp-replace* c s (add-esc c))) str escs))) (define (expected tys #:given [givens ""] #:note [note ""]) (string-append note ".*Expected.+argument\\(s\\) with type\\(s\\).+" diff --git a/tapl/tests/stlc+lit-tests.rkt b/tapl/tests/stlc+lit-tests.rkt index 3a24e78..59ff533 100644 --- a/tapl/tests/stlc+lit-tests.rkt +++ b/tapl/tests/stlc+lit-tests.rkt @@ -41,15 +41,14 @@ (typecheck-fail (+ 1 (λ ([x : Int]) x)) - #:with-msg - "Arguments to function \\+ have wrong type.+Given:\n 1 : Int.+(→ Int Int).+Expected: 2 arguments with type.+Int\\, Int") + #:with-msg (expected "Int, Int" #:given "Int, (→ Int Int)")) (typecheck-fail (λ ([x : (→ Int Int)]) (+ x x)) - #:with-msg - "Arguments to function \\+ have wrong type.+Given:.+(→ Int Int).+Expected: 2 arguments with type.+Int\\, Int") + #:with-msg (expected "Int, Int" #:given "(→ Int Int), (→ Int Int)")) (typecheck-fail ((λ ([x : Int] [y : Int]) y) 1) - #:with-msg "Arguments to function.+have.+wrong number of arguments") + #:with-msg (expected "Int, Int" #:given "Int" + #:note "Wrong number of arguments")) (check-type ((λ ([x : Int]) (+ x x)) 10) : Int ⇒ 20) diff --git a/tapl/tests/stlc+overloading-tests.rkt b/tapl/tests/stlc+overloading-tests.rkt index 44754ea..0729bd6 100644 --- a/tapl/tests/stlc+overloading-tests.rkt +++ b/tapl/tests/stlc+overloading-tests.rkt @@ -75,7 +75,7 @@ (typecheck-fail ((resolve to-string Num) "hello") - #:with-msg "have wrong type") + #:with-msg (expected "Num" #:given "Str")) ;; -- instances are type-checked. They must match (typecheck-fail diff --git a/tapl/tests/stlc+reco+var-tests.rkt b/tapl/tests/stlc+reco+var-tests.rkt index 622245e..57f039d 100644 --- a/tapl/tests/stlc+reco+var-tests.rkt +++ b/tapl/tests/stlc+reco+var-tests.rkt @@ -49,7 +49,8 @@ (check-not-type (var coffee = (void) as (∨ [coffee : Unit])) : (∨ [coffee : Unit] [tea : Unit])) (typecheck-fail ((λ ([x : (∨ [coffee : Unit] [tea : Unit])]) x) (var coffee = (void) as (∨ [coffee : Unit]))) - #:with-msg "Arguments to function.+have wrong type") + #:with-msg (expected "(∨ [coffee : Unit] [tea : Unit])" + #:given "(∨ [coffee : Unit])")) (check-type (var coffee = (void) as (∨ [coffee : Unit] [tea : Unit])) : (∨ [coffee : Unit] [tea : Unit])) (check-type (var coffee = (void) as (∨ [coffee : Unit] [tea : Unit] [coke : Unit]))