From 9b569aa9a2ea5ac800c6ba50eb4f29452ecc1dd6 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 9 Feb 2012 21:56:09 -0700
Subject: [PATCH] adjust some libraries to avoid converting paths to strings
 too early

Early conversions leave absolute paths in bytecode and rendered
documentation.
---
 collects/rackunit/scribblings/check.scrbl |  1 +
 collects/tests/drracket/get-defs-test.rkt |  8 ++++----
 collects/tests/eli-tester.rkt             | 25 ++++++++++++++---------
 collects/unstable/wrapc.rkt               |  2 +-
 4 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/collects/rackunit/scribblings/check.scrbl b/collects/rackunit/scribblings/check.scrbl
index cc9c912a56..83850a2b04 100644
--- a/collects/rackunit/scribblings/check.scrbl
+++ b/collects/rackunit/scribblings/check.scrbl
@@ -3,6 +3,7 @@
 
 @(define rackunit-eval (make-base-eval))
 @(interaction-eval #:eval rackunit-eval (require rackunit))
+@(interaction-eval #:eval rackunit-eval (error-print-context-length 0))
 
 @title{Checks}
 
diff --git a/collects/tests/drracket/get-defs-test.rkt b/collects/tests/drracket/get-defs-test.rkt
index 54e9176996..dd34e4d354 100644
--- a/collects/tests/drracket/get-defs-test.rkt
+++ b/collects/tests/drracket/get-defs-test.rkt
@@ -20,10 +20,10 @@
              [expected (list (list name start end) ...)])
          (unless (equal? actual expected)
            (eprintf "Test failure at ~a\nActual: ~s\nExpected: ~s\n"
-                    #,(format "~a:~a:~a"
-                              (syntax-source #'stx)
-                              (syntax-line #'stx)
-                              (syntax-column #'stx))
+                    (format "~a:~a:~a"
+                            '(syntax-source #'stx)
+                            '(syntax-line #'stx)
+                            '(syntax-column #'stx))
                     actual
                     expected)))]))
 
diff --git a/collects/tests/eli-tester.rkt b/collects/tests/eli-tester.rkt
index 011c1c3a7d..7206387f6a 100644
--- a/collects/tests/eli-tester.rkt
+++ b/collects/tests/eli-tester.rkt
@@ -47,21 +47,26 @@
   (lambda (prefix qe fmt . args) real-msg))
 (define failure-prefix-mark (gensym 'failure-prefix))
 
+(define (make-location src line col pos)
+  (string->symbol
+   (format "~a:~a" (or src "(unknown)")
+           (let ([l line] [c col])
+             (cond [(and l c) (format "~a:~a" l c)]
+                   [l l]
+                   [pos => (lambda (p) (format "#~a" p))]
+                   [else "?"])))))
+    
 (define-syntax (test-thunk stx)
   (define (blame e fmt . args)
-    (define loc
-      (string->symbol
-       (format "~a:~a" (or (syntax-source e) "(unknown)")
-               (let ([l (syntax-line e)] [c (syntax-column e)])
-                 (cond [(and l c) (format "~a:~a" l c)]
-                       [l l]
-                       [(syntax-position e) => (lambda (p) (format "#~a" p))]
-                       [else "?"])))))
-    (with-syntax ([e e] [fmt fmt] [(arg ...) args] [loc loc])
+    (with-syntax ([e e] [fmt fmt] [(arg ...) args] 
+                  [src (syntax-source e)]
+                  [line (syntax-line e)]
+                  [col (syntax-column e)]
+                  [pos (syntax-position e)])
       #'(let* ([form (failure-format)]
                [prefix (continuation-mark-set->list (current-continuation-marks)
                                                     failure-prefix-mark)])
-          (error 'loc "~a" (form prefix 'e fmt arg ...)))))
+          (error (make-location 'src 'line 'col 'pos) "~a" (form prefix 'e fmt arg ...)))))
   (define (test-1 x)
     #`(let ([x (safe #,x)])
         (unless (and (eq? 'values (car x)) (= 2 (length x)) (cadr x))
diff --git a/collects/unstable/wrapc.rkt b/collects/unstable/wrapc.rkt
index 523cc7898b..c72b79c597 100644
--- a/collects/unstable/wrapc.rkt
+++ b/collects/unstable/wrapc.rkt
@@ -80,7 +80,7 @@
                 [collapsed
                  (collapse-module-path-index source (or here (build-path 'same)))])
            (cond [(and (path? collapsed) here)
-                  #`(quote #,(path->string collapsed))]
+                  #`(quote #,collapsed)]
                  [(path? collapsed)
                   (let-values ([(rel base) (module-path-index-split source)])
                     #`(quote #,rel))]