From 1dc0072d036892e1fbc39891a8c3aaeadd451f80 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 22 Jun 2012 05:24:44 +0800 Subject: [PATCH] further error message convention refinements Add extra intitial-message lines, use "..." on a field name to indicate that it could reasonably be hidden by default, and refine some existing messages. --- collects/errortrace/errortrace-lib.rkt | 2 +- collects/ffi/file.rkt | 6 +- .../lang/private/rewrite-error-message.rkt | 14 +- collects/racket/contract/private/blame.rkt | 11 - collects/racket/private/kw.rkt | 4 +- collects/scribblings/reference/exns.scrbl | 63 ++++- collects/tests/htdp-lang/intm-adv.rktl | 2 +- .../tests/racket/contract-mzlib-test.rktl | 9 +- collects/tests/racket/contract-test.rktl | 9 +- collects/tests/racket/object.rktl | 8 +- collects/tests/racket/procs.rktl | 2 +- collects/tests/racket/sandbox.rktl | 4 +- collects/tests/racket/struct.rktl | 20 +- src/racket/src/compile.c | 62 ++--- src/racket/src/dynext.c | 22 +- src/racket/src/env.c | 6 +- src/racket/src/error.c | 244 +++++++++--------- src/racket/src/eval.c | 15 +- src/racket/src/file.c | 10 +- src/racket/src/fun.c | 42 +-- src/racket/src/list.c | 4 +- src/racket/src/module.c | 115 ++++----- src/racket/src/network.c | 15 +- src/racket/src/port.c | 29 ++- src/racket/src/portfun.c | 12 +- src/racket/src/print.c | 4 +- src/racket/src/read.c | 2 +- src/racket/src/schpriv.h | 2 + src/racket/src/struct.c | 46 ++-- src/racket/src/thread.c | 4 +- 30 files changed, 430 insertions(+), 358 deletions(-) diff --git a/collects/errortrace/errortrace-lib.rkt b/collects/errortrace/errortrace-lib.rkt index 21690b9da3..22a59b4725 100644 --- a/collects/errortrace/errortrace-lib.rkt +++ b/collects/errortrace/errortrace-lib.rkt @@ -504,7 +504,7 @@ (if (exn? exn) (let ([p (open-output-string)]) (display (exn-message exn) p) - (display "\n errortrace:" p) + (display "\n errortrace...:" p) (print-error-trace p exn) (orig (get-output-string p) exn)) (orig msg exn))))) diff --git a/collects/ffi/file.rkt b/collects/ffi/file.rkt index a6f6f0d332..e11db6900a 100644 --- a/collects/ffi/file.rkt +++ b/collects/ffi/file.rkt @@ -30,12 +30,12 @@ ((execute) (set! execute? SCHEME_GUARD_FILE_EXECUTE)) ((delete) (set! delete? SCHEME_GUARD_FILE_DELETE)) ((exists) (set! exists? SCHEME_GUARD_FILE_EXISTS)) - (else (raise-argument-error who "bad permission symbol" "symbol" guard)))) + (else (raise-arguments-error who "bad permission symbol" "symbol" guard)))) guards) (when (and (positive? exists?) (positive? (+ read? write? execute? delete?))) - (raise-argument-error who "permission 'exists must occur alone" - "permissions" guards)) + (raise-arguments-error who "permission 'exists must occur alone" + "permissions" guards)) (+ read? write? execute? delete? exists?))) (define (security-guard-check-file who path modes) diff --git a/collects/lang/private/rewrite-error-message.rkt b/collects/lang/private/rewrite-error-message.rkt index 8799658aa9..090469cb54 100644 --- a/collects/lang/private/rewrite-error-message.rkt +++ b/collects/lang/private/rewrite-error-message.rkt @@ -104,10 +104,10 @@ (define (rewrite-contract-error-message msg) (define replacements - (list (list #rx"application: expected procedure\n given: ([^\n]*)(?:\n arguments: [[]none[]])?" - (lambda (all one) + (list (list #rx"application: not a procedure;\n [^\n]*?\n given: ([^\n]*)(?:\n arguments[.][.][.]:(?: [[]none[]]|(?:\n [^\n]*)*))?" + (lambda (all one) (format "function call: expected a function after the open parenthesis, but received ~a" one))) - (list #rx"reference to an identifier before its definition\n identifier: ([^\n]*)" + (list #rx"([^\n]*): undefined;\n cannot reference an identifier before its definition" (lambda (all one) (format "~a is used here before its definition" one))) (list #rx"expects argument of type (<([^>]+)>)" (lambda (all one two) (format "expects a ~a" two))) @@ -115,9 +115,9 @@ (lambda (all one two) (format "expects a ~a" two))) (list #rx"expects type (<([^>]+)>)" (lambda (all one two) (format "expects a ~a" two))) - (list #px"application: wrong number of arguments.*\n procedure: ([^\n]*)\n expected[^:]*: at least (\\d+)\n given[^:]*: (\\d+)(?:\n arguments:(?:\n [^\n]*)*)?" + (list #px"([^\n]*): arity mismatch;\n[^\n]*\n expected[^:]*: at least (\\d+)\n given[^:]*: (\\d+)(?:\n arguments[.][.][.]:(?:\n [^\n]*)*)?" (lambda (all one two three) (argcount-error-message one two three #t))) - (list #px"application: wrong number of arguments.*\n procedure: ([^\n]*)\n expected[^:]*: (\\d+)\n given[^:]*: (\\d+)(?:\n arguments:(?:\n [^\n]*)*)?" + (list #px"([^\n]*): arity mismatch;\n[^\n]*\n expected[^:]*: (\\d+)\n given[^:]*: (\\d+)(?:\n arguments[.][.][.]:(?:\n [^\n]*)*)?" (lambda (all one two three) (argcount-error-message one two three))) (list #px"contract violation\n expected: (.*?)\n given: ([^\n]*)(?:\n argument position: ([^\n]*))?" (lambda (all ctc given pos) (contract-error-message ctc given pos))) @@ -127,13 +127,13 @@ (lambda (all) ", given ")) (list #rx"; other arguments were:.*" (lambda (all) "")) - (list #px"(?:\n other arguments:(?:\n [^\n]*)*)" + (list #px"(?:\n other arguments[.][.][.]:(?:\n [^\n]*)*)" (lambda (all) "")) (list #rx"expects a (struct:)" (lambda (all one) "expects a ")) (list #rx"list or cyclic list" (lambda (all) "list")) - (list #rx"cannot set variable before its definition\n variable:" + (list #rx"assignment disallowed;\n cannot set variable before its definition\n variable:" (lambda (all) "cannot set variable before its definition:")) ;; When do these show up? I see only `#' errors, currently. (list (regexp-quote "#(struct:object:image% ...)") diff --git a/collects/racket/contract/private/blame.rkt b/collects/racket/contract/private/blame.rkt index b09acae2df..770749d112 100644 --- a/collects/racket/contract/private/blame.rkt +++ b/collects/racket/contract/private/blame.rkt @@ -130,17 +130,6 @@ (loop (cdr strs) new-so-far (regexp-match #rx" $" nxt))]))])) - - -(define (given/produced blame) - (if (blame-original? blame) - "produced" - "given")) - -(define (expected/promised blame) - (if (blame-original? blame) - "expected" - "promised")) (define (default-blame-format blme x custom-message) (define source-message (source-location->string (blame-source blme))) diff --git a/collects/racket/private/kw.rkt b/collects/racket/private/kw.rkt index c74202007b..468d762183 100644 --- a/collects/racket/private/kw.rkt +++ b/collects/racket/private/kw.rkt @@ -359,7 +359,7 @@ (syntax bad))] [else (raise-syntax-error - #f "bad argument sequence" stx (syntax args))])))) + #f "bad argument sequence" stx args)])))) ;; The new `lambda' form: (define-for-syntax (parse-lambda stx local-name non-kw-k kw-k) @@ -871,7 +871,7 @@ (null? (cdr l))) (raise-syntax-error #f - "missing procedure expression; probably originally (), which is an illegal empty application" + "missing procedure expression;\nprobably originally (), which is an illegal empty application" stx) (begin (when l diff --git a/collects/scribblings/reference/exns.scrbl b/collects/scribblings/reference/exns.scrbl index 8e802f0ee5..4f18e27ce8 100644 --- a/collects/scribblings/reference/exns.scrbl +++ b/collects/scribblings/reference/exns.scrbl @@ -21,24 +21,55 @@ particular required arity (e.g., @racket[call-with-input-file], @racket[call/cc]) check the argument's arity immediately, raising @racket[exn:fail:contract] if the arity is incorrect. +@;---------------------------------------------------------------------- +@section{Error Message Conventions} + Racket's @deftech{error message convention} is to produce error messages with the following shape: @racketblock[ - @#,nonterm{name}: @#,nonterm{message} + @#,nonterm{srcloc}: @#,nonterm{name}: @#,nonterm{message}@#,tt{;} + @#,nonterm{continued-message} ... @#,nonterm{field}: @#,nonterm{detail} ... ] -The message starts with a @nonterm{name} that identifies the -complaining function, syntactic form, or other entity. The -@nonterm{message} should be relatively short, and it should be largely -independent of specific values that triggered the error. Specific -values that triggered the error should appear in separate -@nonterm{field} lines, each of which is indented by two spaces. If a -@nonterm{detail} is especially long or takes multiple lines, it should -start on its own line after the @nonterm{field} label, and each of its -lines should be indented by three spaces. +The message starts with an optional source location, @nonterm{srcloc}, +which is followed by a colon and space when present. The message +continues with an optional @nonterm{name} that usually identifies the +complaining function, syntactic form, or other entity, but may also +refer to an entity being complained about; the @nonterm{name} is also +followed by a colon and space when present. + +The @nonterm{message} should be relatively short, and it should be +largely independent of specific values that triggered the error. More +detailed explanation that requires multiple lines should continue with +each line indented by a single space, in which case @nonterm{message} +should end in a semi-colon (but the semi-colon should be omitted if +@nonterm{continued-message} is not present). Message text should be +lowercase---using semi-colons to separate sentences if needed, +although long explanations may be better deferred to extra fields. + +Specific values that triggered the error or other helpful information +should appear in separate @nonterm{field} lines, each of which is +indented by two spaces. If a @nonterm{detail} is especially long or +takes multiple lines, it should start on its own line after the +@nonterm{field} label, and each of its lines should be indented by +three spaces. Field names should be all lowercase. + +A @nonterm{field} name should end with @litchar{...} if the field +provides relatively detailed information that might be distracting in +common cases but useful in others. For example, when a contract +failure is reported for a particular argument of a function, other +arguments to the function might be shown in an ``other arguments...'' +field. The intent is that fields whose names end in @litchar{...} +might be hidden by default in an environment such as DrRacket. + +Make @nonterm{field} names as short as possible, relying on +@nonterm{message} or @nonterm{continued message} text to clarify the +meaning for a field. For example, prefer ``given'' to ``given turtle'' +as a field name, where @nonterm{message} is something like ``given +turtle is too sleepy'' to clarify that ``given'' refers to a turtle. @;------------------------------------------------------------------------ @section[#:tag "errorproc"]{Raising Exceptions} @@ -182,7 +213,9 @@ as a ``result'' instead of an ``argument.''} Creates an @racket[exn:fail:contract] value and @racket[raise]s it as an exception. The @racket[name] is used as the source procedure's name in the error message. The @racket[message] is the error -message. Each @racket[field] must have a corresponding @racket[v], +message; if @racket[message] contains newline characters, each new line is +suitably indented (by adding one extra space at the start). +Each @racket[field] must have a corresponding @racket[v], and the two are rendered on their own line in the error message, with each @racket[v] formatted using the error value conversion handler (see @@ -191,8 +224,8 @@ using the error value conversion handler (see @examples[ (raise-arguments-error 'eat "fish is smaller than its given meal" - "fish size" 12 - "given meal size" 13) + "fish" 12 + "meal" 13) ]} @@ -279,7 +312,9 @@ exception. Macros use this procedure to report syntax errors. The @racket[name] argument is usually @racket[#f] when @racket[expr] is provided; it is described in more detail below. The -@racket[message] is used as the main body of the error message. +@racket[message] is used as the main body of the error message; if +@racket[message] contains newline characters, each new line is +suitably indented (by adding one extra space at the start). The optional @racket[expr] argument is the erroneous source syntax object or S-expression (but the expression @racket[#f] cannot be diff --git a/collects/tests/htdp-lang/intm-adv.rktl b/collects/tests/htdp-lang/intm-adv.rktl index 370903ad29..011e1cc3de 100644 --- a/collects/tests/htdp-lang/intm-adv.rktl +++ b/collects/tests/htdp-lang/intm-adv.rktl @@ -1,7 +1,7 @@ (htdp-err/rt-test (/) "/: expects at least 1 argument, but found none") (htdp-err/rt-test (pi) #px"function call: expected a function after the open parenthesis, but received 3[.]14\\d+$") -(htdp-err/rt-test (pi 1 2) #px"function call: expected a function after the open parenthesis, but received 3[.]14\\d+\n arguments:\n 1\n 2$") +(htdp-err/rt-test (pi 1 2) #px"function call: expected a function after the open parenthesis, but received 3[.]14\\d+$") (htdp-top (define (f x) x)) (htdp-err/rt-test (f 1 2) "f: expects only 1 argument, but found 2") diff --git a/collects/tests/racket/contract-mzlib-test.rktl b/collects/tests/racket/contract-mzlib-test.rktl index 597aeff8c3..7a65e01637 100644 --- a/collects/tests/racket/contract-mzlib-test.rktl +++ b/collects/tests/racket/contract-mzlib-test.rktl @@ -2730,7 +2730,14 @@ of the contract library does not change over time. m 1 2)) - "application: wrong number of arguments\n procedure: m method\n expected number of arguments: 1\n given number of arguments: 2\n arguments:\n 1\n 2") + (string-append + "m method: arity mismatch;\n" + " the expected number of arguments does not match the given number\n" + " expected: 1\n" + " given: 2\n" + " arguments...:\n" + " 1\n" + " 2")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl index 136689018e..4887010d33 100644 --- a/collects/tests/racket/contract-test.rktl +++ b/collects/tests/racket/contract-test.rktl @@ -6469,7 +6469,14 @@ m 1 2)) - "application: wrong number of arguments\n procedure: m method\n expected number of arguments: 1\n given number of arguments: 2\n arguments:\n 1\n 2") + (string-append + "m method: arity mismatch;\n" + " the expected number of arguments does not match the given number\n" + " expected: 1\n" + " given: 2\n" + " arguments...:\n" + " 1\n" + " 2")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/collects/tests/racket/object.rktl b/collects/tests/racket/object.rktl index 933b410a9c..07b74a5c9d 100644 --- a/collects/tests/racket/object.rktl +++ b/collects/tests/racket/object.rktl @@ -1366,8 +1366,8 @@ (eval (syntax-property #'(lambda (a b) a) 'method-arity-error #t)))] [check-arity-error (lambda (f cl?) - (test (if cl? '("given number of arguments: 0") '("expected number of arguments: 1\n")) - regexp-match #rx"expected number of arguments: 1\n|given number of arguments: 0$" + (test (if cl? '("given: 0") '("expected: 1\n")) + regexp-match #rx"expected: 1\n|given: 0$" (exn-message (with-handlers ([values values]) ;; Use `apply' to avoid triggering ;; compilation of f: @@ -1390,8 +1390,8 @@ [meth (procedure->method f)] [check-arity-error (lambda (f cl?) - (test (if cl? '("given number of arguments: 0") '("expected number of arguments: 1\n")) - regexp-match #rx"expected number of arguments: 1\n|given number of arguments: 0$" + (test (if cl? '("given: 0") '("expected: 1\n")) + regexp-match #rx"expected: 1\n|given: 0$" (exn-message (with-handlers ([values values]) ;; Use `apply' to avoid triggering ;; compilation of f: diff --git a/collects/tests/racket/procs.rktl b/collects/tests/racket/procs.rktl index 2ebba3fee5..933b359577 100644 --- a/collects/tests/racket/procs.rktl +++ b/collects/tests/racket/procs.rktl @@ -71,7 +71,7 @@ (let ([a (cadr p)]) (test a procedure-arity (car p)) (when (number? a) - (let ([rx (regexp (format "wrong number of arguments.*expected number of arguments: (|at least )~a" + (let ([rx (regexp (format "arity mismatch;.*expected: (|at least )~a" (if (zero? a) "(0|no)" a)))] [bad-args (cons 'extra (for/list ([i (in-range a)]) 'a))]) (test #t regexp-match? rx diff --git a/collects/tests/racket/sandbox.rktl b/collects/tests/racket/sandbox.rktl index c66aefed3b..1df5cb4c57 100644 --- a/collects/tests/racket/sandbox.rktl +++ b/collects/tests/racket/sandbox.rktl @@ -263,7 +263,7 @@ ;; test source locations too --top-- (make-base-evaluator! 0 1 2 '(define foo)) - =err> "define:.* source:\n program:4:0" + =err> "^program:4:0: define:" ;; empty program for clean repls --top-- @@ -471,7 +471,7 @@ (make-base-evaluator! "(define l null)") --eval-- (cond [null? l 0]) => 0 - (last-pair l) =err> "reference to an identifier" + (last-pair l) =err> "last-pair: undefined" --top-- (make-evaluator! '(special beginner) (make-prog "(define l null)" "(define x 3.5)")) diff --git a/collects/tests/racket/struct.rktl b/collects/tests/racket/struct.rktl index 77cc4144f9..252cb0da53 100644 --- a/collects/tests/racket/struct.rktl +++ b/collects/tests/racket/struct.rktl @@ -239,16 +239,16 @@ (err/rt-test (bad3 1) exn:application:arity?) (err/rt-test (bad11 1) exn:application:arity?) - (test '("procedure: p") regexp-match "procedure: p" + (test '("p") regexp-match "^p" (with-handlers ([exn:fail? exn-message]) (bad1))) - (test '("procedure: q") regexp-match "procedure: q" + (test '("q") regexp-match "^q" (with-handlers ([exn:fail? exn-message]) (bad2))) - (test '("procedure: r") regexp-match "procedure: r" + (test '("r") regexp-match "^r" (with-handlers ([exn:fail? exn-message]) (bad3))) - (test '("procedure: p") regexp-match "procedure: p" + (test '("p") regexp-match "^p" (with-handlers ([exn:fail? exn-message]) (bad11)))) @@ -286,23 +286,23 @@ (test 1-2-value cons3 1 2) (test 1-2-value cons11 1 2) - (test #f not (regexp-match (re "procedure: p") + (test #f not (regexp-match (re "^p") (with-handlers ([exn:fail? exn-message]) (cons1)))) - (test #f not (regexp-match (re "procedure: q") + (test #f not (regexp-match (re "^q") (with-handlers ([exn:fail? exn-message]) (cons2)))) - (test #f not (regexp-match (re "procedure: r") + (test #f not (regexp-match (re "^r") (with-handlers ([exn:fail? exn-message]) (cons3)))) - (test #f not (regexp-match (re "procedure: p") + (test #f not (regexp-match (re "^p") (with-handlers ([exn:fail? exn-message]) (cons11))))) 'done)) - (try-proc-structs 0 0 null (lambda (x) 'cons) (lambda (x) "procedure: cons") '(1 . 2) (current-inspector)) - (try-proc-structs 0 0 null (lambda (x) 'cons) (lambda (x) "procedure: cons") '(1 . 2) t-insp) + (try-proc-structs 0 0 null (lambda (x) 'cons) (lambda (x) "^cons") '(1 . 2) (current-inspector)) + (try-proc-structs 0 0 null (lambda (x) 'cons) (lambda (x) "^cons") '(1 . 2) t-insp) (try-proc-structs (lambda (s a b) (when (and (struct? s) (not (arity-at-least? s))) (error "should be opaque")) diff --git a/src/racket/src/compile.c b/src/racket/src/compile.c index 7de3b59294..fa6c6f1209 100644 --- a/src/racket/src/compile.c +++ b/src/racket/src/compile.c @@ -352,7 +352,7 @@ static int check_form(Scheme_Object *form, Scheme_Object *base_form) } if (!SCHEME_STX_NULLP(form)) { - scheme_wrong_syntax(NULL, form, base_form, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, form, base_form, IMPROPER_LIST_FORM); } return i; @@ -361,7 +361,7 @@ static int check_form(Scheme_Object *form, Scheme_Object *base_form) static void bad_form(Scheme_Object *form, int l) { scheme_wrong_syntax(NULL, NULL, form, - "bad syntax (has %d part%s after keyword)", + "bad syntax;\nhas %d part%s after keyword", l - 1, (l != 2) ? "s" : ""); } @@ -570,7 +570,7 @@ make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code, } if (SCHEME_STX_NULLP(forms)) - scheme_wrong_syntax(NULL, NULL, code, "bad syntax (empty body)"); + scheme_wrong_syntax(NULL, NULL, code, "empty body not allowed"); forms = scheme_datum_to_syntax(forms, code, code, 0, 0); forms = scheme_add_env_renames(forms, frame, env); @@ -709,7 +709,7 @@ void scheme_define_parse(Scheme_Object *form, DupCheckRecord r; if (!no_toplevel_check && !scheme_is_toplevel(env)) - scheme_wrong_syntax(NULL, NULL, form, "illegal use (not at top-level)"); + scheme_wrong_syntax(NULL, NULL, form, "not in a definition context"); len = check_form(form, form); if (len != 3) @@ -845,7 +845,7 @@ quote_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *re rest = SCHEME_STX_CDR(form); if (!(SCHEME_STX_PAIRP(rest) && SCHEME_STX_NULLP(SCHEME_STX_CDR(rest)))) - scheme_wrong_syntax(NULL, NULL, form, "bad syntax (wrong number of parts)"); + scheme_wrong_syntax(NULL, NULL, form, "wrong number of parts"); scheme_compile_rec_done_local(rec, drec); scheme_default_compile_rec(rec, drec); @@ -868,7 +868,7 @@ quote_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec rest = SCHEME_STX_CDR(form); if (!(SCHEME_STX_PAIRP(rest) && SCHEME_STX_NULLP(SCHEME_STX_CDR(rest)))) - scheme_wrong_syntax(NULL, NULL, form, "bad syntax (wrong number of parts)"); + scheme_wrong_syntax(NULL, NULL, form, "wrong number of parts"); return form; } @@ -882,7 +882,7 @@ static void check_if_len(Scheme_Object *form, int len) if (len != 4) { if (len == 3) { scheme_wrong_syntax(NULL, NULL, form, - "bad syntax (must have an \"else\" expression)"); + "missing an \"else\" expression"); } else { bad_form(form, len); } @@ -1512,8 +1512,8 @@ static void case_lambda_check_line(Scheme_Object *line, Scheme_Object *form, Sch lambda_check_args(args, form, env); if (!SCHEME_STX_PAIRP(body)) - scheme_wrong_syntax(NULL, line, form, "bad syntax (%s)", - SCHEME_STX_NULLP(body) ? "empty body" : IMPROPER_LIST_FORM); + scheme_wrong_syntax(NULL, line, form, "%s", + SCHEME_STX_NULLP(body) ? "empty body not allowed" : IMPROPER_LIST_FORM); } static Scheme_Object * @@ -2093,7 +2093,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, i = scheme_stx_proper_list_length(form); if (i < 3) - scheme_wrong_syntax(NULL, NULL, form, (!i ? "bad syntax (empty body)" : NULL)); + scheme_wrong_syntax(NULL, NULL, form, (!i ? "empty body not allowed" : NULL)); bindings = SCHEME_STX_CDR(form); bindings = SCHEME_STX_CAR(bindings); @@ -2457,7 +2457,7 @@ do_let_expand(Scheme_Object *orig_form, Scheme_Comp_Env *origenv, Scheme_Expand_ if (!SCHEME_STX_PAIRP(body)) scheme_wrong_syntax(NULL, NULL, form, (SCHEME_STX_NULLP(body) - ? "bad syntax (empty body)" + ? "empty body not allowed" : NULL)); boundname = scheme_check_name_property(form, erec[drec].value_name); @@ -2787,7 +2787,7 @@ Scheme_Object *scheme_compile_sequence(Scheme_Object *forms, if (scheme_stx_proper_list_length(forms) < 0) { scheme_wrong_syntax(scheme_begin_stx_string, NULL, scheme_datum_to_syntax(cons(begin_symbol, forms), forms, forms, 0, 0), - "bad syntax (" IMPROPER_LIST_FORM ")"); + IMPROPER_LIST_FORM); return NULL; } else { Scheme_Object *body; @@ -2815,7 +2815,7 @@ do_begin_syntax(char *name, if (SCHEME_STX_NULLP(forms)) { if (!zero && scheme_is_toplevel(env)) return scheme_compiled_void(); - scheme_wrong_syntax(NULL, NULL, form, "bad syntax (empty form)"); + scheme_wrong_syntax(NULL, NULL, form, "empty form not allowed"); return NULL; } @@ -3036,7 +3036,7 @@ do_begin_expand(char *name, SCHEME_EXPAND_OBSERVE_EXIT_LIST(erec[drec].observer, form); return orig_form; } - scheme_wrong_syntax(NULL, NULL, form, "bad syntax (empty form)"); + scheme_wrong_syntax(NULL, NULL, form, "empty form not allowed"); return NULL; } @@ -3139,7 +3139,7 @@ static Scheme_Object *check_single(Scheme_Object *form, Scheme_Comp_Env *top_onl rest = SCHEME_STX_CDR(form); if (!(SCHEME_STX_PAIRP(rest) && SCHEME_STX_NULLP(SCHEME_STX_CDR(rest)))) - scheme_wrong_syntax(NULL, NULL, form, "bad syntax (wrong number of parts)"); + scheme_wrong_syntax(NULL, NULL, form, "wrong number of parts"); if (top_only && !scheme_is_toplevel(top_only)) scheme_wrong_syntax(NULL, NULL, form, "illegal use (not at top-level)"); @@ -3364,7 +3364,7 @@ begin_for_syntax_expand(Scheme_Object *orig_form, Scheme_Comp_Env *in_env, Schem form = orig_form; if (!scheme_is_toplevel(in_env)) - scheme_wrong_syntax(NULL, NULL, form, "illegal use (not at top-level)"); + scheme_wrong_syntax(NULL, NULL, form, "not in a definition context"); (void)check_form(form, form); @@ -3694,11 +3694,11 @@ do_letrec_syntaxes(const char *where, rhs_env = stx_env; if (!SCHEME_STX_NULLP(bindings) && !SCHEME_STX_PAIRP(bindings)) { - scheme_wrong_syntax(NULL, bindings, forms, "bad syntax (not a binding sequence)"); + scheme_wrong_syntax(NULL, bindings, forms, "not a binding sequence"); } else check_form(bindings, forms); if (!SCHEME_STX_NULLP(var_bindings) && !SCHEME_STX_PAIRP(var_bindings)) { - scheme_wrong_syntax(NULL, var_bindings, forms, "bad syntax (not a binding sequence)"); + scheme_wrong_syntax(NULL, var_bindings, forms, "not a binding sequence"); } else check_form(var_bindings, forms); @@ -3743,7 +3743,7 @@ do_letrec_syntaxes(const char *where, if (!v) scheme_wrong_syntax(NULL, a, forms, - "bad syntax (binding clause not an identifier sequence and expression)"); + "binding clause not an identifier sequence and expression"); for (l = SCHEME_STX_CAR(a); SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) { a = SCHEME_STX_CAR(l); @@ -4813,14 +4813,14 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, if (has_orig_unbound) { scheme_wrong_syntax(scheme_compile_stx_string, orig_unbound_name, form, - "unbound identifier%s " - "(and no %S syntax transformer is bound)", + "unbound identifier%s;\n" + "also, no %S syntax transformer is bound", phase, SCHEME_STX_VAL(stx)); } else { scheme_wrong_syntax(scheme_compile_stx_string, NULL, form, - "bad syntax; %s is not allowed, " - "because no %S syntax transformer is bound%s", + "%s is not allowed;\n" + "no %S syntax transformer is bound%s", not_allowed, SCHEME_STX_VAL(stx), phase); @@ -5580,7 +5580,7 @@ compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, /* FIXME: Redundant with check done by scheme_flatten_begin below? */ if (scheme_stx_proper_list_length(first) < 0) scheme_wrong_syntax(scheme_begin_stx_string, NULL, first, - "bad syntax (" IMPROPER_LIST_FORM ")"); + IMPROPER_LIST_FORM); forms = SCHEME_STX_CDR(forms); @@ -5600,7 +5600,7 @@ compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, if (SCHEME_STX_NULLP(forms)) { if (!SCHEME_PAIRP(pre_exprs)) { scheme_wrong_syntax(scheme_begin_stx_string, NULL, first, - "bad syntax (empty form)"); + "empty form is not allowed"); return NULL; } else { /* fall through to handle expressions without definitions */ @@ -5669,7 +5669,7 @@ compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, if (!SCHEME_STX_PAIRP(v)) scheme_wrong_syntax(NULL, NULL, first, - "bad syntax (" IMPROPER_LIST_FORM ")"); + IMPROPER_LIST_FORM); var = NULL; vars = SCHEME_STX_CAR(v); @@ -5728,15 +5728,15 @@ compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, if (!SCHEME_STX_PAIRP(expr)) { if (SCHEME_STX_NULLP(expr)) scheme_wrong_syntax(NULL, NULL, first, - "bad syntax (missing expression)"); + "missing expression"); else scheme_wrong_syntax(NULL, NULL, first, - "bad syntax (" IMPROPER_LIST_FORM ")"); + IMPROPER_LIST_FORM); } link = SCHEME_STX_CDR(expr); if (!SCHEME_STX_NULLP(link)) { scheme_wrong_syntax(NULL, NULL, first, - "bad syntax (extra data after expression)"); + "extra data after expression"); } expr = SCHEME_STX_CAR(expr); @@ -5988,7 +5988,7 @@ scheme_expand_list(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info if (scheme_stx_proper_list_length(form) < 0) { /* This is already checked for anything but application */ scheme_wrong_syntax(scheme_application_stx_string, NULL, form, - "bad syntax (" IMPROPER_LIST_FORM ")"); + IMPROPER_LIST_FORM); } fm = form; @@ -6027,7 +6027,7 @@ scheme_flatten_begin(Scheme_Object *expr, Scheme_Object *append_onto) Scheme_Object *l, *ll, *a, *name, *body; if (scheme_stx_proper_list_length(expr) < 0) - scheme_wrong_syntax(NULL, NULL, expr, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, NULL, expr, IMPROPER_LIST_FORM); name = SCHEME_STX_CAR(expr); body = SCHEME_STX_CDR(expr); diff --git a/src/racket/src/dynext.c b/src/racket/src/dynext.c index 0b501b377b..d5891d5906 100644 --- a/src/racket/src/dynext.c +++ b/src/racket/src/dynext.c @@ -118,6 +118,8 @@ THREAD_LOCAL_DECL(static Scheme_Hash_Table *fullpath_loaded_extensions;) /* hash /* For precise GC, make a proc ptr look like a fixnum: */ #define mzPROC_TO_HASH_OBJ(f) ((Scheme_Object *)(((intptr_t)f) | 0x1)) +#define BAD_VERSION_STR "found version does not match the expected version" + void scheme_init_dynamic_extension(Scheme_Env *env) { if (scheme_starting_up) { @@ -261,9 +263,9 @@ static Scheme_Object *do_load_extension(const char *filename, vers = copy_vers(vers); dlclose(dl); scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION, - "load-extension: bad version\n" - " found version: %s\n" - " expected version: %s\n" + "load-extension: " BAD_VERSION_STR "\n" + " found: %s\n" + " expected: %s\n" " path: %s", vers, VERSION_AND_VARIANT, filename); } @@ -328,9 +330,9 @@ static Scheme_Object *do_load_extension(const char *filename, vers = copy_vers(vers); FreeLibrary(dl); scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION, - "load-extension: bad version\n" - " found version: %s\n" - " expected version: %s\n" + "load-extension: " BAD_VERSION_STR "\n" + " found: %s\n" + " expected: %s\n" " path: %s", vers, VERSION_AND_VARIANT, filename); } @@ -377,9 +379,9 @@ static Scheme_Object *do_load_extension(const char *filename, if (!vers || strcmp(vers, VERSION_AND_VARIANT)) scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION, - "load-extension: bad version\n" - " found version: %s\n" - " expected version: %s\n" + "load-extension: " BAD_VERSION "\n" + " found: %s\n" + " expected: %s\n" " path: %s", vers, VERSION_AND_VARIANT, filename); @@ -418,7 +420,7 @@ static Scheme_Object *do_load_extension(const char *filename, #endif #ifdef NO_DYNAMIC_LOAD scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "load-extension: not supported on this platform"); + "load-extension: " NOT_SUPPORTED_STR); return NULL; #else diff --git a/src/racket/src/env.c b/src/racket/src/env.c index b59d62249d..8e691bba74 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -1603,7 +1603,8 @@ namespace_variable_value(int argc, Scheme_Object *argv[]) return NULL; } else { scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, argv[0], - "namespace-variable-value: is not defined\n name: %S", + "namespace-variable-value: given name is not defined\n" + " name: %S", argv[0]); return NULL; } @@ -1664,7 +1665,8 @@ namespace_undefine_variable(int argc, Scheme_Object *argv[]) bucket->val = NULL; } else { scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, argv[0], - "namespace-undefine-variable!: not defined\n name: %S", + "namespace-undefine-variable!: given name is not defined\n" + " name: %S", argv[0]); } diff --git a/src/racket/src/error.c b/src/racket/src/error.c index 0ab1ec52e3..bc53d076c9 100644 --- a/src/racket/src/error.c +++ b/src/racket/src/error.c @@ -1035,14 +1035,14 @@ static Scheme_Object *check_arity_property_value_ok(int argc, Scheme_Object *arg return argv[0]; } -#define WRONG_NUMBER_OF_ARGUMENTS "application: wrong number of arguments" +#define WRONG_NUMBER_OF_ARGUMENTS "arity mismatch;\n the expected number of arguments does not match the given number" static char *make_arity_expect_string(const char *name, int namelen, int minc, int maxc, int argc, Scheme_Object **argv, intptr_t *_len, int is_method) /* minc == -1 => name is really a case-lambda, native closure, or proc-struct. - minc == -2 => use generic "no matching clause" message */ + minc == -2 => use generic arity-mismatch message */ { intptr_t len, pos, slen; int xargc, xminc, xmaxc; @@ -1115,10 +1115,9 @@ static char *make_arity_expect_string(const char *name, int namelen, if (arity_str) { pos = scheme_sprintf(s, slen, - WRONG_NUMBER_OF_ARGUMENTS "\n" - " procedure: %t\n" - " expected number of arguments: %t\n" - " given number of arguments: %d", + "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n" + " expected: %t\n" + " given: %d", name, (intptr_t)namelen, arity_str, (intptr_t)arity_len, xargc); } else if (minc < 0) { const char *n; @@ -1136,38 +1135,33 @@ static char *make_arity_expect_string(const char *name, int namelen, } pos = scheme_sprintf(s, slen, - "application: no clause matching given number of arguments\n" - " procedure: %t\n" - " given number of arguments: %d", + "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n" + " given: %d", n, (intptr_t)nlen, xargc); } else if (!maxc) pos = scheme_sprintf(s, slen, - WRONG_NUMBER_OF_ARGUMENTS "\n" - " procedure: %t\n" - " expected number of arguments: 0\n" - " given number of arguments: %d", + "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n" + " expected: 0\n" + " given: %d", name, (intptr_t)namelen, xargc); else if (maxc < 0) pos = scheme_sprintf(s, slen, - WRONG_NUMBER_OF_ARGUMENTS "\n" - " procedure: %t\n" - " expected number of arguments: at least %d\n" - " given number of arguments: %d", + "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n" + " expected: at least %d\n" + " given: %d", name, (intptr_t)namelen, xminc, xargc); else if (minc == maxc) pos = scheme_sprintf(s, slen, - WRONG_NUMBER_OF_ARGUMENTS "\n" - " procedure: %t\n" - " expected number of arguments: %d\n" - " given number of arguments: %d", + "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n" + " expected: %d\n" + " given: %d", name, (intptr_t)namelen, xminc, xargc); else pos = scheme_sprintf(s, slen, - WRONG_NUMBER_OF_ARGUMENTS "\n" - " procedure: %t\n" + "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n" " expected: %d to %d\n" - " given number of arguments: %d", + " given: %d", name, (intptr_t)namelen, xminc, xmaxc, xargc); if (xargc && argv) { @@ -1180,8 +1174,8 @@ static char *make_arity_expect_string(const char *name, int namelen, intptr_t l; char *o; if (i == (is_method ? 1 : 0)) { - strcpy(s + pos, "\n arguments:\n "); - pos += 17; + strcpy(s + pos, "\n arguments...:\n "); + pos += 20; } else { strcpy(s + pos, "\n "); pos += 4; @@ -1549,12 +1543,16 @@ void scheme_wrong_type(const char *name, const char *expected, } } -static const char *indent_lines(const char *s) +static const char *indent_lines(const char *s, intptr_t *_len, int initial_indent, int amt) { intptr_t len, i, j, lines = 1; + int a; char *s2; - len = strlen(s); + if (_len) + len = *_len; + else + len = strlen(s); for (i = 0; i < len; i++) { if (s[i] == '\n') @@ -1562,20 +1560,30 @@ static const char *indent_lines(const char *s) } if ((len > 72) || (lines > 1)) { - s2 = scheme_malloc_atomic(len + (lines * 4) + 1); + s2 = scheme_malloc_atomic(len + (lines * (amt + 1)) + 1); + + if (initial_indent) { + s2[0] = '\n'; + j = 1; + for (a = 0; a < amt; a++) { + s2[j++] = ' '; + } + } else + j = 0; - memcpy(s2, "\n ", 4); - j = 4; for (i = 0; i < len; i++) { s2[j++] = s[i]; if (s[i] == '\n') { - s2[j++] = ' '; - s2[j++] = ' '; - s2[j++] = ' '; + for (a = 0; a < amt; a++) { + s2[j++] = ' '; + } } } s2[j] = 0; + if (_len) + *_len = j; + return s2; } @@ -1590,17 +1598,21 @@ void scheme_wrong_contract(const char *name, const char *expected, char *s; intptr_t slen; int isres = 0; - GC_CAN_IGNORE char *isgiven = "given"; + GC_CAN_IGNORE char *isgiven = "given", *kind = "argument"; o = argv[which < 0 ? 0 : which]; if (argc < 0) { argc = -argc; isgiven = "received"; + kind = "result"; isres = 1; } if (which == -2) { isgiven = "received"; + kind = "result"; } + if (argc == 0) + kind = "value"; s = scheme_make_provided_string(o, 1, &slen); @@ -1609,8 +1621,8 @@ void scheme_wrong_contract(const char *name, const char *expected, "%s: contract violation\n" " expected: %s\n" " %s: %t", - name, - indent_lines(expected), + name, + indent_lines(expected, NULL, 1, 3), isgiven, s, slen); else { char *other; @@ -1622,12 +1634,12 @@ void scheme_wrong_contract(const char *name, const char *expected, "%s: contract violation\n" " expected: %s\n" " %s: %t\n" - " argument position: %d%s\n" - " other %s:%s", + " %s position: %d%s\n" + " other %s...:%s", name, - indent_lines(expected), + indent_lines(expected, NULL, 1, 3), isgiven, s, slen, - which + 1, scheme_number_suffix(which + 1), + kind, which + 1, scheme_number_suffix(which + 1), (!isres ? "arguments" : "results"), other, olen); } } @@ -1757,8 +1769,8 @@ void scheme_contract_error(const char *name, const char *msg, ...) { GC_CAN_IGNORE va_list args; int i, cnt = 0, kind; - intptr_t len = 0, nlen, mlen; - const char *strs[MAX_MISMATCH_EXTRAS], *str; + intptr_t len = 0, nlen, mlen, seplen; + const char *strs[MAX_MISMATCH_EXTRAS], *str, *sep; Scheme_Object *vs[MAX_MISMATCH_EXTRAS], *v; const char *v_strs[MAX_MISMATCH_EXTRAS], *v_str; intptr_t v_str_lens[MAX_MISMATCH_EXTRAS], v_str_len; @@ -1792,17 +1804,22 @@ void scheme_contract_error(const char *name, const char *msg, ...) len += v_str_len + 5 + strlen(strs[i]); } + sep = ": "; + mlen = strlen(msg); nlen = strlen(name); + seplen = strlen(sep); - len += mlen + nlen + 10; + msg = indent_lines(msg, &mlen, 0, 1); + + len += mlen + nlen + seplen + 10; s = scheme_malloc_atomic(len); len = 0; memcpy(s, name, nlen); len += nlen; - memcpy(s + len, ": ", 2); - len += 2; + memcpy(s + len, sep, seplen); + len += seplen; memcpy(s + len, msg, mlen); len += mlen; for (i = 0; i < cnt; i++) { @@ -1827,13 +1844,15 @@ void scheme_wrong_chaperoned(const char *who, const char *what, Scheme_Object *o { char buf[128]; - sprintf(buf, "chaperone produced a %s that is not a chaperone of the original %s", + sprintf(buf, + "non-chaperone result;\n" + "received a %s that is not a chaperone of the original %s", what, what); scheme_contract_error(who, buf, "original", 1, orig, - "chaperoned", 1, naya, + "received", 1, naya, NULL); } @@ -1990,11 +2009,12 @@ void scheme_read_err(Scheme_Object *port, ? MZEXN_FAIL_READ_NON_CHAR : MZEXN_FAIL_READ)), scheme_make_pair(loc, scheme_null), - "%t%s%s%s%t%s", + "%t%s%t%s%s%s", + fn, fnlen, + fnlen ? ": " : "", s, slen, (*suggests ? "\n possible cause: " : ""), suggests, - fnlen ? "\n source:\n " : "", - fn, fnlen, ls); + ls); } static void do_wrong_syntax(const char *where, @@ -2023,7 +2043,7 @@ static void do_wrong_syntax(const char *where, good name: */ if ((where == scheme_compile_stx_string) || (where == scheme_expand_stx_string)) { - who = nomwho = scheme_false; + where = NULL; } else if (where == scheme_application_stx_string) { who = scheme_intern_symbol("#%app"); nomwho = who; @@ -2132,29 +2152,34 @@ static void do_wrong_syntax(const char *where, else where = scheme_symbol_val(who); } + + s = (char *)indent_lines(s, &slen, 0, 1); if (v) { if (dv) blen = scheme_sprintf(buffer, blen, - "%s: %t\n" + "%t%s%s: %t\n" " at: %t\n" - " in: %t" - "%s%t", - where, s, slen, + " in: %t", + p, plen, + p ? ": " : "", + where, + s, slen, dv, dvlen, - v, vlen, - plen ? "\n source:\n " : "", - p, plen); + v, vlen); else - blen = scheme_sprintf(buffer, blen, "%s: %t\n" - " in: %t" - "%s%t", - where, s, slen, - v, vlen, - plen ? "\n source:\n " : "", - p, plen); + blen = scheme_sprintf(buffer, blen, + "%t%s%s: %t\n" + " in: %t", + p, plen, + p ? ": " : "", + where, + s, slen, + v, vlen); } else - blen = scheme_sprintf(buffer, blen, "%s: %t", where, s, slen); + blen = scheme_sprintf(buffer, blen, "%s: %t", + where, + s, slen); /* We don't actually use nomwho and mod, anymore. */ @@ -2242,9 +2267,10 @@ void scheme_wrong_rator(Scheme_Object *rator, int argc, Scheme_Object **argv) s = scheme_make_arg_lines_string(" ", -1, argc, argv, &slen); scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "application: expected procedure\n" + "application: not a procedure;\n" + " expected a procedure that can be applied to arguments\n" " given: %t\n" - " arguments:%t", + " arguments...:%t", r, rlen, s, slen); } @@ -2279,57 +2305,25 @@ void scheme_wrong_return_arity(const char *where, v = ""; vlen = 0; } else { - int i; - intptr_t len, origlen, maxpos; Scheme_Object **array; - v = init_buf(&len, NULL); - v[0] = ':'; - v[1] = 0; - array = ((got == 1) ? (Scheme_Object **) mzALIAS &argv : argv); - origlen = len; - len /= got; - - maxpos = got; - if (len < 3) { - maxpos = origlen / 4; - len = 3; - } - - vlen = 1; - for (i = 0; i < maxpos; i++) { - char *o; - intptr_t olen; - - o = error_write_to_string_w_max(array[i], len, &olen); - memcpy(v + vlen, " ", 1); - memcpy(v + vlen + 1, o, olen); - vlen += 1 + olen; - } - - if (maxpos != got) { - strcpy(v + vlen, " ..."); - vlen += 4; - } - v[vlen] = 0; + v = scheme_make_arg_lines_string(" ", -1, got, array, &vlen); } blen = scheme_sprintf(buffer, blen, - "%s%scontext%s%t%s expected %d value%s," - " received %d value%s%t", + "%s%sresult arity mismatch;\n" + " expected number of values not received\n" + " expected: %d\n" + " received: %d" "%t\n" + " values...:%t", where ? where : "", where ? ": " : "", - s ? " (" : "", - s ? s : "", - slen, - s ? ")" : "", expected, - (expected == 1) ? "" : "s", got, - (got == 1) ? "" : "s", + s, slen, v, vlen); scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, @@ -2380,12 +2374,12 @@ void scheme_unbound_global(Scheme_Bucket *b) char *phase, phase_buf[20], *phase_note = ""; if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))) - errmsg = ("reference to an identifier before its definition\n" - " identifier: %S\n" + errmsg = ("%S: undefined;\n" + " cannot reference an identifier before its definition\n" " in module: %D%s%s"); else - errmsg = ("reference to an identifier before its definition\n" - " identifier: %S%_%s%s"); + errmsg = ("%S: undefined;\n" + " cannot reference an identifier before its definition%_%s%s"); if (home->phase) { sprintf(phase_buf, "\n phase: %" PRIdPTR "", home->phase); @@ -2410,8 +2404,8 @@ void scheme_unbound_global(Scheme_Bucket *b) } else { scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, name, - "reference to undefined identifier\n" - " identifier: %S", + "%S: undefined;\n" + " cannot reference undefined identifier", name); } } @@ -2686,7 +2680,9 @@ static Scheme_Object *raise_result_error(int argc, Scheme_Object *argv[]) static Scheme_Object *do_raise_mismatch_error(const char *who, int mismatch, int argc, Scheme_Object *argv[]) { Scheme_Object *s; - int i; + int i; + char *s2; + intptr_t l2; if (!SCHEME_SYMBOLP(argv[0])) scheme_wrong_contract(who, "symbol?", 0, argc, argv); @@ -2735,6 +2731,11 @@ static Scheme_Object *do_raise_mismatch_error(const char *who, int mismatch, int s = scheme_char_string_to_byte_string(argv[i+offset]); st = SCHEME_BYTE_STR_VAL(s); slen = SCHEME_BYTE_STRLEN_VAL(s); + if (i == 1) { + intptr_t fl = slen; + st = (char *)indent_lines(st, &fl, 0, 1); + slen = fl; + } if (!mismatch) total += 5; } else { @@ -2763,12 +2764,19 @@ static Scheme_Object *do_raise_mismatch_error(const char *who, int mismatch, int st[total] = 0; s = scheme_char_string_to_byte_string(argv[1]); + if (mismatch) { + s2 = ""; + l2 = 0; + } else { + s2 = SCHEME_BYTE_STR_VAL(s); + l2 = SCHEME_BYTE_STRLEN_VAL(s); + s2 = (char *)indent_lines(s2, &l2, 0, 1); + } scheme_raise_exn(MZEXN_FAIL_CONTRACT, "%s: %t%t", scheme_symbol_val(argv[0]), - mismatch ? "" : SCHEME_BYTE_STR_VAL(s), - mismatch ? 0 : SCHEME_BYTE_STRLEN_VAL(s), + s2, l2, st, total); } @@ -2987,7 +2995,7 @@ def_error_display_proc(int argc, Scheme_Object *argv[]) if (max_cnt == orig_max_cnt) { /* Starting label: */ - scheme_write_byte_string("\n context:\n", 12, port); + scheme_write_byte_string("\n context...:\n", 15, port); } else scheme_write_byte_string("\n", 1, port); diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index f48dd9cc02..db3183b4e7 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -1738,6 +1738,8 @@ void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Obj /* evaluation of various forms */ /*========================================================================*/ +#define CANNOT_SET_ERROR_STR "assignment disallowed" + void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val, int set_undef) { @@ -1754,11 +1756,13 @@ void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val, int is_set; if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))) - msg = ("%s: cannot %s\n" + msg = ("%s: " CANNOT_SET_ERROR_STR ";\n" + " cannot %s\n" " %s: %S\n" " in module: %D"); else - msg = ("%s: cannot %s\n" + msg = ("%s: " CANNOT_SET_ERROR_STR ";\n" + " cannot %s\n" " %s: %S"); is_set = !strcmp(who, "set!"); @@ -1782,7 +1786,8 @@ void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val, home->module->modsrc); } else { scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, b->key, - "%s: cannot %s\n" + "%s: " CANNOT_SET_ERROR_STR ";\n" + " cannot %s\n" " %s: %S", who, (val @@ -1945,9 +1950,9 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro, i, g, (g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array, "%s%s%s", - show_any ? "defining \"" : "0 names", + show_any ? "\n defining: " : "0 names", symname, - show_any ? ((i == 1) ? "\"" : "\", ...") : ""); + show_any ? ((i == 1) ? "" : " ...") : ""); } return NULL; diff --git a/src/racket/src/file.c b/src/racket/src/file.c index 5638cbdb37..2bab5394ca 100644 --- a/src/racket/src/file.c +++ b/src/racket/src/file.c @@ -2764,7 +2764,7 @@ static Scheme_Object *do_build_path(int argc, Scheme_Object **argv, int idelta, scheme_raise_exn(MZEXN_FAIL_CONTRACT, "%s: path element is an empty string\n" " argument position: %d%s\n" - " other arguments:%t", + " other arguments...:%t", who, i + 1, scheme_number_suffix(i + 1), @@ -4755,7 +4755,7 @@ static Scheme_Object *current_drive(int argc, Scheme_Object *argv[]) return scheme_make_sized_path(drive, strlen(drive), 0); #else - scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "current-drive: not supported"); + scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "current-drive: " NOT_SUPPORTED_STR); return NULL; #endif } @@ -5365,8 +5365,8 @@ static Scheme_Object *make_link(int argc, Scheme_Object *argv[]) #if defined(DOS_FILE_SYSTEM) scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "make-file-or-directory-link: link creation not supported on this platform; " - "cannot create link\n" + "make-file-or-directory-link: " NOT_SUPPORTED_STR ";\n" + " cannot create link\n" " path: %Q", argv[1]); #else @@ -5689,7 +5689,7 @@ static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[]) || ((new_bits & MZ_UNC_WRITE) != ((new_bits & (MZ_UNC_WRITE << 6)) >> 6)) || (new_bits >= (1 << 9))) scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, - "file-or-directory-permissions: update of failed:" + "file-or-directory-permissions: update failed due to" " unsupported bit combination\n" " path: %c\n" " permission value: %d", diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index e67928bec1..bc2886e7aa 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -1785,8 +1785,8 @@ scheme_apply_macro(Scheme_Object *name, Scheme_Env *menv, if (!SCHEME_STXP(code)) { scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%S: return value from syntax expander was not syntax\n" - " return value: %V", + "%S: received value from syntax expander was not syntax\n" + " received: %V", SCHEME_STX_SYM(name), code); } @@ -3273,10 +3273,12 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object } } else { scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, - "procedure %s: incorrect number of results from wrapper\n" + "procedure %s: arity mismatch;\n" + " expected number of results not received from wrapper on the orignal\n" + " procedure's arguments\n" " wrapper: %V\n" - " expected number of results: %d or %d\n" - " received number of results: %d", + " expected: %d or %d\n" + " received: %d", what, SCHEME_CAR(px->redirects), argc, argc + 1, @@ -3328,10 +3330,11 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object /* First element is a filter for the result(s) */ if (!SCHEME_PROCP(post)) scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "procedure %s: wrapper's first result is not a procedure\n" + "procedure %s: wrapper's first result is not a procedure;\n" + " extra result compared to original argument count should be\n" + " a wrapper for the original procedure's result\n" " wrapper: %V\n" - " received first result: %V\n" - " explanation: extra result compared to original argument count should be a result wrapper", + " received: %V", what, what, SCHEME_CAR(px->redirects), @@ -3383,10 +3386,11 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object if (!scheme_check_proc_arity(NULL, c, 0, -1, &post)) scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "procedure-result chaperone: wrapper does not accept the number" - " of values produced by the chaperoned procedure\n" + "procedure-result chaperone: arity mismatch;\n" + " wrapper does not accept the number of values produced by\n" + " the original procedure\n" " wrapper: %V\n" - " number of values produced by procedure: %d", + " number of values: %d", post, c); @@ -3423,13 +3427,15 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object } } else { scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, - "procedure-result %s: wrapper returned wrong number of values\n" + "procedure-result %s: result arity mismatch;\n" + " expected number of values not received from wrapper on the original\n" + " procedure's result\n" " wrapper: %V\n" - " number of returned values: %d\n" - " expected number of returned values: %d", + " expected: %d\n" + " received: %d", what, post, - argc, c); + c, argc); return NULL; } @@ -8261,9 +8267,9 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *), return jump_to_alt_continuation(); } scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, - "jump to escape continuation in progress," - " but the target is not in the current continuation" - " after a `dynamic-wind' post-thunk return"); + "continuation application: lost target;\n" + " jump to escape continuation in progress, and the target is not in the\n" + " current continuation after a `dynamic-wind' post-thunk return"); return NULL; } } diff --git a/src/racket/src/list.c b/src/racket/src/list.c index d7a62efca7..f0ce69936d 100644 --- a/src/racket/src/list.c +++ b/src/racket/src/list.c @@ -2997,8 +2997,8 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem red = o; if (!scheme_check_proc_arity(NULL, 3, 1, 2, vals)) scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: chaperone produced invalid second value\n" - " expected matching: (procedure-arity-includes/c 2)\n" + "%s: chaperone produced a second value that does not match the expected contract\n" + " expected: (procedure-arity-includes/c 2)\n" " received: %V", who, red); diff --git a/src/racket/src/module.c b/src/racket/src/module.c index d62b75e492..a73802f4ce 100644 --- a/src/racket/src/module.c +++ b/src/racket/src/module.c @@ -4311,8 +4311,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object } scheme_wrong_syntax("link", stx, symbol, - "module mismatch\n" - " possible explanation: bytecode file needs re-compile because dependencies changed\n" + "module mismatch;\n" + " possibly, bytecode file needs re-compile because dependencies changed\n" "%s%t%s" " exporting module: %D\n" " exporting phase level: %d\n" @@ -6539,7 +6539,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, } if (!scheme_is_toplevel(env)) - scheme_wrong_syntax(NULL, NULL, form, "illegal use (not at top-level)"); + scheme_wrong_syntax(NULL, NULL, form, "not in a module-definition context"); fm = SCHEME_STX_CDR(form); if (!SCHEME_STX_PAIRP(fm)) @@ -7404,7 +7404,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env scheme_wrong_syntax(NULL, NULL, form, "illegal use (not a module body)"); if (scheme_stx_proper_list_length(form) < 0) - scheme_wrong_syntax(NULL, NULL, form, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, NULL, form, IMPROPER_LIST_FORM); if (!env->genv->module) scheme_wrong_syntax(NULL, NULL, form, "not currently transforming a module"); @@ -10109,7 +10109,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, Scheme_Object *phase; if (scheme_stx_proper_list_length(e) < 0) - scheme_wrong_syntax(NULL, e, form, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, e, form, IMPROPER_LIST_FORM); for (l = SCHEME_STX_CDR(e); !SCHEME_STX_NULLP(l); l = SCHEME_STX_CDR(l)) { Scheme_Object *a, *midx, *name, *av; @@ -10125,7 +10125,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, av = NULL; if (SAME_OBJ(protect_symbol, av)) { if (protect_cnt) - scheme_wrong_syntax(NULL, a, e, "bad syntax (nested protect)"); + scheme_wrong_syntax(NULL, a, e, "nested `protect' not allowed"); protect_stx = a; a = SCHEME_STX_CDR(a); a = scheme_flatten_syntax_list(a, NULL); @@ -10147,10 +10147,10 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, if (mode_cnt) scheme_wrong_syntax(NULL, a, e, (SAME_OBJ(av, for_syntax_symbol) - ? "bad syntax (nested `for-syntax')" + ? "nested `for-syntax' not allowed" : (SAME_OBJ(av, for_label_symbol) - ? "bad syntax (nested `for-label')" - : "bad syntax (nested `for-meta')"))); + ? "nested `for-label' not allowed" + : "nested `for-meta' not allowed"))); mode_stx = a; a = SCHEME_STX_CDR(a); @@ -10217,9 +10217,9 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, p = SCHEME_STX_CAR(rest); rest = SCHEME_STX_CDR(rest); if (!SCHEME_STX_NULLP(rest)) - scheme_wrong_syntax(NULL, a, e, "bad syntax (extra forms after one to expand)"); + scheme_wrong_syntax(NULL, a, e, "extra forms after one to expand"); } else { - scheme_wrong_syntax(NULL, a, e, "bad syntax (missing form to expand)"); + scheme_wrong_syntax(NULL, a, e, "missing form to expand"); return; } @@ -10269,12 +10269,12 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, rest = SCHEME_STX_CDR(rest); enm = SCHEME_STX_CAR(rest); if (!SCHEME_STX_SYMBOLP(inm)) - scheme_wrong_syntax(NULL, a, e, "bad syntax (internal name is not an identifier)"); + scheme_wrong_syntax(NULL, a, e, "internal name is not an identifier"); if (!SCHEME_STX_SYMBOLP(enm)) - scheme_wrong_syntax(NULL, a, e, "bad syntax (external name is not an identifier)"); + scheme_wrong_syntax(NULL, a, e, "external name is not an identifier"); rest = SCHEME_STX_CDR(rest); if (!SCHEME_STX_NULLP(rest)) - scheme_wrong_syntax(NULL, a, e, "bad syntax (data following external name)"); + scheme_wrong_syntax(NULL, a, e, "data following external name"); enm = SCHEME_STX_VAL(enm); @@ -10286,11 +10286,11 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, Scheme_Object *reprovided; if (protect_cnt) - scheme_wrong_syntax(NULL, a, e, "bad syntax (not allowed as protected)"); + scheme_wrong_syntax(NULL, a, e, "not allowed as protected"); if (!SCHEME_STX_PAIRP(rest)) scheme_wrong_syntax(NULL, a, e, "bad syntax"); if (!SCHEME_STX_NULLP(SCHEME_STX_CDR(rest))) - scheme_wrong_syntax(NULL, a, e, "bad syntax (data following `all-from')"); + scheme_wrong_syntax(NULL, a, e, "data following `all-from'"); midx = SCHEME_STX_CAR(rest); midx = scheme_make_modidx(scheme_syntax_to_datum(midx, 0, NULL), @@ -10312,14 +10312,14 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, int len; if (protect_cnt) - scheme_wrong_syntax(NULL, a, e, "bad syntax (not allowed as protected)"); + scheme_wrong_syntax(NULL, a, e, "not allowed as protected"); len = scheme_stx_proper_list_length(a); if (len < 0) - scheme_wrong_syntax(NULL, a, e, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, a, e, IMPROPER_LIST_FORM); else if (len == 1) - scheme_wrong_syntax(NULL, a, e, "bad syntax (missing module name)"); + scheme_wrong_syntax(NULL, a, e, "missing module name"); midx = SCHEME_STX_CAR(rest); midx = scheme_make_modidx(scheme_syntax_to_datum(midx, 0, NULL), @@ -10332,7 +10332,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, p = SCHEME_STX_CAR(el); if (!SCHEME_STX_SYMBOLP(p)) { scheme_wrong_syntax(NULL, p, e, - "bad syntax (excluded name is not an identifier)"); + "excluded name is not an identifier"); } } @@ -10352,11 +10352,11 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, len = scheme_stx_proper_list_length(rest); if (len != 2) { if (len < 0) - scheme_wrong_syntax(NULL, a, e, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, a, e, IMPROPER_LIST_FORM); else - scheme_wrong_syntax(NULL, a, e, "bad syntax " - "(not a struct identifier followed by " - "a sequence of field identifiers)"); + scheme_wrong_syntax(NULL, a, e, + "not a struct identifier followed by " + "a sequence of field identifiers"); } base = SCHEME_STX_CAR(rest); @@ -10365,19 +10365,18 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, if (!SCHEME_STX_SYMBOLP(base)) scheme_wrong_syntax(NULL, base, e, - "bad syntax (struct name is not an identifier)"); + "struct name is not an identifier"); /* Check all field names are identifiers: */ for (el = fields; SCHEME_STX_PAIRP(el); el = SCHEME_STX_CDR(el)) { p = SCHEME_STX_CAR(el); if (!SCHEME_STX_SYMBOLP(p)) { scheme_wrong_syntax(NULL, p, e, - "bad syntax (field name is not an identifier)"); + "field name is not an identifier"); } } if (!SCHEME_STX_NULLP(el)) - scheme_wrong_syntax(NULL, fields, e, - "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, fields, e, IMPROPER_LIST_FORM); prnt_base = base; base = SCHEME_STX_VAL(base); @@ -10421,7 +10420,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, if (!SCHEME_STX_SYMBOLP(prefix)) { scheme_wrong_syntax(NULL, a, e, - "bad syntax (prefix is not an identifier)"); + "prefix is not an identifier"); } prefix = SCHEME_STX_VAL(prefix); @@ -10446,15 +10445,15 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, len = scheme_stx_proper_list_length(a); if (len < 0) - scheme_wrong_syntax(NULL, a, e, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, a, e, IMPROPER_LIST_FORM); if (is_prefix && (len < 2)) - scheme_wrong_syntax(NULL, a, e, "bad syntax (missing prefix)"); + scheme_wrong_syntax(NULL, a, e, "missing prefix"); if (is_prefix) { prefix = SCHEME_STX_CAR(rest); if (!SCHEME_STX_SYMBOLP(prefix)) - scheme_wrong_syntax(NULL, a, e, "bad syntax (prefix is not an identifier)"); + scheme_wrong_syntax(NULL, a, e, "prefix is not an identifier"); prefix = SCHEME_STX_VAL(prefix); rest = SCHEME_STX_CDR(rest); } @@ -10466,7 +10465,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, p = SCHEME_STX_CAR(el); if (!SCHEME_STX_SYMBOLP(p)) { scheme_wrong_syntax(NULL, p, e, - "bad syntax (excluded name is not an identifier)"); + "excluded name is not an identifier"); } } @@ -11109,7 +11108,7 @@ void parse_requires(Scheme_Object *form, int at_phase, is_mpi = 1; } else { if (scheme_stx_proper_list_length(form) < 0) - scheme_wrong_syntax(NULL, NULL, form, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, NULL, form, IMPROPER_LIST_FORM); is_mpi = 0; } @@ -11143,15 +11142,15 @@ void parse_requires(Scheme_Object *form, int at_phase, if (mode_cnt) scheme_wrong_syntax(NULL, i, form, (SAME_OBJ(for_syntax_symbol, aav) - ? "bad syntax (nested `for-syntax')" + ? "nested `for-syntax' not allowed" : (SAME_OBJ(for_template_symbol, aav) - ? "bad syntax (nested `for-template')" + ? "nested `for-template' not allowed" : (SAME_OBJ(for_label_symbol, aav) - ? "bad syntax (nested `for-label')" - : "bad syntax (nested `for-meta')")))); + ? "nested `for-label' not allowed" + : "nested `for-meta' not allowed")))); } else { if (just_mode_cnt) - scheme_wrong_syntax(NULL, i, form, "bad syntax (nested `just-meta')"); + scheme_wrong_syntax(NULL, i, form, "nested `just-meta' not allowed"); } aa = scheme_flatten_syntax_list(i, NULL); @@ -11210,13 +11209,13 @@ void parse_requires(Scheme_Object *form, int at_phase, GC_CAN_IGNORE const char *reason; if (len < 0) - reason = "bad syntax (" IMPROPER_LIST_FORM ")"; + reason = IMPROPER_LIST_FORM; else if (len < 2) - reason = "bad syntax (prefix missing)"; + reason = "prefix missing"; else if (len < 3) - reason = "bad syntax (module name missing)"; + reason = "module name missing"; else - reason = "bad syntax (extra data after module name)"; + reason = "extra data after module name"; scheme_wrong_syntax(NULL, i, form, reason); return; } @@ -11248,11 +11247,11 @@ void parse_requires(Scheme_Object *form, int at_phase, len = scheme_stx_proper_list_length(i); if (len < 0) - scheme_wrong_syntax(NULL, i, form, "bad syntax (" IMPROPER_LIST_FORM ")"); + scheme_wrong_syntax(NULL, i, form, IMPROPER_LIST_FORM); else if (has_prefix && (len < 2)) - scheme_wrong_syntax(NULL, i, form, "bad syntax (prefix missing)"); + scheme_wrong_syntax(NULL, i, form, "prefix missing"); else if (len < (has_prefix ? 3 : 2)) - scheme_wrong_syntax(NULL, i, form, "bad syntax (module name missing)"); + scheme_wrong_syntax(NULL, i, form, "module name missing"); idxstx = SCHEME_STX_CDR(i); if (has_prefix) { @@ -11260,7 +11259,7 @@ void parse_requires(Scheme_Object *form, int at_phase, idxstx = SCHEME_STX_CDR(idxstx); if (!SCHEME_SYMBOLP(SCHEME_STX_VAL(prefix))) { - scheme_wrong_syntax(NULL, prefix, form, "bad prefix (not an identifier)"); + scheme_wrong_syntax(NULL, prefix, form, "prefix is not an identifier"); return; } prefix = SCHEME_STX_VAL(prefix); @@ -11273,7 +11272,7 @@ void parse_requires(Scheme_Object *form, int at_phase, if (!SCHEME_STX_SYMBOLP(SCHEME_STX_CAR(l))) { l = SCHEME_STX_CAR(l); scheme_wrong_syntax(NULL, l, form, - "bad syntax (excluded name is not an identifier)"); + "excluded name is not an identifier"); } } if (SCHEME_STX_NULLP(exns)) @@ -11291,9 +11290,9 @@ void parse_requires(Scheme_Object *form, int at_phase, GC_CAN_IGNORE const char *reason; if (len < 0) - reason = "bad syntax (" IMPROPER_LIST_FORM ")"; + reason = IMPROPER_LIST_FORM; else - reason = "bad syntax (module name missing)"; + reason = "module name missing"; scheme_wrong_syntax(NULL, i, form, reason); return; } @@ -11306,7 +11305,7 @@ void parse_requires(Scheme_Object *form, int at_phase, while (SCHEME_STX_PAIRP(rest)) { nm = SCHEME_STX_CAR(rest); if (!SCHEME_STX_SYMBOLP(nm)) { - scheme_wrong_syntax(NULL, nm, form, "bad syntax (name for `only' is not an identifier)"); + scheme_wrong_syntax(NULL, nm, form, "name for `only' is not an identifier"); } scheme_hash_set(onlys, SCHEME_STX_VAL(nm), nm); rest = SCHEME_STX_CDR(rest); @@ -11328,15 +11327,15 @@ void parse_requires(Scheme_Object *form, int at_phase, GC_CAN_IGNORE const char *reason; if (len < 0) - reason = "bad syntax (" IMPROPER_LIST_FORM ")"; + reason = IMPROPER_LIST_FORM; else if (len < 2) - reason = "bad syntax (module name missing)"; + reason = "module name missing"; else if (len < 3) - reason = "bad syntax (internal name missing)"; + reason = "internal name missing"; else if (len < 4) - reason = "bad syntax (external name missing)"; + reason = "external name missing"; else - reason = "bad syntax (extra data after external name)"; + reason = "extra data after external name"; scheme_wrong_syntax(NULL, i, form, reason); return; } @@ -11349,9 +11348,9 @@ void parse_requires(Scheme_Object *form, int at_phase, ename = SCHEME_STX_CAR(rest); if (!SCHEME_STX_SYMBOLP(iname)) - scheme_wrong_syntax(NULL, i, form, "bad syntax (internal name is not an identifier)"); + scheme_wrong_syntax(NULL, i, form, "internal name is not an identifier"); if (!SCHEME_STX_SYMBOLP(ename)) - scheme_wrong_syntax(NULL, i, form, "bad syntax (external name is not an identifier)"); + scheme_wrong_syntax(NULL, i, form, "external name is not an identifier"); mark_src = iname; diff --git a/src/racket/src/network.c b/src/racket/src/network.c index 7fca126570..446b52a3ca 100644 --- a/src/racket/src/network.c +++ b/src/racket/src/network.c @@ -877,8 +877,7 @@ static void TCP_INIT(char *name) if (!started) scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "%s: not supported on this machine\n" - " explanation: no winsock driver", + "%s: no winsock driver", name); # ifdef MZ_USE_PLACES @@ -2008,7 +2007,7 @@ static Scheme_Object *tcp_connect(int argc, Scheme_Object *argv[]) nameerr, errid); #else scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "tcp-connect: not supported on this platform"); + "tcp-connect: " NOT_SUPPORTED_STR); #endif return NULL; @@ -2306,7 +2305,7 @@ tcp_listen(int argc, Scheme_Object *argv[]) origid, errid); #else scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "tcp-listen: not supported on this platform"); + "tcp-listen: " NOT_SUPPORTED_STR); #endif return NULL; @@ -2761,9 +2760,9 @@ static Scheme_Object *tcp_accept_evt(int argc, Scheme_Object *argv[]) return r; } -static Scheme_Object *accept_failed(void *msg, int argc, Scheme_Object **argv) +static Scheme_Object *accept_failed(void *_msg, int argc, Scheme_Object **argv) { - scheme_raise_exn(MZEXN_FAIL_NETWORK, msg ? (const char *)msg : "accept failed"); + scheme_raise_exn(MZEXN_FAIL_NETWORK, (char *)_msg); return NULL; } @@ -2781,7 +2780,7 @@ static int tcp_check_accept_evt(Scheme_Object *ae, Scheme_Schedule_Info *sinfo) } else { /* error on accept */ scheme_set_sync_target(sinfo, scheme_always_ready_evt, - scheme_make_closed_prim(accept_failed, fail_reason), + scheme_make_closed_prim(accept_failed, fail_reason), NULL, 0, 0, NULL); return 1; } @@ -3047,7 +3046,7 @@ static Scheme_Object *make_udp(int argc, Scheme_Object *argv[]) return (Scheme_Object *)udp; #else scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "udp-open-socket: not supported on this platform"); + "udp-open-socket: " NOT_SUPPORTED_STR); return NULL; #endif } diff --git a/src/racket/src/port.c b/src/racket/src/port.c index db490d5d80..a31d8472fe 100644 --- a/src/racket/src/port.c +++ b/src/racket/src/port.c @@ -4470,7 +4470,8 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[ astr = scheme_make_args_string("other ", i, argc, argv, &alen); scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: bad mode: %s%t", name, + "%s: bad mode symbol\n" + " given symbol: %s%t", name, scheme_make_provided_string(argv[i], 1, NULL), astr, alen); } @@ -4481,8 +4482,8 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[ astr = scheme_make_args_string("", -1, argc, argv, &alen); scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: conflicting or redundant " - "file modes given%t", name, + "%s: conflicting or redundant file modes given%t", + name, astr, alen); } } @@ -4677,7 +4678,8 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv astr = scheme_make_args_string("other ", i, argc, argv, &alen); scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: bad mode: %s%s", name, + "%s: bad mode symbol\n" + " given symbol: : %s%s", name, scheme_make_provided_string(argv[i], 1, NULL), astr, alen); } @@ -4688,8 +4690,8 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv astr = scheme_make_args_string("", -1, argc, argv, &alen); scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: conflicting or redundant " - "file modes given%t", name, + "%s: conflicting or redundant file modes given%t", + name, astr, alen); } } @@ -4909,7 +4911,7 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv if (and_read) { scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "%s: not supported on this platform", + "%s: " NOT_SUPPORTED_STR, name); return NULL; } @@ -8395,7 +8397,7 @@ static Scheme_Object *subprocess_status(int argc, Scheme_Object **argv) } #else scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "%s: not supported on this platform", + "%s: " NOT_SUPPORTED_STR, "subprocess-status"); #endif } @@ -8424,7 +8426,7 @@ static Scheme_Object *subprocess_wait(int argc, Scheme_Object **argv) } #else scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "%s: not supported on this platform", + "%s: " NOT_SUPPORTED_STR, "subprocess-wait"); #endif } @@ -8516,7 +8518,8 @@ static Scheme_Object *do_subprocess_kill(Scheme_Object *_sp, Scheme_Object *kill #endif if (can_error) - scheme_raise_exn(MZEXN_FAIL, "subprocess-kill: failed\n" + scheme_raise_exn(MZEXN_FAIL, + "subprocess-kill: operation failed\n" " system error: %E", errno); return NULL; @@ -8542,7 +8545,7 @@ static Scheme_Object *subprocess_kill(int argc, Scheme_Object **argv) return do_subprocess_kill(argv[0], argv[1], 1); #else scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "%s: not supported on this platform", + "%s: " NOT_SUPPORTED_STR, "subprocess-wait"); return NULL; #endif @@ -9403,7 +9406,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[]) /*--------------------------------------*/ scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "%s: not supported on this platform", + "%s: " NOT_SUPPORTED_STR, name); return NULL; # endif @@ -9537,7 +9540,7 @@ static Scheme_Object *sch_shell_execute(int c, Scheme_Object *argv[]) } #else scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "shell-execute: not supported on this platform"); + "shell-execute: " NOT_SUPPORTED_STR); return NULL; #endif } diff --git a/src/racket/src/portfun.c b/src/racket/src/portfun.c index d87bcf323c..247de7926b 100644 --- a/src/racket/src/portfun.c +++ b/src/racket/src/portfun.c @@ -4520,8 +4520,9 @@ static Scheme_Object *do_load_handler(void *data) Scheme_Input_Port *ip; ip = scheme_input_port_record(port); scheme_raise_exn(MZEXN_FAIL, - "default-load-handler: expected only a `module' declaration," - " but found an extra form\n in: %V", + "default-load-handler: expected only a `module' declaration;\n" + " found an extra form\n" + " in: %V", modname, ip->name); @@ -4572,7 +4573,9 @@ static Scheme_Object *do_load_handler(void *data) Scheme_Input_Port *ip; ip = scheme_input_port_record(port); scheme_raise_exn(MZEXN_FAIL, - "default-load-handler: expected a `module' declaration, but found end-of-file\n in: %V", + "default-load-handler: expected a `module' declaration;\n" + " found end-of-file\n" + " in: %V", modname, ip->name); @@ -4773,7 +4776,8 @@ static Scheme_Object *abs_directory_p(const char *name, Scheme_Object *d) if (!scheme_is_complete_path(s, len, SCHEME_PLATFORM_PATH_KIND)) scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: path is not a complete path\n path: %q", + "%s: path is not a complete path\n" + " path: %q", name, s); diff --git a/src/racket/src/print.c b/src/racket/src/print.c index e0ff9a835d..9d8ea08d8d 100644 --- a/src/racket/src/print.c +++ b/src/racket/src/print.c @@ -1127,7 +1127,9 @@ print_to_port(char *name, Scheme_Object *obj, Scheme_Object *port, int notdispla op = scheme_output_port_record(port); if (op->closed) - scheme_raise_exn(MZEXN_FAIL, "%s: output port is closed\n port: %V", name, port); + scheme_raise_exn(MZEXN_FAIL, "%s: output port is closed\n" + " port: %V", + name, port); str = print_to_string(obj, &len, notdisplay, port, maxl, qq_depth); diff --git a/src/racket/src/read.c b/src/racket/src/read.c index 47aee846da..17244a1d72 100644 --- a/src/racket/src/read.c +++ b/src/racket/src/read.c @@ -3477,7 +3477,7 @@ read_number_or_symbol(int init_ch, int skip_rt, Scheme_Object *port, scheme_tell_all(port, &xl, &xc, &xp); scheme_read_err(port, stxsrc, xl, xc, xp, 1, 0, indentation, - "read: illegal use of \".\""); + "read: illegal use of `.'"); return NULL; } diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 148840ddfa..64c7fac822 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -3298,6 +3298,8 @@ char *scheme_submodule_path_to_string(Scheme_Object *p, intptr_t *_len); /* errors and exceptions */ /*========================================================================*/ +#define NOT_SUPPORTED_STR "unsupported on this platform" + void scheme_read_err(Scheme_Object *port, Scheme_Object *stxsrc, intptr_t line, intptr_t column, intptr_t pos, intptr_t span, diff --git a/src/racket/src/struct.c b/src/racket/src/struct.c index f61cc4d378..73c317650a 100644 --- a/src/racket/src/struct.c +++ b/src/racket/src/struct.c @@ -1301,9 +1301,9 @@ static Scheme_Object *guard_property(Scheme_Object *prop, Scheme_Object *v, Sche /* ok */ } else { scheme_contract_error("make-struct-type", - "contract failed for prop:procedure value", - "expected matching", 0, "(or/c procedure? exact-nonnegative-integer?)", - "value", 1, orig_v, + "given value did not satisfy the contract for prop:procedure", + "expected", 0, "(or/c procedure? exact-nonnegative-integer?)", + "given", 1, orig_v, NULL); } @@ -1363,8 +1363,8 @@ typedef int (*Check_Val_Proc)(Scheme_Object *); static void wrong_property_contract(const char *name, const char *contract, Scheme_Object *v) { scheme_contract_error(name, - "contract violation for property value", - "expected matching", 0, contract, + "contract violation for given property value", + "expected", 0, contract, "given", 1, v, NULL); } @@ -1885,10 +1885,10 @@ static void wrong_struct_type(char *name, { if (SAME_OBJ(expected, received)) scheme_contract_error(name, - "contract failure", - "expected matching", 0, pred_name_string(expected), + "contract violation;\n" + " given value instantiates a different structure type with the same name", + "expected", 0, pred_name_string(expected), "given", 1, argv[which], - "explanation", 0, "given value instantiates a different structure type with the same name", NULL); else scheme_wrong_contract(name, @@ -2498,13 +2498,16 @@ static Scheme_Object *apply_chaperones(const char *who, Scheme_Object *procs, in if (cnt != argc) { scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, - "%s: chaperone returned wrong number of values\n" - " chaperone: %V\n" - " expected count: %d\n" - " returned count: %d", + "%s: arity mismatch;\n" + " received wrong number of values from %s replacement procedure\n" + " expected: %d\n" + " received: %d\n" + " %s: %V\n", who, + is_impersonator ? "an impersonator's" : "an chaperone's", SCHEME_CAR(procs), - argc, cnt); + argc, cnt, + is_impersonator ? "impersonator" : "chaperone"); } if (!is_impersonator) { @@ -3266,8 +3269,8 @@ static Scheme_Object *do_chaperone_guard_proc(int is_impersonator, void *data, i scheme_wrong_chaperoned("evt chaperone", "value", evt, vals[0]); if (!scheme_check_proc_arity(NULL, 1, 1, 1, vals)) scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "evt %s: contract failure for second %s result\n" - " expected matching: (any/c any/c . -> . any)\n" + "evt %s: contract violation for second %s result\n" + " expected: (any/c any/c . -> . any)\n" " received: %V", (is_impersonator ? "impersonator" : "chaperone"), (is_impersonator ? "impersonator" : "chaperone"), @@ -4123,8 +4126,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base, && ((struct_type->num_slots < parent_type->num_slots) || (struct_type->num_islots < parent_type->num_islots)))) { /* Too many fields. */ - scheme_raise_exn(MZEXN_FAIL, - "too many fields for struct-type\n" + scheme_raise_exn(MZEXN_FAIL, "too many fields for struct-type\n" " maximum total field count: " MAX_STRUCT_FIELD_COUNT_STR); return NULL; } @@ -4333,8 +4335,8 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base, if (guard) { if (!scheme_check_proc_arity(NULL, struct_type->num_islots + 1, -1, 0, &guard)) { scheme_contract_error("make-struct-type", - "guard procedure does not accept correct number of arguments", - "explanation", 0, "should accept one more than the number of constructor arguments", + "guard procedure does not accept correct number of arguments;\n" + " should accept one more than the number of constructor arguments", "guard procedure", 1, guard, "expected arity", 1, scheme_make_integer(struct_type->num_islots + 1), NULL); @@ -4472,8 +4474,8 @@ static char* immutable_pos_list_to_immutable_array(Scheme_Object *immutable_pos_ a_val = SCHEME_INT_VAL(a); if (a_val < 0) { scheme_contract_error("make-struct-type", - "contract failure at index for immutable field", - "expected matching", 0, "(and/c exact-nonnegative-integer? fixnum?)", + "contract violation for index of immutable field", + "expected:", 0, "(and/c exact-nonnegative-integer? fixnum?)", "given", 1, a, "in list", 1, immutable_pos_list, NULL); @@ -5335,7 +5337,7 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator, scheme_contract_error(name, "operation's redirection procedure does not match the expected arity", "given", 1, proc, - "expected matching", 0, buf, + "expected", 0, buf, "operation kind", 0, kind, "operation procedure", 1, a[0], NULL); diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 9126ae984d..7ea82100d6 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -771,7 +771,7 @@ static Scheme_Object *custodian_require_mem(int argc, Scheme_Object *args[]) #endif scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "custodian-require-memory: not supported"); + "custodian-require-memory: " NOT_SUPPORTED_STR); return NULL; /* doesn't get here */ } @@ -815,7 +815,7 @@ static Scheme_Object *custodian_limit_mem(int argc, Scheme_Object *args[]) #endif scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, - "custodian-limit-memory: not supported"); + "custodian-limit-memory: " NOT_SUPPORTED_STR); return NULL; /* doesn't get here */ }