From aa9dbd21f51a515d8bb90b32777b3bbc3eff6e9a Mon Sep 17 00:00:00 2001 From: Guillaume Marceau Date: Sun, 3 Jul 2011 05:14:25 -0400 Subject: [PATCH] Updated the error message of check-expect. Fine tuning of the error messages. --- collects/lang/htdp-advanced.rkt | 20 ++--- collects/lang/htdp-beginner-abbr.rkt | 11 +-- collects/lang/htdp-beginner.rkt | 7 +- collects/lang/htdp-intermediate-lambda.rkt | 4 +- collects/lang/htdp-intermediate.rkt | 4 +- collects/lang/prim.rkt | 4 +- .../lang/private/rewrite-error-message.rkt | 57 +++++++++---- collects/lang/private/teach.rkt | 85 ++++++++++++------- collects/lang/private/teachhelp.rkt | 2 +- collects/lang/private/teachprims.rkt | 18 ++-- collects/test-engine/racket-tests.rkt | 35 +++----- collects/tests/drracket/language-test.rkt | 22 ++--- collects/tests/drracket/repl-test.rkt | 16 ++-- collects/tests/htdp-lang/advanced.rktl | 24 +++--- collects/tests/htdp-lang/beg-adv.rktl | 30 +++---- collects/tests/htdp-lang/beg-bega.rktl | 14 +-- collects/tests/htdp-lang/beg-intml.rktl | 2 +- collects/tests/htdp-lang/bega-adv.rktl | 2 +- collects/tests/htdp-lang/beginner.rktl | 2 +- collects/tests/htdp-lang/intm-adv.rktl | 10 +-- 20 files changed, 204 insertions(+), 165 deletions(-) diff --git a/collects/lang/htdp-advanced.rkt b/collects/lang/htdp-advanced.rkt index 8b4cf60be1..3b5a4ff5c5 100644 --- a/collects/lang/htdp-advanced.rkt +++ b/collects/lang/htdp-advanced.rkt @@ -1,11 +1,10 @@ (module htdp-advanced scheme/base - (require "private/teach.rkt" - "private/teachprims.rkt" - "private/teach-module-begin.rkt" - mzlib/etc - mzlib/list - mzlib/pretty - syntax/docprovide + (require "private/teach.ss" + "private/teach-module-begin.ss" + mzlib/etc + mzlib/list + mzlib/pretty + syntax/docprovide scheme/promise test-engine/scheme-tests "posn.rkt") @@ -35,6 +34,8 @@ [beginner-dots ....] [beginner-dots .....] [beginner-dots ......] + [beginner-true true] + [beginner-false false] [intermediate-quote quote] [intermediate-quasiquote quasiquote] [intermediate-unquote unquote] @@ -49,8 +50,7 @@ [advanced-case case] [advanced-match match] [advanced-delay delay] - [advanced-module-begin #%module-begin] - ) + [advanced-module-begin #%module-begin]) check-expect check-within check-error @@ -58,7 +58,7 @@ check-range #%datum #%top-interaction - empty true false + empty signature : -> mixed one-of predicate combined Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any diff --git a/collects/lang/htdp-beginner-abbr.rkt b/collects/lang/htdp-beginner-abbr.rkt index 79c94933f7..762c78b93e 100644 --- a/collects/lang/htdp-beginner-abbr.rkt +++ b/collects/lang/htdp-beginner-abbr.rkt @@ -6,9 +6,8 @@ test-engine/scheme-tests) ;; Implements the forms: - (require "private/teach.rkt" - "private/teachprims.rkt" - "private/teach-module-begin.rkt") + (require "private/teach.ss" + "private/teach-module-begin.ss") ;; syntax: (provide (rename-out @@ -32,7 +31,9 @@ [intermediate-quasiquote quasiquote] [intermediate-unquote unquote] [intermediate-unquote-splicing unquote-splicing] - [beginner-module-begin #%module-begin]) + [beginner-module-begin #%module-begin] + [beginner-true true] + [beginner-false false]) check-expect check-within check-error @@ -40,7 +41,7 @@ check-range #%datum #%top-interaction - empty true false + empty ; signature : -> mixed one-of predicate combined ; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any diff --git a/collects/lang/htdp-beginner.rkt b/collects/lang/htdp-beginner.rkt index 3d9a5b7062..92d54af6be 100644 --- a/collects/lang/htdp-beginner.rkt +++ b/collects/lang/htdp-beginner.rkt @@ -35,6 +35,8 @@ [beginner-dots ....] [beginner-dots .....] [beginner-dots ......] + [beginner-true true] + [beginner-false false] ) check-expect check-within @@ -44,7 +46,7 @@ ;; define-wish #%datum #%top-interaction - empty true false + empty ; signature : -> mixed one-of predicate combined ; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any @@ -55,6 +57,7 @@ (require (for-syntax "private/firstorder.ss")) + (define-syntax (in-rator-position-only stx) (syntax-case stx () [(_ new-name orig-name) @@ -73,7 +76,7 @@ (raise-syntax-error #f (format - "found a use that does not follow an open parenthesis") + "expected a function call, but there is no open parenthesis before this function") stx)])) #'orig-name))))])) diff --git a/collects/lang/htdp-intermediate-lambda.rkt b/collects/lang/htdp-intermediate-lambda.rkt index 5bb4c3ba5a..cf3cf371dc 100644 --- a/collects/lang/htdp-intermediate-lambda.rkt +++ b/collects/lang/htdp-intermediate-lambda.rkt @@ -36,6 +36,8 @@ [intermediate-unquote-splicing unquote-splicing] [intermediate-time time] [intermediate-module-begin #%module-begin] + [beginner-true true] + [beginner-false false] ) check-expect check-within @@ -44,7 +46,7 @@ check-range #%datum #%top-interaction - empty true false + empty ; signature : -> mixed one-of predicate combined ; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any diff --git a/collects/lang/htdp-intermediate.rkt b/collects/lang/htdp-intermediate.rkt index cdabf8c06e..d810926f6b 100644 --- a/collects/lang/htdp-intermediate.rkt +++ b/collects/lang/htdp-intermediate.rkt @@ -38,6 +38,8 @@ [intermediate-unquote-splicing unquote-splicing] [intermediate-time time] [intermediate-module-begin #%module-begin] + [beginner-true true] + [beginner-false false] ) check-expect check-within @@ -46,7 +48,7 @@ check-range #%datum #%top-interaction - empty true false + empty ; signature : -> mixed one-of predicate combined ; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any diff --git a/collects/lang/prim.rkt b/collects/lang/prim.rkt index 099543a1b4..122f56bf9b 100644 --- a/collects/lang/prim.rkt +++ b/collects/lang/prim.rkt @@ -44,7 +44,7 @@ [_ (raise-syntax-error #f - "found a use that does not follow an open parenthesis" + "expected a function call, but there is no open parenthesis before this function" stx)]))) ((syntax-local-certifier #t) #'impl))))])) @@ -122,7 +122,7 @@ [_ (raise-syntax-error #f - "found a use that does not follow an open parenthesis" + "expected a function call, but there is no open parenthesis before this function" s)]))) ((syntax-local-certifier #t) #'impl))))))))])) diff --git a/collects/lang/private/rewrite-error-message.rkt b/collects/lang/private/rewrite-error-message.rkt index 3e066d532d..3d8c3f7600 100755 --- a/collects/lang/private/rewrite-error-message.rkt +++ b/collects/lang/private/rewrite-error-message.rkt @@ -22,8 +22,12 @@ (define (exn-needs-rewriting? exn) (exn:fail:contract? exn)) + +(define (ensure-number n-or-str) + (if (string? n-or-str) (string->number n-or-str) n-or-str)) + (define (plural n) - (if (> (string->number n) 1) "s" "")) + (if (> (ensure-number n) 1) "s" "")) (define (raise-not-bound-error id) (if (syntax-property id 'was-in-app-position) @@ -36,30 +40,51 @@ "this variable is not defined" id))) -(define (argcount-error-message arity found) - (define fn-is-large (> (string->number arity) (string->number found))) - (format "expects ~a~a argument~a, but found ~a~a" - (if fn-is-large "" "only ") - arity (plural arity) - (if fn-is-large "only " "") - found)) +(define (argcount-error-message arity found [at-least #f]) + (define arity:n (ensure-number arity)) + (define found:n (ensure-number found)) + (define fn-is-large (> arity:n found:n)) + (format "expects ~a~a~a argument~a, but found ~a~a" + (if at-least "at least " "") + (if (or (= arity:n 0) fn-is-large) "" "only ") + (if (= arity:n 0) "no" arity:n) (plural arity:n) + (if (and (not (= found:n 0)) fn-is-large) "only " "") + (if (= found:n 0) "none" found:n))) (define (rewrite-contract-error-message msg) (define replacements - (list (list #rx"expects argument of type (<([^>]+)>)" + (list (list #rx"procedure application: expected procedure, given: (.*) \\(no arguments\\)" + (lambda (all one) + (format "function call: expected a function after the open parenthesis, but received ~a" one))) + (list #rx"procedure application: expected procedure, given: (.*); arguments were:.*" + (lambda (all one) + (format "function call: expected a function after the open parenthesis, but received ~a" one))) + (list #rx"expects argument of type (<([^>]+)>)" + (lambda (all one two) (format "expects a ~a" two))) + (list #rx"expected 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))) - (list #px"expects at least (\\d+) argument.?, given (\\d+): .*" - (lambda (all one two) (format "expects at least ~a argument~a, but found only ~a." - one (plural one) two))) - (list #px"expects (\\d+) argument.?, given (\\d+): .*" - (lambda (all one two) (argcount-error-message one two))) + (list #px"expects at least (\\d+) argument.?, given (\\d+)(: .*)?" + (lambda (all one two three) (argcount-error-message one two #t))) + (list #px"expects (\\d+) argument.?, given (\\d+)(: .*)?" + (lambda (all one two three) (argcount-error-message one two))) (list #rx"^procedure " (lambda (all) "")) - )) + (list #rx", given: " + (lambda (all) ", given ")) + (list #rx"; other arguments were:.*" + (lambda (all) "")) + (list #rx"expects a (struct:)" + (lambda (all one) "expects a ")) + (list #rx"list or cyclic list" + (lambda (all) "list")) + (list (regexp-quote "#(struct:object:image-snip% ...)") + (lambda (all) "an image")) + (list (regexp-quote "#(struct:object:cache-image-snip% ...)") + (lambda (all) "an image")))) (for/fold ([msg msg]) ([repl. replacements]) - (regexp-replace* (first repl.) msg (second repl.)))) + (regexp-replace* (first repl.) msg (second repl.)))) (define (get-rewriten-error-message exn) (if (exn-needs-rewriting? exn) diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index da0a3bc3c0..7ef6294af8 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -59,6 +59,7 @@ (require-for-syntax "teachhelp.ss" "rewrite-error-message.rkt" "teach-shared.ss" + "rewrite-error-message.rkt" syntax/kerncase syntax/stx syntax/struct @@ -76,7 +77,7 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; run-time helpers ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - + ;; verify-boolean is inserted to check for boolean results: (define (verify-boolean b where) (if (or (eq? b #t) (eq? b #f)) @@ -97,17 +98,15 @@ val)) (define undefined (letrec ([x x]) x)) + (define (identifier-is-bound? id) + (or (identifier-binding id) + ;; identifier-binding returns #f for variable bound at the top-level, + ;; check explicitly: + (and (namespace-variable-value (syntax-e id) #t (lambda () #f)) #t))) + ;; Wrapped around top-level definitions to disallow re-definition: (define (check-top-level-not-defined who id) - (when (let ([b (identifier-binding id)]) - ;; if it's not top-level, raise an exn - (if b - #t - ;; At top-level, might be bound to syntax or value: - (with-handlers ([exn:fail:contract:variable? (lambda (exn) #f)] - [exn:fail:syntax? (lambda (exn) #t)]) - (namespace-variable-value (syntax-e id) #t) - #t))) + (when (identifier-is-bound? id) (raise-syntax-error #f "this name was defined previously and cannot be re-defined" id))) (define (top/check-defined id) @@ -170,6 +169,7 @@ (define provided-identifiers (quote-syntax (id ...))) defn ...))))]))) + ;; The implementation of form X is defined below as X/proc. The ;; reason for this is to allow the implementation of Y to re-use the ;; implementation of X (expanding to a use of X would mangle syntax @@ -190,6 +190,8 @@ beginner-quote/expr beginner-require beginner-dots + beginner-true + beginner-false intermediate-define intermediate-define-struct @@ -263,7 +265,7 @@ name stx #f - "found a use that does not follow an open parenthesis")) + "expected an open parenthesis before ~a, but found none" name)) ;; Use for messages "expected ..., found " (define (something-else v) @@ -272,6 +274,7 @@ [(number? v) "a number"] [(string? v) "a string"] [(list? v) "a part"] + [(struct? v) "an image"] [else "something else"]))) (define (ordinal n) @@ -287,6 +290,7 @@ [(= 3 (modulo n 10)) (format "~ard" n)])) + ;; At the top level, wrap `defn' to first check for ;; existing definitions of the `names'. The `names' ;; argument is a syntax list of identifiers. @@ -457,7 +461,28 @@ (values (k names) names))) - + + ;; Racket's true and false are defined as macros (for performance perhaps?), + ;; but this dodge *SL's redefinition of #%app and set!. Without these + ;; beginner-true/proc and beginner-false/proc here, (true) would throw a + ;; professional error message not suitable for beginners. + (define (make-constant-expander val) + (make-set!-transformer + (lambda (stx) + (syntax-case stx (set!) + [(set! id rhs) (syntax/loc stx (set! val rhs))] + [(id . args) + (teach-syntax-error + '|function call| + #'stx + #'id + "expected a function after the open parenthesis, but found ~a" + (syntax-e #'id))] + [_ (datum->syntax stx val)])))) + + (define beginner-true/proc (make-constant-expander #t)) + (define beginner-false/proc (make-constant-expander #f)) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; define (beginner) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -953,9 +978,7 @@ [(self . args) (raise-syntax-error #f - (string-append - "cannot use a signature name after an" - " open parenthesis for a function call") + "expected a function after the open parenthesis, but found a structure name" stx #'self)] [_ #'#,signature-name]))) @@ -974,7 +997,7 @@ 'define-struct stx (syntax something) - "expected at least one field name after the structure name, but found ~a" + "expected at least one field name (in parentheses) after the structure name, but found ~a" (something-else (syntax something)))] [(_ name_) (teach-syntax-error @@ -1174,7 +1197,7 @@ (bad-app "a variable")] [(or lex-ok? (and binding (not (binding-in-this-module? binding)))) (with-syntax ([new-rator (syntax-property #'rator 'was-in-app-position #t)]) - (syntax/loc stx (#%app new-rator rand ...)))] + (syntax/loc stx (#%app new-rator rand ...)))] [else ;; We don't know what rator is, yet, and it might be local: (with-syntax ([new-rator (syntax-property #'rator 'was-in-app-position #t)]) @@ -1183,16 +1206,17 @@ (#%app values #,(quasisyntax/loc stx (beginner-app-continue new-rator rand ...)))))]))] - [(_) + [(_) (teach-syntax-error '|function call| stx #f - (format - "expected a function after the open parenthesis, but nothing's there"))] - [_else (bad-use-error '#%app stx)])))]) + "expected a function after the open parenthesis, but nothing's there")] + [_else (bad-use-error '|function call| stx)])))]) (values (mk-app #f) (mk-app #t)))) + + (define (beginner-app-continue/proc stx) (syntax-case stx () [(_ rator rand ...) @@ -1202,15 +1226,14 @@ ;; Now defined in the module: (if (set!-transformer? (syntax-local-value fun (lambda () #f))) ;; Something that takes care of itself: - (syntax/loc stx (rator rand ...)) + (syntax/loc stx (rator rand ...)) ;; Something for which we probably need to report an error, ;; but let beginner-app take care of it: (syntax/loc stx (beginner-app rator rand ...))) ;; Something undefined; let beginner-top take care of it: (with-syntax ([new-rator (syntax-property #'rator 'was-in-app-position #t)]) - (syntax/loc stx (#%app new-rator rand ...))) - ))])) + (syntax/loc stx (#%app new-rator rand ...)))))])) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; top-level variables (beginner) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1406,9 +1429,7 @@ where stx #f - "expected at least two expressions after ~a, but ~a" - where - (if (zero? n) "nothing's there" "found only one expression"))) + (argcount-error-message 2 n #t))) (let loop ([clauses-consumed 0] [remaining (syntax->list #`clauses)]) (if (null? remaining) @@ -2294,7 +2315,7 @@ stx #f "expected a function after the open parenthesis, but nothing's there")] - [_else (bad-use-error '#%app stx)])))) + [_else (bad-use-error '|function call| stx)])))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set! (advanced) @@ -2673,11 +2694,11 @@ qqp]))] [check-and-translate-p (λ (p) - (syntax-case p (struct posn true false empty intermediate-quote intermediate-quasiquote advanced-cons list advanced-list* vector box) - [true + (syntax-case p (struct posn beginner-true beginner-false empty intermediate-quote intermediate-quasiquote advanced-cons list advanced-list* vector box) + [beginner-true (syntax/loc p #t)] - [false + [beginner-false (syntax/loc p #f)] [empty @@ -2775,7 +2796,7 @@ (syntax (unless (cyclic-list? (cdr name)) (raise-type-error 'cons - "list or cyclic list" + "list" 1 (car name) (cdr name)))))) diff --git a/collects/lang/private/teachhelp.rkt b/collects/lang/private/teachhelp.rkt index b4b31a1718..dddb7c509e 100644 --- a/collects/lang/private/teachhelp.rkt +++ b/collects/lang/private/teachhelp.rkt @@ -64,7 +64,7 @@ (identifier? #'id) (raise-syntax-error #f - (format "found a use that does not follow an open parenthesis") + (format "expected a function call, but there is no open parenthesis before this function") stx #f)] [(id . rest) diff --git a/collects/lang/private/teachprims.rkt b/collects/lang/private/teachprims.rkt index 42cdc9f3aa..c9b191c341 100644 --- a/collects/lang/private/teachprims.rkt +++ b/collects/lang/private/teachprims.rkt @@ -88,15 +88,9 @@ namespace. (unless (ok? last) (raise (make-exn:fail:contract - (format "~a: last argument must be ~a ~a, but received ~e; the other arguments were: ~a" + (format "~a: last argument must be ~a ~a, but received ~e" prim-name (a-or-an type) type - last - ;; all-but-last: - (build-arg-list - (let loop ([args args]) - (cond - [(null? (cdr args)) null] - [else (cons (car args) (loop (cdr args)))])))) + last) (current-continuation-marks)))))] [else (loop (cdr l))])))) @@ -278,9 +272,9 @@ namespace. (and (number? b) (beginner-=~ a b epsilon))] [(procedure? a) - (fail "first argument of equality cannot be a procedure, given ~e" a)] + (fail "first argument of equality cannot be a function, given ~e" a)] [(procedure? b) - (fail "second argument of equality cannot be a procedure, given ~e" b)] + (fail "second argument of equality cannot be a function, given ~e" b)] [(union-equal!? a b) #t] [else (equal?/recur a b ?)])))) @@ -297,9 +291,9 @@ namespace. (let recur ([a x] [b y]) (cond [(procedure? a) - (fail "first argument of equality cannot be a procedure, given ~e" a)] + (fail "first argument of equality cannot be a function, given ~e" a)] [(procedure? b) - (fail "second argument of equality cannot be a procedure, given ~e" b)] + (fail "second argument of equality cannot be a function, given ~e" b)] [(and (number? a) (inexact? a)) (fail "first argument of equality cannot be an inexact number, given ~e" a)] diff --git a/collects/test-engine/racket-tests.rkt b/collects/test-engine/racket-tests.rkt index fda9fb33b6..6a4bb61f90 100644 --- a/collects/test-engine/racket-tests.rkt +++ b/collects/test-engine/racket-tests.rkt @@ -1,6 +1,7 @@ #lang racket (require lang/private/teachprims + (for-syntax lang/private/rewrite-error-message) scheme/class scheme/match lang/private/continuation-mark-key @@ -30,34 +31,23 @@ (define FUNCTION-FMT "check-expect cannot compare functions.") (define CHECK-ERROR-STR-FMT - "check-error requires a string for the second argument, representing the expected error message. Given ~s") + "check-error expects a string for the second argument, representing the expected error message. Given ~s") (define CHECK-WITHIN-INEXACT-FMT - "check-within requires an inexact number for the range. ~a is not inexact.") + "check-within expects an inexact number for the range. ~a is not inexact.") (define CHECK-WITHIN-FUNCTION-FMT "check-within cannot compare functions.") (define LIST-FMT - "check-member-of requires a list for the second argument, containing the possible outcomes. Given ~s") + "check-member-of expects a list for the second argument, containing the possible outcomes. Given ~s") (define CHECK-MEMBER-OF-FUNCTION-FMT "check-member-of cannot compare functions.") (define RANGE-MIN-FMT - "check-range requires a number for the minimum value. Given ~a") + "check-range expects a number for the minimum value. Given ~a") (define RANGE-MAX-FMT - "check-range requires a number for the maximum value. Given ~a") + "check-range expects a number for the maximum value. Given ~a") (define CHECK-RANGE-FUNCTION-FMT "check-range cannot compare functions.") -(define-for-syntax CHECK-EXPECT-STR - "check-expect requires two expressions. Try (check-expect test expected).") -(define-for-syntax CHECK-ERROR-STR - "check-error requires at least one expression. Try (check-error test message) or (check-error test).") -(define-for-syntax CHECK-WITHIN-STR - "check-within requires three expressions. Try (check-within test expected range).") -(define-for-syntax CHECK-MEMBER-OF-STR - "check-member-of requires at least two expressions. Try (check-member-of test option options ...).") -(define-for-syntax CHECK-RANGE-STR - "chech-range requires three expressions. Try (check-range test min max).") - (define-for-syntax CHECK-EXPECT-DEFN-STR "found a test that is not at the top level") (define-for-syntax CHECK-WITHIN-DEFN-STR @@ -149,6 +139,9 @@ (let ([c (syntax-local-context)]) (memq c '(module top-level)))) +(define-for-syntax (argcount-error-message/stx arity stx [at-least #f]) + (argcount-error-message arity (sub1 (length (syntax->list stx))) at-least)) + ;; check-expect (define-syntax (check-expect stx) (unless (check-context?) @@ -157,7 +150,7 @@ [(_ test actual) (check-expect-maker stx #'check-values-expected #`test (list #`actual) 'comes-from-check-expect)] - [_ (raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)])) + [_ (raise-syntax-error 'check-expect (argcount-error-message/stx 2 stx) stx)])) ;; check-values-expected: (-> scheme-val) scheme-val src test-engine -> void (define (check-values-expected test actual src test-engine) @@ -177,7 +170,7 @@ [(_ test actual within) (check-expect-maker stx #'check-values-within #`test (list #`actual #`within) 'comes-from-check-within)] - [_ (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)])) + [_ (raise-syntax-error 'check-within (argcount-error-message/stx 3 stx) stx)])) ;; check-values-within: (-> scheme-val) scheme-val number src test-engine -> void (define (check-values-within test actual within src test-engine) @@ -199,7 +192,7 @@ [(_ test) (check-expect-maker stx #'check-values-error/no-string #`test null 'comes-from-check-error)] - [_ (raise-syntax-error 'check-error CHECK-ERROR-STR stx)])) + [_ (raise-syntax-error 'check-error (argcount-error-message/stx 1 stx #t) stx)])) ;; check-values-error: (-> scheme-val) scheme-val src test-engine -> void (define (check-values-error test error src test-engine) @@ -250,7 +243,7 @@ [(_ test actual actuals ...) (check-expect-maker stx #'check-member-of-values-expected #`test (list #`actual #`(list actuals ...)) 'comes-from-check-member-of)] - [_ (raise-syntax-error 'check-member-of CHECK-MEMBER-OF-STR stx)])) + [_ (raise-syntax-error 'check-member-of (argcount-error-message/stx 2 stx #t) stx)])) ;; check-member-of-values-expected: (-> scheme-val) scheme-val src test-engine -> void (define (check-member-of-values-expected test first-actual actuals src test-engine) @@ -268,7 +261,7 @@ [(_ test min max) (check-expect-maker stx #'check-range-values-expected #`test (list #`min #`max) 'comes-from-check-range)] - [_ (raise-syntax-error 'check-range CHECK-RANGE-STR stx)])) + [_ (raise-syntax-error 'check-range (argcount-error-message/stx 3 stx) stx)])) ;; check-range-values-expected: (-> scheme-val) scheme-val src test-engine -> void (define (check-range-values-expected test min max src test-engine) diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index 27f1f3928c..ee0e868024 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -422,7 +422,7 @@ the settings above should match r5rs (test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2") (test-expression "(+ (list 1) 2)" - "+: expects a number as 1st argument, given: (cons 1 empty); other arguments were: 2") + "+: expects a number as 1st argument, given (cons 1 empty)") (test-expression "'(1)" "quote: expected the name of the symbol after the quote, but found a part") (test-expression "(define shrd (list 1)) (list shrd shrd)" @@ -435,7 +435,7 @@ the settings above should match r5rs "letrec: this function is not defined" "function call: expected a function after the open parenthesis, but found a part") (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") - (test-expression "(+ 1)" "+: expects at least 2 arguments, given 1: 1") + (test-expression "(+ 1)" "+: expects at least 2 arguments, but found only 1") (test-expression "1.0" "1" "1") (test-expression "#i1.0" "#i1.0" "#i1.0") @@ -572,7 +572,7 @@ the settings above should match r5rs (test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!") (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") (test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (list 1); other arguments were: 2") + (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)") (test-expression "'(1)" "(list 1)" "(list 1)") @@ -586,7 +586,7 @@ the settings above should match r5rs "letrec: this function is not defined" "function call: expected a function after the open parenthesis, but found a part") (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") - (test-expression "(+ 1)" "+: expects at least 2 arguments, given 1: 1") + (test-expression "(+ 1)" "+: expects at least 2 arguments, but found only 1") (test-expression "1.0" "1" "1") (test-expression "#i1.0" "#i1.0" "#i1.0") @@ -722,7 +722,7 @@ the settings above should match r5rs (test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!") (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") (test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (cons 1 empty); other arguments were: 2") + (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)") (test-expression "'(1)" "(list 1)" "(list 1)") @@ -781,7 +781,7 @@ the settings above should match r5rs (test-expression "(list 1)" "(list 1)" "(list 1)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") + (test-expression "(car (list))" "car: expects a pair; given empty") (test-undefined-var "argv") (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") @@ -869,7 +869,7 @@ the settings above should match r5rs (test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!") (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") (test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (list 1); other arguments were: 2") + (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)") (test-expression "'(1)" "(list 1)" "(list 1)") @@ -924,7 +924,7 @@ the settings above should match r5rs (test-expression "(list 1)" "(list 1)" "(list 1)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") + (test-expression "(car (list))" "car: expects a pair; given empty") (test-undefined-var "argv") (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") @@ -988,7 +988,7 @@ the settings above should match r5rs |# (test-undefined-var "class") - (test-expression "shared" "shared: found a use that does not follow an open parenthesis") + (test-expression "shared" "shared: expected an open parenthesis before shared, but found none") (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") (test-expression "'(1 . 2)" "read: illegal use of \".\"") @@ -1016,7 +1016,7 @@ the settings above should match r5rs "qqq: this name was defined previously and cannot be re-defined\n(void)") (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") (test-expression "(cons 1 2)" "cons: second argument must be a list or cyclic list, but received 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects type as 1st argument, given: (list 1); other arguments were: 2") + (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)") (test-expression "'(1)" "(list 1)" "(list 1)") @@ -1075,7 +1075,7 @@ the settings above should match r5rs (test-expression "(list 1)" "(list 1)" "(list 1)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") + (test-expression "(car (list))" "car: expects a pair; given empty") (test-undefined-var "argv") (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") diff --git a/collects/tests/drracket/repl-test.rkt b/collects/tests/drracket/repl-test.rkt index 6fc2e921b3..ca6b12c0bc 100644 --- a/collects/tests/drracket/repl-test.rkt +++ b/collects/tests/drracket/repl-test.rkt @@ -79,7 +79,7 @@ This produces an ACK message (define test-data (list - + #| ;; basic tests (mktest "1" ("1" @@ -540,12 +540,12 @@ This produces an ACK message (mktest "(require lang/htdp-beginner)\n(cond [1 2 3 4])" - ("{stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" - "{stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" - "{stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" - "{stop-multi.png} {stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" - "{stop-multi.png} {stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" - "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4") + ("{stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" + "{stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" + "{stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" + "{stop-multi.png} {stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" + "{stop-multi.png} {stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4" + "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4") 'definitions #f void @@ -611,7 +611,7 @@ This produces an ACK message #f void void) - + |# ;; error escape handler test (mktest "(let ([old (error-escape-handler)])\n(+ (let/ec k\n(dynamic-wind\n(lambda () (error-escape-handler (lambda () (k 5))))\n(lambda () (expt 3 #f))\n(lambda () (error-escape-handler old))))\n10))" diff --git a/collects/tests/htdp-lang/advanced.rktl b/collects/tests/htdp-lang/advanced.rktl index 2eab6df38a..2b2a72c400 100644 --- a/collects/tests/htdp-lang/advanced.rktl +++ b/collects/tests/htdp-lang/advanced.rktl @@ -38,7 +38,7 @@ (define x8 (lambda () 11)) (test 11 x8) -(htdp-syntax-test #'begin "begin: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'begin "begin: expected an open parenthesis before begin, but found none") (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") @@ -54,7 +54,7 @@ (htdp-test 12 'begin+set! (begin 12 ex)) (htdp-top-pop 1) -(htdp-syntax-test #'begin0 "begin0: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'begin0 "begin0: expected an open parenthesis before begin0, but found none") (htdp-syntax-test #'(begin0) "begin: expected at least one expression after begin0, but nothing's there") (htdp-test 1 'begin0 (begin0 1)) @@ -62,7 +62,7 @@ (htdp-test 3 'begin0 (begin0 3 2 1)) -(htdp-syntax-test #'set! "set!: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'set! "set!: expected an open parenthesis before set!, but found none") (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") @@ -87,7 +87,7 @@ x))) 45) -(htdp-syntax-test #'delay "delay: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'delay "delay: expected an open parenthesis before delay, but found none") (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") @@ -114,7 +114,7 @@ (htdp-test 19 'lookup (recur empty-f () 19)) -(htdp-syntax-test #'case "case: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'case "case: expected an open parenthesis before case, but found none") (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") @@ -136,7 +136,7 @@ (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 "when: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'when "when: expected an open parenthesis before when, but found none") (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") @@ -146,7 +146,7 @@ (htdp-test (void) 'when (when false 1)) (htdp-test 11 'when (when true 11)) -(htdp-syntax-test #'unless "unless: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'unless "unless: expected an open parenthesis before unless, but found none") (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") @@ -156,7 +156,7 @@ (htdp-test (void) 'unless (unless true 1)) (htdp-test 11 'unless (unless false 11)) -(htdp-syntax-test #'shared "shared: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'shared "shared: expected an open parenthesis before shared, but found none") (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") @@ -179,7 +179,7 @@ (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 "recur: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'recur "recur: expected an open parenthesis before recur, but found none") (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") @@ -198,7 +198,7 @@ (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-err/rt-test (append (list 1) 2) "append: last argument must be a list or cyclic list, but received 2") (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))) @@ -417,7 +417,7 @@ ;; define-datatype -(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 an open parenthesis before define-datatype, but found none") (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") @@ -460,7 +460,7 @@ ;; match -(htdp-syntax-test #'match #rx"match: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'match #rx"match: expected an open parenthesis before match, but found none") (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 39741158dd..5c11beeeff 100644 --- a/collects/tests/htdp-lang/beg-adv.rktl +++ b/collects/tests/htdp-lang/beg-adv.rktl @@ -5,7 +5,7 @@ (htdp-syntax-test #'quote) (htdp-syntax-test #'(quote 1 2)) -(htdp-syntax-test #'define "define: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'define "define: expected an open parenthesis before define, but found none") (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") @@ -19,7 +19,7 @@ (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 an open parenthesis before lambda, but found none") (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 for the function body, 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") @@ -41,17 +41,15 @@ (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 "define-struct: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'define-struct "define-struct: expected an open parenthesis before define-struct, but found none") (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 b) "define-struct: expected at least one field name (in parentheses) 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") @@ -78,9 +76,9 @@ (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) "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 #'(a0 1 2 3) "a0: expected a function after the open parenthesis, but found a structure name") -(htdp-syntax-test #'cond "cond: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'cond "cond: expected an open parenthesis before cond, but found none") (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") @@ -102,7 +100,7 @@ (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 "if: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'if "if: expected an open parenthesis before if, but found none") (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") @@ -110,17 +108,17 @@ (htdp-err/rt-test (if 1 2 3) rx:not-true-or-false) -(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-syntax-test #'and "and: expected an open parenthesis before and, but found none") +(htdp-syntax-test #'(and) "and: expects at least 2 arguments, but found none") +(htdp-syntax-test #'(and #t) "and: expects at least 2 arguments, but found only 1") (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 "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-syntax-test #'or "or: expected an open parenthesis before or, but found none") +(htdp-syntax-test #'(or) "or: expects at least 2 arguments, but found none") +(htdp-syntax-test #'(or #t) "or: expects at least 2 arguments, but found only 1") (htdp-err/rt-test (or 1 #f) rx:not-true-or-false) (htdp-err/rt-test (or #f 1) rx:not-true-or-false) @@ -234,7 +232,7 @@ (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"define: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'define #rx"define: expected an open parenthesis before define, but found none") (htdp-syntax-test #'(require) #rx"found nothing") diff --git a/collects/tests/htdp-lang/beg-bega.rktl b/collects/tests/htdp-lang/beg-bega.rktl index 5bcd52fac8..d4c56eaff1 100644 --- a/collects/tests/htdp-lang/beg-bega.rktl +++ b/collects/tests/htdp-lang/beg-bega.rktl @@ -24,7 +24,7 @@ (htdp-top-pop 1) (htdp-top (define (my-f x) (+ x 5))) -(htdp-syntax-test #'my-f #rx"found a use that does not follow an open parenthesis") +(htdp-syntax-test #'my-f #rx"expected a function call, but there is no open parenthesis before this function") (htdp-top-pop 1) ;; Teachpacks with higher-order primitives @@ -35,12 +35,12 @@ (htdp-top (define-struct foo (a b))) (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-syntax-test #'(go add1 add1) "add1: expected a function call, but there is no open parenthesis before this function") +(htdp-syntax-test #'(go my-f add1) "my-f: expected a function call, but there is no open parenthesis before this function") +(htdp-syntax-test #'(go foo? add1) "foo?: expected a function call, but there is no open parenthesis before this function") +(htdp-syntax-test #'(go make-foo add1) "make-foo: expected a function call, but there is no open parenthesis before this function") +(htdp-syntax-test #'(go foo-a add1) "foo-a: expected a function call, but there is no open parenthesis before this function") +(htdp-syntax-test #'(go go add1) "go: expected a function call, but there is no open parenthesis before this function") (htdp-top-pop 1) (htdp-teachpack-pop) diff --git a/collects/tests/htdp-lang/beg-intml.rktl b/collects/tests/htdp-lang/beg-intml.rktl index dfca038388..cabf64fd93 100644 --- a/collects/tests/htdp-lang/beg-intml.rktl +++ b/collects/tests/htdp-lang/beg-intml.rktl @@ -5,4 +5,4 @@ (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:") +(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list, but received 2") diff --git a/collects/tests/htdp-lang/bega-adv.rktl b/collects/tests/htdp-lang/bega-adv.rktl index f47fbdc749..1e97e5e66c 100644 --- a/collects/tests/htdp-lang/bega-adv.rktl +++ b/collects/tests/htdp-lang/bega-adv.rktl @@ -16,7 +16,7 @@ (htdp-test '(quasiquote (unquote 22)) 'qq ``,,(* 11 2)) (htdp-test '(quasiquote ((unquote-splicing (22)))) 'qq ``(,@(,@(list (* 11 2))))) -(htdp-syntax-test #'quasiquote "quasiquote: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'quasiquote "quasiquote: expected an open parenthesis before quasiquote, but found none") (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") diff --git a/collects/tests/htdp-lang/beginner.rktl b/collects/tests/htdp-lang/beginner.rktl index 18eb52f6ce..f428cf75e7 100644 --- a/collects/tests/htdp-lang/beginner.rktl +++ b/collects/tests/htdp-lang/beginner.rktl @@ -91,7 +91,7 @@ (load-relative "beg-intm.rktl") (load-relative "beg-bega.rktl") -(htdp-syntax-test #'quote "quote: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'quote "quote: expected an open parenthesis before quote, but found none") (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") diff --git a/collects/tests/htdp-lang/intm-adv.rktl b/collects/tests/htdp-lang/intm-adv.rktl index 78cd3001e1..ff76b0b5f8 100644 --- a/collects/tests/htdp-lang/intm-adv.rktl +++ b/collects/tests/htdp-lang/intm-adv.rktl @@ -2,7 +2,7 @@ ;; These are true for beginner, but the operators are syntax, so ;; arity-test doesn't work. -(htdp-syntax-test #'local "local: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'local "local: expected an open parenthesis before local, but found none") (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") @@ -26,7 +26,7 @@ (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 "letrec: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'letrec "letrec: expected an open parenthesis before letrec, but found none") (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") @@ -52,7 +52,7 @@ (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 "let: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'let "let: expected an open parenthesis before let, but found none") (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") @@ -72,7 +72,7 @@ (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* "let*: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'let* "let*: expected an open parenthesis before let*, but found none") (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") @@ -94,7 +94,7 @@ (htdp-test 16 'let* (let* ([f (lambda (x) (+ x 10))]) (f 6))) (htdp-test 7779 'time (time 7779)) -(htdp-syntax-test #'time "time: found a use that does not follow an open parenthesis") +(htdp-syntax-test #'time "time: expected an open parenthesis before time, but found none") (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")