suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

further error message convention refinements

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2012-06-22 05:24:44 +08:00
parent ed9c612cae
commit 1dc0072d03
30 changed files with 430 additions and 358 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/errortrace/errortrace-lib.rkt
View File

@ -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)))))

6
collects/ffi/file.rkt
View File

@ -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)

12
collects/lang/private/rewrite-error-message.rkt
View File

@ -104,10 +104,10 @@
(define (rewrite-contract-error-message msg)
(define replacements
(list (list #rx"application: expected procedure\n given: ([^\n]*)(?:\n arguments: [[]none[]])?"
(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 `#<image>' errors, currently.
(list (regexp-quote "#(struct:object:image% ...)")

11
collects/racket/contract/private/blame.rkt
View File

@ -131,17 +131,6 @@
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)))
(define positive-message (show/display (convert-blame-party (blame-positive blme))))

4
collects/racket/private/kw.rkt
View File

@ -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

63
collects/scribblings/reference/exns.scrbl
View File

@ -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

2
collects/tests/htdp-lang/intm-adv.rktl
View File

@ -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")

9
collects/tests/racket/contract-mzlib-test.rktl
View File

@ -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"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

9
collects/tests/racket/contract-test.rktl
View File

@ -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"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

8
collects/tests/racket/object.rktl
View File

@ -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:

2
collects/tests/racket/procs.rktl
View File

@ -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

4
collects/tests/racket/sandbox.rktl
View File

@ -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)"))

20
collects/tests/racket/struct.rktl
View File

@ -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"))

62
src/racket/src/compile.c
View File

@ -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);

22
src/racket/src/dynext.c
View File

@ -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

6
src/racket/src/env.c
View File

@ -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]);
}

240
src/racket/src/error.c
View File

@ -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);
@ -1610,7 +1622,7 @@ void scheme_wrong_contract(const char *name, const char *expected,
" expected: %s\n"
" %s: %t",
name,
indent_lines(expected),
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;
@ -2133,28 +2153,33 @@ static void do_wrong_syntax(const char *where,
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);
}
}
@ -2687,6 +2681,8 @@ static Scheme_Object *do_raise_mismatch_error(const char *who, int mismatch, int
{
Scheme_Object *s;
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);

15
src/racket/src/eval.c
View File

@ -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;

10
src/racket/src/file.c
View File

@ -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",

42
src/racket/src/fun.c
View File

@ -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;
}
}

4
src/racket/src/list.c
View File

@ -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);

115
src/racket/src/module.c
View File

@ -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;

13
src/racket/src/network.c
View File

@ -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;
}
@ -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
}

29
src/racket/src/port.c
View File

@ -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
}

12
src/racket/src/portfun.c
View File

@ -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);

4
src/racket/src/print.c
View File

@ -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);

2
src/racket/src/read.c
View File

@ -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;
}

2
src/racket/src/schpriv.h
View File

@ -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,

46
src/racket/src/struct.c
View File

@ -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);

4
src/racket/src/thread.c
View File

@ -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 */
}