make serialization work right when a module is dynamic-required using a (non-string) path
svn: r2321
This commit is contained in:
parent
c34a75443e
commit
d9e3e1e267
|
@ -423,6 +423,18 @@
|
|||
(void? v)
|
||||
(date? v)
|
||||
(arity-at-least? v)))
|
||||
|
||||
;; If a module is dynamic-required through a path,
|
||||
;; then it can cause simplified module paths to be paths;
|
||||
;; keep the literal path, but marshal it to bytes.
|
||||
(define (protect-path p)
|
||||
(if (path? p)
|
||||
(path->bytes p)
|
||||
p))
|
||||
(define (unprotect-path p)
|
||||
(if (bytes? p)
|
||||
(bytes->path p)
|
||||
p))
|
||||
|
||||
(define (mod-to-id info mod-map cache)
|
||||
(let ([deserialize-id (serialize-info-deserialize-id info)])
|
||||
|
@ -438,10 +450,11 @@
|
|||
(and (list? b)
|
||||
(if (symbol? (caddr b))
|
||||
(caddr b)
|
||||
(collapse-module-path-index
|
||||
(caddr b)
|
||||
`(file ,(build-path (serialize-info-dir info)
|
||||
"here.ss")))))
|
||||
(protect-path
|
||||
(collapse-module-path-index
|
||||
(caddr b)
|
||||
(build-path (serialize-info-dir info)
|
||||
"here.ss")))))
|
||||
(syntax-e deserialize-id)))]
|
||||
[(symbol? deserialize-id)
|
||||
(cons #f deserialize-id)]
|
||||
|
@ -449,10 +462,11 @@
|
|||
(cons
|
||||
(if (symbol? (cdr deserialize-id))
|
||||
(cdr deserialize-id)
|
||||
(collapse-module-path-index
|
||||
(cdr deserialize-id)
|
||||
`(file ,(build-path (serialize-info-dir info)
|
||||
"here.ss"))))
|
||||
(protect-path
|
||||
(collapse-module-path-index
|
||||
(cdr deserialize-id)
|
||||
(build-path (serialize-info-dir info)
|
||||
"here.ss"))))
|
||||
(car deserialize-id))])])
|
||||
(hash-table-get
|
||||
mod-map path+name
|
||||
|
@ -818,7 +832,8 @@
|
|||
(unless (null? l)
|
||||
(let* ([path+name (car l)]
|
||||
[des (if (car path+name)
|
||||
(dynamic-require (car path+name) (cdr path+name))
|
||||
(dynamic-require (unprotect-path (car path+name))
|
||||
(cdr path+name))
|
||||
(namespace-variable-value (cdr path+name)))])
|
||||
;; Register maker and struct type:
|
||||
(vector-set! mod-map n des))
|
||||
|
|
|
@ -337,10 +337,10 @@ currently exist).
|
|||
`ext-proc' is #f.
|
||||
|
||||
> (resolve-module-path module-path-v rel-to-path-string/thunk/#f) -
|
||||
resolves a module path to filename path. The module path is
|
||||
resolved relative to `rel-to-path-string/thunk/#f' if it is a string
|
||||
(a filename path), to the directory result of calling the thunk if
|
||||
it is a thunk, or to the current directory otherwise.
|
||||
resolves a module path to filename path. The module path is resolved
|
||||
relative to `rel-to-path-string/thunk/#f' if it is a path string, to
|
||||
the directory result of calling the thunk if it is a thunk, or to
|
||||
the current directory otherwise.
|
||||
|
||||
> (resolve-module-path-index module-path-index rel-to-path-string/thunk/#f)
|
||||
- like `resolve-module-path' but the input is a module path index
|
||||
|
@ -353,8 +353,13 @@ currently exist).
|
|||
> (collapse-module-path module-path-v rel-to-module-path-v) - returns
|
||||
a "simplified" module path by combining `module-path-v' with
|
||||
`rel-to-module-path', where the latter must have the form '(lib
|
||||
<relative-path> <collection>), '(file <path>), a relative path, or a
|
||||
thunk to generate one of those.
|
||||
<relative-path> <collection>), '(file <string>), a path, or a thunk
|
||||
to generate one of those.
|
||||
|
||||
The result can be a path if `module-path-v' contains a path element
|
||||
that is needed for the result, or if `rel-to-module-path-v' is a
|
||||
non-string path that is needed for the result; otherwise, the result
|
||||
is a printable "quoted" module path.
|
||||
|
||||
> (collapse-module-path-index module-path-index rel-to-module-path-v)
|
||||
- like `collapse-module-path', but the input is a module path index
|
||||
|
|
|
@ -294,7 +294,7 @@
|
|||
|
||||
(define collapse-module-path
|
||||
;; relto-mp should be a relative path, '(lib relative-path collection), or '(file path)
|
||||
;; of a thunk that produces one of those
|
||||
;; or a thunk that produces one of those
|
||||
(lambda (s relto-mp)
|
||||
(let ([combine-relative-elements
|
||||
(lambda (elements)
|
||||
|
@ -302,7 +302,9 @@
|
|||
(set! relto-mp (relto-mp)))
|
||||
(cond
|
||||
[(path-string? relto-mp)
|
||||
(bytes->string/locale
|
||||
((if (path? relto-mp)
|
||||
bytes->path
|
||||
bytes->string/locale)
|
||||
(apply
|
||||
bytes-append
|
||||
(let ([m (regexp-match re:path-only (if (path? relto-mp)
|
||||
|
|
Loading…
Reference in New Issue
Block a user