suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Modify exn:test:check to support prop:exn:srclocs to produce good error messages even without debugging enabled.

Browse Source 
Closes PR-13451.
This commit is contained in:
Danny Yoo 2013-02-27 12:01:09 -07:00
parent 17a99bf1d8
commit f5e85a6503
2 changed files with 23 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/rackunit/private/base.rkt
View File

@ -1,5 +1,7 @@
#lang racket/base #lang racket/base
(require racket/contract/base) (require racket/contract/base
"check-info.rkt"
"location.rkt")
;; struct test : ;; struct test :
(define-struct test ()) (define-struct test ())
@ -15,7 +17,16 @@
;; struct (exn:test:check struct:exn:test) : (list-of check-info) ;; struct (exn:test:check struct:exn:test) : (list-of check-info)
;; ;;
;; The exception thrown to indicate a check has failed ;; 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) : () ;; struct (exn:test:check:internal exn:test:check) : ()
;; ;;
;; Exception thrown to indicate an internal failure in an ;; Exception thrown to indicate an internal failure in an

11
collects/rackunit/private/location.rkt
View File

@ -20,7 +20,8 @@
[location-position (location/c . -> . (or/c number? false/c))] [location-position (location/c . -> . (or/c number? false/c))]
[location-span (location/c . -> . (or/c number? false/c))] [location-span (location/c . -> . (or/c number? false/c))]
[syntax->location (syntax? . -> . location/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 ;; syntax->location : syntax -> location
(define (syntax->location stx) (define (syntax->location stx)
@ -38,6 +39,14 @@
":" ":"
(maybe-number->string (location-column location)))) (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) (define (source->string source)
(cond (cond
((string? source) source) ((string? source) source)