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) (if (exn? exn)
(let ([p (open-output-string)]) (let ([p (open-output-string)])
(display (exn-message exn) p) (display (exn-message exn) p)
(display "\n errortrace:" p) (display "\n errortrace...:" p)
(print-error-trace p exn) (print-error-trace p exn)
(orig (get-output-string p) exn)) (orig (get-output-string p) exn))
(orig msg exn))))) (orig msg exn)))))

4
collects/ffi/file.rkt
View File

@ -30,11 +30,11 @@
((execute) (set! execute? SCHEME_GUARD_FILE_EXECUTE)) ((execute) (set! execute? SCHEME_GUARD_FILE_EXECUTE))
((delete) (set! delete? SCHEME_GUARD_FILE_DELETE)) ((delete) (set! delete? SCHEME_GUARD_FILE_DELETE))
((exists) (set! exists? SCHEME_GUARD_FILE_EXISTS)) ((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) guards)
(when (and (positive? exists?) (when (and (positive? exists?)
(positive? (+ read? write? execute? delete?))) (positive? (+ read? write? execute? delete?)))
(raise-argument-error who "permission 'exists must occur alone" (raise-arguments-error who "permission 'exists must occur alone"
"permissions" guards)) "permissions" guards))
(+ read? write? execute? delete? exists?))) (+ read? write? execute? delete? exists?)))

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

@ -104,10 +104,10 @@
(define (rewrite-contract-error-message msg) (define (rewrite-contract-error-message msg)
(define replacements (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) (lambda (all one)
(format "function call: expected a function after the open parenthesis, but received ~a" 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))) (lambda (all one) (format "~a is used here before its definition" one)))
(list #rx"expects argument of type (<([^>]+)>)" (list #rx"expects argument of type (<([^>]+)>)"
(lambda (all one two) (format "expects a ~a" two))) (lambda (all one two) (format "expects a ~a" two)))
@ -115,9 +115,9 @@
(lambda (all one two) (format "expects a ~a" two))) (lambda (all one two) (format "expects a ~a" two)))
(list #rx"expects type (<([^>]+)>)" (list #rx"expects type (<([^>]+)>)"
(lambda (all one two) (format "expects a ~a" two))) (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))) (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))) (lambda (all one two three) (argcount-error-message one two three)))
(list #px"contract violation\n expected: (.*?)\n given: ([^\n]*)(?:\n argument position: ([^\n]*))?" (list #px"contract violation\n expected: (.*?)\n given: ([^\n]*)(?:\n argument position: ([^\n]*))?"
(lambda (all ctc given pos) (contract-error-message ctc given pos))) (lambda (all ctc given pos) (contract-error-message ctc given pos)))
@ -127,13 +127,13 @@
(lambda (all) ", given ")) (lambda (all) ", given "))
(list #rx"; other arguments were:.*" (list #rx"; other arguments were:.*"
(lambda (all) "")) (lambda (all) ""))
(list #px"(?:\n other arguments:(?:\n [^\n]*)*)" (list #px"(?:\n other arguments[.][.][.]:(?:\n [^\n]*)*)"
(lambda (all) "")) (lambda (all) ""))
(list #rx"expects a (struct:)" (list #rx"expects a (struct:)"
(lambda (all one) "expects a ")) (lambda (all one) "expects a "))
(list #rx"list or cyclic list" (list #rx"list or cyclic list"
(lambda (all) "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:")) (lambda (all) "cannot set variable before its definition:"))
;; When do these show up? I see only `#<image>' errors, currently. ;; When do these show up? I see only `#<image>' errors, currently.
(list (regexp-quote "#(struct:object:image% ...)") (list (regexp-quote "#(struct:object:image% ...)")

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

@ -131,17 +131,6 @@
new-so-far new-so-far
(regexp-match #rx" $" nxt))]))])) (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 (default-blame-format blme x custom-message)
(define source-message (source-location->string (blame-source blme))) (define source-message (source-location->string (blame-source blme)))
(define positive-message (show/display (convert-blame-party (blame-positive 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))] (syntax bad))]
[else [else
(raise-syntax-error (raise-syntax-error
#f "bad argument sequence" stx (syntax args))])))) #f "bad argument sequence" stx args)]))))
;; The new `lambda' form: ;; The new `lambda' form:
(define-for-syntax (parse-lambda stx local-name non-kw-k kw-k) (define-for-syntax (parse-lambda stx local-name non-kw-k kw-k)
@ -871,7 +871,7 @@
(null? (cdr l))) (null? (cdr l)))
(raise-syntax-error (raise-syntax-error
#f #f
"missing procedure expression; probably originally (), which is an illegal empty application" "missing procedure expression;\nprobably originally (), which is an illegal empty application"
stx) stx)
(begin (begin
(when l (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[call/cc]) check the argument's arity immediately, raising
@racket[exn:fail:contract] if the arity is incorrect. @racket[exn:fail:contract] if the arity is incorrect.
@;----------------------------------------------------------------------
@section{Error Message Conventions}
Racket's @deftech{error message convention} is to produce error Racket's @deftech{error message convention} is to produce error
messages with the following shape: messages with the following shape:
@racketblock[ @racketblock[
@#,nonterm{name}: @#,nonterm{message} @#,nonterm{srcloc}: @#,nonterm{name}: @#,nonterm{message}@#,tt{;}
@#,nonterm{continued-message} ...
@#,nonterm{field}: @#,nonterm{detail} @#,nonterm{field}: @#,nonterm{detail}
... ...
] ]
The message starts with a @nonterm{name} that identifies the The message starts with an optional source location, @nonterm{srcloc},
complaining function, syntactic form, or other entity. The which is followed by a colon and space when present. The message
@nonterm{message} should be relatively short, and it should be largely continues with an optional @nonterm{name} that usually identifies the
independent of specific values that triggered the error. Specific complaining function, syntactic form, or other entity, but may also
values that triggered the error should appear in separate refer to an entity being complained about; the @nonterm{name} is also
@nonterm{field} lines, each of which is indented by two spaces. If a followed by a colon and space when present.
@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 The @nonterm{message} should be relatively short, and it should be
lines should be indented by three spaces. 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} @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 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 an exception. The @racket[name] is used as the source procedure's
name in the error message. The @racket[message] is the error 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 and the two are rendered on their own
line in the error message, with each @racket[v] formatted line in the error message, with each @racket[v] formatted
using the error value conversion handler (see using the error value conversion handler (see
@ -191,8 +224,8 @@ using the error value conversion handler (see
@examples[ @examples[
(raise-arguments-error 'eat (raise-arguments-error 'eat
"fish is smaller than its given meal" "fish is smaller than its given meal"
"fish size" 12 "fish" 12
"given meal size" 13) "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] The @racket[name] argument is usually @racket[#f] when @racket[expr]
is provided; it is described in more detail below. The 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 The optional @racket[expr] argument is the erroneous source syntax
object or S-expression (but the expression @racket[#f] cannot be 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 (/) "/: 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) #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-top (define (f x) x))
(htdp-err/rt-test (f 1 2) "f: expects only 1 argument, but found 2") (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 m
1 1
2)) 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 m
1 1
2)) 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)))] (eval (syntax-property #'(lambda (a b) a) 'method-arity-error #t)))]
[check-arity-error [check-arity-error
(lambda (f cl?) (lambda (f cl?)
(test (if cl? '("given number of arguments: 0") '("expected number of arguments: 1\n")) (test (if cl? '("given: 0") '("expected: 1\n"))
regexp-match #rx"expected number of arguments: 1\n|given number of arguments: 0$" regexp-match #rx"expected: 1\n|given: 0$"
(exn-message (with-handlers ([values values]) (exn-message (with-handlers ([values values])
;; Use `apply' to avoid triggering ;; Use `apply' to avoid triggering
;; compilation of f: ;; compilation of f:
@ -1390,8 +1390,8 @@
[meth (procedure->method f)] [meth (procedure->method f)]
[check-arity-error [check-arity-error
(lambda (f cl?) (lambda (f cl?)
(test (if cl? '("given number of arguments: 0") '("expected number of arguments: 1\n")) (test (if cl? '("given: 0") '("expected: 1\n"))
regexp-match #rx"expected number of arguments: 1\n|given number of arguments: 0$" regexp-match #rx"expected: 1\n|given: 0$"
(exn-message (with-handlers ([values values]) (exn-message (with-handlers ([values values])
;; Use `apply' to avoid triggering ;; Use `apply' to avoid triggering
;; compilation of f: ;; compilation of f:

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

@ -71,7 +71,7 @@
(let ([a (cadr p)]) (let ([a (cadr p)])
(test a procedure-arity (car p)) (test a procedure-arity (car p))
(when (number? a) (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)))] (if (zero? a) "(0|no)" a)))]
[bad-args (cons 'extra (for/list ([i (in-range a)]) 'a))]) [bad-args (cons 'extra (for/list ([i (in-range a)]) 'a))])
(test #t regexp-match? rx (test #t regexp-match? rx

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

@ -263,7 +263,7 @@
;; test source locations too ;; test source locations too
--top-- --top--
(make-base-evaluator! 0 1 2 '(define foo)) (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 ;; empty program for clean repls
--top-- --top--
@ -471,7 +471,7 @@
(make-base-evaluator! "(define l null)") (make-base-evaluator! "(define l null)")
--eval-- --eval--
(cond [null? l 0]) => 0 (cond [null? l 0]) => 0
(last-pair l) =err> "reference to an identifier" (last-pair l) =err> "last-pair: undefined"
--top-- --top--
(make-evaluator! '(special beginner) (make-evaluator! '(special beginner)
(make-prog "(define l null)" "(define x 3.5)")) (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 (bad3 1) exn:application:arity?)
(err/rt-test (bad11 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]) (with-handlers ([exn:fail? exn-message])
(bad1))) (bad1)))
(test '("procedure: q") regexp-match "procedure: q" (test '("q") regexp-match "^q"
(with-handlers ([exn:fail? exn-message]) (with-handlers ([exn:fail? exn-message])
(bad2))) (bad2)))
(test '("procedure: r") regexp-match "procedure: r" (test '("r") regexp-match "^r"
(with-handlers ([exn:fail? exn-message]) (with-handlers ([exn:fail? exn-message])
(bad3))) (bad3)))
(test '("procedure: p") regexp-match "procedure: p" (test '("p") regexp-match "^p"
(with-handlers ([exn:fail? exn-message]) (with-handlers ([exn:fail? exn-message])
(bad11)))) (bad11))))
@ -286,23 +286,23 @@
(test 1-2-value cons3 1 2) (test 1-2-value cons3 1 2)
(test 1-2-value cons11 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]) (with-handlers ([exn:fail? exn-message])
(cons1)))) (cons1))))
(test #f not (regexp-match (re "procedure: q") (test #f not (regexp-match (re "^q")
(with-handlers ([exn:fail? exn-message]) (with-handlers ([exn:fail? exn-message])
(cons2)))) (cons2))))
(test #f not (regexp-match (re "procedure: r") (test #f not (regexp-match (re "^r")
(with-handlers ([exn:fail? exn-message]) (with-handlers ([exn:fail? exn-message])
(cons3)))) (cons3))))
(test #f not (regexp-match (re "procedure: p") (test #f not (regexp-match (re "^p")
(with-handlers ([exn:fail? exn-message]) (with-handlers ([exn:fail? exn-message])
(cons11))))) (cons11)))))
'done)) '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) "^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) t-insp)
(try-proc-structs (lambda (s a b) (try-proc-structs (lambda (s a b)
(when (and (struct? s) (not (arity-at-least? s))) (when (and (struct? s) (not (arity-at-least? s)))
(error "should be opaque")) (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)) { 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; 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) static void bad_form(Scheme_Object *form, int l)
{ {
scheme_wrong_syntax(NULL, NULL, form, 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" : ""); l - 1, (l != 2) ? "s" : "");
} }
@ -570,7 +570,7 @@ make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code,
} }
if (SCHEME_STX_NULLP(forms)) 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_datum_to_syntax(forms, code, code, 0, 0);
forms = scheme_add_env_renames(forms, frame, env); forms = scheme_add_env_renames(forms, frame, env);
@ -709,7 +709,7 @@ void scheme_define_parse(Scheme_Object *form,
DupCheckRecord r; DupCheckRecord r;
if (!no_toplevel_check && !scheme_is_toplevel(env)) 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); len = check_form(form, form);
if (len != 3) 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); rest = SCHEME_STX_CDR(form);
if (!(SCHEME_STX_PAIRP(rest) && SCHEME_STX_NULLP(SCHEME_STX_CDR(rest)))) 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_compile_rec_done_local(rec, drec);
scheme_default_compile_rec(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); rest = SCHEME_STX_CDR(form);
if (!(SCHEME_STX_PAIRP(rest) && SCHEME_STX_NULLP(SCHEME_STX_CDR(rest)))) 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; return form;
} }
@ -882,7 +882,7 @@ static void check_if_len(Scheme_Object *form, int len)
if (len != 4) { if (len != 4) {
if (len == 3) { if (len == 3) {
scheme_wrong_syntax(NULL, NULL, form, scheme_wrong_syntax(NULL, NULL, form,
"bad syntax (must have an \"else\" expression)"); "missing an \"else\" expression");
} else { } else {
bad_form(form, len); 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); lambda_check_args(args, form, env);
if (!SCHEME_STX_PAIRP(body)) if (!SCHEME_STX_PAIRP(body))
scheme_wrong_syntax(NULL, line, form, "bad syntax (%s)", scheme_wrong_syntax(NULL, line, form, "%s",
SCHEME_STX_NULLP(body) ? "empty body" : IMPROPER_LIST_FORM); SCHEME_STX_NULLP(body) ? "empty body not allowed" : IMPROPER_LIST_FORM);
} }
static Scheme_Object * 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); i = scheme_stx_proper_list_length(form);
if (i < 3) 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_CDR(form);
bindings = SCHEME_STX_CAR(bindings); 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)) if (!SCHEME_STX_PAIRP(body))
scheme_wrong_syntax(NULL, NULL, form, (SCHEME_STX_NULLP(body) scheme_wrong_syntax(NULL, NULL, form, (SCHEME_STX_NULLP(body)
? "bad syntax (empty body)" ? "empty body not allowed"
: NULL)); : NULL));
boundname = scheme_check_name_property(form, erec[drec].value_name); 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) { if (scheme_stx_proper_list_length(forms) < 0) {
scheme_wrong_syntax(scheme_begin_stx_string, NULL, scheme_wrong_syntax(scheme_begin_stx_string, NULL,
scheme_datum_to_syntax(cons(begin_symbol, forms), forms, forms, 0, 0), scheme_datum_to_syntax(cons(begin_symbol, forms), forms, forms, 0, 0),
"bad syntax (" IMPROPER_LIST_FORM ")"); IMPROPER_LIST_FORM);
return NULL; return NULL;
} else { } else {
Scheme_Object *body; Scheme_Object *body;
@ -2815,7 +2815,7 @@ do_begin_syntax(char *name,
if (SCHEME_STX_NULLP(forms)) { if (SCHEME_STX_NULLP(forms)) {
if (!zero && scheme_is_toplevel(env)) if (!zero && scheme_is_toplevel(env))
return scheme_compiled_void(); 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; return NULL;
} }
@ -3036,7 +3036,7 @@ do_begin_expand(char *name,
SCHEME_EXPAND_OBSERVE_EXIT_LIST(erec[drec].observer, form); SCHEME_EXPAND_OBSERVE_EXIT_LIST(erec[drec].observer, form);
return orig_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; return NULL;
} }
@ -3139,7 +3139,7 @@ static Scheme_Object *check_single(Scheme_Object *form, Scheme_Comp_Env *top_onl
rest = SCHEME_STX_CDR(form); rest = SCHEME_STX_CDR(form);
if (!(SCHEME_STX_PAIRP(rest) && SCHEME_STX_NULLP(SCHEME_STX_CDR(rest)))) 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)) if (top_only && !scheme_is_toplevel(top_only))
scheme_wrong_syntax(NULL, NULL, form, "illegal use (not at top-level)"); 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; form = orig_form;
if (!scheme_is_toplevel(in_env)) 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); (void)check_form(form, form);
@ -3694,11 +3694,11 @@ do_letrec_syntaxes(const char *where,
rhs_env = stx_env; rhs_env = stx_env;
if (!SCHEME_STX_NULLP(bindings) && !SCHEME_STX_PAIRP(bindings)) { 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 } else
check_form(bindings, forms); check_form(bindings, forms);
if (!SCHEME_STX_NULLP(var_bindings) && !SCHEME_STX_PAIRP(var_bindings)) { 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 } else
check_form(var_bindings, forms); check_form(var_bindings, forms);
@ -3743,7 +3743,7 @@ do_letrec_syntaxes(const char *where,
if (!v) if (!v)
scheme_wrong_syntax(NULL, a, forms, 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)) { for (l = SCHEME_STX_CAR(a); SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) {
a = SCHEME_STX_CAR(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) { if (has_orig_unbound) {
scheme_wrong_syntax(scheme_compile_stx_string, scheme_wrong_syntax(scheme_compile_stx_string,
orig_unbound_name, form, orig_unbound_name, form,
"unbound identifier%s " "unbound identifier%s;\n"
"(and no %S syntax transformer is bound)", "also, no %S syntax transformer is bound",
phase, phase,
SCHEME_STX_VAL(stx)); SCHEME_STX_VAL(stx));
} else { } else {
scheme_wrong_syntax(scheme_compile_stx_string, NULL, form, scheme_wrong_syntax(scheme_compile_stx_string, NULL, form,
"bad syntax; %s is not allowed, " "%s is not allowed;\n"
"because no %S syntax transformer is bound%s", "no %S syntax transformer is bound%s",
not_allowed, not_allowed,
SCHEME_STX_VAL(stx), SCHEME_STX_VAL(stx),
phase); 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? */ /* FIXME: Redundant with check done by scheme_flatten_begin below? */
if (scheme_stx_proper_list_length(first) < 0) if (scheme_stx_proper_list_length(first) < 0)
scheme_wrong_syntax(scheme_begin_stx_string, NULL, first, scheme_wrong_syntax(scheme_begin_stx_string, NULL, first,
"bad syntax (" IMPROPER_LIST_FORM ")"); IMPROPER_LIST_FORM);
forms = SCHEME_STX_CDR(forms); 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_STX_NULLP(forms)) {
if (!SCHEME_PAIRP(pre_exprs)) { if (!SCHEME_PAIRP(pre_exprs)) {
scheme_wrong_syntax(scheme_begin_stx_string, NULL, first, scheme_wrong_syntax(scheme_begin_stx_string, NULL, first,
"bad syntax (empty form)"); "empty form is not allowed");
return NULL; return NULL;
} else { } else {
/* fall through to handle expressions without definitions */ /* 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)) if (!SCHEME_STX_PAIRP(v))
scheme_wrong_syntax(NULL, NULL, first, scheme_wrong_syntax(NULL, NULL, first,
"bad syntax (" IMPROPER_LIST_FORM ")"); IMPROPER_LIST_FORM);
var = NULL; var = NULL;
vars = SCHEME_STX_CAR(v); 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_PAIRP(expr)) {
if (SCHEME_STX_NULLP(expr)) if (SCHEME_STX_NULLP(expr))
scheme_wrong_syntax(NULL, NULL, first, scheme_wrong_syntax(NULL, NULL, first,
"bad syntax (missing expression)"); "missing expression");
else else
scheme_wrong_syntax(NULL, NULL, first, scheme_wrong_syntax(NULL, NULL, first,
"bad syntax (" IMPROPER_LIST_FORM ")"); IMPROPER_LIST_FORM);
} }
link = SCHEME_STX_CDR(expr); link = SCHEME_STX_CDR(expr);
if (!SCHEME_STX_NULLP(link)) { if (!SCHEME_STX_NULLP(link)) {
scheme_wrong_syntax(NULL, NULL, first, scheme_wrong_syntax(NULL, NULL, first,
"bad syntax (extra data after expression)"); "extra data after expression");
} }
expr = SCHEME_STX_CAR(expr); 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) { if (scheme_stx_proper_list_length(form) < 0) {
/* This is already checked for anything but application */ /* This is already checked for anything but application */
scheme_wrong_syntax(scheme_application_stx_string, NULL, form, scheme_wrong_syntax(scheme_application_stx_string, NULL, form,
"bad syntax (" IMPROPER_LIST_FORM ")"); IMPROPER_LIST_FORM);
} }
fm = form; fm = form;
@ -6027,7 +6027,7 @@ scheme_flatten_begin(Scheme_Object *expr, Scheme_Object *append_onto)
Scheme_Object *l, *ll, *a, *name, *body; Scheme_Object *l, *ll, *a, *name, *body;
if (scheme_stx_proper_list_length(expr) < 0) 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); name = SCHEME_STX_CAR(expr);
body = SCHEME_STX_CDR(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: */ /* For precise GC, make a proc ptr look like a fixnum: */
#define mzPROC_TO_HASH_OBJ(f) ((Scheme_Object *)(((intptr_t)f) | 0x1)) #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) void scheme_init_dynamic_extension(Scheme_Env *env)
{ {
if (scheme_starting_up) { if (scheme_starting_up) {
@ -261,9 +263,9 @@ static Scheme_Object *do_load_extension(const char *filename,
vers = copy_vers(vers); vers = copy_vers(vers);
dlclose(dl); dlclose(dl);
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION, scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION,
"load-extension: bad version\n" "load-extension: " BAD_VERSION_STR "\n"
" found version: %s\n" " found: %s\n"
" expected version: %s\n" " expected: %s\n"
" path: %s", " path: %s",
vers, VERSION_AND_VARIANT, filename); vers, VERSION_AND_VARIANT, filename);
} }
@ -328,9 +330,9 @@ static Scheme_Object *do_load_extension(const char *filename,
vers = copy_vers(vers); vers = copy_vers(vers);
FreeLibrary(dl); FreeLibrary(dl);
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION, scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION,
"load-extension: bad version\n" "load-extension: " BAD_VERSION_STR "\n"
" found version: %s\n" " found: %s\n"
" expected version: %s\n" " expected: %s\n"
" path: %s", " path: %s",
vers, VERSION_AND_VARIANT, filename); 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)) if (!vers || strcmp(vers, VERSION_AND_VARIANT))
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION, scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_VERSION,
"load-extension: bad version\n" "load-extension: " BAD_VERSION "\n"
" found version: %s\n" " found: %s\n"
" expected version: %s\n" " expected: %s\n"
" path: %s", " path: %s",
vers, VERSION_AND_VARIANT, filename); vers, VERSION_AND_VARIANT, filename);
@ -418,7 +420,7 @@ static Scheme_Object *do_load_extension(const char *filename,
#endif #endif
#ifdef NO_DYNAMIC_LOAD #ifdef NO_DYNAMIC_LOAD
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"load-extension: not supported on this platform"); "load-extension: " NOT_SUPPORTED_STR);
return NULL; return NULL;
#else #else

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

@ -1603,7 +1603,8 @@ namespace_variable_value(int argc, Scheme_Object *argv[])
return NULL; return NULL;
} else { } else {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, argv[0], 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]); argv[0]);
return NULL; return NULL;
} }
@ -1664,7 +1665,8 @@ namespace_undefine_variable(int argc, Scheme_Object *argv[])
bucket->val = NULL; bucket->val = NULL;
} else { } else {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, argv[0], 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]); argv[0]);
} }

236
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]; 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, static char *make_arity_expect_string(const char *name, int namelen,
int minc, int maxc, int minc, int maxc,
int argc, Scheme_Object **argv, int argc, Scheme_Object **argv,
intptr_t *_len, int is_method) intptr_t *_len, int is_method)
/* minc == -1 => name is really a case-lambda, native closure, or proc-struct. /* 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; intptr_t len, pos, slen;
int xargc, xminc, xmaxc; int xargc, xminc, xmaxc;
@ -1115,10 +1115,9 @@ static char *make_arity_expect_string(const char *name, int namelen,
if (arity_str) { if (arity_str) {
pos = scheme_sprintf(s, slen, pos = scheme_sprintf(s, slen,
WRONG_NUMBER_OF_ARGUMENTS "\n" "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n"
" procedure: %t\n" " expected: %t\n"
" expected number of arguments: %t\n" " given: %d",
" given number of arguments: %d",
name, (intptr_t)namelen, arity_str, (intptr_t)arity_len, xargc); name, (intptr_t)namelen, arity_str, (intptr_t)arity_len, xargc);
} else if (minc < 0) { } else if (minc < 0) {
const char *n; const char *n;
@ -1136,38 +1135,33 @@ static char *make_arity_expect_string(const char *name, int namelen,
} }
pos = scheme_sprintf(s, slen, pos = scheme_sprintf(s, slen,
"application: no clause matching given number of arguments\n" "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n"
" procedure: %t\n" " given: %d",
" given number of arguments: %d",
n, (intptr_t)nlen, n, (intptr_t)nlen,
xargc); xargc);
} else if (!maxc) } else if (!maxc)
pos = scheme_sprintf(s, slen, pos = scheme_sprintf(s, slen,
WRONG_NUMBER_OF_ARGUMENTS "\n" "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n"
" procedure: %t\n" " expected: 0\n"
" expected number of arguments: 0\n" " given: %d",
" given number of arguments: %d",
name, (intptr_t)namelen, xargc); name, (intptr_t)namelen, xargc);
else if (maxc < 0) else if (maxc < 0)
pos = scheme_sprintf(s, slen, pos = scheme_sprintf(s, slen,
WRONG_NUMBER_OF_ARGUMENTS "\n" "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n"
" procedure: %t\n" " expected: at least %d\n"
" expected number of arguments: at least %d\n" " given: %d",
" given number of arguments: %d",
name, (intptr_t)namelen, xminc, xargc); name, (intptr_t)namelen, xminc, xargc);
else if (minc == maxc) else if (minc == maxc)
pos = scheme_sprintf(s, slen, pos = scheme_sprintf(s, slen,
WRONG_NUMBER_OF_ARGUMENTS "\n" "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n"
" procedure: %t\n" " expected: %d\n"
" expected number of arguments: %d\n" " given: %d",
" given number of arguments: %d",
name, (intptr_t)namelen, xminc, xargc); name, (intptr_t)namelen, xminc, xargc);
else else
pos = scheme_sprintf(s, slen, pos = scheme_sprintf(s, slen,
WRONG_NUMBER_OF_ARGUMENTS "\n" "%t: " WRONG_NUMBER_OF_ARGUMENTS "\n"
" procedure: %t\n"
" expected: %d to %d\n" " expected: %d to %d\n"
" given number of arguments: %d", " given: %d",
name, (intptr_t)namelen, xminc, xmaxc, xargc); name, (intptr_t)namelen, xminc, xmaxc, xargc);
if (xargc && argv) { if (xargc && argv) {
@ -1180,8 +1174,8 @@ static char *make_arity_expect_string(const char *name, int namelen,
intptr_t l; intptr_t l;
char *o; char *o;
if (i == (is_method ? 1 : 0)) { if (i == (is_method ? 1 : 0)) {
strcpy(s + pos, "\n arguments:\n "); strcpy(s + pos, "\n arguments...:\n ");
pos += 17; pos += 20;
} else { } else {
strcpy(s + pos, "\n "); strcpy(s + pos, "\n ");
pos += 4; pos += 4;
@ -1549,11 +1543,15 @@ 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; intptr_t len, i, j, lines = 1;
int a;
char *s2; char *s2;
if (_len)
len = *_len;
else
len = strlen(s); len = strlen(s);
for (i = 0; i < len; i++) { for (i = 0; i < len; i++) {
@ -1562,20 +1560,30 @@ static const char *indent_lines(const char *s)
} }
if ((len > 72) || (lines > 1)) { 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++) { for (i = 0; i < len; i++) {
s2[j++] = s[i]; s2[j++] = s[i];
if (s[i] == '\n') { if (s[i] == '\n') {
for (a = 0; a < amt; a++) {
s2[j++] = ' '; s2[j++] = ' ';
s2[j++] = ' '; }
s2[j++] = ' ';
} }
} }
s2[j] = 0; s2[j] = 0;
if (_len)
*_len = j;
return s2; return s2;
} }
@ -1590,17 +1598,21 @@ void scheme_wrong_contract(const char *name, const char *expected,
char *s; char *s;
intptr_t slen; intptr_t slen;
int isres = 0; int isres = 0;
GC_CAN_IGNORE char *isgiven = "given"; GC_CAN_IGNORE char *isgiven = "given", *kind = "argument";
o = argv[which < 0 ? 0 : which]; o = argv[which < 0 ? 0 : which];
if (argc < 0) { if (argc < 0) {
argc = -argc; argc = -argc;
isgiven = "received"; isgiven = "received";
kind = "result";
isres = 1; isres = 1;
} }
if (which == -2) { if (which == -2) {
isgiven = "received"; isgiven = "received";
kind = "result";
} }
if (argc == 0)
kind = "value";
s = scheme_make_provided_string(o, 1, &slen); 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" " expected: %s\n"
" %s: %t", " %s: %t",
name, name,
indent_lines(expected), indent_lines(expected, NULL, 1, 3),
isgiven, s, slen); isgiven, s, slen);
else { else {
char *other; char *other;
@ -1622,12 +1634,12 @@ void scheme_wrong_contract(const char *name, const char *expected,
"%s: contract violation\n" "%s: contract violation\n"
" expected: %s\n" " expected: %s\n"
" %s: %t\n" " %s: %t\n"
" argument position: %d%s\n" " %s position: %d%s\n"
" other %s:%s", " other %s...:%s",
name, name,
indent_lines(expected), indent_lines(expected, NULL, 1, 3),
isgiven, s, slen, isgiven, s, slen,
which + 1, scheme_number_suffix(which + 1), kind, which + 1, scheme_number_suffix(which + 1),
(!isres ? "arguments" : "results"), other, olen); (!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; GC_CAN_IGNORE va_list args;
int i, cnt = 0, kind; int i, cnt = 0, kind;
intptr_t len = 0, nlen, mlen; intptr_t len = 0, nlen, mlen, seplen;
const char *strs[MAX_MISMATCH_EXTRAS], *str; const char *strs[MAX_MISMATCH_EXTRAS], *str, *sep;
Scheme_Object *vs[MAX_MISMATCH_EXTRAS], *v; Scheme_Object *vs[MAX_MISMATCH_EXTRAS], *v;
const char *v_strs[MAX_MISMATCH_EXTRAS], *v_str; const char *v_strs[MAX_MISMATCH_EXTRAS], *v_str;
intptr_t v_str_lens[MAX_MISMATCH_EXTRAS], v_str_len; 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]); len += v_str_len + 5 + strlen(strs[i]);
} }
sep = ": ";
mlen = strlen(msg); mlen = strlen(msg);
nlen = strlen(name); 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); s = scheme_malloc_atomic(len);
len = 0; len = 0;
memcpy(s, name, nlen); memcpy(s, name, nlen);
len += nlen; len += nlen;
memcpy(s + len, ": ", 2); memcpy(s + len, sep, seplen);
len += 2; len += seplen;
memcpy(s + len, msg, mlen); memcpy(s + len, msg, mlen);
len += mlen; len += mlen;
for (i = 0; i < cnt; i++) { 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]; 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); what, what);
scheme_contract_error(who, scheme_contract_error(who,
buf, buf,
"original", 1, orig, "original", 1, orig,
"chaperoned", 1, naya, "received", 1, naya,
NULL); NULL);
} }
@ -1990,11 +2009,12 @@ void scheme_read_err(Scheme_Object *port,
? MZEXN_FAIL_READ_NON_CHAR ? MZEXN_FAIL_READ_NON_CHAR
: MZEXN_FAIL_READ)), : MZEXN_FAIL_READ)),
scheme_make_pair(loc, scheme_null), scheme_make_pair(loc, scheme_null),
"%t%s%s%s%t%s", "%t%s%t%s%s%s",
fn, fnlen,
fnlen ? ": " : "",
s, slen, s, slen,
(*suggests ? "\n possible cause: " : ""), suggests, (*suggests ? "\n possible cause: " : ""), suggests,
fnlen ? "\n source:\n " : "", ls);
fn, fnlen, ls);
} }
static void do_wrong_syntax(const char *where, static void do_wrong_syntax(const char *where,
@ -2023,7 +2043,7 @@ static void do_wrong_syntax(const char *where,
good name: */ good name: */
if ((where == scheme_compile_stx_string) if ((where == scheme_compile_stx_string)
|| (where == scheme_expand_stx_string)) { || (where == scheme_expand_stx_string)) {
who = nomwho = scheme_false; where = NULL;
} else if (where == scheme_application_stx_string) { } else if (where == scheme_application_stx_string) {
who = scheme_intern_symbol("#%app"); who = scheme_intern_symbol("#%app");
nomwho = who; nomwho = who;
@ -2133,28 +2153,33 @@ static void do_wrong_syntax(const char *where,
where = scheme_symbol_val(who); where = scheme_symbol_val(who);
} }
s = (char *)indent_lines(s, &slen, 0, 1);
if (v) { if (v) {
if (dv) if (dv)
blen = scheme_sprintf(buffer, blen, blen = scheme_sprintf(buffer, blen,
"%s: %t\n" "%t%s%s: %t\n"
" at: %t\n" " at: %t\n"
" in: %t" " in: %t",
"%s%t", p, plen,
where, s, slen, p ? ": " : "",
where,
s, slen,
dv, dvlen, dv, dvlen,
v, vlen, v, vlen);
plen ? "\n source:\n " : "",
p, plen);
else else
blen = scheme_sprintf(buffer, blen, "%s: %t\n" blen = scheme_sprintf(buffer, blen,
" in: %t" "%t%s%s: %t\n"
"%s%t", " in: %t",
where, s, slen, p, plen,
v, vlen, p ? ": " : "",
plen ? "\n source:\n " : "", where,
p, plen); s, slen,
v, vlen);
} else } 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. */ /* 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); s = scheme_make_arg_lines_string(" ", -1, argc, argv, &slen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT, 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" " given: %t\n"
" arguments:%t", " arguments...:%t",
r, rlen, s, slen); r, rlen, s, slen);
} }
@ -2279,57 +2305,25 @@ void scheme_wrong_return_arity(const char *where,
v = ""; v = "";
vlen = 0; vlen = 0;
} else { } else {
int i;
intptr_t len, origlen, maxpos;
Scheme_Object **array; Scheme_Object **array;
v = init_buf(&len, NULL);
v[0] = ':';
v[1] = 0;
array = ((got == 1) ? (Scheme_Object **) mzALIAS &argv : argv); array = ((got == 1) ? (Scheme_Object **) mzALIAS &argv : argv);
origlen = len; v = scheme_make_arg_lines_string(" ", -1, got, array, &vlen);
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;
} }
blen = scheme_sprintf(buffer, blen = scheme_sprintf(buffer,
blen, blen,
"%s%scontext%s%t%s expected %d value%s," "%s%sresult arity mismatch;\n"
" received %d value%s%t", " expected number of values not received\n"
" expected: %d\n"
" received: %d" "%t\n"
" values...:%t",
where ? where : "", where ? where : "",
where ? ": " : "", where ? ": " : "",
s ? " (" : "",
s ? s : "",
slen,
s ? ")" : "",
expected, expected,
(expected == 1) ? "" : "s",
got, got,
(got == 1) ? "" : "s", s, slen,
v, vlen); v, vlen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, 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 = ""; char *phase, phase_buf[20], *phase_note = "";
if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))) if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC)))
errmsg = ("reference to an identifier before its definition\n" errmsg = ("%S: undefined;\n"
" identifier: %S\n" " cannot reference an identifier before its definition\n"
" in module: %D%s%s"); " in module: %D%s%s");
else else
errmsg = ("reference to an identifier before its definition\n" errmsg = ("%S: undefined;\n"
" identifier: %S%_%s%s"); " cannot reference an identifier before its definition%_%s%s");
if (home->phase) { if (home->phase) {
sprintf(phase_buf, "\n phase: %" PRIdPTR "", home->phase); sprintf(phase_buf, "\n phase: %" PRIdPTR "", home->phase);
@ -2410,8 +2404,8 @@ void scheme_unbound_global(Scheme_Bucket *b)
} else { } else {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE,
name, name,
"reference to undefined identifier\n" "%S: undefined;\n"
" identifier: %S", " cannot reference undefined identifier",
name); name);
} }
} }
@ -2687,6 +2681,8 @@ static Scheme_Object *do_raise_mismatch_error(const char *who, int mismatch, int
{ {
Scheme_Object *s; Scheme_Object *s;
int i; int i;
char *s2;
intptr_t l2;
if (!SCHEME_SYMBOLP(argv[0])) if (!SCHEME_SYMBOLP(argv[0]))
scheme_wrong_contract(who, "symbol?", 0, argc, argv); 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]); s = scheme_char_string_to_byte_string(argv[i+offset]);
st = SCHEME_BYTE_STR_VAL(s); st = SCHEME_BYTE_STR_VAL(s);
slen = SCHEME_BYTE_STRLEN_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) if (!mismatch)
total += 5; total += 5;
} else { } else {
@ -2763,12 +2764,19 @@ static Scheme_Object *do_raise_mismatch_error(const char *who, int mismatch, int
st[total] = 0; st[total] = 0;
s = scheme_char_string_to_byte_string(argv[1]); 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, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: %t%t", "%s: %t%t",
scheme_symbol_val(argv[0]), scheme_symbol_val(argv[0]),
mismatch ? "" : SCHEME_BYTE_STR_VAL(s), s2, l2,
mismatch ? 0 : SCHEME_BYTE_STRLEN_VAL(s),
st, total); st, total);
} }
@ -2987,7 +2995,7 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
if (max_cnt == orig_max_cnt) { if (max_cnt == orig_max_cnt) {
/* Starting label: */ /* Starting label: */
scheme_write_byte_string("\n context:\n", 12, port); scheme_write_byte_string("\n context...:\n", 15, port);
} else } else
scheme_write_byte_string("\n", 1, port); 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 */ /* evaluation of various forms */
/*========================================================================*/ /*========================================================================*/
#define CANNOT_SET_ERROR_STR "assignment disallowed"
void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val, void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val,
int set_undef) int set_undef)
{ {
@ -1754,11 +1756,13 @@ void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val,
int is_set; int is_set;
if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))) 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" " %s: %S\n"
" in module: %D"); " in module: %D");
else else
msg = ("%s: cannot %s\n" msg = ("%s: " CANNOT_SET_ERROR_STR ";\n"
" cannot %s\n"
" %s: %S"); " %s: %S");
is_set = !strcmp(who, "set!"); 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); home->module->modsrc);
} else { } else {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, b->key, scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, b->key,
"%s: cannot %s\n" "%s: " CANNOT_SET_ERROR_STR ";\n"
" cannot %s\n"
" %s: %S", " %s: %S",
who, who,
(val (val
@ -1945,9 +1950,9 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
i, g, i, g,
(g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array, (g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array,
"%s%s%s", "%s%s%s",
show_any ? "defining \"" : "0 names", show_any ? "\n defining: " : "0 names",
symname, symname,
show_any ? ((i == 1) ? "\"" : "\", ...") : ""); show_any ? ((i == 1) ? "" : " ...") : "");
} }
return NULL; 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, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: path element is an empty string\n" "%s: path element is an empty string\n"
" argument position: %d%s\n" " argument position: %d%s\n"
" other arguments:%t", " other arguments...:%t",
who, who,
i + 1, i + 1,
scheme_number_suffix(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); return scheme_make_sized_path(drive, strlen(drive), 0);
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "current-drive: not supported"); scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "current-drive: " NOT_SUPPORTED_STR);
return NULL; return NULL;
#endif #endif
} }
@ -5365,8 +5365,8 @@ static Scheme_Object *make_link(int argc, Scheme_Object *argv[])
#if defined(DOS_FILE_SYSTEM) #if defined(DOS_FILE_SYSTEM)
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"make-file-or-directory-link: link creation not supported on this platform; " "make-file-or-directory-link: " NOT_SUPPORTED_STR ";\n"
"cannot create link\n" " cannot create link\n"
" path: %Q", " path: %Q",
argv[1]); argv[1]);
#else #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 & MZ_UNC_WRITE) != ((new_bits & (MZ_UNC_WRITE << 6)) >> 6))
|| (new_bits >= (1 << 9))) || (new_bits >= (1 << 9)))
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, 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" " unsupported bit combination\n"
" path: %c\n" " path: %c\n"
" permission value: %d", " 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)) { if (!SCHEME_STXP(code)) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%S: return value from syntax expander was not syntax\n" "%S: received value from syntax expander was not syntax\n"
" return value: %V", " received: %V",
SCHEME_STX_SYM(name), SCHEME_STX_SYM(name),
code); code);
} }
@ -3273,10 +3273,12 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
} }
} else { } else {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, 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" " wrapper: %V\n"
" expected number of results: %d or %d\n" " expected: %d or %d\n"
" received number of results: %d", " received: %d",
what, what,
SCHEME_CAR(px->redirects), SCHEME_CAR(px->redirects),
argc, argc + 1, 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) */ /* First element is a filter for the result(s) */
if (!SCHEME_PROCP(post)) if (!SCHEME_PROCP(post))
scheme_raise_exn(MZEXN_FAIL_CONTRACT, 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" " wrapper: %V\n"
" received first result: %V\n" " received: %V",
" explanation: extra result compared to original argument count should be a result wrapper",
what, what,
what, what,
SCHEME_CAR(px->redirects), 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)) if (!scheme_check_proc_arity(NULL, c, 0, -1, &post))
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"procedure-result chaperone: wrapper does not accept the number" "procedure-result chaperone: arity mismatch;\n"
" of values produced by the chaperoned procedure\n" " wrapper does not accept the number of values produced by\n"
" the original procedure\n"
" wrapper: %V\n" " wrapper: %V\n"
" number of values produced by procedure: %d", " number of values: %d",
post, post,
c); c);
@ -3423,13 +3427,15 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
} }
} else { } else {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, 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" " wrapper: %V\n"
" number of returned values: %d\n" " expected: %d\n"
" expected number of returned values: %d", " received: %d",
what, what,
post, post,
argc, c); c, argc);
return NULL; return NULL;
} }
@ -8261,9 +8267,9 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *),
return jump_to_alt_continuation(); return jump_to_alt_continuation();
} }
scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"jump to escape continuation in progress," "continuation application: lost target;\n"
" but the target is not in the current continuation" " jump to escape continuation in progress, and the target is not in the\n"
" after a `dynamic-wind' post-thunk return"); " current continuation after a `dynamic-wind' post-thunk return");
return NULL; 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; red = o;
if (!scheme_check_proc_arity(NULL, 3, 1, 2, vals)) if (!scheme_check_proc_arity(NULL, 3, 1, 2, vals))
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced invalid second value\n" "%s: chaperone produced a second value that does not match the expected contract\n"
" expected matching: (procedure-arity-includes/c 2)\n" " expected: (procedure-arity-includes/c 2)\n"
" received: %V", " received: %V",
who, who,
red); 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, scheme_wrong_syntax("link", stx, symbol,
"module mismatch\n" "module mismatch;\n"
" possible explanation: bytecode file needs re-compile because dependencies changed\n" " possibly, bytecode file needs re-compile because dependencies changed\n"
"%s%t%s" "%s%t%s"
" exporting module: %D\n" " exporting module: %D\n"
" exporting phase level: %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)) 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); fm = SCHEME_STX_CDR(form);
if (!SCHEME_STX_PAIRP(fm)) 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)"); scheme_wrong_syntax(NULL, NULL, form, "illegal use (not a module body)");
if (scheme_stx_proper_list_length(form) < 0) 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) if (!env->genv->module)
scheme_wrong_syntax(NULL, NULL, form, "not currently transforming a 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; Scheme_Object *phase;
if (scheme_stx_proper_list_length(e) < 0) 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)) { for (l = SCHEME_STX_CDR(e); !SCHEME_STX_NULLP(l); l = SCHEME_STX_CDR(l)) {
Scheme_Object *a, *midx, *name, *av; Scheme_Object *a, *midx, *name, *av;
@ -10125,7 +10125,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
av = NULL; av = NULL;
if (SAME_OBJ(protect_symbol, av)) { if (SAME_OBJ(protect_symbol, av)) {
if (protect_cnt) 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; protect_stx = a;
a = SCHEME_STX_CDR(a); a = SCHEME_STX_CDR(a);
a = scheme_flatten_syntax_list(a, NULL); 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) if (mode_cnt)
scheme_wrong_syntax(NULL, a, e, scheme_wrong_syntax(NULL, a, e,
(SAME_OBJ(av, for_syntax_symbol) (SAME_OBJ(av, for_syntax_symbol)
? "bad syntax (nested `for-syntax')" ? "nested `for-syntax' not allowed"
: (SAME_OBJ(av, for_label_symbol) : (SAME_OBJ(av, for_label_symbol)
? "bad syntax (nested `for-label')" ? "nested `for-label' not allowed"
: "bad syntax (nested `for-meta')"))); : "nested `for-meta' not allowed")));
mode_stx = a; mode_stx = a;
a = SCHEME_STX_CDR(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); p = SCHEME_STX_CAR(rest);
rest = SCHEME_STX_CDR(rest); rest = SCHEME_STX_CDR(rest);
if (!SCHEME_STX_NULLP(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 { } else {
scheme_wrong_syntax(NULL, a, e, "bad syntax (missing form to expand)"); scheme_wrong_syntax(NULL, a, e, "missing form to expand");
return; return;
} }
@ -10269,12 +10269,12 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
rest = SCHEME_STX_CDR(rest); rest = SCHEME_STX_CDR(rest);
enm = SCHEME_STX_CAR(rest); enm = SCHEME_STX_CAR(rest);
if (!SCHEME_STX_SYMBOLP(inm)) 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)) 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); rest = SCHEME_STX_CDR(rest);
if (!SCHEME_STX_NULLP(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); enm = SCHEME_STX_VAL(enm);
@ -10286,11 +10286,11 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
Scheme_Object *reprovided; Scheme_Object *reprovided;
if (protect_cnt) 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)) if (!SCHEME_STX_PAIRP(rest))
scheme_wrong_syntax(NULL, a, e, "bad syntax"); scheme_wrong_syntax(NULL, a, e, "bad syntax");
if (!SCHEME_STX_NULLP(SCHEME_STX_CDR(rest))) 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_STX_CAR(rest);
midx = scheme_make_modidx(scheme_syntax_to_datum(midx, 0, NULL), 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; int len;
if (protect_cnt) 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); len = scheme_stx_proper_list_length(a);
if (len < 0) 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) 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_STX_CAR(rest);
midx = scheme_make_modidx(scheme_syntax_to_datum(midx, 0, NULL), 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); p = SCHEME_STX_CAR(el);
if (!SCHEME_STX_SYMBOLP(p)) { if (!SCHEME_STX_SYMBOLP(p)) {
scheme_wrong_syntax(NULL, p, e, 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); len = scheme_stx_proper_list_length(rest);
if (len != 2) { if (len != 2) {
if (len < 0) if (len < 0)
scheme_wrong_syntax(NULL, a, e, "bad syntax (" IMPROPER_LIST_FORM ")"); scheme_wrong_syntax(NULL, a, e, IMPROPER_LIST_FORM);
else else
scheme_wrong_syntax(NULL, a, e, "bad syntax " scheme_wrong_syntax(NULL, a, e,
"(not a struct identifier followed by " "not a struct identifier followed by "
"a sequence of field identifiers)"); "a sequence of field identifiers");
} }
base = SCHEME_STX_CAR(rest); 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)) if (!SCHEME_STX_SYMBOLP(base))
scheme_wrong_syntax(NULL, base, e, 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: */ /* Check all field names are identifiers: */
for (el = fields; SCHEME_STX_PAIRP(el); el = SCHEME_STX_CDR(el)) { for (el = fields; SCHEME_STX_PAIRP(el); el = SCHEME_STX_CDR(el)) {
p = SCHEME_STX_CAR(el); p = SCHEME_STX_CAR(el);
if (!SCHEME_STX_SYMBOLP(p)) { if (!SCHEME_STX_SYMBOLP(p)) {
scheme_wrong_syntax(NULL, p, e, 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)) if (!SCHEME_STX_NULLP(el))
scheme_wrong_syntax(NULL, fields, e, scheme_wrong_syntax(NULL, fields, e, IMPROPER_LIST_FORM);
"bad syntax (" IMPROPER_LIST_FORM ")");
prnt_base = base; prnt_base = base;
base = SCHEME_STX_VAL(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)) { if (!SCHEME_STX_SYMBOLP(prefix)) {
scheme_wrong_syntax(NULL, a, e, scheme_wrong_syntax(NULL, a, e,
"bad syntax (prefix is not an identifier)"); "prefix is not an identifier");
} }
prefix = SCHEME_STX_VAL(prefix); 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); len = scheme_stx_proper_list_length(a);
if (len < 0) 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)) 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) { if (is_prefix) {
prefix = SCHEME_STX_CAR(rest); prefix = SCHEME_STX_CAR(rest);
if (!SCHEME_STX_SYMBOLP(prefix)) 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); prefix = SCHEME_STX_VAL(prefix);
rest = SCHEME_STX_CDR(rest); 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); p = SCHEME_STX_CAR(el);
if (!SCHEME_STX_SYMBOLP(p)) { if (!SCHEME_STX_SYMBOLP(p)) {
scheme_wrong_syntax(NULL, p, e, 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; is_mpi = 1;
} else { } else {
if (scheme_stx_proper_list_length(form) < 0) 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; is_mpi = 0;
} }
@ -11143,15 +11142,15 @@ void parse_requires(Scheme_Object *form, int at_phase,
if (mode_cnt) if (mode_cnt)
scheme_wrong_syntax(NULL, i, form, scheme_wrong_syntax(NULL, i, form,
(SAME_OBJ(for_syntax_symbol, aav) (SAME_OBJ(for_syntax_symbol, aav)
? "bad syntax (nested `for-syntax')" ? "nested `for-syntax' not allowed"
: (SAME_OBJ(for_template_symbol, aav) : (SAME_OBJ(for_template_symbol, aav)
? "bad syntax (nested `for-template')" ? "nested `for-template' not allowed"
: (SAME_OBJ(for_label_symbol, aav) : (SAME_OBJ(for_label_symbol, aav)
? "bad syntax (nested `for-label')" ? "nested `for-label' not allowed"
: "bad syntax (nested `for-meta')")))); : "nested `for-meta' not allowed"))));
} else { } else {
if (just_mode_cnt) 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); 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; GC_CAN_IGNORE const char *reason;
if (len < 0) if (len < 0)
reason = "bad syntax (" IMPROPER_LIST_FORM ")"; reason = IMPROPER_LIST_FORM;
else if (len < 2) else if (len < 2)
reason = "bad syntax (prefix missing)"; reason = "prefix missing";
else if (len < 3) else if (len < 3)
reason = "bad syntax (module name missing)"; reason = "module name missing";
else else
reason = "bad syntax (extra data after module name)"; reason = "extra data after module name";
scheme_wrong_syntax(NULL, i, form, reason); scheme_wrong_syntax(NULL, i, form, reason);
return; return;
} }
@ -11248,11 +11247,11 @@ void parse_requires(Scheme_Object *form, int at_phase,
len = scheme_stx_proper_list_length(i); len = scheme_stx_proper_list_length(i);
if (len < 0) 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)) 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)) 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); idxstx = SCHEME_STX_CDR(i);
if (has_prefix) { if (has_prefix) {
@ -11260,7 +11259,7 @@ void parse_requires(Scheme_Object *form, int at_phase,
idxstx = SCHEME_STX_CDR(idxstx); idxstx = SCHEME_STX_CDR(idxstx);
if (!SCHEME_SYMBOLP(SCHEME_STX_VAL(prefix))) { 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; return;
} }
prefix = SCHEME_STX_VAL(prefix); 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))) { if (!SCHEME_STX_SYMBOLP(SCHEME_STX_CAR(l))) {
l = SCHEME_STX_CAR(l); l = SCHEME_STX_CAR(l);
scheme_wrong_syntax(NULL, l, form, 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)) if (SCHEME_STX_NULLP(exns))
@ -11291,9 +11290,9 @@ void parse_requires(Scheme_Object *form, int at_phase,
GC_CAN_IGNORE const char *reason; GC_CAN_IGNORE const char *reason;
if (len < 0) if (len < 0)
reason = "bad syntax (" IMPROPER_LIST_FORM ")"; reason = IMPROPER_LIST_FORM;
else else
reason = "bad syntax (module name missing)"; reason = "module name missing";
scheme_wrong_syntax(NULL, i, form, reason); scheme_wrong_syntax(NULL, i, form, reason);
return; return;
} }
@ -11306,7 +11305,7 @@ void parse_requires(Scheme_Object *form, int at_phase,
while (SCHEME_STX_PAIRP(rest)) { while (SCHEME_STX_PAIRP(rest)) {
nm = SCHEME_STX_CAR(rest); nm = SCHEME_STX_CAR(rest);
if (!SCHEME_STX_SYMBOLP(nm)) { 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); scheme_hash_set(onlys, SCHEME_STX_VAL(nm), nm);
rest = SCHEME_STX_CDR(rest); rest = SCHEME_STX_CDR(rest);
@ -11328,15 +11327,15 @@ void parse_requires(Scheme_Object *form, int at_phase,
GC_CAN_IGNORE const char *reason; GC_CAN_IGNORE const char *reason;
if (len < 0) if (len < 0)
reason = "bad syntax (" IMPROPER_LIST_FORM ")"; reason = IMPROPER_LIST_FORM;
else if (len < 2) else if (len < 2)
reason = "bad syntax (module name missing)"; reason = "module name missing";
else if (len < 3) else if (len < 3)
reason = "bad syntax (internal name missing)"; reason = "internal name missing";
else if (len < 4) else if (len < 4)
reason = "bad syntax (external name missing)"; reason = "external name missing";
else else
reason = "bad syntax (extra data after external name)"; reason = "extra data after external name";
scheme_wrong_syntax(NULL, i, form, reason); scheme_wrong_syntax(NULL, i, form, reason);
return; return;
} }
@ -11349,9 +11348,9 @@ void parse_requires(Scheme_Object *form, int at_phase,
ename = SCHEME_STX_CAR(rest); ename = SCHEME_STX_CAR(rest);
if (!SCHEME_STX_SYMBOLP(iname)) 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)) 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; mark_src = iname;

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

@ -877,8 +877,7 @@ static void TCP_INIT(char *name)
if (!started) if (!started)
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"%s: not supported on this machine\n" "%s: no winsock driver",
" explanation: no winsock driver",
name); name);
# ifdef MZ_USE_PLACES # ifdef MZ_USE_PLACES
@ -2008,7 +2007,7 @@ static Scheme_Object *tcp_connect(int argc, Scheme_Object *argv[])
nameerr, errid); nameerr, errid);
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"tcp-connect: not supported on this platform"); "tcp-connect: " NOT_SUPPORTED_STR);
#endif #endif
return NULL; return NULL;
@ -2306,7 +2305,7 @@ tcp_listen(int argc, Scheme_Object *argv[])
origid, errid); origid, errid);
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"tcp-listen: not supported on this platform"); "tcp-listen: " NOT_SUPPORTED_STR);
#endif #endif
return NULL; return NULL;
@ -2761,9 +2760,9 @@ static Scheme_Object *tcp_accept_evt(int argc, Scheme_Object *argv[])
return r; 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; return NULL;
} }
@ -3047,7 +3046,7 @@ static Scheme_Object *make_udp(int argc, Scheme_Object *argv[])
return (Scheme_Object *)udp; return (Scheme_Object *)udp;
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"udp-open-socket: not supported on this platform"); "udp-open-socket: " NOT_SUPPORTED_STR);
return NULL; return NULL;
#endif #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); astr = scheme_make_args_string("other ", i, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT, 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), scheme_make_provided_string(argv[i], 1, NULL),
astr, alen); 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); astr = scheme_make_args_string("", -1, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: conflicting or redundant " "%s: conflicting or redundant file modes given%t",
"file modes given%t", name, name,
astr, alen); 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); astr = scheme_make_args_string("other ", i, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT, 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), scheme_make_provided_string(argv[i], 1, NULL),
astr, alen); 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); astr = scheme_make_args_string("", -1, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: conflicting or redundant " "%s: conflicting or redundant file modes given%t",
"file modes given%t", name, name,
astr, alen); astr, alen);
} }
} }
@ -4909,7 +4911,7 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv
if (and_read) { if (and_read) {
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"%s: not supported on this platform", "%s: " NOT_SUPPORTED_STR,
name); name);
return NULL; return NULL;
} }
@ -8395,7 +8397,7 @@ static Scheme_Object *subprocess_status(int argc, Scheme_Object **argv)
} }
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"%s: not supported on this platform", "%s: " NOT_SUPPORTED_STR,
"subprocess-status"); "subprocess-status");
#endif #endif
} }
@ -8424,7 +8426,7 @@ static Scheme_Object *subprocess_wait(int argc, Scheme_Object **argv)
} }
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"%s: not supported on this platform", "%s: " NOT_SUPPORTED_STR,
"subprocess-wait"); "subprocess-wait");
#endif #endif
} }
@ -8516,7 +8518,8 @@ static Scheme_Object *do_subprocess_kill(Scheme_Object *_sp, Scheme_Object *kill
#endif #endif
if (can_error) 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); " system error: %E", errno);
return NULL; 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); return do_subprocess_kill(argv[0], argv[1], 1);
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"%s: not supported on this platform", "%s: " NOT_SUPPORTED_STR,
"subprocess-wait"); "subprocess-wait");
return NULL; return NULL;
#endif #endif
@ -9403,7 +9406,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
/*--------------------------------------*/ /*--------------------------------------*/
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"%s: not supported on this platform", "%s: " NOT_SUPPORTED_STR,
name); name);
return NULL; return NULL;
# endif # endif
@ -9537,7 +9540,7 @@ static Scheme_Object *sch_shell_execute(int c, Scheme_Object *argv[])
} }
#else #else
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"shell-execute: not supported on this platform"); "shell-execute: " NOT_SUPPORTED_STR);
return NULL; return NULL;
#endif #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; Scheme_Input_Port *ip;
ip = scheme_input_port_record(port); ip = scheme_input_port_record(port);
scheme_raise_exn(MZEXN_FAIL, scheme_raise_exn(MZEXN_FAIL,
"default-load-handler: expected only a `module' declaration," "default-load-handler: expected only a `module' declaration;\n"
" but found an extra form\n in: %V", " found an extra form\n"
" in: %V",
modname, modname,
ip->name); ip->name);
@ -4572,7 +4573,9 @@ static Scheme_Object *do_load_handler(void *data)
Scheme_Input_Port *ip; Scheme_Input_Port *ip;
ip = scheme_input_port_record(port); ip = scheme_input_port_record(port);
scheme_raise_exn(MZEXN_FAIL, 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, modname,
ip->name); 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)) if (!scheme_is_complete_path(s, len, SCHEME_PLATFORM_PATH_KIND))
scheme_raise_exn(MZEXN_FAIL_CONTRACT, 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, name,
s); 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); op = scheme_output_port_record(port);
if (op->closed) 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); 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_tell_all(port, &xl, &xc, &xp);
scheme_read_err(port, stxsrc, xl, xc, xp, scheme_read_err(port, stxsrc, xl, xc, xp,
1, 0, indentation, 1, 0, indentation,
"read: illegal use of \".\""); "read: illegal use of `.'");
return NULL; 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 */ /* errors and exceptions */
/*========================================================================*/ /*========================================================================*/
#define NOT_SUPPORTED_STR "unsupported on this platform"
void scheme_read_err(Scheme_Object *port, void scheme_read_err(Scheme_Object *port,
Scheme_Object *stxsrc, Scheme_Object *stxsrc,
intptr_t line, intptr_t column, intptr_t pos, intptr_t span, 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 */ /* ok */
} else { } else {
scheme_contract_error("make-struct-type", scheme_contract_error("make-struct-type",
"contract failed for prop:procedure value", "given value did not satisfy the contract for prop:procedure",
"expected matching", 0, "(or/c procedure? exact-nonnegative-integer?)", "expected", 0, "(or/c procedure? exact-nonnegative-integer?)",
"value", 1, orig_v, "given", 1, orig_v,
NULL); 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) static void wrong_property_contract(const char *name, const char *contract, Scheme_Object *v)
{ {
scheme_contract_error(name, scheme_contract_error(name,
"contract violation for property value", "contract violation for given property value",
"expected matching", 0, contract, "expected", 0, contract,
"given", 1, v, "given", 1, v,
NULL); NULL);
} }
@ -1885,10 +1885,10 @@ static void wrong_struct_type(char *name,
{ {
if (SAME_OBJ(expected, received)) if (SAME_OBJ(expected, received))
scheme_contract_error(name, scheme_contract_error(name,
"contract failure", "contract violation;\n"
"expected matching", 0, pred_name_string(expected), " given value instantiates a different structure type with the same name",
"expected", 0, pred_name_string(expected),
"given", 1, argv[which], "given", 1, argv[which],
"explanation", 0, "given value instantiates a different structure type with the same name",
NULL); NULL);
else else
scheme_wrong_contract(name, scheme_wrong_contract(name,
@ -2498,13 +2498,16 @@ static Scheme_Object *apply_chaperones(const char *who, Scheme_Object *procs, in
if (cnt != argc) { if (cnt != argc) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY,
"%s: chaperone returned wrong number of values\n" "%s: arity mismatch;\n"
" chaperone: %V\n" " received wrong number of values from %s replacement procedure\n"
" expected count: %d\n" " expected: %d\n"
" returned count: %d", " received: %d\n"
" %s: %V\n",
who, who,
is_impersonator ? "an impersonator's" : "an chaperone's",
SCHEME_CAR(procs), SCHEME_CAR(procs),
argc, cnt); argc, cnt,
is_impersonator ? "impersonator" : "chaperone");
} }
if (!is_impersonator) { 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]); scheme_wrong_chaperoned("evt chaperone", "value", evt, vals[0]);
if (!scheme_check_proc_arity(NULL, 1, 1, 1, vals)) if (!scheme_check_proc_arity(NULL, 1, 1, 1, vals))
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"evt %s: contract failure for second %s result\n" "evt %s: contract violation for second %s result\n"
" expected matching: (any/c any/c . -> . any)\n" " expected: (any/c any/c . -> . any)\n"
" received: %V", " received: %V",
(is_impersonator ? "impersonator" : "chaperone"), (is_impersonator ? "impersonator" : "chaperone"),
(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_slots < parent_type->num_slots)
|| (struct_type->num_islots < parent_type->num_islots)))) { || (struct_type->num_islots < parent_type->num_islots)))) {
/* Too many fields. */ /* Too many fields. */
scheme_raise_exn(MZEXN_FAIL, scheme_raise_exn(MZEXN_FAIL, "too many fields for struct-type\n"
"too many fields for struct-type\n"
" maximum total field count: " MAX_STRUCT_FIELD_COUNT_STR); " maximum total field count: " MAX_STRUCT_FIELD_COUNT_STR);
return NULL; return NULL;
} }
@ -4333,8 +4335,8 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
if (guard) { if (guard) {
if (!scheme_check_proc_arity(NULL, struct_type->num_islots + 1, -1, 0, &guard)) { if (!scheme_check_proc_arity(NULL, struct_type->num_islots + 1, -1, 0, &guard)) {
scheme_contract_error("make-struct-type", scheme_contract_error("make-struct-type",
"guard procedure does not accept correct number of arguments", "guard procedure does not accept correct number of arguments;\n"
"explanation", 0, "should accept one more than the number of constructor arguments", " should accept one more than the number of constructor arguments",
"guard procedure", 1, guard, "guard procedure", 1, guard,
"expected arity", 1, scheme_make_integer(struct_type->num_islots + 1), "expected arity", 1, scheme_make_integer(struct_type->num_islots + 1),
NULL); NULL);
@ -4472,8 +4474,8 @@ static char* immutable_pos_list_to_immutable_array(Scheme_Object *immutable_pos_
a_val = SCHEME_INT_VAL(a); a_val = SCHEME_INT_VAL(a);
if (a_val < 0) { if (a_val < 0) {
scheme_contract_error("make-struct-type", scheme_contract_error("make-struct-type",
"contract failure at index for immutable field", "contract violation for index of immutable field",
"expected matching", 0, "(and/c exact-nonnegative-integer? fixnum?)", "expected:", 0, "(and/c exact-nonnegative-integer? fixnum?)",
"given", 1, a, "given", 1, a,
"in list", 1, immutable_pos_list, "in list", 1, immutable_pos_list,
NULL); NULL);
@ -5335,7 +5337,7 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
scheme_contract_error(name, scheme_contract_error(name,
"operation's redirection procedure does not match the expected arity", "operation's redirection procedure does not match the expected arity",
"given", 1, proc, "given", 1, proc,
"expected matching", 0, buf, "expected", 0, buf,
"operation kind", 0, kind, "operation kind", 0, kind,
"operation procedure", 1, a[0], "operation procedure", 1, a[0],
NULL); 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 #endif
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"custodian-require-memory: not supported"); "custodian-require-memory: " NOT_SUPPORTED_STR);
return NULL; /* doesn't get here */ return NULL; /* doesn't get here */
} }
@ -815,7 +815,7 @@ static Scheme_Object *custodian_limit_mem(int argc, Scheme_Object *args[])
#endif #endif
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"custodian-limit-memory: not supported"); "custodian-limit-memory: " NOT_SUPPORTED_STR);
return NULL; /* doesn't get here */ return NULL; /* doesn't get here */
} }