From f5e85a650314e24852e03edde4297ad355f984ab Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@hashcollision.org>
Date: Wed, 27 Feb 2013 12:01:09 -0700
Subject: [PATCH] Modify exn:test:check to support prop:exn:srclocs to produce
 good error messages even without debugging enabled.

Closes PR-13451.
---
 collects/rackunit/private/base.rkt     | 15 +++++++++++++--
 collects/rackunit/private/location.rkt | 11 ++++++++++-
 2 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/collects/rackunit/private/base.rkt b/collects/rackunit/private/base.rkt
index 7a0e2ab480..1d66dd7831 100644
--- a/collects/rackunit/private/base.rkt
+++ b/collects/rackunit/private/base.rkt
@@ -1,5 +1,7 @@
 #lang racket/base
-(require racket/contract/base)
+(require racket/contract/base
+         "check-info.rkt"
+         "location.rkt")
 
 ;; struct test : 
 (define-struct test ())
@@ -15,7 +17,16 @@
 ;; struct (exn:test:check struct:exn:test) : (list-of check-info)
 ;;
 ;; The exception thrown to indicate a check has failed
-(define-struct (exn:test:check exn:test) (stack))
+(define-struct (exn:test:check exn:test) (stack)
+  #:property prop:exn:srclocs
+  (lambda (self)
+    ;; Try to get a location from the stack.
+    (define maybe-location (for/or ([check-info (exn:test:check-stack self)])
+                             (and (check-location? check-info) check-info)))
+    (cond [maybe-location
+           (list (location->srcloc (check-info-value maybe-location)))]
+          [else
+           (list)])))
 ;; struct (exn:test:check:internal exn:test:check) : ()
 ;;
 ;; Exception thrown to indicate an internal failure in an
diff --git a/collects/rackunit/private/location.rkt b/collects/rackunit/private/location.rkt
index 5852a9e1fa..eba1a7ac51 100644
--- a/collects/rackunit/private/location.rkt
+++ b/collects/rackunit/private/location.rkt
@@ -20,7 +20,8 @@
  [location-position (location/c . -> . (or/c number? false/c))]
  [location-span (location/c . -> . (or/c number? false/c))]
  [syntax->location (syntax? . -> . location/c)]
- [location->string (location/c . -> . string?)])
+ [location->string (location/c . -> . string?)]
+ [location->srcloc (location/c . -> . srcloc?)])
 
 ;; syntax->location : syntax -> location
 (define (syntax->location stx)
@@ -38,6 +39,14 @@
                  ":"
                  (maybe-number->string (location-column location))))
 
+;; location->srcloc: location -> srcloc
+(define (location->srcloc location)
+  (srcloc (location-source location)
+          (location-line location)
+          (location-column location)
+          (location-position location)
+          (location-span location)))
+
 (define (source->string source)
   (cond
    ((string? source) source)