diff --git a/collects/racket/private/serialize.rkt b/collects/racket/private/serialize.rkt index a011c16b60..176683d9b4 100644 --- a/collects/racket/private/serialize.rkt +++ b/collects/racket/private/serialize.rkt @@ -130,7 +130,17 @@ (vector? o) (hash? o)) (not (immutable? o))) - (serializable-struct? o))) + (serializable-struct? o) + (let ([k (prefab-struct-key o)]) + (and k + ;; Check whether all fields are mutable: + (pair? k) + (let-values ([(si skipped?) (struct-info o)]) + (let loop ([si si]) + (let*-values ([(name init auto acc mut imms super skipped?) (struct-type-info si)]) + (and (null? imms) + (or (not super) + (loop super)))))))))) ;; Finds a mutable object among those that make the ;; current cycle. @@ -152,8 +162,8 @@ (+ (hash-count share) (hash-count cycle))) - ;; Traverses v to find cycles and charing. Shared - ;; object go in the `shared' table, and cycle-breakers go in + ;; Traverses v to find cycles and sharing. Shared + ;; objects go in the `shared' table, and cycle-breakers go in ;; `cycle'. In each case, the object is mapped to a number that is ;; incremented as shared/cycle objects are discovered, so ;; when the objects are deserialized, build them in reverse @@ -332,7 +342,11 @@ [(hash? v) (cons 'h (append (if (not (hash-eq? v)) '(equal) null) - (if (hash-weak? v) '(weak) null)))])) + (if (hash-weak? v) '(weak) null)))] + [else + ;; A mutable prefab + (cons 'pf (cons (prefab-struct-key v) + (sub1 (vector-length (struct->vector v)))))])) (define (serialize v) (let ([mod-map (make-hasheq)] @@ -491,7 +505,22 @@ ht (lambda (k v) (hash-set! ht0 k v))))) - ht0)])] + ht0)] + [(pf) + ;; Prefab + (let ([s (apply make-prefab-struct + (cadr v) + (vector->list (make-vector (cddr v) #f)))]) + (vector-set! fixup n (lambda (v) + (let-values ([(si skipped?) (struct-info s)]) + (let loop ([si si]) + (let*-values ([(name init auto acc mut imms super skipped?) (struct-type-info si)]) + (let ([count (+ init auto)]) + (for ([i (in-range 0 count)]) + (mut s i (acc v i))) + (when super + (loop super)))))))) + s)])] [else (case v [(c) diff --git a/collects/scribblings/reference/serialization.scrbl b/collects/scribblings/reference/serialization.scrbl index d17e6d5dd3..7d45e29581 100644 --- a/collects/scribblings/reference/serialization.scrbl +++ b/collects/scribblings/reference/serialization.scrbl @@ -60,6 +60,15 @@ all content of the value is serializable. If a value given to @scheme[serialize] is not completely serializable, the @exnraise[exn:fail:contract]. +If @racket[v] contains a cycle (i.e., a collection of objects that +are all reachable from each other), then @racket[v] can be serialized +only if the cycle includes a mutable value, where a @tech{prefab} +structure counts as mutable only if all of its fields are mutable. + +@margin-note{The @racket[serialize] and @racket[deserialize] functions +currently do not handle certain cyclic values that @racket[read] and +@racket[write] can handle, such as @racket['@#,read[(open-input-string "#0=(#0#)")]].} + See @scheme[deserialize] for information on the format of serialized data.} diff --git a/collects/scribblings/reference/struct.scrbl b/collects/scribblings/reference/struct.scrbl index d1854dc8af..9aec50ac30 100644 --- a/collects/scribblings/reference/struct.scrbl +++ b/collects/scribblings/reference/struct.scrbl @@ -506,7 +506,7 @@ following items: any).} @item{Nothing else, if the structure type has no - supertype. Otherwise, the rest of the list matches is the key + supertype. Otherwise, the rest of the list is the key for the supertype.} ] @@ -537,7 +537,10 @@ supplied @racket[v]s, the @exnraise[exn:fail:contract]. Returns a @tech{structure type descriptor} for the @tech{prefab} structure type specified by the combination of @racket[key] and -@racket[field-count].} +@racket[field-count]. + +If the number of fields indicated by @racket[key] is inconsistent with +@racket[field-count], the @exnraise[exn:fail:contract].} @;------------------------------------------------------------------------ @section[#:tag "structinfo"]{Structure Type Transformer Binding} diff --git a/collects/tests/racket/serialize.rktl b/collects/tests/racket/serialize.rktl index bf086c3705..785a17245d 100644 --- a/collects/tests/racket/serialize.rktl +++ b/collects/tests/racket/serialize.rktl @@ -269,6 +269,15 @@ (test-ser p2) (test-ser (cons p1 p2)) (test-ser (cons p2 p1))) + +(let () + (struct a ([b #:mutable] [c #:mutable]) #:prefab) + (struct z a ([b #:mutable] [c #:mutable]) #:prefab) + + (let ([z0 (z 1 2 3 4)]) + (test-ser z0) + (set-z-b! z0 z0) + (test-ser z0))) ;; ----------------------------------------