From 79589b9b9fd2435c43e41244ffabe4d558394a46 Mon Sep 17 00:00:00 2001 From: Guillaume Marceau Date: Wed, 1 Jun 2011 14:49:48 -0400 Subject: [PATCH] The htdp test suite now checks that the correct error messages are thrown. --- collects/drracket/private/rep.rkt | 17 +- .../lang/private/rewrite-error-message.rkt | 16 +- collects/lang/private/teach.rkt | 134 +++++----- collects/lang/private/teachprims.rkt | 4 +- collects/tests/htdp-lang/advanced.rktl | 172 ++++++------ collects/tests/htdp-lang/beg-adv.rktl | 250 ++++++++---------- collects/tests/htdp-lang/beg-bega.rktl | 24 +- collects/tests/htdp-lang/beg-intm.rktl | 12 +- collects/tests/htdp-lang/beg-intml.rktl | 7 +- collects/tests/htdp-lang/bega-adv.rktl | 21 +- collects/tests/htdp-lang/beginner.rktl | 12 +- collects/tests/htdp-lang/htdp-test.rktl | 8 +- collects/tests/htdp-lang/intermediate.rktl | 2 + collects/tests/htdp-lang/intm-adv.rktl | 127 ++++----- collects/tests/htdp-lang/intm-intml.rktl | 4 +- collects/tests/htdp-lang/intmlam-adv.rktl | 5 + collects/tests/racket/testing.rktl | 4 +- 17 files changed, 440 insertions(+), 379 deletions(-) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index a54777c282..f808d8da3a 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -708,7 +708,22 @@ TODO (reset-highlighting) (set! error-ranges locs) - + +#| + TODO +send: target is not an object: #f for method: begin-edit-sequence + + === context === +C:\documents\projects\plt\collects\racket\private\class-internal.rkt:4550:0: obj-error +C:\documents\projects\plt\collects\racket\private\class-internal.rkt:3814:0: find-method/who +C:\documents\projects\plt\collects\drracket\private\rep.rkt:719:20 +C:\documents\projects\plt\collects\racket\private\map.rkt:45:11: for-each +C:\documents\projects\plt\collects\drracket\private\rep.rkt:660:6: core +C:\documents\projects\plt\collects\mred\private\wx\common\queue.rkt:430:6 +C:\documents\projects\plt\collects\mred\private\wx\common\queue.rkt:470:32 +C:\documents\projects\plt\collects\mred\private\wx\common\queue.rkt:607:3 + +|# (for-each (λ (loc) (send (srcloc-source loc) begin-edit-sequence)) locs) (when color? diff --git a/collects/lang/private/rewrite-error-message.rkt b/collects/lang/private/rewrite-error-message.rkt index f2e8de8891..86cb09d9dd 100755 --- a/collects/lang/private/rewrite-error-message.rkt +++ b/collects/lang/private/rewrite-error-message.rkt @@ -33,16 +33,28 @@ (compose raise rewrite-lookup-error-message)]) (top . id))))])) +(define (change-contract-exn-messages e msg) + (define constructor + (cond [(exn:fail:contract:arity? e) make-exn:fail:contract:arity] + [(exn:fail:contract:divide-by-zero? e) make-exn:fail:contract:divide-by-zero] + [(exn:fail:contract:non-fixnum-result? e) make-exn:fail:contract:non-fixnum-result] + [(exn:fail:contract:continuation? e) make-exn:fail:contract:continuation] + [else make-exn:fail:contract])) + (constructor msg (exn-continuation-marks e))) + (define (rewrite-contract-error-message e) (define replacements (list (list #rx"expects argument of type (<([^>]+)>)" (lambda (all one two) (format "expects a ~a" two))) (list #rx"expects type (<([^>]+)>)" - (lambda (all one two) (format "expects a ~a" two))))) + (lambda (all one two) (format "expects a ~a" two))) + (list #rx"^procedure " + (lambda (all) "")) + )) (define new-message (for/fold ([msg (exn-message e)]) ([repl. replacements]) (regexp-replace* (first repl.) msg (second repl.)))) - (struct-copy exn e [message new-message])) + (change-contract-exn-messages e new-message)) (define-for-syntax (wrap-for-contract-error-message* stx) (syntax-case stx () diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index 7f5a3be6a4..fa963858bd 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -227,9 +227,10 @@ ;; Raise a syntax error: (define (teach-syntax-error form stx detail msg . args) - (let ([form (if (eq? form '|function call|) + (let (#;[form (if (eq? form '|function call|) form #f)] ; extract name from stx + [form (or form (first (flatten (syntax->datum stx))))] [msg (apply format msg args)]) (if detail (raise-syntax-error form msg stx detail) @@ -564,7 +565,7 @@ 'define stx dup - "found a variable that was used more than once: ~a" + "found a variable that is used more than once: ~a" (syntax-e dup)))) (check-single-result-expr (syntax->list (syntax (expr ...))) #f @@ -703,7 +704,7 @@ 'lambda rhs dup - "found a variable that was used more than once: ~a" + "found a variable that is used more than once: ~a" (syntax-e dup)))) (check-single-result-expr (syntax->list (syntax (lexpr ...))) #f @@ -772,7 +773,7 @@ 'define-struct stx field - "found a field name that was used more than once: ~a" + "found a field name that is used more than once: ~a" sym)) (hash-table-put! ht sym #t))) fields) @@ -1040,7 +1041,7 @@ 'define-datatype stx v-stx - "found a variant name that was used more than once: ~a" + "found a variant name that is used more than once: ~a" v))) (for-each @@ -1063,7 +1064,7 @@ 'define-datatype stx f-stx - "in variant `~a': found a field name that was used more than once: ~a" + "in variant `~a': found a field name that is used more than once: ~a" (syntax-e #'variant) (syntax-e f-stx)))))) (syntax->list #'((variant field ...) ...)))) @@ -1232,12 +1233,12 @@ (if (not (identifier-binding #'id)) (if (syntax-property #'id 'was-in-app-position) (teach-syntax-error - 'unknown + #f #'id #f "this function is not defined") (teach-syntax-error - 'unknown + #f #'id #f "this variable is not defined")) @@ -1377,9 +1378,11 @@ 'if stx #f - "expected a question and two answers, but found ~a part~a" - (if (zero? n) "no" n) - (if (= n 1) "" "s")))] + "expected a question and two answers, but ~a" + (cond [(zero? n) "nothing's there"] + [(= n 1) "found only 1 part"] + [(= n 2) "found only 2 parts"] + [else (format "found ~a parts" n)])))] [_else (bad-use-error 'if stx)])))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1405,9 +1408,9 @@ where stx #f - "expected at least two expressions after ~a, but found ~a" + "expected at least two expressions after ~a, but ~a" where - (if (zero? n) "no expressions" "only one expression"))) + (if (zero? n) "nothing's there" "found only one expression"))) (let loop ([clauses-consumed 0] [remaining (syntax->list #`clauses)]) (if (null? remaining) @@ -1444,7 +1447,7 @@ 'quote stx #f - "expected the name of the symbol after the quote, found ~a" + "expected the name of the symbol after the quote, but found ~a" (something-else sym))) (syntax/loc stx (quote expr)))] [_else (bad-use-error 'quote stx)])) @@ -1686,7 +1689,7 @@ (syntax-e dup))) (let ([exprs (syntax->list (syntax exprs))]) (check-single-expression 'local - "after the local definition sequence" + "after the local definitions" stx exprs (append val-ids stx-ids))) @@ -1881,30 +1884,23 @@ (let ([bindings (syntax->list (syntax (binding ...)))]) (for-each (lambda (binding) (syntax-case binding () + [(something . exprs) + (not (identifier/non-kw? (syntax something))) + (teach-syntax-error + who + orig-stx + (syntax something) + "expected a variable for the binding, but found ~a" + (something-else/kw (syntax something)))] [(name expr) - (let ([name (syntax name)]) - (unless (identifier/non-kw? name) - (teach-syntax-error - who - orig-stx - name - "expected a variable for the binding, but found ~a" - (something-else/kw name))))] + (void)] [(name . exprs) - (identifier/non-kw? (syntax name)) (check-single-expression who (format "after the name ~a" (syntax-e (syntax name))) binding (syntax->list (syntax exprs)) #f)] - [(something . exprs) - (teach-syntax-error - who - orig-stx - (syntax something) - "expected a variable after the square bracket, but found ~a" - (something-else/kw (syntax something)))] [_else (teach-syntax-error who @@ -1927,7 +1923,7 @@ (syntax-e dup))))) (let ([exprs (syntax->list (syntax exprs))]) (check-single-expression who - "after the name-defining sequence" + "after the bindings" orig-stx exprs #f)))] @@ -2050,7 +2046,7 @@ "found a variable that is used more than once: ~a" (syntax-e dup)))) (check-single-expression 'lambda - "within lambda" + "after the variables" stx (syntax->list (syntax (lexpr ...))) args) @@ -2082,7 +2078,7 @@ [(_ expr ...) (begin (check-single-expression 'quote - "after the quote keyword" + "after quote" stx (syntax->list (syntax (expr ...))) ;; Don't expand expr! @@ -2406,24 +2402,28 @@ stx (lambda () (syntax-case stx () - [(_ q expr ...) - (let ([exprs (syntax->list (syntax (expr ...)))]) - (check-single-expression who - (format "for the answer in ~a" - who) - stx - exprs - null) - (with-syntax ([who who] - [target target-stx]) - (syntax/loc stx (target (verify-boolean q 'who) expr ...))))] [(_) (teach-syntax-error who stx #f - "expected a question after ~a, but nothing's there" - who)] + "expected a question and an answer, but nothing's there")] + [(_ q) + (teach-syntax-error + who + stx + #'q + "expected a question and an answer, but found only one part")] + [(_ q a) + (with-syntax ([who who] + [target target-stx]) + (syntax/loc stx (target (verify-boolean q 'who) a)))] + [(_ . parts) + (teach-syntax-error* + who + stx + (syntax->list #'parts) + "expected a question and an answer, but found ~a parts" (length (syntax->list #'parts)))] [_else (bad-use-error who stx)])))))]) (values (mk 'when (quote-syntax when)) @@ -2445,17 +2445,22 @@ stx (lambda () (syntax-case stx () - [(_ name ids body) + [(_form name . rest) (identifier/non-kw? (syntax name)) - (syntax/loc stx (let name ids body))] - [(_ name . rest) + (begin + (bad-let-form 'let (syntax (_form . rest)) stx) + (syntax/loc stx (let name . rest)))] + [(_ name) (identifier/non-kw? (syntax name)) - (teach-syntax-error - 'let + (teach-syntax-error + 'let stx #f - "bad syntax for named let")] - [(_ . rest) + "expected at least one binding (in parentheses) after ~a, but nothing's there" (syntax->datum (syntax name)))] + [(_form name . rest) + (identifier/non-kw? (syntax name)) + (bad-let-form 'let (syntax (_form . rest)) stx)] + [(_ . rest) (syntax/loc stx (intermediate-let . rest))] [_else (bad-use-error 'let stx)])))) @@ -2517,7 +2522,7 @@ 'case stx #f - "expected a clause with choices and an answer after the expression, but nothing's there")] + "expected a clause with at least one choice (in parentheses) and an answer after the expression, but nothing's there")] [(_ v-expr clause ...) (let ([clauses (syntax->list (syntax (clause ...)))]) (for-each @@ -2534,7 +2539,7 @@ in its case expression")) (let ([answers (syntax->list (syntax (answer ...)))]) (check-single-expression 'case - "for the answer in a case clause" + "for the answer in the case clause" clause answers null)))] @@ -2568,7 +2573,7 @@ choices "expected at least one choice (in parentheses), but nothing's there")) (check-single-expression 'case - "for the answer in a case clause" + "for the answer in the case clause" clause answers null))] @@ -2743,7 +2748,7 @@ [(_ expr ...) (begin (check-single-expression 'delay - "after the delay keyword" + "after delay" stx (syntax->list (syntax (expr ...))) null) @@ -2813,7 +2818,18 @@ "after the bindings" stx (syntax->list (syntax exprs)) - #f))] + #f) + (let ([dup (check-duplicate-identifier (map (lambda (binding) + (syntax-case binding () + [(name . _) (syntax name)])) + bindings))]) + (when dup + (teach-syntax-error + 'shared + stx + dup + "found a variable that is used more than once: ~a" + (syntax-e dup)))))] [(_ bad-bind . exprs) (teach-syntax-error 'shared diff --git a/collects/lang/private/teachprims.rkt b/collects/lang/private/teachprims.rkt index c101286880..42cdc9f3aa 100644 --- a/collects/lang/private/teachprims.rkt +++ b/collects/lang/private/teachprims.rkt @@ -462,10 +462,10 @@ namespace. ;; is s a list of 1-letter strings ;; effect: not a list, not a list of strings (define (1-letter*? tag s) - (unless (list? s) (err tag "expected a ~a, but received a list: ~e" 1-LETTER* s)) + (unless (list? s) (err tag "expected a ~a, but received: ~e" 1-LETTER* s)) (for-each (lambda (c) - (unless (string? c) (err tag "expected a ~a, but received a string: ~e" 1-LETTER* c))) + (unless (string? c) (err tag "expected a ~a, but received: ~e" 1-LETTER* c))) s) (andmap (compose (curry = 1) string-length) s)) diff --git a/collects/tests/htdp-lang/advanced.rktl b/collects/tests/htdp-lang/advanced.rktl index ddda8fe007..46e8eb0b1e 100644 --- a/collects/tests/htdp-lang/advanced.rktl +++ b/collects/tests/htdp-lang/advanced.rktl @@ -38,12 +38,12 @@ (define x8 (lambda () 11)) (test 11 x8) -(htdp-syntax-test #'begin) -(htdp-syntax-test #'(begin)) -(htdp-syntax-test #'(begin (define x 10))) -(htdp-syntax-test #'(begin (define x 10) x)) -(htdp-syntax-test #'(let () (begin (define x 10) x))) -(htdp-syntax-test #'(+ 1 (begin))) +(htdp-syntax-test #'begin "begin: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(begin) "begin: expected at least one expression after begin, but nothing's there") +(htdp-syntax-test #'(begin (define x 10)) "define: found a definition that is not at the top level") +(htdp-syntax-test #'(begin (define x 10) x) "define: found a definition that is not at the top level") +(htdp-syntax-test #'(let () (begin (define x 10) x)) "define: found a definition that is not at the top level") +(htdp-syntax-test #'(+ 1 (begin)) "begin: expected at least one expression after begin, but nothing's there") (test 1 'begin (begin 1)) (test 2 'begin (begin 1 2)) @@ -54,21 +54,21 @@ (htdp-test 12 'begin+set! (begin 12 ex)) (htdp-top-pop 1) -(htdp-syntax-test #'begin0) -(htdp-syntax-test #'(begin0)) +(htdp-syntax-test #'begin0 "begin0: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(begin0) "begin: expected at least one expression after begin0, but nothing's there") (htdp-test 1 'begin0 (begin0 1)) (htdp-test 2 'begin0 (begin0 2 1)) (htdp-test 3 'begin0 (begin0 3 2 1)) -(htdp-syntax-test #'set!) -(htdp-syntax-test #'(set!)) -(htdp-syntax-test #'(set! x)) -(htdp-syntax-test #'(set! 1 2)) -(htdp-syntax-test #'(set! x 2 3)) -(htdp-syntax-test #'(set! set! 2)) -(htdp-syntax-test #'(lambda (x) (set! x 2))) -(htdp-syntax-test #'(let ([x 5]) (lambda (x) (set! x 2)))) +(htdp-syntax-test #'set! "set!: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(set!) "set!: expected a variable after set!, but nothing's there") +(htdp-syntax-test #'(set! x) "set!: expected an expression for the new value, but nothing's there") +(htdp-syntax-test #'(set! 1 2) "set!: expected a variable after set!, but found a number") +(htdp-syntax-test #'(set! x 2 3) "set!: expected only one expression for the new value, but found 1 extra part") +(htdp-syntax-test #'(set! set! 2) "set!: expected a variable after set!, but found a set!") +(htdp-syntax-test #'(lambda (x) (set! x 2)) "set!: expected a mutable variable after set!, but found a variable that cannot be modified") +(htdp-syntax-test #'(let ([x 5]) (lambda (x) (set! x 2))) "set!: expected a mutable variable after set!, but found a variable that cannot be modified") (htdp-top (set! x 'hello)) (htdp-test 'hello 'access-x x) @@ -83,9 +83,9 @@ x))) 45) -(htdp-syntax-test #'delay) -(htdp-syntax-test #'(delay)) -(htdp-syntax-test #'(delay 1 2)) +(htdp-syntax-test #'delay "delay: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(delay) "delay: expected an expression after delay, but nothing's there") +(htdp-syntax-test #'(delay 1 2) "delay: expected only one expression after delay, but found 1 extra part") (htdp-top (define d (delay (begin (set! x 89) 12)))) (htdp-test #t promise? d) @@ -96,33 +96,43 @@ (htdp-test 12 force d) (htdp-test 13 'access-x x) -(htdp-syntax-test #'(let name)) -(htdp-syntax-test #'(let name 10)) -(htdp-syntax-test #'(let name ())) -(htdp-syntax-test #'(let name ([x]) 1)) -(htdp-syntax-test #'(let name ([x 10] 2) 1)) -(htdp-syntax-test #'(let name ([11 10]) 1)) -(htdp-syntax-test #'(let name ([x 10]) 1 2)) -(htdp-syntax-test #'(let name ([x 10][x 11]) 1)) + + + + + + + +"let: bad syntax (not a sequence of identifier--expression bindings)" + + +(htdp-syntax-test #'(let name) "let: expected at least one binding (in parentheses) after let, but nothing's there") +(htdp-syntax-test #'(let name 10) "let: expected at least one binding (in parentheses) after let, but found a number") +(htdp-syntax-test #'(let name ()) "let: expected an expression after the bindings, but nothing's there") +(htdp-syntax-test #'(let name ([x]) 1) "let: expected an expression after the name x, but nothing's there") +(htdp-syntax-test #'(let name ([x 10] 2) 1) "let: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(let name ([11 10]) 1) "let: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(let name ([x 10]) 1 2) "let: expected only one expression after the bindings, but found 1 extra part") +(htdp-syntax-test #'(let name ([x 10][x 11]) 1) "let: x was defined locally more than once") (htdp-test 10 'lookup (let name () 10)) (htdp-test 1024 'loop (let loop ([n 10]) (if (zero? n) 1 (* 2 (loop (sub1 n)))))) (htdp-test 19 'lookup (recur empty-f () 19)) -(htdp-syntax-test #'case) -(htdp-syntax-test #'(case)) -(htdp-syntax-test #'(case 5)) -(htdp-syntax-test #'(case 5 12)) -(htdp-syntax-test #'(case 5 [])) -(htdp-syntax-test #'(case 5 [5 10])) -(htdp-syntax-test #'(case 5 [(5) 10] 12)) -(htdp-syntax-test #'(case 5 [(5)])) -(htdp-syntax-test #'(case 5 [(5) 12 13])) -(htdp-syntax-test #'(case 5 [("a") 10])) -(htdp-syntax-test #'(case 5 [() 10])) -(htdp-syntax-test #'(case 5 [(5 "a") 10])) -(htdp-syntax-test #'(case 5 [else 12][(5) 10])) -(htdp-syntax-test #'(case 5 [(5) 10][else 12][else 13])) +(htdp-syntax-test #'case "case: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(case) "case: expected an expression after case, but nothing's there") +(htdp-syntax-test #'(case 5) "expected a clause with at least one choice (in parentheses) and an answer after the expression, but nothing's there") +(htdp-syntax-test #'(case 5 12) "case: expected a clause with at least one choice (in parentheses) and an answer, but found a number") +(htdp-syntax-test #'(case 5 []) "case: expected a clause with at least one choice (in parentheses) and an answer, but found an empty part") +(htdp-syntax-test #'(case 5 [5 10]) "case: expected at least one choice (in parentheses), but found a number") +(htdp-syntax-test #'(case 5 [(5) 10] 12) "case: expected a clause with at least one choice (in parentheses) and an answer, but found a number") +(htdp-syntax-test #'(case 5 [(5)]) "case: expected an expression for the answer in the case clause, but nothing's there") +(htdp-syntax-test #'(case 5 [(5) 12 13]) "case: expected only one expression for the answer in the case clause, but found 1 extra part") +(htdp-syntax-test #'(case 5 [("a") 10]) "case: expected a symbol (without its quote) or a number as a choice, but found a string") +(htdp-syntax-test #'(case 5 [() 10]) "case: expected at least one choice, but nothing's there") +(htdp-syntax-test #'(case 5 [(5 "a") 10]) "case: expected a symbol (without its quote) or a number as a choice, but found a string") +(htdp-syntax-test #'(case 5 [else 12][(5) 10]) "case: found an else clause that isn't the last clause in its case expression") +(htdp-syntax-test #'(case 5 [(5) 10][else 12][else 13]) "case: found an else clause that isn't the last clause in its case expression") (htdp-test 'a 'case (case 5 [(5) 'a])) (htdp-test 'b 'case (case 5 [(6) 'a][else 'b])) @@ -131,37 +141,37 @@ (htdp-test 'd 'case (case 'hello [(no) 10][(6 5 hello) 'd][else 'b])) (htdp-test 'cc 'case (case (+ 2 3) [(6 5) 'cc][else 'b])) -(htdp-syntax-test #'when) -(htdp-syntax-test #'(when)) -(htdp-syntax-test #'(when 10)) -(htdp-syntax-test #'(when 10 12 13)) +(htdp-syntax-test #'when "when: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(when) "when: expected a question and an answer, but nothing's there") +(htdp-syntax-test #'(when 10) "when: expected a question and an answer, but found only one part") +(htdp-syntax-test #'(when 10 12 13) "when: expected a question and an answer, but found 3 parts") -(htdp-err/rt-test (when 1 2)) +(htdp-err/rt-test (when 1 2) rx:not-true-or-false) (htdp-test (void) 'when (when false 1)) (htdp-test 11 'when (when true 11)) -(htdp-syntax-test #'unless) -(htdp-syntax-test #'(unless)) -(htdp-syntax-test #'(unless 10)) -(htdp-syntax-test #'(unless 10 12 13)) +(htdp-syntax-test #'unless "unless: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(unless) "unless: expected a question and an answer, but nothing's there") +(htdp-syntax-test #'(unless 10) "unless: expected a question and an answer, but found only one part") +(htdp-syntax-test #'(unless 10 12 13) "unless: expected a question and an answer, but found 3 parts") -(htdp-err/rt-test (unless 1 2)) +(htdp-err/rt-test (unless 1 2) rx:not-true-or-false) (htdp-test (void) 'unless (unless true 1)) (htdp-test 11 'unless (unless false 11)) -(htdp-syntax-test #'shared) -(htdp-syntax-test #'(shared)) -(htdp-syntax-test #'(shared ())) -(htdp-syntax-test #'(shared 1 2)) -(htdp-syntax-test #'(shared () 1 2)) -(htdp-syntax-test #'(shared (x) 2)) -(htdp-syntax-test #'(shared ([]) 2)) -(htdp-syntax-test #'(shared ([x]) 2)) -(htdp-syntax-test #'(shared ([x 1 3]) 2)) -(htdp-syntax-test #'(shared ([1 3]) 2)) -(htdp-syntax-test #'(shared ([x 1][x 2]) 2)) +(htdp-syntax-test #'shared "shared: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(shared) "shared: expected at least one binding (in parentheses) after shared, but nothing's there") +(htdp-syntax-test #'(shared ()) "shared: expected an expression after the bindings, but nothing's there") +(htdp-syntax-test #'(shared 1 2) "shared: expected at least one binding (in parentheses) after shared, but found a number") +(htdp-syntax-test #'(shared () 1 2) "shared: expected only one expression after the bindings, but found 1 extra part") +(htdp-syntax-test #'(shared (x) 2) "shared: expected a binding with a variable and an expression, but found something else") +(htdp-syntax-test #'(shared ([]) 2) "shared: expected a variable for a binding, but nothing's there") +(htdp-syntax-test #'(shared ([x]) 2) "shared: expected an expression after the binding name, but nothing's there") +(htdp-syntax-test #'(shared ([x 1 3]) 2) "shared: expected only one expression after the binding name, but found 1 extra part") +(htdp-syntax-test #'(shared ([1 3]) 2) "shared: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(shared ([x 1][x 2]) 2) "shared: found a variable that is used more than once: x") (htdp-test 1 'shared (shared () 1)) (htdp-test 1 'shared (shared ([x 1]) x)) @@ -174,17 +184,17 @@ (htdp-test #t (lambda (l) (eq? l (cadr l))) (shared ([x (list x x)]) x)) (htdp-err/rt-test (shared ([x (cons 1 y)][y 5]) x)) -(htdp-syntax-test #'recur) -(htdp-syntax-test #'(recur)) -(htdp-syntax-test #'(recur 10)) -(htdp-syntax-test #'(recur name)) -(htdp-syntax-test #'(recur name 10)) -(htdp-syntax-test #'(recur name ([x 1]))) -(htdp-syntax-test #'(recur name ([x]) 1)) -(htdp-syntax-test #'(recur name ([x 10] 2) 1)) -(htdp-syntax-test #'(recur name ([11 10]) 1)) -(htdp-syntax-test #'(recur name ([x 10]) 1 2)) -(htdp-syntax-test #'(recur name ([x 10][x 11]) 1)) +(htdp-syntax-test #'recur "recur: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(recur) "recur: expected a function name after recur, but nothing's there") +(htdp-syntax-test #'(recur 10) "recur: expected a function name after recur, but found a number") +(htdp-syntax-test #'(recur name) "recur: expected at least one binding (in parentheses) after recur, but nothing's there") +(htdp-syntax-test #'(recur name 10) "recur: expected at least one binding (in parentheses) after recur, but found a number") +(htdp-syntax-test #'(recur name ([x 1])) "recur: expected an expression after the bindings, but nothing's there") +(htdp-syntax-test #'(recur name ([x]) 1) "recur: expected an expression after the name x, but nothing's there") +(htdp-syntax-test #'(recur name ([x 10] 2) 1) "recur: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(recur name ([11 10]) 1) "recur: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(recur name ([x 10]) 1 2) "recur: expected only one expression after the bindings, but found 1 extra part") +(htdp-syntax-test #'(recur name ([x 10][x 11]) 1) "recur: x was defined locally more than once") (htdp-test 18 'lookup (recur name ([x 18]) x)) (htdp-test 1024 'loop (recur loop ([n 10]) (if (zero? n) 1 (* 2 (loop (sub1 n)))))) (htdp-test 13 'loop (recur f ([f 13]) f)) @@ -192,6 +202,9 @@ (load (build-path (collection-path "tests" "racket") "shared-tests.rktl")) +(htdp-err/rt-test (cons 1 2) "cons: second argument must be a list or cyclic list, but received 1 and 2") +(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list or cyclic list, but received 2; the other arguments were:") + (htdp-test #t 'equal? (equal? (vector (list 10) 'apple) (vector (list 10) 'apple))) (htdp-test #t 'equal? (equal? (shared ([x (cons 10 x)]) x) (shared ([x (cons 10 x)]) x))) (htdp-test #t 'equal? (equal? (shared ([x (cons (vector x) x)]) x) (shared ([x (cons (vector x) x)]) x))) @@ -409,21 +422,22 @@ ;; define-datatype -(htdp-syntax-test #'define-datatype #rx"define-datatype: found a use of `define-datatype' that does not follow an open parenthesis") +(htdp-syntax-test #'define-datatype #rx"define-datatype: found a use that does not follow an open parenthesis") (htdp-syntax-test #'(define-datatype) #rx"define-datatype: expected a datatype type name after `define-datatype', but nothing's there") (htdp-syntax-test #'(define-datatype dt 10) #rx"define-datatype: expected a variant after the datatype type name in `define-datatype', but found a number") (htdp-syntax-test #'(define-datatype dt [v1] 10) #rx"define-datatype: expected a variant after the datatype type name in `define-datatype', but found a number") (htdp-syntax-test #'(define-datatype dt v1) #rx"define-datatype: expected a variant after the datatype type name in `define-datatype', but found something else") -(htdp-syntax-test #'(define-datatype dt [v1 f1 f1]) #rx"define-datatype: in variant `v1': found a field name that was used more than once: f1") +(htdp-syntax-test #'(define-datatype dt [v1 f1 f1]) #rx"define-datatype: in variant `v1': found a field name that is used more than once: f1") (htdp-syntax-test #'(define-datatype dt [10]) #rx"define-datatype: expected a variant name, found a number") -(htdp-syntax-test #'(define-datatype dt [(v1)]) #rx"define-datatype: expected a variant name, found something else") +(htdp-syntax-test #'(define-datatype dt [(v1)]) #rx"define-datatype: expected a variant name, found a part") (htdp-syntax-test #'(define-datatype dt [v1 10]) #rx"define-datatype: in variant `v1': expected a field name, found a number") -(htdp-syntax-test #'(define-datatype dt [v1] [v1]) #rx"define-datatype: found a variant name that was used more than once: v1") +(htdp-syntax-test #'(define-datatype dt [v1] [v1]) #rx"define-datatype: found a variant name that is used more than once: v1") (htdp-syntax-test #'(define-datatype posn [v1]) #rx"posn\\?: this name has a built-in meaning and cannot be re-defined") (htdp-syntax-test #'(define-datatype dt [posn]) #rx"posn: this name has a built-in meaning and cannot be re-defined") (htdp-syntax-test #'(define-datatype lambda [v1]) #rx"define-datatype: expected a datatype type name after `define-datatype', but found a keyword") (htdp-syntax-test #'(define-datatype dt [lambda]) #rx"define-datatype: expected a variant name, found a keyword") -(htdp-syntax-test #'(define-datatype (dt)) #rx"define-datatype: expected a datatype type name after `define-datatype', but found something else") +(htdp-syntax-test #'(define-datatype (dt)) #rx"define-datatype: expected a datatype type name after `define-datatype', +but found a part") (htdp-syntax-test #'(+ 1 (define-datatype dt [v1])) #rx"define-datatype: found a definition that is not at the top level") (htdp-top (define-datatype dt)) @@ -452,7 +466,7 @@ ;; match -(htdp-syntax-test #'match #rx"match: found a use of `match' that does not follow an open parenthesis") +(htdp-syntax-test #'match #rx"match: found a use that does not follow an open parenthesis") (htdp-syntax-test #'(match) #rx"match: expected an expression after `match', but nothing's there") (htdp-syntax-test #'(match 1) #rx"match: expected a pattern--answer clause after the expression following `match', but nothing's there") diff --git a/collects/tests/htdp-lang/beg-adv.rktl b/collects/tests/htdp-lang/beg-adv.rktl index fa9af82bce..083705e687 100644 --- a/collects/tests/htdp-lang/beg-adv.rktl +++ b/collects/tests/htdp-lang/beg-adv.rktl @@ -1,64 +1,63 @@ -(htdp-syntax-test #'()) +(htdp-syntax-test #'() "function call: expected a function after the open parenthesis, but nothing's there") + (htdp-syntax-test #'#%app) - (htdp-syntax-test #'quote) (htdp-syntax-test #'(quote 1 2)) -(htdp-syntax-test #'define) -(htdp-syntax-test #'(define)) -(htdp-syntax-test #'(define x)) -(htdp-syntax-test #'(define x 10 12)) -(htdp-syntax-test #'(define (10 y) 12)) -(htdp-syntax-test #'(define (10) 12)) -(htdp-syntax-test #'(define ("x" y) 12)) -(htdp-syntax-test #'(define (y 10) 12)) -(htdp-syntax-test #'(define (y "x") 12)) -(htdp-syntax-test #'(define (y z 10) 12)) -(htdp-syntax-test #'(define (x y) 10 12)) -(htdp-syntax-test #'(define (x y y) 10)) -(htdp-syntax-test #'(define () 10)) -(htdp-syntax-test #'(define 1 10)) -(htdp-syntax-test #'(define x lambda)) -(htdp-syntax-test #'(define x (lambda))) -(htdp-syntax-test #'(define x (lambda (x)))) -(htdp-syntax-test #'(define x (lambda y))) -(htdp-syntax-test #'(define x (lambda y 10))) -(htdp-syntax-test #'(define x (lambda (10) 10))) -(htdp-syntax-test #'(define x (lambda (x 10) 10))) -(htdp-syntax-test #'(define x (lambda (y) 10 11))) -(htdp-syntax-test #'(define x (lambda (y) 10 11))) -(htdp-syntax-test #'(define x (lambda (y y) 10))) -(htdp-syntax-test #'(+ (define x 5))) +(htdp-syntax-test #'define "define: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(define) "define: expected a variable name, or a function name and its variables (in parentheses)") +(htdp-syntax-test #'(define x) "define: expected an expression after the variable name") +(htdp-syntax-test #'(define x 10 12) "define: expected only one expression after the variable name") +(htdp-syntax-test #'(define (10 y) 12) "define: expected the name of the function, but found a number") +(htdp-syntax-test #'(define (10) 12) "define: expected the name of the function, but found a number") +(htdp-syntax-test #'(define ("x" y) 12) "define: expected the name of the function, but found a string") +(htdp-syntax-test #'(define (y 10) 12) "define: expected a variable, but found a number") +(htdp-syntax-test #'(define (y "x") 12) "define: expected a variable, but found a string") +(htdp-syntax-test #'(define (y z 10) 12) "define: expected a variable, but found a number") +(htdp-syntax-test #'(define (x y) 10 12) "define: expected only one expression for the function body, but found 1 extra part") +(htdp-syntax-test #'(define (x y y) 10) "define: found a variable that is used more than once: y") +(htdp-syntax-test #'(define () 10) "define: expected a name for the function, but nothing's there") +(htdp-syntax-test #'(define 1 10) "define: expected a variable name, or a function name and its variables (in parentheses), but found a number") +(htdp-syntax-test #'(define x lambda) "lambda: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(define x (lambda)) "lambda: expected at least one variable (in parentheses) after lambda, but nothing's there") +(htdp-syntax-test #'(define x (lambda (x))) "lambda: expected an expression after the variables, but nothing's there") +(htdp-syntax-test #'(define x (lambda y)) "lambda: expected at least one variable (in parentheses) after lambda, but found something else") +(htdp-syntax-test #'(define x (lambda y 10) "lambda: expected at least one variable (in parentheses) after lambda, but found something else")) +(htdp-syntax-test #'(define x (lambda (10) 10)) "lambda: expected a variable, but found a number") +(htdp-syntax-test #'(define x (lambda (x 10) 10)) "lambda: expected a variable, but found a number") +(htdp-syntax-test #'(define x (lambda (y) 10 11)) "lambda: expected only one expression after the variables, but found 1 extra part") +(htdp-syntax-test #'(define x (lambda (y y) 10)) "lambda: found a variable that is used more than once: y") +(htdp-syntax-test #'(+ (define x 5)) "define: found a definition that is not at the top level") ;; Keywords: -(htdp-syntax-test #'(define (define y) 12)) -(htdp-syntax-test #'(define (lambda y) 12)) -(htdp-syntax-test #'(define (cond y) 12)) -(htdp-syntax-test #'(define (if y) 12)) -(htdp-syntax-test #'(define (y define) 12)) -(htdp-syntax-test #'(define (y lambda) 12)) -(htdp-syntax-test #'(define (y cond) 12)) -(htdp-syntax-test #'(define (y if) 12)) -(htdp-syntax-test #'(define (y and) 12)) -(htdp-syntax-test #'(define (y or) 12)) -(htdp-syntax-test #'(define (y true) 12)) -(htdp-syntax-test #'(define (y false) 12)) -(htdp-syntax-test #'(define (y empty) 12)) +(htdp-syntax-test #'(define (define y) 12) "define: expected the name of the function, but found a keyword") +(htdp-syntax-test #'(define (lambda y) 12) "define: expected the name of the function, but found a keyword") +(htdp-syntax-test #'(define (cond y) 12) "define: expected the name of the function, but found a keyword") +(htdp-syntax-test #'(define (if y) 12) "define: expected the name of the function, but found a keyword") +(htdp-syntax-test #'(define (y define) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y lambda) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y cond) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y if) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y and) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y or) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y true) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y false) 12) "define: expected a variable, but found a keyword") +(htdp-syntax-test #'(define (y empty) 12) "define: expected a variable, but found a keyword") -(htdp-syntax-test #'define-struct) -(htdp-syntax-test #'(define-struct)) -(htdp-syntax-test #'(define-struct a)) -(htdp-syntax-test #'(define-struct a (b) 10)) -(htdp-syntax-test #'(define-struct a (b) 10 11 12)) -(htdp-syntax-test #'(define-struct 10 (b))) -(htdp-syntax-test #'(define-struct a b)) -(htdp-syntax-test #'(define-struct a (10))) -(htdp-syntax-test #'(define-struct a (b 10))) -(htdp-syntax-test #'(define-struct (a) (b))) -(htdp-syntax-test #'(define-struct a (b b))) -(htdp-syntax-test #'(define-struct lambda (b))) -(htdp-syntax-test #'(+ 1 (define-struct a (b)))) +(htdp-syntax-test #'define-struct "define-struct: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(define-struct) "define-struct: expected the structure name after define-struct, but nothing's there") +(htdp-syntax-test #'(define-struct a) "define-struct: expected at least one field name (in parentheses) after the structure name, but nothing's there") +(htdp-syntax-test #'(define-struct a (b) 10) "define-struct: expected nothing after the field names, but found 1 extra part") +(htdp-syntax-test #'(define-struct a (b) 10 11 12) "define-struct: expected nothing after the field names, but found 3 extra parts") +(htdp-syntax-test #'(define-struct 10 (b)) "define-struct: expected the structure name after define-struct, but found a number") +(htdp-syntax-test #'(define-struct a b) "define-struct: expected at least one field name after the structure name, but found something else") +(htdp-syntax-test #'(define-struct a (10)) "define-struct: expected a field name, but found a number") +(htdp-syntax-test #'(define-struct a (b 10)) "define-struct: expected a field name, but found a number") +(htdp-syntax-test #'(define-struct (a) (b)) "define-struct: expected the structure name after define-struct, but found a part") +(htdp-syntax-test #'(define-struct a (b b)) "define-struct: found a field name that is used more than once: b") +(htdp-syntax-test #'(define-struct lambda (b)) "define-struct: expected the structure name after define-struct, but found a keyword") +(htdp-syntax-test #'(+ 1 (define-struct a (b))) "define-struct: found a definition that is not at the top level") (htdp-top (define x 5)) (htdp-top (define (f y) (+ x y))) @@ -77,49 +76,50 @@ (htdp-test #t 'a3? (a3? (make-a3 1 2 3))) (htdp-test #f 'a1? (a1? (make-a3 1 2 3))) (htdp-test #f 'a3? (a3? (make-a1 1))) -(htdp-err/rt-test (a1-b 10) #rx"a1-b") -(htdp-syntax-test #'(a0 1 2 3)) +(htdp-err/rt-test (a1-b 10) "a1-b: expects argument of type ; given 10") +(htdp-syntax-test #'(a0 1 2 3) "a0: cannot use a structure name after an open parenthesis for a function call") -(htdp-syntax-test #'cond) -(htdp-syntax-test #'(cond)) -(htdp-syntax-test #'(cond 1)) -(htdp-syntax-test #'(cond [#t 6] 2)) -(htdp-syntax-test #'(cond [else 6] [#f 10])) -(htdp-syntax-test #'(cond [else 6] [else 10])) -(htdp-syntax-test #'(cond [])) -(htdp-syntax-test #'(cond [1])) -(htdp-syntax-test #'(cond [1 2 3])) -(htdp-syntax-test #'(cond [1 2][])) -(htdp-syntax-test #'(cond [1 2][3 4 5])) +(htdp-syntax-test #'cond "cond: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(cond) "cond: expected a clause after cond, but nothing's there") +(htdp-syntax-test #'(cond 1) "cond: expected a clause with a question and an answer, but found a number") +(htdp-syntax-test #'(cond [#t 6] 2) "cond: expected a clause with a question and an answer, but found a number") +(htdp-syntax-test #'(cond [else 6] [#f 10]) "cond: found an else clause that isn't the last clause in its cond expression") +(htdp-syntax-test #'(cond [else 6] [else 10]) "cond: found an else clause that isn't the last clause in its cond expression") +(htdp-syntax-test #'(cond []) "cond: expected a clause with a question and an answer, but found an empty part") +(htdp-syntax-test #'(cond [1]) "cond: expected a clause with a question and an answer, but found a clause with only one part") +(htdp-syntax-test #'(cond [1 2 3]) "cond: expected a clause with a question and an answer, but found a clause with 3 parts") +(htdp-syntax-test #'(cond [1 2][]) "cond: expected a clause with a question and an answer, but found an empty part") +(htdp-syntax-test #'(cond [1 2][3 4 5]) "cond: expected a clause with a question and an answer, but found a clause with 3 parts") (htdp-test 17 'cond (cond [else 17])) (htdp-test 18 'cond (cond [#t 18])) (htdp-test 19 'cond (cond [(zero? 10) 0] [#t 19])) (htdp-test 19 'cond (cond [(zero? 10) 0] [else 19])) -(htdp-err/rt-test (cond [#f 10]) exn:fail?) ;; Should it be a different exception? + +(htdp-err/rt-test (cond [#f 10]) "cond: all question results were false") ;; Should it be a different exception? (define rx:not-true-or-false "not true or false") (htdp-err/rt-test (cond [1 10]) rx:not-true-or-false) -(htdp-syntax-test #'if) -(htdp-syntax-test #'(if)) -(htdp-syntax-test #'(if #t)) -(htdp-syntax-test #'(if #t 1)) -(htdp-syntax-test #'(if #t 1 2 3)) +(htdp-syntax-test #'if "if: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(if) "if: expected a question and two answers, but nothing's there") +(htdp-syntax-test #'(if #t) "if: expected a question and two answers, but found only 1 part") +(htdp-syntax-test #'(if #t 1) "if: expected a question and two answers, but found only 2 parts") +(htdp-syntax-test #'(if #t 1 2 3) "if: expected a question and two answers, but found 4 parts") (htdp-err/rt-test (if 1 2 3) rx:not-true-or-false) -(htdp-syntax-test #'and) -(htdp-syntax-test #'(and)) -(htdp-syntax-test #'(and #t)) +(htdp-syntax-test #'and "and: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(and) "and: expected at least two expressions after and, but nothing's there") +(htdp-syntax-test #'(and #t) "and: expected at least two expressions after and, but found only one expression") (htdp-err/rt-test (and 1 #t) rx:not-true-or-false) (htdp-err/rt-test (and #t 1) rx:not-true-or-false) (htdp-test #f 'ok-and (and #t #f 1)) -(htdp-syntax-test #'or) -(htdp-syntax-test #'(or)) -(htdp-syntax-test #'(or #t)) +(htdp-syntax-test #'or "or: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(or) "or: expected at least two expressions after or, but nothing's there") +(htdp-syntax-test #'(or #t) "or: expected at least two expressions after or, but found only one expression") (htdp-err/rt-test (or 1 #f) rx:not-true-or-false) (htdp-err/rt-test (or #f 1) rx:not-true-or-false) @@ -128,8 +128,6 @@ (htdp-test #t 'empty? (empty? empty)) (htdp-test #t 'cons? (cons? (cons 1 empty))) -(htdp-err/rt-test (cons 1 2)) -(htdp-err/rt-test (append (list 1) 2)) (htdp-test #t 'boolean? (boolean? true)) (htdp-test #t 'boolean? (boolean? false)) @@ -159,6 +157,9 @@ (htdp-error-test #'(define-struct an-example (function y))) (htdp-top-pop 1) + + + (htdp-test #t 'equal? (equal? 1 1)) (htdp-test #t 'equal? (equal? (list 1) (list 1))) (htdp-test #t 'equal? (equal? (list #i1.0 2) (list #i1.0 2))) @@ -223,15 +224,17 @@ ;; Error messages (htdp-top (define my-x 5)) (htdp-top (define (my-f x) (+ x 5))) + (htdp-syntax-test #'(cond [true my-x 5]) #rx"found a clause with 3 parts") -(htdp-syntax-test #'(define foo17 my-x 5) #rx"found one extra part") -(htdp-syntax-test #'(my-y 17) #rx"not defined, not a parameter, and not a primitive name") -(htdp-syntax-test #'(cond [true my-y 17]) #rx"not defined, not a parameter, and not a primitive name") +(htdp-syntax-test #'(define foo17 my-x 5) #rx"define: expected only one expression after the variable name foo17, but found 1 extra part") +(htdp-syntax-test #'(my-y 17) #rx"my-y: this function is not defined") +(htdp-syntax-test #'(cond [true my-y 17]) #rx"my-y: this variable is not defined") (htdp-syntax-test #'(define my-f 12) #rx"cannot be re-defined") (htdp-syntax-test #'(define (my-x h) 12) #rx"cannot be re-defined") (htdp-top-pop 1) (htdp-top-pop 1) -(htdp-syntax-test #'define #rx"does not follow") +(htdp-syntax-test #'define #rx"define: found a use that does not follow an open parenthesis") + (htdp-syntax-test #'(require) #rx"found nothing") (htdp-syntax-test #'(require a!) #rx"bad syntax for a module path") @@ -298,88 +301,69 @@ (htdp-test 2 'two 2) (htdp-top-pop 1) + ;; ----------------------------------------------------------------------------- ;; mf's tests for string functions replacing chars (htdp-test "h" 'string-ith (string-ith "hell" 0)) -(htdp-err/rt-test (string-ith "hell" 4) exn:fail:contract? - #; - (string-append - "string-ith:" - " " - " for second argument expected, given " - "4")) +(htdp-err/rt-test (string-ith "hell" 4) + (exn-type-and-msg exn:fail:contract? + "string-ith: expected an exact integer in [0, length of the given string] for the second argument, but received 4")) -(htdp-err/rt-test (string-ith 10 4) exn:fail:contract? - #; - (string-append "string-ith: for first argument expected, given " - "10")) +(htdp-err/rt-test (string-ith 10 4) + (exn-type-and-msg exn:fail:contract? + "string-ith: expected a string for the first argument, but received 10")) -(htdp-err/rt-test (string-ith "10" 'a) exn:fail:contract? - #; - (string-append "string-ith: for second argument expected, given " - "a")) + +(htdp-err/rt-test (string-ith "10" 'a) + (exn-type-and-msg exn:fail:contract? + "string-ith: expected a natural number for the second argument, but received 'a")) (htdp-test "aaa" 'replicate (replicate 3 "a")) (htdp-test "ababab" 'replicate (replicate 3 "ab")) -(htdp-err/rt-test (replicate 3 10) exn:fail:contract? - #; - "replicate: expected, given 10") +(htdp-err/rt-test (replicate 3 10) + (exn-type-and-msg exn:fail:contract? "replicate: expected a string, but received 10")) (htdp-test "\n" 'int->string (int->string 10)) -(htdp-err/rt-test (int->string 56555) exn:fail:contract? - #; - (string-append - "int->string: expected, given " - "56555")) +(htdp-err/rt-test (int->string 56555) + (exn-type-and-msg exn:fail:contract? "int->string: expected an exact integer in [0,55295] or [57344 1114111], but received 56555")) -(htdp-err/rt-test (int->string "A") exn:fail:contract? - #; - (string-append - "int->string: expected, given " - (format "~s" "A"))) +(htdp-err/rt-test (int->string "A") + (exn-type-and-msg exn:fail:contract? "int->string: expected an exact integer in [0,55295] or [57344 1114111], but received \"A\"")) (htdp-test 65 'string->int (string->int "A")) -(htdp-err/rt-test (string->int 10) exn:fail:contract? - #; - (string-append "string->int: " 1-LETTER " expected, not a string: 10")) +(htdp-err/rt-test (string->int 10) + (exn-type-and-msg exn:fail:contract? "string->int: expected a 1-letter string, but received a string: 10")) -(htdp-err/rt-test (string->int "AB") exn:fail:contract? - #; - (string-append - "string->int: " 1-LETTER " expected, given " (format "~s" "AB"))) +(htdp-err/rt-test (string->int "AB") + (exn-type-and-msg exn:fail:contract? "string->int: expected a 1-letter string, but received \"AB\"")) (htdp-test (list "h" "e" "l" "l" "o") 'explode (explode "hello")) -(htdp-err/rt-test (explode 10) exn:fail:contract? - #; - (string-append "explode: expected, given " "10")) +(htdp-err/rt-test (explode 10) + (exn-type-and-msg exn:fail:contract? "explode: expected a string, but received 10")) (htdp-test "hello" 'implode (implode (list "h" "e" "l" "l" "o"))) -(htdp-err/rt-test (implode 10) exn:fail:contract? - #; - (string-append "implode: " 1-LETTER* " expected, not a : 10")) +(htdp-err/rt-test (implode 10) + (exn-type-and-msg exn:fail:contract? "implode: expected a list of 1-letter strings, but received: 10")) + +(htdp-err/rt-test (implode (list "he" "l")) + (exn-type-and-msg exn:fail:contract? "implode: expected a list of 1-letter strings, but received '(\"he\" \"l\")")) -(htdp-err/rt-test (implode (list "he" "l")) exn:fail:contract? - #; - (string-append "implode: " 1-LETTER* " expected, given " - (format "~s" (list "he" "l")))) (htdp-test true 'string-numeric? (string-numeric? "0")) (htdp-test true 'string-numeric? (string-numeric? "10")) (htdp-test false 'string-numeric? (string-numeric? "a")) (htdp-test false 'string-numeric? (string-numeric? "ab")) -(htdp-err/rt-test (string-numeric? 10) exn:fail:contract? - #; - (string-append "string-numeric?: expected, given 10")) - +(htdp-err/rt-test (string-numeric? 10) + (exn-type-and-msg exn:fail:contract? "string-numeric?: expected a string, but received 10")) (htdp-test false 'string-alphabetic? (string-alphabetic? "a0")) (htdp-test true 'string-alphabetic? (string-alphabetic? "a")) diff --git a/collects/tests/htdp-lang/beg-bega.rktl b/collects/tests/htdp-lang/beg-bega.rktl index b6fd51da38..5bcd52fac8 100644 --- a/collects/tests/htdp-lang/beg-bega.rktl +++ b/collects/tests/htdp-lang/beg-bega.rktl @@ -1,14 +1,14 @@ -(htdp-syntax-test #'(local [(define x 5)] x)) -(htdp-syntax-test #'(recur name ([x 18]) x)) +(htdp-syntax-test #'(local [(define x 5)] x) "local: this function is not defined") +(htdp-syntax-test #'(recur name ([x 18]) x) "recur: this function is not defined") -(htdp-syntax-test #'(define (f78 a) (a))) ; no functions as arguments +(htdp-syntax-test #'(define (f78 a) (a)) "function call: expected a function after the open parenthesis, but found a variable") ;; See htdp-top uses in beg-adv.rkt: (htdp-error-test #'f) (htdp-error-test #'(x 1)) (htdp-error-test #'(+ f 1)) -(htdp-error-test #'((f 1))) +(htdp-error-test #'((f 1)) ) (htdp-error-test #'a1) (htdp-error-test #'make-a1) (htdp-error-test #'a1?) @@ -24,7 +24,7 @@ (htdp-top-pop 1) (htdp-top (define (my-f x) (+ x 5))) -(htdp-syntax-test #'my-f #rx"a procedure, so it must be applied") +(htdp-syntax-test #'my-f #rx"found a use that does not follow an open parenthesis") (htdp-top-pop 1) ;; Teachpacks with higher-order primitives @@ -34,13 +34,13 @@ (htdp-top (define (my-f x) x)) (htdp-top (define-struct foo (a b))) -(htdp-syntax-test #'(go 5 8)) -(htdp-syntax-test #'(go add1 add1)) -(htdp-syntax-test #'(go my-f add1)) -(htdp-syntax-test #'(go foo? add1)) -(htdp-syntax-test #'(go make-foo add1)) -(htdp-syntax-test #'(go foo-a add1)) -(htdp-syntax-test #'(go go add1)) +(htdp-syntax-test #'(go 5 8) "go: expects a function in this position at: 8 in: (go 5 8)") +(htdp-syntax-test #'(go add1 add1) "add1: found a use that does not follow an open parenthesis in: add1") +(htdp-syntax-test #'(go my-f add1) "my-f: found a use that does not follow an open parenthesis in: my-f") +(htdp-syntax-test #'(go foo? add1) "foo?: found a use that does not follow an open parenthesis in: foo?") +(htdp-syntax-test #'(go make-foo add1) "make-foo: found a use that does not follow an open parenthesis in: make-foo") +(htdp-syntax-test #'(go foo-a add1) "foo-a: found a use that does not follow an open parenthesis in: foo-a") +(htdp-syntax-test #'(go go add1) "go: found a use that does not follow an open parenthesis in: go") (htdp-top-pop 1) (htdp-teachpack-pop) diff --git a/collects/tests/htdp-lang/beg-intm.rktl b/collects/tests/htdp-lang/beg-intm.rktl index a73b55dc81..bca832b89e 100644 --- a/collects/tests/htdp-lang/beg-intm.rktl +++ b/collects/tests/htdp-lang/beg-intm.rktl @@ -1,12 +1,14 @@ ;; For every test here, make sure the opposite test is in intml-adv.rkt -(htdp-syntax-test #'(1 2 3)) -(htdp-syntax-test #'("hello" 1 2)) +(htdp-syntax-test #'(1 2 3) "function call: expected a function after the open parenthesis, but found a number") +(htdp-syntax-test #'("hello" 1 2) "function call: expected a function after the open parenthesis, but found a string") +(htdp-syntax-test #'(define x17 (lambda (y) (lambda (z) z))) "lambda: found a lambda that is not a function definition") +(htdp-syntax-test #'(lambda (x) 10) "lambda: found a lambda that is not a function definition") -(htdp-syntax-test #'(define x17 (lambda (y) (lambda (z) z)))) -(htdp-syntax-test #'(lambda (x) 10)) +(htdp-syntax-test #'(lambda (f) (f f)) "lambda: found a lambda that is not a function definition") -(htdp-syntax-test #'(lambda (f) (f f))) +(htdp-syntax-test #'(recur empty-f () 10) "recur: this function is not defined") +(htdp-syntax-test #'((unquote-splicing (list 10))) "function call: expected a function after the open parenthesis, but found a part") diff --git a/collects/tests/htdp-lang/beg-intml.rktl b/collects/tests/htdp-lang/beg-intml.rktl index 5f253734d5..dfca038388 100644 --- a/collects/tests/htdp-lang/beg-intml.rktl +++ b/collects/tests/htdp-lang/beg-intml.rktl @@ -1,5 +1,8 @@ ;; For every test here, make sure the opposite test is in advanced.rkt -(htdp-syntax-test #'(define (xthnk) 10)) -(htdp-syntax-test #'(define xthnk (lambda () 10))) +(htdp-syntax-test #'(define (xthnk) 10) "define: expected at least one variable after the function name, but found none") +(htdp-syntax-test #'(define xthnk (lambda () 10)) "lambda: expected at least one variable after lambda, but found none") + +(htdp-err/rt-test (cons 1 2) "cons: second argument must be a list, but received 1 and 2") +(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list, but received 2; the other arguments were:") diff --git a/collects/tests/htdp-lang/bega-adv.rktl b/collects/tests/htdp-lang/bega-adv.rktl index 52c59596ba..cadb91476c 100644 --- a/collects/tests/htdp-lang/bega-adv.rktl +++ b/collects/tests/htdp-lang/bega-adv.rktl @@ -16,17 +16,16 @@ (htdp-test '(quasiquote (unquote 22)) 'qq ``,,(* 11 2)) (htdp-test '(quasiquote ((unquote-splicing (22)))) 'qq ``(,@(,@(list (* 11 2))))) -(htdp-syntax-test #'quasiquote) -(htdp-syntax-test #'`unquote) -(htdp-syntax-test #'`unquote-splicing) -(htdp-syntax-test #'`(unquote-splicing 10)) +(htdp-syntax-test #'quasiquote "quasiquote: found a use that does not precede an open parenthesis") +(htdp-syntax-test #'`unquote "quasiquote: misuse of unquote within a quasiquoting backquote") +(htdp-syntax-test #'`unquote-splicing "quasiquote: misuse of ,@ or unquote-splicing within a quasiquoting backquote") +(htdp-syntax-test #'`(unquote-splicing 10) "quasiquote: misuse of ,@ or unquote-splicing within a quasiquoting backquote") -(htdp-syntax-test #'unquote) -(htdp-syntax-test #'(unquote)) -(htdp-syntax-test #'(unquote 10)) +(htdp-syntax-test #'unquote "unquote: misuse of a comma or unquote, not under a quasiquoting backquote") +(htdp-syntax-test #'(unquote) "unquote: misuse of a comma or unquote, not under a quasiquoting backquote") +(htdp-syntax-test #'(unquote 10) "unquote: misuse of a comma or unquote, not under a quasiquoting backquote") -(htdp-syntax-test #'unquote-splicing) -(htdp-syntax-test #'(unquote-splicing (list 10))) -(htdp-syntax-test #'((unquote-splicing (list 10)))) +(htdp-syntax-test #'unquote-splicing "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote") +(htdp-syntax-test #'(unquote-splicing (list 10)) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote") -(htdp-err/rt-test `(,@4)) +(htdp-err/rt-test `(,@4) (exn-type-and-msg exn:fail:contract? "append: expected argument of type ; given 4")) diff --git a/collects/tests/htdp-lang/beginner.rktl b/collects/tests/htdp-lang/beginner.rktl index 57b516f3fe..e12e6c7c6d 100644 --- a/collects/tests/htdp-lang/beginner.rktl +++ b/collects/tests/htdp-lang/beginner.rktl @@ -91,11 +91,11 @@ (load-relative "beg-intm.rktl") (load-relative "beg-bega.rktl") -(htdp-syntax-test #'quote) -(htdp-syntax-test #''1) -(htdp-syntax-test #''"hello") -(htdp-syntax-test #''(1 2)) -(htdp-syntax-test #'''a) +(htdp-syntax-test #'quote "found a use that isn't before a parenthesis") +(htdp-syntax-test #''1 "quote: expected the name of the symbol after the quote, but found a number") +(htdp-syntax-test #''"hello" "quote: expected the name of the symbol after the quote, but found a string") +(htdp-syntax-test #''(1 2) "quote: expected the name of the symbol after the quote, but found a part") +(htdp-syntax-test #'''a "quote: expected the name of the symbol after the quote, but found a part") + -(report-errs) diff --git a/collects/tests/htdp-lang/htdp-test.rktl b/collects/tests/htdp-lang/htdp-test.rktl index afa4284440..9c665b49ec 100644 --- a/collects/tests/htdp-lang/htdp-test.rktl +++ b/collects/tests/htdp-lang/htdp-test.rktl @@ -64,7 +64,7 @@ #,(strip-context stx)) (lambda (x) (and (exn:fail:syntax? x) - (regexp-match rx (exn-message x)))))])) + (regexp-match (if (string? rx) (regexp-quote rx) rx) (exn-message x)))))])) (require (only-in mzscheme [let mz-let] @@ -106,6 +106,12 @@ [(_ expr exn?) #'(do-htdp-test #'expr #f (htdp-string-to-pred exn?))])) +(define (exn-type-and-msg type-pred msg) + (lambda (exn) + (and (type-pred exn) + (regexp-match (if (string? msg) (regexp-quote msg) msg) (exn-message exn))))) + + (define (htdp-error-test stx) (do-htdp-test stx #t #f)) diff --git a/collects/tests/htdp-lang/intermediate.rktl b/collects/tests/htdp-lang/intermediate.rktl index a4eb8c96e1..3bbe58d07d 100644 --- a/collects/tests/htdp-lang/intermediate.rktl +++ b/collects/tests/htdp-lang/intermediate.rktl @@ -32,4 +32,6 @@ (load-relative "intm-intml.rktl") (load-relative "intm-adv.rktl") +(htdp-syntax-test #'(local [(lambda (x) x)] 1) "lambda: found a lambda that is not a function definition") + (report-errs) diff --git a/collects/tests/htdp-lang/intm-adv.rktl b/collects/tests/htdp-lang/intm-adv.rktl index bbf6955d21..78cd3001e1 100644 --- a/collects/tests/htdp-lang/intm-adv.rktl +++ b/collects/tests/htdp-lang/intm-adv.rktl @@ -2,20 +2,21 @@ ;; These are true for beginner, but the operators are syntax, so ;; arity-test doesn't work. -(htdp-syntax-test #'local) -(htdp-syntax-test #'(local)) -(htdp-syntax-test #'(local ())) -(htdp-syntax-test #'(local 1)) -(htdp-syntax-test #'(local 1 1)) -(htdp-syntax-test #'(local () 1 2)) -(htdp-syntax-test #'(local [1] 1 2)) -(htdp-syntax-test #'(local [(+ 1 2)] 1)) -(htdp-syntax-test #'(local [(define x)] 1)) -(htdp-syntax-test #'(local [(lambda (x) x)] 1)) -(htdp-syntax-test #'(local [(define x 1) (define x 2)] 1)) -(htdp-syntax-test #'(local [(define (x a) 12) (+ 1 2)] 1)) +(htdp-syntax-test #'local "local: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(local) "local: expected at least one definition (in square brackets) after local, but nothing's there") +(htdp-syntax-test #'(local ()) "local: expected an expression after the local definitions, but nothing's there") +(htdp-syntax-test #'(local 1) "local: expected at least one definition (in square brackets) after local, but found a number") +(htdp-syntax-test #'(local 1 1) "local: expected at least one definition (in square brackets) after local, but found a number") +(htdp-syntax-test #'(local () 1 2) "local: expected only one expression after the local definitions, but found 1 extra part") +(htdp-syntax-test #'(local [1] 1 2) "local: expected a definition, but found a number") +(htdp-syntax-test #'(local [(+ 1 2)] 1) "local: expected a definition, but found a part") +(htdp-syntax-test #'(local [(define x)] 1) "define: expected an expression after the variable name x, but nothing's there") +(htdp-syntax-test #'(local [(define x 1) (define x 2)] 1) "local: x was defined locally more than once") +(htdp-syntax-test #'(local [(define (x a) 12) (+ 1 2)] 1) "local: expected a definition, but found a part") -(htdp-err/rt-test (local [(define x y) (define y 5)] 10) exn:fail:contract:variable?) +(htdp-err/rt-test (local [(define x y) (define y 5)] 10) + (exn-type-and-msg exn:fail:contract:variable? + "local variable used before its definition: y")) (htdp-test 1 'local (local () 1)) (htdp-test 5 'local (local [(define y 5) (define x y)] x)) @@ -25,22 +26,24 @@ (htdp-test 19 (local [(define (f x) (+ x 10))] f) 9) (htdp-test 16 'local (local [(define (f x) (+ x 10))] (f 6))) -(htdp-syntax-test #'letrec) -(htdp-syntax-test #'(letrec)) -(htdp-syntax-test #'(letrec ())) -(htdp-syntax-test #'(letrec 1 2)) -(htdp-syntax-test #'(letrec 1 2 3)) -(htdp-syntax-test #'(letrec (10) 1)) -(htdp-syntax-test #'(letrec ([x]) 1)) -(htdp-syntax-test #'(letrec ([x 2 3]) 1)) -(htdp-syntax-test #'(letrec ([x 5] 10) 1)) -(htdp-syntax-test #'(letrec ([1 5]) 1)) -(htdp-syntax-test #'(letrec ([1 5 6]) 1)) -(htdp-syntax-test #'(letrec ([x 5]) 1 2)) -(htdp-syntax-test #'(letrec ([x 5][x 6]) 1)) - -(htdp-err/rt-test (letrec ([x y] [y 5]) 10) exn:fail:contract:variable?) +(htdp-syntax-test #'letrec "letrec: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(letrec) "letrec: expected at least one binding (in parentheses) after letrec, but nothing's there") +(htdp-syntax-test #'(letrec ()) "letrec: expected an expression after the bindings, but nothing's there") +(htdp-syntax-test #'(letrec 1 2) "letrec: expected at least one binding (in parentheses) after letrec, but found a number") +(htdp-syntax-test #'(letrec 1 2 3) "letrec: expected at least one binding (in parentheses) after letrec, but found a number") +(htdp-syntax-test #'(letrec (10) 1) "letrec: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(letrec ([x]) 1) "letrec: expected an expression after the name x, but nothing's there") +(htdp-syntax-test #'(letrec ([x 2 3]) 1) "letrec: expected only one expression after the name x, but found 1 extra part") +(htdp-syntax-test #'(letrec ([x 5] 10) 1) "letrec: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(letrec ([1 5]) 1) "letrec: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(letrec ([1 5 6]) 1) "letrec: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(letrec ([x 5]) 1 2) "letrec: expected only one expression after the bindings, but found 1 extra part") +(htdp-syntax-test #'(letrec ([x 5][x 6]) 1) "letrec: x was defined locally more than once") +(htdp-err/rt-test (letrec ([x y] [y 5]) 10) + (exn-type-and-msg exn:fail:contract:variable? + "local variable used before its definition: y")) + (htdp-test 1 'letrec (letrec () 1)) (htdp-test 5 'letrec (letrec ([y 5][x y]) x)) (htdp-test #t 'letrec (letrec ([even (lambda (n) (if (zero? n) true (odd (sub1 n))))] @@ -49,19 +52,19 @@ (htdp-test 19 (letrec ([f (lambda (x) (+ x 10))]) f) 9) (htdp-test 16 'letrec (letrec ([f (lambda (x) (+ x 10))]) (f 6))) -(htdp-syntax-test #'let) -(htdp-syntax-test #'(let)) -(htdp-syntax-test #'(let ())) -(htdp-syntax-test #'(let 1 2)) -(htdp-syntax-test #'(let 1 2 3)) -(htdp-syntax-test #'(let (10) 1)) -(htdp-syntax-test #'(let ([x]) 1)) -(htdp-syntax-test #'(let ([x 2 3]) 1)) -(htdp-syntax-test #'(let ([x 5] 10) 1)) -(htdp-syntax-test #'(let ([1 5]) 1)) -(htdp-syntax-test #'(let ([1 5 6]) 1)) -(htdp-syntax-test #'(let ([x 5]) 1 2)) -(htdp-syntax-test #'(let ([x 5][x 6]) 1)) +(htdp-syntax-test #'let "let: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(let) "let: expected at least one binding (in parentheses) after let, but nothing's there") +(htdp-syntax-test #'(let ()) "let: expected an expression after the bindings, but nothing's there") +(htdp-syntax-test #'(let 1 2) "let: expected at least one binding (in parentheses) after let, but found a number") +(htdp-syntax-test #'(let 1 2 3) "let: expected at least one binding (in parentheses) after let, but found a number") +(htdp-syntax-test #'(let (10) 1) "let: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(let ([x]) 1) "let: expected an expression after the name x, but nothing's there") +(htdp-syntax-test #'(let ([x 2 3]) 1) "let: expected only one expression after the name x, but found 1 extra part" ) +(htdp-syntax-test #'(let ([x 5] 10) 1) "let: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(let ([1 5]) 1) "let: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(let ([1 5 6]) 1) "let: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(let ([x 5]) 1 2) "let: expected only one expression after the bindings, but found 1 extra part") +(htdp-syntax-test #'(let ([x 5][x 6]) 1) "let: x was defined locally more than once") (htdp-test 1 'let (let () 1)) (htdp-test 5 'let (let ([y 5]) (let ([x y]) x))) @@ -69,18 +72,18 @@ (htdp-test 19 (let ([f (lambda (x) (+ x 10))]) f) 9) (htdp-test 16 'let (let ([f (lambda (x) (+ x 10))]) (f 6))) -(htdp-syntax-test #'let*) -(htdp-syntax-test #'(let*)) -(htdp-syntax-test #'(let* ())) -(htdp-syntax-test #'(let* 1 2)) -(htdp-syntax-test #'(let* 1 2 3)) -(htdp-syntax-test #'(let* (10) 1)) -(htdp-syntax-test #'(let* ([x]) 1)) -(htdp-syntax-test #'(let* ([x 2 3]) 1)) -(htdp-syntax-test #'(let* ([x 5] 10) 1)) -(htdp-syntax-test #'(let* ([1 5]) 1)) -(htdp-syntax-test #'(let* ([1 5 6]) 1)) -(htdp-syntax-test #'(let* ([x 5]) 1 2)) +(htdp-syntax-test #'let* "let*: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(let*) "let*: expected at least one binding (in parentheses) after let*, but nothing's there") +(htdp-syntax-test #'(let* ()) "let*: expected an expression after the bindings, but nothing's there") +(htdp-syntax-test #'(let* 1 2) "let*: expected at least one binding (in parentheses) after let*, but found a number") +(htdp-syntax-test #'(let* 1 2 3) "let*: expected at least one binding (in parentheses) after let*, but found a number") +(htdp-syntax-test #'(let* (10) 1) "let*: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(let* ([x]) 1) "let*: expected an expression after the name x, but nothing's there") +(htdp-syntax-test #'(let* ([x 2 3]) 1) "let*: expected only one expression after the name x, but found 1 extra part") +(htdp-syntax-test #'(let* ([x 5] 10) 1) "let*: expected a binding with a variable and an expression, but found a number") +(htdp-syntax-test #'(let* ([1 5]) 1) "let*: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(let* ([1 5 6]) 1) "let*: expected a variable for the binding, but found a number") +(htdp-syntax-test #'(let* ([x 5]) 1 2) "let*: expected only one expression after the bindings, but found 1 extra part") (htdp-test 1 'let* (let* () 1)) (htdp-test 6 'let* (let* ([x 5][x 6]) x)) @@ -91,24 +94,24 @@ (htdp-test 16 'let* (let* ([f (lambda (x) (+ x 10))]) (f 6))) (htdp-test 7779 'time (time 7779)) -(htdp-syntax-test #'time) -(htdp-syntax-test #'(time)) -(htdp-syntax-test #'(time 1 2)) -(htdp-syntax-test #'(time (define x 5))) +(htdp-syntax-test #'time "time: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'(time) "time: expected an expression after time, but nothing's there") +(htdp-syntax-test #'(time 1 2) "time: expected only one expression after time, but found 1 extra part") +(htdp-syntax-test #'(time (define x 5)) "define: found a definition that is not at the top level") (htdp-err/rt-test (foldr car 2 '(1 2 3)) - "foldr : first argument must be a that accepts two arguments, given #") + "foldr : first argument must be a function that expects two arguments, given") (htdp-err/rt-test (foldl car 2 '(1 2 3)) - "foldl : first argument must be a that accepts two arguments, given #") + "foldl : first argument must be a function that expects two arguments, given #") (htdp-err/rt-test (build-string 2 add1) - "build-string : second argument must be a that produces a , given #, which produced 1 for 0") + "build-string : the second argument must be a function that produces a character, given #, which produced 1 for 0") (htdp-test 0 '+ (+)) (htdp-test 1 '+ (+ 1)) (htdp-test 1 '* (*)) (htdp-test 1 '* (* 1)) -;(htdp-test (-) exn:application:arity?) -;(htdp-err/rt-test (/) exn:application:arity?) +(htdp-err/rt-test (-) (exn-type-and-msg exn:application:arity? "-: expects at least 1 argument, given 0")) +(htdp-err/rt-test (/) (exn-type-and-msg exn:application:arity? "/: expects at least 1 argument, given 0")) ;(htdp-test 1 (/ 1) exn:application:arity?) diff --git a/collects/tests/htdp-lang/intm-intml.rktl b/collects/tests/htdp-lang/intm-intml.rktl index 471d64accc..947ff2d6a4 100644 --- a/collects/tests/htdp-lang/intm-intml.rktl +++ b/collects/tests/htdp-lang/intm-intml.rktl @@ -1,5 +1,3 @@ -(htdp-syntax-test #'(recur empty-f () 10)) - -(htdp-syntax-test #'(let name ([x 12]) 10)) +(htdp-syntax-test #'(let name ([x 12]) 10) "let: expected at least one binding (in parentheses) after let, but found something else") diff --git a/collects/tests/htdp-lang/intmlam-adv.rktl b/collects/tests/htdp-lang/intmlam-adv.rktl index 3745d00903..9e077c8fef 100644 --- a/collects/tests/htdp-lang/intmlam-adv.rktl +++ b/collects/tests/htdp-lang/intmlam-adv.rktl @@ -12,5 +12,10 @@ (err/rt-test (1 2 3)) +(htdp-syntax-test #'(recur empty-f () 10) "recur: expected a function name after recur, but nothing's there" +(htdp-syntax-test #'(local [(lambda (x) x)] 1) "local: expected a definition, but found a part") + +(htdp-syntax-test #'((unquote-splicing (list 10))) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote") + diff --git a/collects/tests/racket/testing.rktl b/collects/tests/racket/testing.rktl index af75f0d28e..4ca3bfa17d 100644 --- a/collects/tests/racket/testing.rktl +++ b/collects/tests/racket/testing.rktl @@ -175,7 +175,9 @@ transcript. (printf " WRONG EXN ELEM ~s: ~s " sel e) (record-error (list e (cons 'exn-elem sel) expr))))))) exn-table) - + + (printf "~s~n" (if (exn? e) (exn-message e) e)) + #; ;g; ((error-display-handler) (if (exn? e) (exn-message e)