Adjust for new error mesage style.

(This is in part a temporary solution since the ",bt" command is now used
to show a backtrace as well as any "foo...:" hidden fields.)
This commit is contained in:
Eli Barzilay 2012-07-28 05:04:55 -04:00
parent 5b501da131
commit c2bea19d1b
2 changed files with 35 additions and 10 deletions

View File

@ -1,5 +1,12 @@
#lang at-exp racket/base
;; General note for anyone who tries to run these tests: since the tests check
;; interactions it can be hard to find the problem, and sometimes it's best to
;; just comment a suffix of the tests to find it. In addition, when it fails
;; it tries to provide information that helps finding the problem, but
;; sometimes there's very little help, and it might also fail by just getting
;; stuck.
(define verbose? (make-parameter #f))
(define global-ns (current-namespace))
@ -102,11 +109,15 @@
'foo> «,top»
-> «(define enter! 123)»
-> «(enter! 'foo)»
; procedure application: expected procedure, given: 123; arguments were: 'foo
; [,bt for context]
; application: not a procedure;
; expected a procedure that can be applied to arguments
; given: 123
; [,bt for context]
-> «(enter! 'fooo)»
; procedure application: expected procedure, given: 123; arguments were:
; 'fooo [,bt for context]
; application: not a procedure;
; expected a procedure that can be applied to arguments
; given: 123
; [,bt for context]
-> «,en foo» but this still works
'foo> «,top»
-> «,switch foo»
@ -121,7 +132,9 @@
typed/racket::-> «,switch
; *** Switching to the `*' namespace ***
-> «bleh»
; reference to undefined identifier: bleh [,bt for context]
; bleh: undefined;
; cannot reference undefined identifier
; [,bt for context]
-> «,ap BLEH»
; No matches found.
-> «,ap path->»
@ -157,12 +170,16 @@
123 ...but we still got in
'broken> «,top»
-> «string->jsexpr»
; reference to undefined identifier: string->jsexpr [,bt for context]
; string->jsexpr: undefined;
; cannot reference undefined identifier
; [,bt for context]
-> «,r (only-in json string->jsexpr)» works with an expression
-> «string->jsexpr»
#<procedure:string->jsexpr>
-> «jsexpr->string» didn't get this
; reference to undefined identifier: jsexpr->string [,bt for context]
; jsexpr->string: undefined;
; cannot reference undefined identifier
; [,bt for context]
-> «,en json»
json/main> «,sh echo $F»
@|collects|/json/main.rkt

View File

@ -1459,12 +1459,20 @@
(let* ([s (get-output-string (current-error-port))]
[s (regexp-replace* #rx"^\n+|\n+$" s "")]
[s (regexp-replace* #rx"\n\n+" s "\n")])
(and (not (equal? str s))
;; temporary hack: this is always on since it shows all fields,
;; so ",bt" is now really a generic "more info"
(and ; (not (equal? str s))
(begin (set! last-backtrace s) #t)))))
(define msg "[,bt for context]")
(parameterize ([current-output-port (current-error-port)])
(with-wrapped-output
(if backtrace? (printf "; ~a ~a\n" str msg) (printf "; ~a\n" str)))))
(let* ([s (regexp-replace* #rx"^\n+|\n+$" str "")]
[s (regexp-replace* #rx"\n\n+" s "\n")]
[s (regexp-replace* #rx"\n [^\n]+\\.\\.\\.:(?:[^\n]+|\n )+" s "")]
[s (regexp-replace* #rx"\n" s "\n; ")]
[s (if backtrace?
(string-append s (if (regexp-match? #rx"\n" s) "\n; " " ") msg)
s)])
(with-wrapped-output (printf "; ~a\n" s)))))
;; ----------------------------------------------------------------------------
;; set up the xrepl environment