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

Update deserialize-module-guard. (#2147)

Browse Source 
It can now optionally return a pair to redirect the module
that is dynamic-required.
This commit is contained in:
Leif Andersen 2018-06-22 10:48:12 -04:00 committed by Ben Greenman
parent d061970a01
commit eb97c7f54e
3 changed files with 41 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/racket-doc/scribblings/reference/serialization.scrbl
View File

@ -368,13 +368,21 @@ More precisely, it returns the same value that @racket[(equal?
@; ----------------------------------------------------------------------
@defparam[deserialize-module-guard guard (module-path? symbol? . -> . void?)]{
@defparam[deserialize-module-guard guard (-> module-path? symbol?
(or/c void? (cons/c module-path? symbol?)))]{
A parameter whose value is called by @racket[deserialize] before
dynamically loading a module via @racket[dynamic-require]. The two
arguments provided to the procedure are the same as the arguments to
be passed to @racket[dynamic-require]. The procedure can raise an
exception to disallow the @racket[dynamic-require].}
exception to disallow the @racket[dynamic-require].
The procedure can optionally return a pair containing a
@tech{module-path} and @tech{symbol}. If returned,
@racket[deserialize] will use them as arguments to
@racket[dynamic-require] instead.
@history[#:changed "6.90.0.30" "Adds optional return values for bindings."]}
@; ----------------------------------------------------------------------

26
pkgs/racket-test-core/tests/racket/serialize.rktl
View File

@ -579,4 +579,30 @@
;; ----------------------------------------
(module immutable-b racket/base
(require racket/serialize)
(provide (all-defined-out))
(define-serializable-struct immutable-b (b))
(define alt-immutable-b-deserial
(make-deserialize-info
(λ _ 2048)
(λ () (error 'alt-immutable "no cycles")))))
(require 'immutable-b)
(let ([a (immutable-b 42)])
(parameterize ([deserialize-module-guard
(λ (mod name)
(test name values 'deserialize-info:immutable-b-v0)
(void))])
(deserialize (serialize a))))
(let ([a (immutable-b 42)])
(parameterize ([deserialize-module-guard
(λ (mod name)
(cons ''immutable-b 'alt-immutable-b-deserial))])
(test 2048 values (deserialize (serialize a)))))
;; ----------------------------------------
(report-errs)

8
racket/collects/racket/private/serialize.rkt
View File

@ -674,9 +674,11 @@
(unless (null? l)
(let* ([path+name (car l)]
[des (if (car path+name)
(let ([p (unprotect-path (car path+name))]
[sym (revive-symbol (cdr path+name))])
((deserialize-module-guard) p sym)
(let ([serial-p (unprotect-path (car path+name))]
[serial-sym (revive-symbol (cdr path+name))])
(define maybe-binding ((deserialize-module-guard) serial-p serial-sym))
(define p (if (pair? maybe-binding) (car maybe-binding) serial-p))
(define sym (if (pair? maybe-binding) (cdr maybe-binding) serial-sym))
(let ([sub (add-submodule p)]
[fallback
(lambda ()