From c2bea19d1beacd514eb313bfbf7603c69099bffd Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Sat, 28 Jul 2012 05:04:55 -0400
Subject: [PATCH] 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.)
---
 collects/tests/xrepl/xrepl.rkt | 31 ++++++++++++++++++++++++-------
 collects/xrepl/xrepl.rkt       | 14 +++++++++++---
 2 files changed, 35 insertions(+), 10 deletions(-)

diff --git a/collects/tests/xrepl/xrepl.rkt b/collects/tests/xrepl/xrepl.rkt
index a9e6e92b68..9d832d0e50 100644
--- a/collects/tests/xrepl/xrepl.rkt
+++ b/collects/tests/xrepl/xrepl.rkt
@@ -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
diff --git a/collects/xrepl/xrepl.rkt b/collects/xrepl/xrepl.rkt
index 6c7d30ad33..4b79ea18c5 100644
--- a/collects/xrepl/xrepl.rkt
+++ b/collects/xrepl/xrepl.rkt
@@ -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