From 644a4c550f1f08b33282978f1cc5e015cb9e1a42 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 9 Dec 2015 17:22:42 -0700
Subject: [PATCH] use syntax objects to represent source locations

To avoid the possibility of absolute paths in bytecode form,
rely on syntax objects to encode source locations (so that the
marshaling of syntax object can avoid absolute paths).
---
 rackunit-lib/rackunit/private/check.rkt     | 20 +++++++-------------
 rackunit-lib/rackunit/private/test-case.rkt | 11 +++++++----
 2 files changed, 14 insertions(+), 17 deletions(-)

diff --git a/rackunit-lib/rackunit/private/check.rkt b/rackunit-lib/rackunit/private/check.rkt
index 9e9e31e..b8af95f 100644
--- a/rackunit-lib/rackunit/private/check.rkt
+++ b/rackunit-lib/rackunit/private/check.rkt
@@ -1,8 +1,7 @@
 #lang racket/base
 
 (require racket/match
-         (for-syntax racket/base
-                     "location.rkt")
+         (for-syntax racket/base)
          rackunit/log
          "base.rkt"
          "check-info.rkt"
@@ -145,19 +144,18 @@
            (define check-secret-name check-fn)
            
            (define-syntax (name stx)
-             (with-syntax
-                 ([loc (syntax->location stx)])
+             (with-syntax ([loc (datum->syntax #f 'loc stx)])
                (syntax-case stx ()
                  ((name actual ...)
                   (syntax/loc stx
                     (check-secret-name actual ...
-                                       #:location (quote loc)
+                                       #:location (syntax->location (quote-syntax loc))
                                        #:expression (quote (name actual ...)))))
 
                  ((name actual ... msg)
                   (syntax/loc stx
                     (check-secret-name actual ... msg
-                                       #:location (quote loc)
+                                       #:location (syntax->location (quote-syntax loc))
                                        #:expression (quote (name actual ...)))))
                     
                  (name
@@ -166,11 +164,11 @@
                     (case-lambda
                       [(formal ...)
                        (check-secret-name formal ... 
-                                          #:location (quote loc) 
+                                          #:location (syntax->location (quote-syntax loc))
                                           #:expression (quote (name actual ...)))]
                       [(formal ... msg)
                        (check-secret-name formal ... msg
-                                          #:location (quote loc) 
+                                          #:location (syntax->location (quote-syntax loc))
                                           #:expression (quote (name actual ...)))]))))))
            ))))))
 
@@ -307,11 +305,7 @@
        (with-check-info*
         (list (make-check-name 'check-match)
               (make-check-location
-               (list '(unsyntax (syntax-source stx))
-                     '(unsyntax (syntax-line stx))
-                     '(unsyntax (syntax-column stx))
-                     '(unsyntax (syntax-position stx))
-                     '(unsyntax (syntax-span stx))))
+               (syntax->location (quote-syntax #,(datum->syntax #f 'loc stx))))
               (make-check-expression '#,(syntax->datum stx))
               (make-check-actual actual-val)
               (make-check-expected 'expected))
diff --git a/rackunit-lib/rackunit/private/test-case.rkt b/rackunit-lib/rackunit/private/test-case.rkt
index f314e05..12aeaab 100644
--- a/rackunit-lib/rackunit/private/test-case.rkt
+++ b/rackunit-lib/rackunit/private/test-case.rkt
@@ -64,12 +64,15 @@
     [(_ name expr ...)
      (quasisyntax/loc stx
        (parameterize
-           ([current-test-name 
-             (contract string? name 
-                       '#,(syntax-source-module #'name #t)
-                       '#,(syntax-source-module #'test-case #t))])
+           ([current-test-name
+             (ensure-string name (quote-syntax #,(datum->syntax #f 'loc #'name)))])
          (test-begin expr ...)))]))
 
+(define (ensure-string name src-stx)
+  (contract string? name
+            (syntax-source name)
+            (syntax-source-module #'test-case #t)))
+
 (define-syntax before
   (syntax-rules ()
     ((_ before-e expr1 expr2 ...)