scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- The daylight-savings time flag was blowing up date->time conversion 

when it wasn't relevant.

- Error returns from mktime() were not being caught.
This commit is contained in:
shivers 1997-04-18 03:25:32 +00:00
parent 1a2d8690ce
commit a304e9b7f9
2 changed files with 42 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
scsh/time.scm
View File

@ -104,7 +104,7 @@
fixnum) ; lo secs
(define-foreign %date->time/errno (date2time (fixnum sec)
(define-foreign %date->time/error (date2time (fixnum sec)
(fixnum min)
(fixnum hour)
(fixnum month-day)
@ -113,17 +113,17 @@
(desc tz-name) ; #f or string
(desc tz-secs) ; #f or int
(bool summer?))
desc ; errno or #f
desc ; errno, -1, or #f
fixnum ; hi secs
fixnum) ; lo secs
(define (time . args) ; optional arg [date]
(let lp ()
(receive (err hi-secs lo-secs)
(if (null? args)
(%time/errno) ; Fast path for (time).
(if (pair? args)
(if (null? (cdr args))
(let ((date (check-arg date? (car args) time)))
(%date->time/errno (date:seconds date)
(%date->time/error (date:seconds date)
(date:minute date)
(date:hour date)
(date:month-day date)
@ -131,11 +131,14 @@
(date:year date)
(date:tz-name date) ; #f or string
(date:tz-secs date) ; #f or int
(date:summer? date))))
(date:summer? date)))
(error "Too many arguments to TIME procedure" args))
(%time/errno)) ; Fast path for (time).
(cond ((not err) (compose-8/24 hi-secs lo-secs)) ; Win.
((= errno/intr err) (lp)) ; Retry.
(else (apply errno-error err time args)))))); Lose.
((= -1 err) (error "Error converting date to time." args)) ; Lose.
(else (apply errno-error err time args)))))) ; Lose.
;;; Date

32
scsh/time1.c
View File

@ -190,6 +190,18 @@ scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone,
}
/* Oops
** There's a fundamental problem with the Posix mktime() function used below
** -- it's error return value (-1) is also a valid return value, for date
** 11:59:00 UTC, 12/31/1969
**
** 1. We choose to err on the paranoid side. If mktime() returns -1, it is
** considered an error.
** 2. If we return an error, we try to return a useful errno value, if we can.
**
** Who designed this interface?
*/
scheme_value date2time(int sec, int min, int hour,
int mday, int month, int year,
scheme_value tz_name, scheme_value tz_secs,
@ -198,7 +210,6 @@ scheme_value date2time(int sec, int min, int hour,
{
time_t t;
struct tm d;
int error = 0;
d.tm_sec = sec; d.tm_min = min; d.tm_hour = hour;
d.tm_mday = mday; d.tm_mon = month; d.tm_year = year;
@ -208,9 +219,11 @@ scheme_value date2time(int sec, int min, int hour,
char **oldenv = environ; /* Set TZ to UTC */
environ = utc_env; /* time temporarily. */
tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */
errno = 0; /* A -1 ret value from mktime() might be legal; */
t = mktime(&d); /* hack errno to disambiguate. Ugh. */
if( t == -1 && errno ) error = errno;
d.tm_isdst = 0; /* FreeBSD, at least, needs this or it sulks. */
errno = 0;
t = mktime(&d);
/* t == -1 => you probably have an error. */
if( t == -1 ) return ENTER_FIXNUM(errno ? errno : -1);
t -= EXTRACT_FIXNUM(tz_secs);
environ = oldenv;
}
@ -220,20 +233,19 @@ scheme_value date2time(int sec, int min, int hour,
char **oldenv = make_newenv(tz_name, newenv);
if( !oldenv ) return ENTER_FIXNUM(errno);
tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */
errno = 0; /* A -1 ret value from mktime() might be legal; */
t = mktime(&d); /* hack errno to disambiguate. Ugh. */
if( t == -1 && errno ) error = errno;
errno = 0;
t = mktime(&d);
if( t == -1 ) return ENTER_FIXNUM(errno ? errno : -1);
revert_env(oldenv);
}
else { /* Local time */
tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */
errno = 0;
t = mktime(&d);
if( t == -1 && errno ) error = errno;
if( t == -1) return ENTER_FIXNUM(errno ? errno : -1);
}
if( error ) return ENTER_FIXNUM(error);
*hi_secs = hi8(t);
*lo_secs = lo24(t);
return SCHFALSE;