Skip to content

Commit

Permalink
Add date-dst? and date-zone-name procedures
Browse files Browse the repository at this point in the history 
Accesses existing-but-hidden DST information in date records,
and adds support for getting a name of the current time zone
when a time zone offset is not explicitly provided.
  • Loading branch information
@samth
samth committed Jun 8, 2017
1 parent b395a76 commit 3c8be62
Show file tree
Hide file tree
Showing 35 changed files with 1,553 additions and 835 deletions.
4 changes: 4 additions & 0 deletions LOG
View file
Original file line number Diff line number Diff line change
Expand Up @@ -493,3 +493,7 @@
evaluation-order bug.
cp0.ss,
4.ms
- added date-dst? to access the previously-hidden DST information in
date records, and added date-zone-name to provide a time zone name.
date.ss, primdata.ss, stats.c, date.ms, root-experr*,
patch-compile*, system.stex
101 changes: 68 additions & 33 deletions c/stats.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,8 @@

static struct timespec starting_mono_tp;

static long adjust_time_zone(ptr dtvec, struct tm *tmxp, ptr given_tzoff);

/******** unique-id ********/

#if (time_t_bits == 32)
Expand Down Expand Up @@ -326,16 +328,16 @@ ptr S_gmtime(ptr tzoff, ptr tspair) {
}

if (tzoff == Sfalse) {
struct tm tmx2; time_t tx2;
if (localtime_r(&tx, &tmx) == NULL) return Sfalse;
if (gmtime_r(&tx, &tmx2) == NULL) return Sfalse;
tmx2.tm_isdst = tmx.tm_isdst;
if ((tx2 = mktime(&tmx2)) == (time_t)-1) return Sfalse;
INITVECTIT(dtvec, dtvec_tzoff) = S_integer_time_t(tx - tx2);
tmx.tm_isdst = -1; /* have mktime determine the DST status */
if (mktime(&tmx) == (time_t)-1) return Sfalse;
(void) adjust_time_zone(dtvec, &tmx, Sfalse);
} else {
tx += Sinteger_value(tzoff);
if (gmtime_r(&tx, &tmx) == NULL) return Sfalse;
INITVECTIT(dtvec, dtvec_tzoff) = tzoff;
INITVECTIT(dtvec, dtvec_isdst) = Sfalse;
INITVECTIT(dtvec, dtvec_tzname) = Sfalse;
}

INITVECTIT(dtvec, dtvec_sec) = Sinteger(tmx.tm_sec);
Expand All @@ -346,7 +348,6 @@ ptr S_gmtime(ptr tzoff, ptr tspair) {
INITVECTIT(dtvec, dtvec_year) = Sinteger(tmx.tm_year);
INITVECTIT(dtvec, dtvec_wday) = Sinteger(tmx.tm_wday);
INITVECTIT(dtvec, dtvec_yday) = Sinteger(tmx.tm_yday);
INITVECTIT(dtvec, dtvec_isdst) = Sinteger(tmx.tm_isdst);

return dtvec;
}
Expand All @@ -367,7 +368,7 @@ ptr S_asctime(ptr dtvec) {
tmx.tm_year = (int)Sinteger_value(Svector_ref(dtvec, dtvec_year));
tmx.tm_wday = (int)Sinteger_value(Svector_ref(dtvec, dtvec_wday));
tmx.tm_yday = (int)Sinteger_value(Svector_ref(dtvec, dtvec_yday));
tmx.tm_isdst = (int)Sinteger_value(Svector_ref(dtvec, dtvec_isdst));
tmx.tm_isdst = (int)Sboolean_value(Svector_ref(dtvec, dtvec_isdst));
if (asctime_r(&tmx, buf) == NULL) return Sfalse;
}

Expand All @@ -377,7 +378,8 @@ ptr S_asctime(ptr dtvec) {
ptr S_mktime(ptr dtvec) {
time_t tx;
struct tm tmx;
long orig_tzoff = (long)UNFIX(INITVECTIT(dtvec, dtvec_tzoff));
long orig_tzoff, tzoff;
ptr given_tzoff;

tmx.tm_sec = (int)Sinteger_value(Svector_ref(dtvec, dtvec_sec));
tmx.tm_min = (int)Sinteger_value(Svector_ref(dtvec, dtvec_min));
Expand All @@ -386,18 +388,14 @@ ptr S_mktime(ptr dtvec) {
tmx.tm_mon = (int)Sinteger_value(Svector_ref(dtvec, dtvec_mon)) - 1;
tmx.tm_year = (int)Sinteger_value(Svector_ref(dtvec, dtvec_year));

tmx.tm_isdst = 0;
given_tzoff = INITVECTIT(dtvec, dtvec_tzoff);
if (given_tzoff == Sfalse)
orig_tzoff = 0;
else
orig_tzoff = (long)UNFIX(given_tzoff);

tmx.tm_isdst = -1; /* have mktime determine the DST status */
if ((tx = mktime(&tmx)) == (time_t)-1) return Sfalse;
if (tmx.tm_isdst == 1) { /* guessed wrong */
tmx.tm_sec = (int)Sinteger_value(Svector_ref(dtvec, dtvec_sec));
tmx.tm_min = (int)Sinteger_value(Svector_ref(dtvec, dtvec_min));
tmx.tm_hour = (int)Sinteger_value(Svector_ref(dtvec, dtvec_hour));
tmx.tm_mday = (int)Sinteger_value(Svector_ref(dtvec, dtvec_mday));
tmx.tm_mon = (int)Sinteger_value(Svector_ref(dtvec, dtvec_mon)) - 1;
tmx.tm_year = (int)Sinteger_value(Svector_ref(dtvec, dtvec_year));
tmx.tm_isdst = 1;
if ((tx = mktime(&tmx)) == (time_t)-1) return Sfalse;
}

/* mktime may have normalized some values, set wday and yday */
INITVECTIT(dtvec, dtvec_sec) = Sinteger(tmx.tm_sec);
Expand All @@ -408,29 +406,66 @@ ptr S_mktime(ptr dtvec) {
INITVECTIT(dtvec, dtvec_year) = Sinteger(tmx.tm_year);
INITVECTIT(dtvec, dtvec_wday) = Sinteger(tmx.tm_wday);
INITVECTIT(dtvec, dtvec_yday) = Sinteger(tmx.tm_yday);

tzoff = adjust_time_zone(dtvec, &tmx, given_tzoff);

if (tzoff != orig_tzoff) tx = (time_t) difftime(tx, (time_t)(orig_tzoff - tzoff));

return Scons(S_integer_time_t(tx), Svector_ref(dtvec, dtvec_nsec));
}

static long adjust_time_zone(ptr dtvec, struct tm *tmxp, ptr given_tzoff) {
ptr tz_name = Sfalse;
long use_tzoff, tzoff;

#ifdef WIN32
{
TIME_ZONE_INFORMATION tz;
DWORD rc = GetTimeZoneInformation(&tz);
long tzoff;
WCHAR *w_tzname;
int len;

/* The ...ForYear() function is available on Windows Vista and later: */
GetTimeZoneInformationForYear(tmxp->tm_year, NULL, &tz);

if (tmxp->tm_isdst) {
tzoff = (tz.Bias + tz.DaylightBias) * -60;
w_tzname = tz.DaylightName;
} else {
tzoff = (tz.Bias + tz.StandardBias) * -60;
w_tzname = tz.StandardName;
}

switch (rc) {
case TIME_ZONE_ID_UNKNOWN:
case TIME_ZONE_ID_STANDARD:
tzoff = tz.Bias * -60;
break;
case TIME_ZONE_ID_DAYLIGHT:
tzoff = (tz.Bias + tz.DaylightBias) * -60;
break;
if (given_tzoff == Sfalse) {
len = (int)wcslen(w_tzname);
tz_name = S_string(NULL, len);
while (len--)
Sstring_set(tz_name, len, w_tzname[len]);
}
if (tzoff != orig_tzoff) tx = (time_t) difftime(tx, (time_t)(orig_tzoff - tzoff));
}
#else
if (tmx.tm_gmtoff != orig_tzoff) tx = difftime(tx, (time_t)(orig_tzoff - tmx.tm_gmtoff));
tzoff = tmxp->tm_gmtoff;
if (given_tzoff == Sfalse) {
# if defined(__linux__) || defined(SOLARIS)
/* Linux and Solaris set `tzname`: */
tz_name = S_string(tzname[tmxp->tm_isdst], -1);
# else
/* BSD variants add `tm_zone` in `struct tm`: */
tz_name = S_string(tmxp->tm_zone, -1);
# endif
}
#endif
return Scons(S_integer_time_t(tx), Svector_ref(dtvec, dtvec_nsec));
}

if (given_tzoff == Sfalse)
use_tzoff = tzoff;
else
use_tzoff = (long)UNFIX(given_tzoff);

INITVECTIT(dtvec, dtvec_isdst) = ((given_tzoff == Sfalse) ? Sboolean(tmxp->tm_isdst) : Sfalse);
INITVECTIT(dtvec, dtvec_tzoff) = FIX(use_tzoff);
INITVECTIT(dtvec, dtvec_tzname) = tz_name;

return tzoff;
}

/******** old real-time and cpu-time support ********/

Expand Down
51 changes: 51 additions & 0 deletions csug/system.stex
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3984,15 +3984,25 @@ It must be an exact integer in the range $-86400$ to
$+86400$, inclusive and defaults to the local time-zone offset.
UTC may be obtained by passing an offset of zero.

If \var{offset} is not provided, then the current time zone's offset
is used, and \scheme{date-dst?} and \scheme{date-zone-name} report
information about the time zone. If \var{offset} is provided, then
\scheme{date-dst?} and \scheme{date-zone-name} on the resulting date
object produce \scheme{#f}.

The following examples assume the local time zone is EST.

\schemedisplay
(current-date) ;=> #<date Thu Dec 27 23:23:20 2007>
(current-date 0) ;=> #<date Fri Dec 28 04:23:20 2007>

(date-zone-name (current-date)) ;=> "EST" \var{or other system-provided string}
(date-zone-name (current-date 0)) ;=> #f
\endschemedisplay

%----------------------------------------------------------------------------
\entryheader
\formdef{make-date}{\categoryprocedure}{(make-date \var{nsec} \var{sec} \var{min} \var{hour} \var{day} \var{mon} \var{year})}
\formdef{make-date}{\categoryprocedure}{(make-date \var{nsec} \var{sec} \var{min} \var{hour} \var{day} \var{mon} \var{year} \var{offset})}
\returns a date object
\listlibraries
Expand All @@ -4015,9 +4025,18 @@ as described above.
It must be an exact integer in the range $-86400$ to $+86400$, inclusive.
UTC may be specified by passing an offset of zero.

If \var{offset} is not provided, then the current time zone's offset
is used, and \scheme{date-dst?} and \scheme{date-zone-name} report
information about the time zone. If \var{offset} is provided, then
\scheme{date-dst?} and \scheme{date-zone-name} on the resulting date
object produce \scheme{#f}.

\schemedisplay
(make-date 0 0 0 0 1 1 1970 0) ;=> #<date Thu Jan 1 00:00:00 1970>
(make-date 0 30 7 9 23 9 2007 -14400) ;=> #<date Sun Sep 23 09:07:30 2007>

(date-zone-name (make-date 0 30 7 9 23 9 2007 -14400)) ;=> #f
(date-zone-name (make-date 0 30 7 9 23 9 2007)) ;=> "EDT" \var{or other system-provided string}
\endschemedisplay

%----------------------------------------------------------------------------
Expand Down Expand Up @@ -4097,6 +4116,32 @@ d2 ;=> #<date Sun Sep 23 09:07:30 2007>
(date-year-day d2) ;=> 265
\endschemedisplay

%----------------------------------------------------------------------------
\entryheader
\formdef{date-dst?}{\categoryprocedure}{(date-dst? \var{date})}
\returns whether \var{date} is in Daylight Saving Time
\formdef{date-zone-name}{\categoryprocedure}{(date-zone-name \var{date})}
\returns \scheme{#f} or a string naming the time zone of \var{date}
\listlibraries
\endentryheader

These procedures report time-zone information for
the date represented by \var{date} for a date object that
is constructed without an explicit time-zone offset. When
a date object is created instead with explicit time-zone offset,
these procedures produce \scheme{#f}.

Daylight Saving Time status for the current time zone and a name
string for the time zone are computed using platform-specific routines.
In particular, the format of the zone name is platform-specific.

\schemedisplay
(define d (make-date 0 30 7 9 23 9 2007))
(date-zone-offset d) ;=> -14400 \var{assuming Eastern U.S. time zone}
(date-dst? d) ;=> #t
(date-zone-name d) ;=> "EDT" \var{or some system-provided string}
\endschemedisplay

%----------------------------------------------------------------------------
\entryheader
\formdef{time-utc->date}{\categoryprocedure}{(time-utc->date \var{time})}
Expand All @@ -4119,6 +4164,12 @@ It must be an exact integer in the range $-86400$ to
$+86400$, inclusive and defaults to the local time-zone offset.
UTC may be obtained by passing an offset of zero.

If \var{offset} is not provided to \scheme{time-utc->date}, then the current time zone's offset
is used, and \scheme{date-dst?} and \scheme{date-zone-name} report
information about the time zone. If \var{offset} is provided, then
\scheme{date-dst?} and \scheme{date-zone-name} on the resulting date
object produce \scheme{#f}.

\schemedisplay
(define d (make-date 0 30 7 9 23 9 2007 -14400))
(date->time-utc d) ;=> #<time-utc 1190552850.000000000>
Expand Down
71 changes: 68 additions & 3 deletions mats/date.ms
View file
Original file line number Diff line number Diff line change
Expand Up @@ -323,8 +323,6 @@
(make-date 0 0 0 0 1))
(error? ; wrong number of arguments
(make-date 0 0 0 0 1 1))
(error? ; wrong number of arguments
(make-date 0 0 0 0 1 1 2007))
(error? ; wrong number of arguments
(make-date 0 0 0 0 1 1 2007 0 0))
(error? ; invalid nanosecond
Expand Down Expand Up @@ -464,6 +462,14 @@
(date-year-day 17))
(error? ; not a date record
(date-year-day $time-t1))
(error? ; wrong number of arguments
(date-dst?))
(error? ; wrong number of arguments
(date-dst? $date-d1 #t))
(error? ; not a date record
(date-dst? 17))
(error? ; not a date record
(date-dst? $time-t1))
(error? ; wrong number of arguments
(date-zone-offset))
(error? ; wrong number of arguments
Expand All @@ -472,6 +478,14 @@
(date-zone-offset 17))
(error? ; not a date record
(date-zone-offset $time-t1))
(error? ; wrong number of arguments
(date-zone-name))
(error? ; wrong number of arguments
(date-zone-name $date-d1 #t))
(error? ; not a date record
(date-zone-name 17))
(error? ; not a date record
(date-zone-name $time-t1))
(error? ; wrong number of arguments
(current-date 0 #t))
(error? ; invalid offset
Expand All @@ -486,7 +500,10 @@
(and (date? $date-d3) (not (time? $date-d3))))
(begin
(define $date-d4 (current-date (* 10 60 60)))
(and (date? $date-d4) (not (time? $date-d3))))
(and (date? $date-d4) (not (time? $date-d4))))
(begin
(define $date-d5 (make-date 0 1 1 1 15 6 2016))
(and (date? $date-d5) (not (time? $date-d5))))
(date? (make-date 0 0 0 0 1 1 1970 -24))
(date? (make-date 999999999 59 59 23 31 12 2007 24))
(eqv? (date-nanosecond $date-d1) 1)
Expand All @@ -497,6 +514,54 @@
(eqv? (date-month $date-d1) 6)
(eqv? (date-year $date-d1) 1970)
(eqv? (date-zone-offset $date-d1) 8)
(boolean? (date-dst? $date-d5))
(fixnum? (date-zone-offset $date-d5))
(eqv? (date-zone-name $date-d1) #f)
(or (string? (date-zone-name $date-d2))
(not (date-zone-name $date-d2)))
(eqv? (date-zone-name $date-d3) #f)
(eqv? (date-zone-name $date-d4) #f)
(or (string? (date-zone-name $date-d5))
(not (date-zone-name $date-d5)))
(begin
(define (plausible-dst? d)
;; Recognize a few time zone names and correlate with the DST field.
;; Names like "EST" appear on Unix variants, while the long names
;; show up on Windows.
(cond
[(member (date-zone-name d) '("EST" "CST" "MST" "PST"
"Eastern Standard Time"
"Central Standard Time"
"Mountain Standard Time"
"Pacific Standard Time"))
(eqv? (date-dst? d) #f)]
[(member (date-zone-name d) '("EDT" "CDT" "MDT" "PDT"
"Eastern Daylight Time"
"Central Daylight Time"
"Mountain Daylight Time"
"Pacific Daylight Time"))
(eqv? (date-dst? d) #t)]
[else #t]))
(plausible-dst? $date-d5))
(begin
(define $date-d6 (make-date 0 1 1 1 15 1 2016))
(plausible-dst? $date-d6))
; check whether tz offsets are set according to DST, assuming that
; DST always means a 1-hour shift
(let ([delta (time-second (time-difference (date->time-utc $date-d5)
(date->time-utc $date-d6)))]
[no-dst-delta (* 152 24 60 60)]; 152 days
[hour-delta (* 60 60)])
(cond
[(and (date-dst? $date-d5) (not (date-dst? $date-d6)))
;; Northern-hemisphere DST reduces delta
(= delta (- no-dst-delta hour-delta))]
[(and (not (date-dst? $date-d5)) (date-dst? $date-d6))
;; Southern-hemisphere DST increases delta
(= delta (+ no-dst-delta hour-delta))]
[else
;; No DST or always DST
(= delta no-dst-delta)]))
; check to make sure dst isn't screwing with our explicitly created dates
; when we call mktime to fill in wday and yday
(let f ([mon 1])
Expand Down
Loading

0 comments on commit 3c8be62

Please sign in to comment.