Circumvented raco cover issue with eval and fixed srcloc for reader-injected code, as suggested by Spencer Florence https://github.com/florence/cover/issues/128#issuecomment-240503899

This commit is contained in:
Georges Dupéron 2016-08-17 21:29:10 +02:00
parent 432bc0742d
commit e930471f52
2 changed files with 51 additions and 33 deletions

View File

@ -10,21 +10,61 @@
(only-in syntax/module-reader make-meta-reader)
syntax/strip-context)
;; Replaces the syntax/loc for the top of the syntax object, until
;; a part which doesn't belong to old-source is reached.
;; e.g. (with-syntax ([d user-provided-syntax])
;; (replace-top-loc
;; #'(a b (c d e))
;; (syntax-source #'here)
;; new-loc))
;; will produce a syntax object #'(a b (c (x (y) z) e))
;; where a, b, c, z, e and their surrounding forms have their srcloc set to
;; new-loc, but (x (y) z) will be left intact, if the user-provided-syntax
;; appears in another file.
(define (replace-top-loc stx old-source new-loc)
(let process ([stx stx])
(cond
[(syntax? stx)
(if (equal? (syntax-source stx) old-source)
(datum->syntax stx (process (syntax-e stx)) new-loc stx)
stx
;; Use the following expression to replace the loc throughout stx
;; instead of stopping the depth-first-search when the syntax-source
;; is not old-source anymore
#;(datum->syntax stx (process (syntax-e stx)) stx stx))]
[(pair? stx)
(cons (process (car stx))
(process (cdr stx)))]
[(vector? stx)
(list->vector (process (vector->list stx)))]
[(prefab-struct-key stx)
=> (λ (key)
(make-prefab-struct key
(process (struct->vector stx))))]
[else
stx])))
(define ((wrap-reader reader) chr in src line col pos)
(define/with-syntax orig-mod
(reader chr (narrow-until-prompt in) src line col pos))
(with-syntax ([(mod nam lang (modbeg . body))
(eval #'(expand #'orig-mod)
(variable-reference->namespace (#%variable-reference)))])
#`(mod nam lang
(modbeg
(module code racket/base)
(module* test racket/base
(require repltest/private/run-interactions)
(run-interactions (open-input-string #,(port->string in))
(#%variable-reference)))
. body))))
(define/with-syntax (mod nam lang (modbeg . body))
(parameterize ([current-namespace (variable-reference->namespace
(#%variable-reference))])
(expand #'orig-mod)))
;; quasisyntax/loc Necessary so that the generated code has the correct srcloc
(replace-top-loc
#`(mod nam lang
(modbeg
;(quote-syntax orig-mod)
(module* test racket/base
(require repltest/private/run-interactions)
;; TODO: set-port-next-location! for (open-input-string …)
(run-interactions (open-input-string #,(port->string in))
(#%variable-reference)))
. body))
(syntax-source #'here)
#'mod))
(define-values (repltest-read repltest-read-syntax repltest-get-info)
(make-meta-reader

View File

@ -1,25 +1,3 @@
#lang racket/base
;; This package is a meta-language, and currently provides no bindings.
;; Notice
;; To install (from within the package directory):
;; $ raco pkg install
;; To install (once uploaded to pkgs.racket-lang.org):
;; $ raco pkg install <<name>>
;; To uninstall:
;; $ raco pkg remove <<name>>
;; To view documentation:
;; $ raco doc <<name>>
;;
;; For your convenience, we have included a LICENSE.txt file, which links to
;; the GNU Lesser General Public License.
;; If you would prefer to use a different license, replace LICENSE.txt with the
;; desired license.
;;
;; Some users like to add a `private/` directory, place auxiliary files there,
;; and require them in `main.rkt`.
;;
;; See the current version of the racket style guide here:
;; http://docs.racket-lang.org/style/index.html