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

fix format of some error messages

Browse Source 
Closes 12536
This commit is contained in:
Matthew Flatt 2012-02-03 22:09:22 -07:00
parent 8a2b06574a
commit 8cf49dfdb1
10 changed files with 52 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/drracket/language-test.rkt
View File

@ -125,7 +125,7 @@ the settings above should match r5rs
(test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)")
(test-expression "(list 1)" "'(1)") (test-expression "(list 1)" "'(1)")
(test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type <pair>; given '()") (test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type <pair>; given: '()")
(test-expression "(current-command-line-arguments)" "'#()") (test-expression "(current-command-line-arguments)" "'#()")
(test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case") (test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case")
@ -227,7 +227,7 @@ the settings above should match r5rs
(test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)")
(test-expression "(list 1)" "(1)") (test-expression "(list 1)" "(1)")
(test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type <pair>; given ()") (test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type <pair>; given: ()")
(test-expression "(current-command-line-arguments)" "#()") (test-expression "(current-command-line-arguments)" "#()")
(test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case") (test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case")
@ -335,7 +335,7 @@ the settings above should match r5rs
(test-expression "(list 1)" "(1)") (test-expression "(list 1)" "(1)")
(test-expression "(car (list))" (test-expression "(car (list))"
"{stop-multi.png} {stop-22x22.png} mcar: expects argument of type <mutable-pair>; given ()") "{stop-multi.png} {stop-22x22.png} mcar: expects argument of type <mutable-pair>; given: ()")
(test-expression "argv" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: argv") (test-expression "argv" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: argv")
(test-expression "(define-syntax app syntax-case)" (test-expression "(define-syntax app syntax-case)"
@ -484,7 +484,7 @@ the settings above should match r5rs
"(cons 1 empty)" "(cons 1 empty)"
"(cons 1 empty)") "(cons 1 empty)")
(test-expression "(car (list))" (test-expression "(car (list))"
"car: expects a pair; given empty") "car: expects a pair; given: empty")
(test-undefined-var "argv") (test-undefined-var "argv")
(test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax")
@ -634,7 +634,7 @@ the settings above should match r5rs
(test-expression "(list 1)" (test-expression "(list 1)"
"(list 1)" "(list 1)"
"(list 1)") "(list 1)")
(test-expression "(car (list))" "car: expects a pair; given empty") (test-expression "(car (list))" "car: expects a pair; given: empty")
(test-undefined-var "argv") (test-undefined-var "argv")
@ -780,7 +780,7 @@ the settings above should match r5rs
(test-expression "(list 1)" (test-expression "(list 1)"
"(list 1)" "(list 1)"
"(list 1)") "(list 1)")
(test-expression "(car (list))" "car: expects a pair; given empty") (test-expression "(car (list))" "car: expects a pair; given: empty")
(test-undefined-var "argv") (test-undefined-var "argv")
(test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax")
@ -923,7 +923,7 @@ the settings above should match r5rs
(test-expression "(list 1)" (test-expression "(list 1)"
"(list 1)" "(list 1)"
"(list 1)") "(list 1)")
(test-expression "(car (list))" "car: expects a pair; given empty") (test-expression "(car (list))" "car: expects a pair; given: empty")
(test-undefined-var "argv") (test-undefined-var "argv")
(test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax")
@ -1074,7 +1074,7 @@ the settings above should match r5rs
(test-expression "(list 1)" (test-expression "(list 1)"
"(list 1)" "(list 1)"
"(list 1)") "(list 1)")
(test-expression "(car (list))" "car: expects a pair; given empty") (test-expression "(car (list))" "car: expects a pair; given: empty")
(test-undefined-var "argv") (test-undefined-var "argv")
(test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax")

6
collects/tests/drracket/module-lang-test.rkt
View File

@ -272,7 +272,7 @@
@t{lambda: bad syntax in: (lambda ())}) @t{lambda: bad syntax in: (lambda ())})
(test @t{#lang racket/base} (test @t{#lang racket/base}
@t{(expt 3 (void))} @t{(expt 3 (void))}
@rx{expt: expected argument of type <number>; given #<void>}) @rx{expt: expected argument of type <number>; given: #<void>})
(test @t{#lang racket/base} (test @t{#lang racket/base}
@t{1 2 ( 3 4} @t{1 2 ( 3 4}
@t{1@"\n"2@"\n". read: expected a `)' to close `('}) @t{1@"\n"2@"\n". read: expected a `)' to close `('})
@ -302,7 +302,7 @@
"(lambda () (expt 3 #f))\n" "(lambda () (expt 3 #f))\n"
"(lambda () (error-escape-handler old))))\n" "(lambda () (error-escape-handler old))))\n"
"10))") "10))")
". . expt: expected argument of type <number>; given #f\n15") ". . expt: expected argument of type <number>; given: #f\n15")
(test @t{#lang racket/base} (test @t{#lang racket/base}
"(write (list (syntax x)))" "(write (list (syntax x)))"
"(.)") "(.)")
@ -322,7 +322,7 @@
(lambda () (expt 3 #f)) (lambda () (expt 3 #f))
(lambda () (semaphore-post s))))) (lambda () (semaphore-post s)))))
'(begin (yield s) (void))) '(begin (yield s) (void)))
". . expt: expected argument of type <number>; given #f") ". . expt: expected argument of type <number>; given: #f")
(test @t{#lang racket/base} (test @t{#lang racket/base}
(format "~s ~s" (format "~s ~s"
'(define x 1) '(define x 1)

48
collects/tests/drracket/repl-test.rkt
View File

@ -446,12 +446,12 @@ This produces an ACK message
; printer setup test ; printer setup test
(mktest "(expt 3 (void))" (mktest "(expt 3 (void))"
("{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #<void>" ("{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #<void>"
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #<void>" "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #<void>"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:0: expt: expected argument of type <number>; given #<void>" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:0: expt: expected argument of type <number>; given: #<void>"
"expt: expected argument of type <number>; given #<void>" "expt: expected argument of type <number>; given: #<void>"
#rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>" #rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given: #<void>"
#rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>") #rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given: #<void>")
'definitions 'definitions
#f #f
void void
@ -548,12 +548,12 @@ This produces an ACK message
(mktest (mktest
"(load \"repl-test-tmp2.rkt\") (define (g) (+ 1 (expt 3 #f))) (f g)" "(load \"repl-test-tmp2.rkt\") (define (g) (+ 1 (expt 3 #f))) (f g)"
("{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f" ("{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #f"
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f" "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #f"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:45: expt: expected argument of type <number>; given #f" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:45: expt: expected argument of type <number>; given: #f"
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f" "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #f"
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f" "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #f"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:28: expt: expected argument of type <number>; given #f") "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:28: expt: expected argument of type <number>; given: #f")
'definitions 'definitions
#f #f
(λ () (λ ()
@ -609,12 +609,12 @@ This produces an ACK message
(mktest (mktest
"(let ([old (error-escape-handler)])\n(+ (let/ec k\n(dynamic-wind\n(lambda () (error-escape-handler (lambda () (k 5))))\n(lambda () (expt 3 #f))\n(lambda () (error-escape-handler old))))\n10))" "(let ([old (error-escape-handler)])\n(+ (let/ec k\n(dynamic-wind\n(lambda () (error-escape-handler (lambda () (k 5))))\n(lambda () (expt 3 #f))\n(lambda () (error-escape-handler old))))\n10))"
("{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f\n15" ("{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #f\n15"
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f\n15" "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given: #f\n15"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:5:19: expt: expected argument of type <number>; given #f\n15" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:5:19: expt: expected argument of type <number>; given: #f\n15"
"expt: expected argument of type <number>; given #f\n15" "expt: expected argument of type <number>; given: #f\n15"
#rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15" #rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given: #f\n15"
#rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15") #rx"{stop-multi.png} {stop-22x22.png} .*rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given: #f\n15")
'definitions 'definitions
#f #f
void void
@ -708,12 +708,12 @@ This produces an ACK message
;; comes and messes up the source location for the error. ;; comes and messes up the source location for the error.
"(define s (make-semaphore 0))\n(queue-callback\n(lambda ()\n(dynamic-wind\nvoid\n(lambda () (expt 3 #f))\n(lambda () (semaphore-post s)))))\n(begin (yield s) (void))" "(define s (make-semaphore 0))\n(queue-callback\n(lambda ()\n(dynamic-wind\nvoid\n(lambda () (expt 3 #f))\n(lambda () (semaphore-post s)))))\n(begin (yield s) (void))"
(#rx"expt: expected argument of type <number>; given #f" (#rx"expt: expected argument of type <number>; given: #f"
#rx"expt: expected argument of type <number>; given #f" #rx"expt: expected argument of type <number>; given: #f"
#rx"expt: expected argument of type <number>; given #f" #rx"expt: expected argument of type <number>; given: #f"
#rx"expt: expected argument of type <number>; given #f" #rx"expt: expected argument of type <number>; given: #f"
#rx"expt: expected argument of type <number>; given #f" #rx"expt: expected argument of type <number>; given: #f"
#rx"expt: expected argument of type <number>; given #f") #rx"expt: expected argument of type <number>; given: #f")
'definitions 'definitions
#f #f
void void

2
collects/tests/drracket/teachpack.rkt
View File

@ -171,7 +171,7 @@
(test-bad/execute-teachpack (test-bad/execute-teachpack
`(module teachpack-tmp mzscheme (car)) `(module teachpack-tmp mzscheme (car))
"car: expects argument of type <pair>; given 1")) "car: expects argument of type <pair>; given: 1"))
(define (get-string-from-file fn) (define (get-string-from-file fn)
(call-with-input-file fn (call-with-input-file fn

4
collects/tests/htdp-lang/advanced.rktl
View File

@ -208,8 +208,8 @@
(htdp-err/rt-test (cons 1 2) "cons: second argument must be a list or cyclic list, but received 1 and 2") (htdp-err/rt-test (cons 1 2) "cons: second argument must be a list or cyclic list, but received 1 and 2")
(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list or cyclic list, but received 2") (htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list or cyclic list, but received 2")
(htdp-err/rt-test (first 1) "first: expected argument of type <non-empty list>; given 1") (htdp-err/rt-test (first 1) "first: expected argument of type <non-empty list>; given: 1")
(htdp-err/rt-test (rest 1) "rest: expected argument of type <non-empty list>; given 1") (htdp-err/rt-test (rest 1) "rest: expected argument of type <non-empty list>; given: 1")
(htdp-test #t 'equal? (equal? (vector (list 10) 'apple) (vector (list 10) 'apple))) (htdp-test #t 'equal? (equal? (vector (list 10) 'apple) (vector (list 10) 'apple)))

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

@ -75,7 +75,7 @@
(htdp-test #t 'a3? (a3? (make-a3 1 2 3))) (htdp-test #t 'a3? (a3? (make-a3 1 2 3)))
(htdp-test #f 'a1? (a1? (make-a3 1 2 3))) (htdp-test #f 'a1? (a1? (make-a3 1 2 3)))
(htdp-test #f 'a3? (a3? (make-a1 1))) (htdp-test #f 'a3? (a3? (make-a1 1)))
(htdp-err/rt-test (a1-b 10) "a1-b: expects argument of type <struct:a1>; given 10") (htdp-err/rt-test (a1-b 10) "a1-b: expects argument of type <struct:a1>; given: 10")
(htdp-syntax-test #'(a0 1 2 3) "a0: expected a function after the open parenthesis, but found a structure name") (htdp-syntax-test #'(a0 1 2 3) "a0: expected a function after the open parenthesis, but found a structure name")
(htdp-syntax-test #'cond "cond: expected an open parenthesis before cond, but found none") (htdp-syntax-test #'cond "cond: expected an open parenthesis before cond, but found none")

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

@ -28,4 +28,4 @@
(htdp-syntax-test #'unquote-splicing "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote") (htdp-syntax-test #'unquote-splicing "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote")
(htdp-syntax-test #'(unquote-splicing (list 10)) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote") (htdp-syntax-test #'(unquote-splicing (list 10)) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote")
(htdp-err/rt-test `(,@4) (exn-type-and-msg exn:fail:contract? "append: expected argument of type <proper list>; given 4")) (htdp-err/rt-test `(,@4) (exn-type-and-msg exn:fail:contract? "append: expected argument of type <proper list>; given: 4"))

15
collects/tests/racket/syntax.rktl
View File

@ -968,24 +968,11 @@
(error-test #'(parameterize ((x . 9)) 8) syntaxe?) (error-test #'(parameterize ((x . 9)) 8) syntaxe?)
(error-test #'(parameterize ([10 10]) 8)) (error-test #'(parameterize ([10 10]) 8))
(error-test #'(parameterize ([10 10]) 8) (lambda (exn) (not (regexp-match #rx"argument" (exn-message exn)))))
(error-test #'(parameterize ([(lambda () 10) 10]) 8)) (error-test #'(parameterize ([(lambda () 10) 10]) 8))
(error-test #'(parameterize ([(lambda (a) 10) 10]) 8)) (error-test #'(parameterize ([(lambda (a) 10) 10]) 8))
(error-test #'(parameterize ([(lambda (a b) 10) 10]) 8)) (error-test #'(parameterize ([(lambda (a b) 10) 10]) 8))
#|
(test #t procedure? (check-parameter-procedure current-directory))
(test #t procedure? (check-parameter-procedure (case-lambda
[() 0]
[(x) 0])))
(test 'exn 'not-param (with-handlers ([void (lambda (x) 'exn)])
(check-parameter-procedure (lambda () 10))))
(test 'exn 'not-param (with-handlers ([void (lambda (x) 'exn)])
(check-parameter-procedure (lambda (x) 10))))
(test 'exn 'not-param (with-handlers ([void (lambda (x) 'exn)])
(check-parameter-procedure (lambda (x y) 10))))
(arity-test check-parameter-procedure 1 1)
|#
(test 1 'time (time 1)) (test 1 'time (time 1))
(test -1 'time (time (cons 1 2) -1)) (test -1 'time (time (cons 1 2) -1))
(test-values '(-1 1) (lambda () (time (values -1 1)))) (test-values '(-1 1) (lambda () (time (values -1 1))))

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

@ -1397,23 +1397,30 @@ void scheme_wrong_type(const char *name, const char *expected,
intptr_t slen; intptr_t slen;
int isres = 0; int isres = 0;
GC_CAN_IGNORE char *isress = "argument"; GC_CAN_IGNORE char *isress = "argument";
GC_CAN_IGNORE char *isgiven = "given";
o = argv[which < 0 ? 0 : which]; o = argv[which < 0 ? 0 : which];
if (argc < 0) { if (argc < 0) {
argc = -argc; argc = -argc;
isress = "result"; isress = "result";
isgiven = "received";
isres = 1; isres = 1;
} }
if (which == -2) {
isress = "value";
isgiven = "received";
}
s = scheme_make_provided_string(o, 1, &slen); s = scheme_make_provided_string(o, 1, &slen);
if ((which < 0) || (argc == 1)) if ((which < 0) || (argc == 1))
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: expect%s %s of type <%s>; " "%s: expect%s %s of type <%s>; "
"given %t", "%s: %t",
name, name,
(which < 0) ? "ed" : "s", (which < 0) ? "ed" : "s",
isress, expected, s, slen); isress, expected, isgiven,
s, slen);
else { else {
char *other; char *other;
intptr_t olen; intptr_t olen;

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

@ -6889,7 +6889,8 @@ static Scheme_Object *extend_parameterization(int argc, Scheme_Object *argv[])
param = argv[i]; param = argv[i];
if (!SCHEME_PARAMETERP(param) if (!SCHEME_PARAMETERP(param)
&& !(SCHEME_CHAPERONEP(param) && SCHEME_PARAMETERP(SCHEME_CHAPERONE_VAL(param)))) { && !(SCHEME_CHAPERONEP(param) && SCHEME_PARAMETERP(SCHEME_CHAPERONE_VAL(param)))) {
scheme_wrong_type("parameterize", "parameter", i, argc, argv); a[0] = param;
scheme_wrong_type("parameterize", "parameter", -2, 1, a);
return NULL; return NULL;
} }
key = argv[i + 1]; key = argv[i + 1];