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

use syntax objects to represent source locations

Browse Source 
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).
This commit is contained in:
Matthew Flatt 2015-12-09 17:22:42 -07:00
parent a3a22d191f
commit 644a4c550f
2 changed files with 14 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
rackunit-lib/rackunit/private/check.rkt
View File

@ -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))

11
rackunit-lib/rackunit/private/test-case.rkt
View File

@ -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 ...)