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:
parent
5b501da131
commit
c2bea19d1b
|
@ -1,5 +1,12 @@
|
||||||
#lang at-exp racket/base
|
#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 verbose? (make-parameter #f))
|
||||||
|
|
||||||
(define global-ns (current-namespace))
|
(define global-ns (current-namespace))
|
||||||
|
@ -102,11 +109,15 @@
|
||||||
'foo> «,top»
|
'foo> «,top»
|
||||||
-> «(define enter! 123)»
|
-> «(define enter! 123)»
|
||||||
-> «(enter! 'foo)»
|
-> «(enter! 'foo)»
|
||||||
; procedure application: expected procedure, given: 123; arguments were: 'foo
|
; application: not a procedure;
|
||||||
|
; expected a procedure that can be applied to arguments
|
||||||
|
; given: 123
|
||||||
; [,bt for context]
|
; [,bt for context]
|
||||||
-> «(enter! 'fooo)»
|
-> «(enter! 'fooo)»
|
||||||
; procedure application: expected procedure, given: 123; arguments were:
|
; application: not a procedure;
|
||||||
; 'fooo [,bt for context]
|
; expected a procedure that can be applied to arguments
|
||||||
|
; given: 123
|
||||||
|
; [,bt for context]
|
||||||
-> «,en foo» ⇒ but this still works
|
-> «,en foo» ⇒ but this still works
|
||||||
'foo> «,top»
|
'foo> «,top»
|
||||||
-> «,switch foo»
|
-> «,switch foo»
|
||||||
|
@ -121,7 +132,9 @@
|
||||||
typed/racket::-> «,switch *»
|
typed/racket::-> «,switch *»
|
||||||
; *** Switching to the `*' namespace ***
|
; *** Switching to the `*' namespace ***
|
||||||
-> «bleh»
|
-> «bleh»
|
||||||
; reference to undefined identifier: bleh [,bt for context]
|
; bleh: undefined;
|
||||||
|
; cannot reference undefined identifier
|
||||||
|
; [,bt for context]
|
||||||
-> «,ap BLEH»
|
-> «,ap BLEH»
|
||||||
; No matches found.
|
; No matches found.
|
||||||
-> «,ap path->»
|
-> «,ap path->»
|
||||||
|
@ -157,12 +170,16 @@
|
||||||
123 ⇒ ...but we still got in
|
123 ⇒ ...but we still got in
|
||||||
'broken> «,top»
|
'broken> «,top»
|
||||||
-> «string->jsexpr»
|
-> «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
|
-> «,r (only-in json string->jsexpr)» ⇒ works with an expression
|
||||||
-> «string->jsexpr»
|
-> «string->jsexpr»
|
||||||
#<procedure:string->jsexpr>
|
#<procedure:string->jsexpr>
|
||||||
-> «jsexpr->string» ⇒ didn't get this
|
-> «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»
|
-> «,en json»
|
||||||
json/main> «,sh echo $F»
|
json/main> «,sh echo $F»
|
||||||
@|collects|/json/main.rkt
|
@|collects|/json/main.rkt
|
||||||
|
|
|
@ -1459,12 +1459,20 @@
|
||||||
(let* ([s (get-output-string (current-error-port))]
|
(let* ([s (get-output-string (current-error-port))]
|
||||||
[s (regexp-replace* #rx"^\n+|\n+$" s "")]
|
[s (regexp-replace* #rx"^\n+|\n+$" s "")]
|
||||||
[s (regexp-replace* #rx"\n\n+" s "\n")])
|
[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)))))
|
(begin (set! last-backtrace s) #t)))))
|
||||||
(define msg "[,bt for context]")
|
(define msg "[,bt for context]")
|
||||||
(parameterize ([current-output-port (current-error-port)])
|
(parameterize ([current-output-port (current-error-port)])
|
||||||
(with-wrapped-output
|
(let* ([s (regexp-replace* #rx"^\n+|\n+$" str "")]
|
||||||
(if backtrace? (printf "; ~a ~a\n" str msg) (printf "; ~a\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
|
;; set up the xrepl environment
|
||||||
|
|
Loading…
Reference in New Issue
Block a user