diff --git a/pkgs/racket-doc/scribblings/reference/serialization.scrbl b/pkgs/racket-doc/scribblings/reference/serialization.scrbl index c0e8600371..9421a514ef 100644 --- a/pkgs/racket-doc/scribblings/reference/serialization.scrbl +++ b/pkgs/racket-doc/scribblings/reference/serialization.scrbl @@ -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."]} @; ---------------------------------------------------------------------- diff --git a/pkgs/racket-test-core/tests/racket/serialize.rktl b/pkgs/racket-test-core/tests/racket/serialize.rktl index 59e8367fd0..647311bdbb 100644 --- a/pkgs/racket-test-core/tests/racket/serialize.rktl +++ b/pkgs/racket-test-core/tests/racket/serialize.rktl @@ -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) diff --git a/racket/collects/racket/private/serialize.rkt b/racket/collects/racket/private/serialize.rkt index 248c1aa785..6ed6af247c 100644 --- a/racket/collects/racket/private/serialize.rkt +++ b/racket/collects/racket/private/serialize.rkt @@ -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 ()