Index: srfi/19/time.ss =================================================================== --- srfi/19/time.ss (revision 18393) +++ srfi/19/time.ss (working copy) @@ -59,13 +59,15 @@ ;; internal. (module time mzscheme - (require srfi/8/receive + (require scheme/serialize + srfi/8/receive srfi/29 srfi/optional) (provide time-tai time-utc time-monotonic time-thread time-process time-duration time-gc current-date current-julian-day current-modified-julian-day current-time time-resolution ;; Time object and accessors make-time time? time-type time-nanosecond + deserialize-info:tm:time-v0 time-second set-time-type! set-time-nanosecond! set-time-second! copy-time ;; Time comparison @@ -75,6 +77,7 @@ ;; Date object and accessors ;; date structure is provided by core PLT Scheme, we just extended tu support miliseconds: srfi:make-date srfi:date? + deserialize-info:tm:date-v0 date-nanosecond srfi:date-second srfi:date-minute srfi:date-hour srfi:date-day srfi:date-month srfi:date-year date-zone-offset ;; This are not part of the date structure (as they are in the original PLT Scheme's date) @@ -268,8 +271,29 @@ (define-values (tm:time make-time time? tm:time-ref tm:time-set!) (make-struct-type - 'tm:time #f 3 0 #f null (make-inspector) #f null)) + 'tm:time #f 3 0 #f + (list (cons prop:serializable + (make-serialize-info + (lambda (t) + (vector (time-type t) + (time-nanosecond t) + (time-second t))) + #'deserialize-info:tm:time-v0 + #f + (or (current-load-relative-directory) + (current-directory))))) + (make-inspector) #f null)) + (define deserialize-info:tm:time-v0 + (make-deserialize-info + make-time + (lambda () + (let ([t0 (make-time #f #f #f)]) + (values t0 (lambda (t1) + (set-time-type! t0 (time-type t1)) + (set-time-nanosecond! t0 (time-nanosecond t1)) + (set-time-second! t0 (time-second t1)))))))) + (define (time-type t) (tm:time-ref t 0)) (define (time-nanosecond t) (tm:time-ref t 1)) (define (time-second t) (tm:time-ref t 2)) @@ -587,7 +611,39 @@ ;; -- Date Structures (define-values (tm:date srfi:make-date srfi:date? tm:date-ref tm:date-set!) (make-struct-type - 'tm:date #f 8 0 #f null (make-inspector) #f null)) + 'tm:date #f 8 0 #f + (list (cons prop:serializable + (make-serialize-info + (lambda (d) + (vector (date-nanosecond d) + (srfi:date-second d) + (srfi:date-minute d) + (srfi:date-hour d) + (srfi:date-day d) + (srfi:date-month d) + (srfi:date-year d) + (date-zone-offset d))) + #'deserialize-info:tm:date-v0 + #f + (or (current-load-relative-directory) + (current-directory))))) + (make-inspector) #f null)) + + (define deserialize-info:tm:date-v0 + (make-deserialize-info + srfi:make-date + (lambda () + (let ([d0 (srfi:make-date #f #f #f #f #f #f #f #f)]) + (values d0 (lambda (d1) + (tm:set-date-nanosecond! d1 (date-nanosecond d0)) + (tm:set-date-second! d1 (srfi:date-second d0)) + (tm:set-date-minute! d1 (srfi:date-minute d0)) + (tm:set-date-hour! d1 (srfi:date-hour d0)) + (tm:set-date-day! d1 (srfi:date-day d0)) + (tm:set-date-month! d1 (srfi:date-month d0)) + (tm:set-date-year! d1 (srfi:date-year d0)) + (tm:set-date-zone-offset! d1 (date-zone-offset d0)))))))) + ;; PLT Scheme date structure has the following: ;; * second : 0 to 61 (60 and 61 are for unusual leap-seconds) ;; * minute : 0 to 59 Index: tests/srfi/19/tests.ss =================================================================== --- tests/srfi/19/tests.ss (revision 17241) +++ tests/srfi/19/tests.ss (working copy) @@ -5,7 +5,8 @@ ;; Dave Gurnell (string->date, date->string) -- 2007-09-14 ;; Dave Gurnell (time{=,<,>,<=,>=}?) -- 2009-11-26 -(require srfi/19/time) +(require scheme/serialize + srfi/19/time) (require schemeunit/test schemeunit/text-ui) @@ -187,7 +188,12 @@ (check = 365 (- (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1 2004 0)) (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1 2003 0)))) (let ([test-date (srfi:make-date 0 0 0 0 1 1 2003 -7200)]) - (check tm:date= test-date (modified-julian-day->date (date->modified-julian-day test-date) -7200)))))) + (check tm:date= test-date (modified-julian-day->date (date->modified-julian-day test-date) -7200)))) + + (test-case "serialize and deserialize" + (check-equal? (deserialize (serialize (make-time time-utc 0 1))) (make-time time-utc 0 1)) + (check-equal? (deserialize (serialize (make-time time-tai 2 3))) (make-time time-tai 2 3)) + (check-equal? (deserialize (serialize (srfi:make-date 0 1 2 3 4 5 6 7))) (srfi:make-date 0 1 2 3 4 5 6 7))))) ; Helper checks and procedures -----------------