From 5efa036427a081f32af08cd17bfa31fab04322b1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 12 Jun 2010 15:49:09 -0600 Subject: [PATCH] fix error reporting for keyword mismatches Closes PR 10954 --- collects/racket/private/kw.rkt | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/collects/racket/private/kw.rkt b/collects/racket/private/kw.rkt index 136ff9e94e..ef749353c5 100644 --- a/collects/racket/private/kw.rkt +++ b/collects/racket/private/kw.rkt @@ -940,9 +940,17 @@ (regexp-replace #rx"^.*? given: x; (other )?" (exn-message exn) ""))]) - (apply - raise-type-error 'x "x" 0 'x - (append args (apply append (map list kws kw-args))))))] + (let-values ([(struct:written make-written written? written-ref written-set!) + (make-struct-type 'written #f 1 0)]) + (parameterize ([error-value->string-handler + (let ([prev (error-value->string-handler)]) + (lambda (v n) + (if (written? v) + (format "~s" (written-ref v 0)) + (prev v n))))]) + (apply + raise-type-error 'x "x" 0 (make-written 'x) + (append args (apply append (map list (map make-written kws) kw-args))))))))] [proc-name (lambda (p) (or (and (named-keyword-procedure? p) (car (keyword-procedure-name+fail p))) (object-name p)