Permalink
Browse files

Modify exn:test:check to support prop:exn:srclocs to produce good err…

…or messages even without debugging enabled.

Closes PR-13451.
  • Loading branch information...
1 parent 17a99bf commit f5e85a650314e24852e03edde4297ad355f984ab @dyoo committed Feb 27, 2013
Showing with 23 additions and 3 deletions.
  1. +13 −2 collects/rackunit/private/base.rkt
  2. +10 −1 collects/rackunit/private/location.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
@@ -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)

0 comments on commit f5e85a6

Please sign in to comment.