mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

The SRFI-19 implementation was completely broken. Already the

Browse source 
reference implementation did not handle DST and time zones properly
and relied on non-R5RS-isms like passing reals to `quotient'.  For
Guile, some additional fixes were needed because of the incomplete
numeric tower implementation.  See also srfi-19.test.

* srfi-19.scm (date-zone-offset): Fixed typo in export clause.
(add-duration): Renamed from priv:add-duration.
(priv:time-normalize!): Handle fractional nanoseconds; remove
duplicate definition.  (priv:current-time-tai): Fixed typo.  (time=?,
time<=?): Fixed typos.  (time-tai->time-utc, time-utc->time-tai,
time-utc->time-monotonic): Use make-time-unnormalized instead of
make-time when uninitialized time fields are used.
(set-date-nanosecond!, set-date-second!, set-date-minute!,
set-date-hour!, set-date-day!, set-date-month!, set-date-year!,
set-date-zone-offset!): Define.  (priv:local-tz-offset): Take an extra
argument in order to handle DST effects.  (time-utc->date,
time-tai->date, time-monotonic->date): Handle the changed signature of
priv:local-tz-offset. Don't pass non-integer arguments to quotient
(non-R5RS, not supported by Guile).  (date->time-utc): Ensure that
seconds in a date structure are always exact integers.  Handle DST
properly.  (current-date, julian-day->date,
modified-julian-day->date): Handle the changed signature of
priv:local-tz-offset.  (julian-day->time-utc): Reverted earlier
inexact->exact hack; make-time now handles inexact arguments.
(priv:locale-print-time-zone): At least print the numerical time zone.
(priv:integer-reader): Fixed named let iteration.
(priv:read-directives): Use set-date-month! instead of
priv:set-date-month! etc.  (string->date): Handle DST properly.
This commit is contained in:
Marius Vollmer 2001-06-18 18:30:58 +00:00
parent 837f9d198e
commit 4549ba4ac6
1 changed files with 113 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

202
srfi/srfi-19.scm
View file

@ -49,6 +49,13 @@
;; substantial ones to be realized, esp. in the later "parsing" half ;; substantial ones to be realized, esp. in the later "parsing" half
;; of the file, by rewriting the code with use of more Guile native ;; of the file, by rewriting the code with use of more Guile native
;; functions that do more work in a "chunk". ;; functions that do more work in a "chunk".
;;
;; FIXME: mkoeppe: Time zones are treated a little simplistic in
;; SRFI-19; they are only a numeric offset. Thus, printing time zones
;; (PRIV:LOCALE-PRINT-TIME-ZONE) can't be implemented sensibly. The
;; functions taking an optional TZ-OFFSET should be extended to take a
;; symbolic time-zone (like "CET"); this string should be stored in
;; the DATE structure.
(define-module (srfi srfi-19) (define-module (srfi srfi-19)
:use-module (srfi srfi-6) :use-module (srfi srfi-6)
@ -100,7 +107,7 @@
date-day date-day
date-month date-month
date-year date-year
date-zone-offset? date-zone-offset
date-year-day date-year-day
date-week-day date-week-day
date-week-number date-week-number
@ -304,13 +311,19 @@
(define (copy-time time) (define (copy-time time)
(make-time (time-type time) (time-nanosecond time) (time-second time))) (make-time (time-type time) (time-nanosecond time) (time-second time)))
(define (priv:split-real r)
(if (integer? r) (values r 0)
(let ((l (truncate r)))
(values (inexact->exact l) (- r l)))))
(define (priv:time-normalize! t) (define (priv:time-normalize! t)
(if (>= (abs (time-nanosecond t)) 1000000000) (if (>= (abs (time-nanosecond t)) 1000000000)
(begin (receive (int frac)
(priv:split-real (time-nanosecond t))
(set-time-second! t (+ (time-second t) (set-time-second! t (+ (time-second t)
(quotient (time-nanosecond t) 1000000000))) (quotient int 1000000000)))
(set-time-nanosecond! t (remainder (time-nanosecond t) (set-time-nanosecond! t (+ (remainder int 1000000000)
1000000000)))) frac))))
(if (and (positive? (time-second t)) (if (and (positive? (time-second t))
(negative? (time-nanosecond t))) (negative? (time-nanosecond t)))
(begin (begin
@ -360,7 +373,7 @@
(usec (cdr tod))) (usec (cdr tod)))
(make-time time-tai (make-time time-tai
(* usec 1000) (* usec 1000)
(+ (car tod) (priv:leap-second-delta seconds))))) (+ (car tod) (priv:leap-second-delta sec)))))
;;(define (priv:current-time-ms-time time-type proc) ;;(define (priv:current-time-ms-time time-type proc)
;; (let ((current-ms (proc))) ;; (let ((current-ms (proc)))
@ -433,7 +446,7 @@
;; Arrange tests for speed and presume that t1 and t2 are actually times. ;; Arrange tests for speed and presume that t1 and t2 are actually times.
;; also presume it will be rare to check two times of different types. ;; also presume it will be rare to check two times of different types.
(and (= (time-second t1) (time-second t2)) (and (= (time-second t1) (time-second t2))
(= (time-nanosecond t1) (time-nanosecond 2)) (= (time-nanosecond t1) (time-nanosecond t2))
(eq? (time-type t1) (time-type t2)))) (eq? (time-type t1) (time-type t2))))
(define (time>? t1 t2) (define (time>? t1 t2)
@ -452,9 +465,9 @@
(>= (time-nanosecond t1) (time-nanosecond t2))))) (>= (time-nanosecond t1) (time-nanosecond t2)))))
(define (time<=? t1 t2) (define (time<=? t1 t2)
(or (< (time-second time1) (time-second time2)) (or (< (time-second t1) (time-second t2))
(and (= (time-second time1) (time-second time2)) (and (= (time-second t1) (time-second t2))
(<= (time-nanosecond time1) (time-nanosecond time2))))) (<= (time-nanosecond t1) (time-nanosecond t2)))))
;; -- Time arithmetic ;; -- Time arithmetic
@ -479,7 +492,7 @@
(set-time-nanosecond! t nsec-plus) (set-time-nanosecond! t nsec-plus)
(priv:time-normalize! t)))) (priv:time-normalize! t))))
(define (priv:add-duration t duration) (define (add-duration t duration)
(let ((result (copy-time t))) (let ((result (copy-time t)))
(add-duration! result))) (add-duration! result)))
@ -509,7 +522,7 @@
time-out) time-out)
(define (time-tai->time-utc time-in) (define (time-tai->time-utc time-in)
(priv:time-tai->time-utc! time-in (make-time #f #f #f) 'time-tai->time-utc)) (priv:time-tai->time-utc! time-in (make-time-unnormalized #f #f #f) 'time-tai->time-utc))
(define (time-tai->time-utc! time-in) (define (time-tai->time-utc! time-in)
@ -526,7 +539,7 @@
time-out) time-out)
(define (time-utc->time-tai time-in) (define (time-utc->time-tai time-in)
(priv:time-utc->time-tai! time-in (make-time #f #f #f) 'time-utc->time-tai)) (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f #f) 'time-utc->time-tai))
(define (time-utc->time-tai! time-in) (define (time-utc->time-tai! time-in)
(priv:time-utc->time-tai! time-in time-in 'time-utc->time-tai!)) (priv:time-utc->time-tai! time-in time-in 'time-utc->time-tai!))
@ -561,7 +574,7 @@
(define (time-utc->time-monotonic time-in) (define (time-utc->time-monotonic time-in)
(if (not (eq? (time-type time-in) time-utc)) (if (not (eq? (time-type time-in) time-utc))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error caller 'incompatible-time-types time-in))
(let ((ntime (priv:time-utc->time-tai! time-in (make-time #f #f #f) (let ((ntime (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f #f)
'time-utc->time-monotonic))) 'time-utc->time-monotonic)))
(set-time-type! ntime time-monotonic) (set-time-type! ntime time-monotonic)
ntime)) ntime))
@ -598,34 +611,14 @@
year year
zone-offset) zone-offset)
date? date?
(nanosecond date-nanosecond) (nanosecond date-nanosecond set-date-nanosecond!)
(second date-second) (second date-second set-date-second!)
(minute date-minute) (minute date-minute set-date-minute!)
(hour date-hour) (hour date-hour set-date-hour!)
(day date-day) (day date-day set-date-day!)
(month date-month) (month date-month set-date-month!)
(year date-year) (year date-year set-date-year!)
(zone-offset date-zone-offset)) (zone-offset date-zone-offset set-date-zone-offset!))
(define (priv:time-normalize! t)
(if (>= (abs (time-nanosecond t)) 1000000000)
(begin
(set-time-second! t (+ (time-second t)
(quotient (time-nanosecond t) 1000000000)))
(set-time-nanosecond! t (remainder (time-nanosecond t)
1000000000))))
(if (and (positive? (time-second t))
(negative? (time-nanosecond t)))
(begin
(set-time-second! t (- (time-second t) 1))
(set-time-nanosecond! t (+ 1000000000 (time-nanosecond t))))
(if (and (negative? (time-second t))
(positive? (time-nanosecond t)))
(begin
(set-time-second! t (+ (time-second t) 1))
(set-time-nanosecond! t (+ 1000000000 (time-nanosecond t))))))
t)
;; gives the julian day which starts at noon. ;; gives the julian day which starts at noon.
(define (priv:encode-julian-day-number day month year) (define (priv:encode-julian-day-number day month year)
@ -640,11 +633,6 @@
(quotient y 400) (quotient y 400)
-32045))) -32045)))
(define (priv:split-real r)
(if (integer? r) (values r 0)
(let ((l (truncate r)))
(values l (- r l)))))
;; gives the seconds/date/month/year ;; gives the seconds/date/month/year
(define (priv:decode-julian-day-number jdn) (define (priv:decode-julian-day-number jdn)
(let* ((days (inexact->exact (truncate jdn))) (let* ((days (inexact->exact (truncate jdn)))
@ -665,9 +653,9 @@
;; differently from MzScheme's.... ;; differently from MzScheme's....
;; This should be written to be OS specific. ;; This should be written to be OS specific.
(define (priv:local-tz-offset) (define (priv:local-tz-offset utc-time)
;; SRFI uses seconds West, but guile (and libc) use seconds East. ;; SRFI uses seconds West, but guile (and libc) use seconds East.
(- (tm:gmtoff (localtime 0)))) (- (tm:gmtoff (localtime (time-second utc-time)))))
;; special thing -- ignores nanos ;; special thing -- ignores nanos
(define (priv:time->julian-day-number seconds tz-offset) (define (priv:time->julian-day-number seconds tz-offset)
@ -681,7 +669,9 @@
(define (time-utc->date time . tz-offset) (define (time-utc->date time . tz-offset)
(if (not (eq? (time-type time) time-utc)) (if (not (eq? (time-type time) time-utc))
(priv:time-error 'time->date 'incompatible-time-types time)) (priv:time-error 'time->date 'incompatible-time-types time))
(let* ((offset (if (null? tz-offset) (priv:local-tz-offset) (car tz-offset))) (let* ((offset (if (null? tz-offset)
(priv:local-tz-offset time)
(car tz-offset)))
(leap-second? (priv:leap-second? (+ offset (time-second time)))) (leap-second? (priv:leap-second? (+ offset (time-second time))))
(jdn (priv:time->julian-day-number (if leap-second? (jdn (priv:time->julian-day-number (if leap-second?
(- (time-second time) 1) (- (time-second time) 1)
@ -690,7 +680,9 @@
(call-with-values (lambda () (priv:decode-julian-day-number jdn)) (call-with-values (lambda () (priv:decode-julian-day-number jdn))
(lambda (secs date month year) (lambda (secs date month year)
(let* ((int-secs (inexact->exact (floor secs))) ;; secs is a real because jdn is a real in Guile;
;; but it is conceptionally an integer.
(let* ((int-secs (inexact->exact (round secs)))
(hours (quotient int-secs (* 60 60))) (hours (quotient int-secs (* 60 60)))
(rem (remainder int-secs (* 60 60))) (rem (remainder int-secs (* 60 60)))
(minutes (quotient rem 60)) (minutes (quotient rem 60))
@ -707,7 +699,9 @@
(define (time-tai->date time . tz-offset) (define (time-tai->date time . tz-offset)
(if (not (eq? (time-type time) time-tai)) (if (not (eq? (time-type time) time-tai))
(priv:time-error 'time->date 'incompatible-time-types time)) (priv:time-error 'time->date 'incompatible-time-types time))
(let* ((offset (if (null? tz-offset) (priv:local-tz-offset) (car tz-offset))) (let* ((offset (if (null? tz-offset)
(priv:local-tz-offset (time-tai->time-utc time))
(car tz-offset)))
(seconds (- (time-second time) (seconds (- (time-second time)
(priv:leap-second-delta (time-second time)))) (priv:leap-second-delta (time-second time))))
(leap-second? (priv:leap-second? (+ offset seconds))) (leap-second? (priv:leap-second? (+ offset seconds)))
@ -717,9 +711,12 @@
offset))) offset)))
(call-with-values (lambda () (priv:decode-julian-day-number jdn)) (call-with-values (lambda () (priv:decode-julian-day-number jdn))
(lambda (secs date month year) (lambda (secs date month year)
;; secs is a real because jdn is a real in Guile;
;; but it is conceptionally an integer.
;; adjust for leap seconds if necessary ... ;; adjust for leap seconds if necessary ...
(let* ((hours (quotient secs (* 60 60))) (let* ((int-secs (inexact->exact (round secs)))
(rem (remainder secs (* 60 60))) (hours (quotient int-secs (* 60 60)))
(rem (remainder int-secs (* 60 60)))
(minutes (quotient rem 60)) (minutes (quotient rem 60))
(seconds (remainder rem 60))) (seconds (remainder rem 60)))
(make-date (time-nanosecond time) (make-date (time-nanosecond time)
@ -735,7 +732,9 @@
(define (time-monotonic->date time . tz-offset) (define (time-monotonic->date time . tz-offset)
(if (not (eq? (time-type time) time-monotonic)) (if (not (eq? (time-type time) time-monotonic))
(priv:time-error 'time->date 'incompatible-time-types time)) (priv:time-error 'time->date 'incompatible-time-types time))
(let* ((offset (if (null? tz-offset) (priv:local-tz-offset) (car tz-offset))) (let* ((offset (if (null? tz-offset)
(priv:local-tz-offset (time-monotonic->time-utc time))
(car tz-offset)))
(seconds (- (time-second time) (seconds (- (time-second time)
(priv:leap-second-delta (time-second time)))) (priv:leap-second-delta (time-second time))))
(leap-second? (priv:leap-second? (+ offset seconds))) (leap-second? (priv:leap-second? (+ offset seconds)))
@ -745,9 +744,12 @@
offset))) offset)))
(call-with-values (lambda () (priv:decode-julian-day-number jdn)) (call-with-values (lambda () (priv:decode-julian-day-number jdn))
(lambda (secs date month year) (lambda (secs date month year)
;; secs is a real because jdn is a real in Guile;
;; but it is conceptionally an integer.
;; adjust for leap seconds if necessary ... ;; adjust for leap seconds if necessary ...
(let* ((hours (quotient secs (* 60 60))) (let* ((int-secs (inexact->exact (round secs)))
(rem (remainder secs (* 60 60))) (hours (quotient int-secs (* 60 60)))
(rem (remainder int-secs (* 60 60)))
(minutes (quotient rem 60)) (minutes (quotient rem 60))
(seconds (remainder rem 60))) (seconds (remainder rem 60)))
(make-date (time-nanosecond time) (make-date (time-nanosecond time)
@ -760,17 +762,20 @@
offset)))))) offset))))))
(define (date->time-utc date) (define (date->time-utc date)
(let ((jdays (- (priv:encode-julian-day-number (date-day date) (let* ((jdays (- (priv:encode-julian-day-number (date-day date)
(date-month date) (date-month date)
(date-year date)) (date-year date))
priv:tai-epoch-in-jd))) priv:tai-epoch-in-jd))
;; jdays is an integer plus 1/2,
(jdays-1/2 (inexact->exact (- jdays 1/2))))
(make-time (make-time
time-utc time-utc
(date-nanosecond date) (date-nanosecond date)
(+ (* (- jdays 1/2) 24 60 60) (+ (* jdays-1/2 24 60 60)
(* (date-hour date) 60 60) (* (date-hour date) 60 60)
(* (date-minute date) 60) (* (date-minute date) 60)
(date-second date))))) (date-second date)
(- (date-zone-offset date))))))
(define (date->time-tai date) (define (date->time-tai date)
(time-utc->time-tai! (date->time-utc date))) (time-utc->time-tai! (date->time-utc date)))
@ -832,9 +837,12 @@
7)) 7))
(define (current-date . tz-offset) (define (current-date . tz-offset)
(let ((time (current-time time-utc)))
(time-utc->date (time-utc->date
(current-time time-utc) time
(if (null? tz-offset) (priv:local-tz-offset) (car tz-offset)))) (if (null? tz-offset)
(priv:local-tz-offset time)
(car tz-offset)))))
;; given a 'two digit' number, find the year within 50 years +/- ;; given a 'two digit' number, find the year within 50 years +/-
(define (priv:natural-year n) (define (priv:natural-year n)
@ -909,8 +917,8 @@
(receive (seconds parts) (receive (seconds parts)
(priv:split-real secs) (priv:split-real secs)
(make-time time-utc (make-time time-utc
(inexact->exact (truncate (* parts priv:nano))) (* parts priv:nano)
(inexact->exact seconds))))) seconds))))
(define (julian-day->time-tai jdn) (define (julian-day->time-tai jdn)
(time-utc->time-tai! (julian-day->time-utc jdn))) (time-utc->time-tai! (julian-day->time-utc jdn)))
@ -919,12 +927,15 @@
(time-utc->time-monotonic! (julian-day->time-utc jdn))) (time-utc->time-monotonic! (julian-day->time-utc jdn)))
(define (julian-day->date jdn . tz-offset) (define (julian-day->date jdn . tz-offset)
(let ((offset (if (null? tz-offset) (priv:local-tz-offset) (car tz-offset)))) (let* ((time (julian-day->time-utc jdn))
(time-utc->date (julian-day->time-utc jdn) offset))) (offset (if (null? tz-offset)
(priv:local-tz-offset time)
(car tz-offset))))
(time-utc->date time offset)))
(define (modified-julian-day->date jdn . tz-offset) (define (modified-julian-day->date jdn . tz-offset)
(let ((offset (if (null? tz-offset) (priv:local-tz-offset) (car tz-offset)))) (apply julian-day->date (+ jdn 4800001/2)
(julian-day->date (+ jdn 4800001/2) offset))) tz-offset))
(define (modified-julian-day->time-utc jdn) (define (modified-julian-day->time-utc jdn)
(julian-day->time-utc (+ jdn 4800001/2))) (julian-day->time-utc (+ jdn 4800001/2)))
@ -991,13 +1002,10 @@
(priv:vector-find string priv:locale-long-month-vector string=?)) (priv:vector-find string priv:locale-long-month-vector string=?))
;; FIXME: mkoeppe: Put a symbolic time zone in the date structs.
;; do nothing. ;; Print it here instead of the numerical offset if available.
;; Your implementation might want to do something...
;;
;; FIXME: is it even possible to do anything reasonable here?
(define (priv:locale-print-time-zone date port) (define (priv:locale-print-time-zone date port)
(values)) (priv:tz-printer (date-zone-offset date) port))
;; FIXME: we should use strftime to determine this dynamically if possible. ;; FIXME: we should use strftime to determine this dynamically if possible.
;; Again, locale specific. ;; Again, locale specific.
@ -1015,8 +1023,6 @@
(display (priv:padding hours #\0 2) port) (display (priv:padding hours #\0 2) port)
(display (priv:padding minutes #\0 2) port)))) (display (priv:padding minutes #\0 2) port))))
;; STOPPED-HERE
;; A table of output formatting directives. ;; A table of output formatting directives.
;; the first time is the format char. ;; the first time is the format char.
;; the second is a procedure that takes the date, a padding character ;; the second is a procedure that takes the date, a padding character
@ -1277,8 +1283,7 @@
(not (char-numeric? ch)) (not (char-numeric? ch))
(and upto (>= nchars upto))) (and upto (>= nchars upto)))
accum accum
(loop port (loop (+ (* accum 10) (priv:char->int (read-char port)))
(+ (* accum 10) (priv:char->int (read-char port)))
(+ nchars 1)))))) (+ nchars 1))))))
(define (priv:make-integer-reader upto) (define (priv:make-integer-reader upto)
@ -1417,41 +1422,41 @@
(list #\A char-alphabetic? locale-reader-long-weekday do-nothing) (list #\A char-alphabetic? locale-reader-long-weekday do-nothing)
(list #\b char-alphabetic? locale-reader-abbr-month (list #\b char-alphabetic? locale-reader-abbr-month
(lambda (val object) (lambda (val object)
(priv:set-date-month! object val))) (set-date-month! object val)))
(list #\B char-alphabetic? locale-reader-long-month (list #\B char-alphabetic? locale-reader-long-month
(lambda (val object) (lambda (val object)
(priv:set-date-month! object val))) (set-date-month! object val)))
(list #\d char-numeric? ireader2 (lambda (val object) (list #\d char-numeric? ireader2 (lambda (val object)
(priv:set-date-day! (set-date-day!
object val))) object val)))
(list #\e char-fail eireader2 (lambda (val object) (list #\e char-fail eireader2 (lambda (val object)
(priv:set-date-day! object val))) (set-date-day! object val)))
(list #\h char-alphabetic? locale-reader-abbr-month (list #\h char-alphabetic? locale-reader-abbr-month
(lambda (val object) (lambda (val object)
(priv:set-date-month! object val))) (set-date-month! object val)))
(list #\H char-numeric? ireader2 (lambda (val object) (list #\H char-numeric? ireader2 (lambda (val object)
(priv:set-date-hour! object val))) (set-date-hour! object val)))
(list #\k char-fail eireader2 (lambda (val object) (list #\k char-fail eireader2 (lambda (val object)
(priv:set-date-hour! object val))) (set-date-hour! object val)))
(list #\m char-numeric? ireader2 (lambda (val object) (list #\m char-numeric? ireader2 (lambda (val object)
(priv:set-date-month! object val))) (set-date-month! object val)))
(list #\M char-numeric? ireader2 (lambda (val object) (list #\M char-numeric? ireader2 (lambda (val object)
(priv:set-date-minute! (set-date-minute!
object val))) object val)))
(list #\S char-numeric? ireader2 (lambda (val object) (list #\S char-numeric? ireader2 (lambda (val object)
(priv:set-date-second! object val))) (set-date-second! object val)))
(list #\y char-fail eireader2 (list #\y char-fail eireader2
(lambda (val object) (lambda (val object)
(priv:set-date-year! object (priv:natural-year val)))) (set-date-year! object (priv:natural-year val))))
(list #\Y char-numeric? ireader4 (lambda (val object) (list #\Y char-numeric? ireader4 (lambda (val object)
(priv:set-date-year! object val))) (set-date-year! object val)))
(list #\z (lambda (c) (list #\z (lambda (c)
(or (char=? c #\Z) (or (char=? c #\Z)
(char=? c #\z) (char=? c #\z)
(char=? c #\+) (char=? c #\+)
(char=? c #\-))) (char=? c #\-)))
priv:zone-reader (lambda (val object) priv:zone-reader (lambda (val object)
(priv:set-date-zone-offset! object val)))))) (set-date-zone-offset! object val))))))
(define (priv:string->date date index format-string str-len port template-string) (define (priv:string->date date index format-string str-len port template-string)
(define (skip-until port skipper) (define (skip-until port skipper)
@ -1513,13 +1518,24 @@
(date-month date) (date-month date)
(date-year date) (date-year date)
(date-zone-offset date))) (date-zone-offset date)))
(let ((newdate (make-date 0 0 0 0 #f #f #f (priv:local-tz-offset)))) (let ((newdate (make-date 0 0 0 0 #f #f #f #f)))
(priv:string->date newdate (priv:string->date newdate
0 0
template-string template-string
(string-length template-string) (string-length template-string)
(open-input-string input-string) (open-input-string input-string)
template-string) template-string)
(if (not (date-zone-offset newdate))
(begin
;; this is necessary to get DST right -- as far as we can
;; get it right (think of the double/missing hour in the
;; night when we are switching between normal time and DST).
(set-date-zone-offset! newdate
(priv:local-tz-offset
(make-time time-utc 0 0)))
(set-date-zone-offset! newdate
(priv:local-tz-offset
(date->time-utc newdate)))))
(if (priv:date-ok? newdate) (if (priv:date-ok? newdate)
newdate newdate
(priv:time-error (priv:time-error