fix relative-path handling for source locations in bytecode

Closes PR 15174
This commit is contained in:
Matthew Flatt 2015-10-29 16:14:14 -04:00
parent 685e74a1c6
commit 6e21376473
3 changed files with 25 additions and 2 deletions

View File

@ -2204,6 +2204,29 @@
name)])))
(eval '(m racket/base values)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check marshaling and unmarshaling with relative paths
(let ()
(define dir (find-system-path 'temp-dir))
(define x (parameterize ([current-namespace (make-base-namespace)])
(compile (datum->syntax #f '#'x (vector (build-path dir "sub" "x.rkt")
1
1
1
1)))))
(define-values (i o) (make-pipe))
(parameterize ([current-write-relative-directory
(cons (build-path dir "nested")
dir)])
(write x o))
(test (build-path dir "inner" 'up "sub" "x.rkt")
syntax-source
(eval (parameterize ([read-accept-compiled #t]
[current-load-relative-directory (build-path dir "inner")])
(read i)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

View File

@ -5693,7 +5693,7 @@ Scheme_Object *scheme_extract_relative_to(Scheme_Object *obj, Scheme_Object *dir
while (!SCHEME_NULLP(be)) {
if (cache) {
obj = scheme_make_pair(up_symbol, scheme_null);
obj = scheme_make_pair(up_symbol, obj);
} else {
a[0] = up_symbol;
a[1] = obj;

View File

@ -747,7 +747,7 @@ static Scheme_Object *read_quote_syntax(Scheme_Object *obj)
static int not_relative_path(Scheme_Object *p, Scheme_Hash_Table *cache)
{
Scheme_Object *dir, *rel_p;
dir = scheme_get_param(scheme_current_config(),
MZCONFIG_WRITE_DIRECTORY);
if (SCHEME_TRUEP(dir)) {