~ chicken-core (chicken-5) f08f4d6d102117e98c09907111873fb196d9c71f
commit f08f4d6d102117e98c09907111873fb196d9c71f
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri May 24 22:25:03 2013 +0200
Commit: Jim Ursetto <zbigniewsz@gmail.com>
CommitDate: Tue Jul 9 19:58:08 2013 -0500
Some shuffling about and fixing of the POSIX time handling stuff.
* All time<->string conversion routines used a static object, which resulted in inconsistent results across several calls using incomplete time specification strings. Now they get fresh buffers allocated whenever they're called (fixes #1014). Thanks to David Krentzlin for pointing out the bug.
* time->string was duplicated in posixunix from posix-common
* posixwin and posixunix both had C_tm_set(), C_tm_set_08, C_asctime() and C_a_mktime() macros, moved these to posix-common
* tm_get could be moved to posix-common, but it is only used in posixunix so it's kept there for now
diff --git a/posix-common.scm b/posix-common.scm
index 78669d14..99c03150 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -50,8 +50,41 @@ static C_TLS struct stat C_statbuf;
# define S_IFSOCK 0140000
#endif
-#define C_strftime(v, f) \
- (strftime(C_time_string, sizeof(C_time_string), C_c_string(f), C_tm_set(v)) ? C_time_string : NULL)
+#define cpy_tmvec_to_tmstc08(ptm, v) \
+ ((ptm)->tm_sec = C_unfix(C_block_item((v), 0)), \
+ (ptm)->tm_min = C_unfix(C_block_item((v), 1)), \
+ (ptm)->tm_hour = C_unfix(C_block_item((v), 2)), \
+ (ptm)->tm_mday = C_unfix(C_block_item((v), 3)), \
+ (ptm)->tm_mon = C_unfix(C_block_item((v), 4)), \
+ (ptm)->tm_year = C_unfix(C_block_item((v), 5)), \
+ (ptm)->tm_wday = C_unfix(C_block_item((v), 6)), \
+ (ptm)->tm_yday = C_unfix(C_block_item((v), 7)), \
+ (ptm)->tm_isdst = (C_block_item((v), 8) != C_SCHEME_FALSE))
+
+#define cpy_tmvec_to_tmstc9(ptm, v) \
+ (((struct tm *)ptm)->tm_gmtoff = -C_unfix(C_block_item((v), 9)))
+
+#define C_tm_set_08(v, tm) cpy_tmvec_to_tmstc08( (tm), (v) )
+#define C_tm_set_9(v, tm) cpy_tmvec_to_tmstc9( (tm), (v) )
+
+static struct tm *
+C_tm_set( C_word v, void *tm )
+{
+ C_tm_set_08( v, (struct tm *)tm );
+#if defined(C_GNU_ENV) && !defined(__CYGWIN__) && !defined(__uClinux__)
+ C_tm_set_9( v, (struct tm *)tm );
+#endif
+ return tm;
+}
+
+#define TIME_STRING_MAXLENGTH 255
+static char C_time_string [TIME_STRING_MAXLENGTH + 1];
+#undef TIME_STRING_MAXLENGTH
+
+#define C_strftime(v, f, tm) \
+ (strftime(C_time_string, sizeof(C_time_string), C_c_string(f), C_tm_set((v), (tm))) ? C_time_string : NULL)
+#define C_a_mktime(ptr, c, v, tm) C_flonum(ptr, mktime(C_tm_set((v), C_data_pointer(tm))))
+#define C_asctime(v, tm) (asctime(C_tm_set((v), (tm))))
#define C_C_fileno(p) C_fix(fileno(C_port_file(p)))
@@ -470,24 +503,27 @@ EOF
(##sys#substring str 0 (fx- (##sys#size str) 1))
(##sys#error 'seconds->string "cannot convert seconds to string" secs) ) ) ) ) )
-(define (local-time->seconds tm)
- (check-time-vector 'local-time->seconds tm)
- (let ((t (##core#inline_allocate ("C_a_mktime" 4) tm)))
- (if (fp= -1.0 t)
- (##sys#error 'local-time->seconds "cannot convert time vector to seconds" tm)
- t)))
+(define local-time->seconds
+ (let ((tm-size (foreign-value "sizeof(struct tm)" int)))
+ (lambda (tm)
+ (check-time-vector 'local-time->seconds tm)
+ (let ((t (##core#inline_allocate ("C_a_mktime" 4) tm (##sys#make-string tm-size #\nul))))
+ (if (fp= -1.0 t)
+ (##sys#error 'local-time->seconds "cannot convert time vector to seconds" tm)
+ t)))))
(define time->string
- (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)]
- [strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object)])
+ (let ((asctime (foreign-lambda c-string "C_asctime" scheme-object scheme-pointer))
+ (strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object scheme-pointer))
+ (tm-size (foreign-value "sizeof(struct tm)" int)))
(lambda (tm #!optional fmt)
(check-time-vector 'time->string tm)
(if fmt
(begin
(##sys#check-string fmt 'time->string)
- (or (strftime tm (##sys#make-c-string fmt 'time->string))
+ (or (strftime tm (##sys#make-c-string fmt 'time->string) (##sys#make-string tm-size #\nul))
(##sys#error 'time->string "time formatting overflows buffer" tm)) )
- (let ([str (asctime tm)])
+ (let ([str (asctime tm (##sys#make-string tm-size #\nul))])
(if str
(##sys#substring str 0 (fx- (##sys#size str) 1))
(##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
diff --git a/posixunix.scm b/posixunix.scm
index 9ea6183d..fb92e921 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -137,7 +137,6 @@ static C_TLS struct {
#endif
static C_TLS int C_pipefds[ 2 ];
static C_TLS time_t C_secs;
-static C_TLS struct tm C_tm;
static C_TLS struct timeval C_timeval;
static C_TLS char C_hostbuf[ 256 ];
static C_TLS struct stat C_statbuf;
@@ -327,21 +326,14 @@ static time_t C_timegm(struct tm *t)
#define C_timegm timegm
#endif
-#define cpy_tmvec_to_tmstc08(ptm, v) \
- (memset((ptm), 0, sizeof(struct tm)), \
- (ptm)->tm_sec = C_unfix(C_block_item((v), 0)), \
- (ptm)->tm_min = C_unfix(C_block_item((v), 1)), \
- (ptm)->tm_hour = C_unfix(C_block_item((v), 2)), \
- (ptm)->tm_mday = C_unfix(C_block_item((v), 3)), \
- (ptm)->tm_mon = C_unfix(C_block_item((v), 4)), \
- (ptm)->tm_year = C_unfix(C_block_item((v), 5)), \
- (ptm)->tm_wday = C_unfix(C_block_item((v), 6)), \
- (ptm)->tm_yday = C_unfix(C_block_item((v), 7)), \
- (ptm)->tm_isdst = (C_block_item((v), 8) != C_SCHEME_FALSE))
-
-#define cpy_tmvec_to_tmstc9(ptm, v) \
- (((struct tm *)ptm)->tm_gmtoff = -C_unfix(C_block_item((v), 9)))
+#define C_a_timegm(ptr, c, v, tm) C_flonum(ptr, C_timegm(C_tm_set((v), C_data_pointer(tm))))
+#ifdef __linux__
+extern char *strptime(const char *s, const char *format, struct tm *tm);
+extern pid_t getpgid(pid_t pid);
+#endif
+
+/* tm_get could be in posix-common, but it's only used in here */
#define cpy_tmstc08_to_tmvec(v, ptm) \
(C_set_block_item((v), 0, C_fix(((struct tm *)ptm)->tm_sec)), \
C_set_block_item((v), 1, C_fix((ptm)->tm_min)), \
@@ -356,63 +348,21 @@ static time_t C_timegm(struct tm *t)
#define cpy_tmstc9_to_tmvec(v, ptm) \
(C_set_block_item((v), 9, C_fix(-(ptm)->tm_gmtoff)))
-#define C_tm_set_08(v) cpy_tmvec_to_tmstc08( &C_tm, (v) )
-#define C_tm_set_9(v) cpy_tmvec_to_tmstc9( &C_tm, (v) )
-
-#define C_tm_get_08(v) cpy_tmstc08_to_tmvec( (v), &C_tm )
-#define C_tm_get_9(v) cpy_tmstc9_to_tmvec( (v), &C_tm )
-
-#if !defined(C_GNU_ENV) || defined(__CYGWIN__) || defined(__uClinux__)
-
-static struct tm *
-C_tm_set( C_word v )
-{
- C_tm_set_08( v );
- return &C_tm;
-}
+#define C_tm_get_08(v, tm) cpy_tmstc08_to_tmvec( (v), (tm) )
+#define C_tm_get_9(v, tm) cpy_tmstc9_to_tmvec( (v), (tm) )
static C_word
-C_tm_get( C_word v )
-{
- C_tm_get_08( v );
- return v;
-}
-
-#else
-
-static struct tm *
-C_tm_set( C_word v )
+C_tm_get( C_word v, void *tm )
{
- C_tm_set_08( v );
- C_tm_set_9( v );
- return &C_tm;
-}
-
-static C_word
-C_tm_get( C_word v )
-{
- C_tm_get_08( v );
- C_tm_get_9( v );
+ C_tm_get_08( v, (struct tm *)tm );
+#if defined(C_GNU_ENV) && !defined(__CYGWIN__) && !defined(__uClinux__)
+ C_tm_get_9( v, (struct tm *)tm );
+#endif
return v;
}
-#endif
-
-#define C_asctime(v) (asctime(C_tm_set(v)))
-#define C_a_mktime(ptr, c, v) C_flonum(ptr, mktime(C_tm_set(v)))
-#define C_a_timegm(ptr, c, v) C_flonum(ptr, C_timegm(C_tm_set(v)))
-
-#define TIME_STRING_MAXLENGTH 255
-static char C_time_string [TIME_STRING_MAXLENGTH + 1];
-#undef TIME_STRING_MAXLENGTH
-
-#ifdef __linux__
-extern char *strptime(const char *s, const char *format, struct tm *tm);
-extern pid_t getpgid(pid_t pid);
-#endif
-
-#define C_strptime(s, f, v) \
- (strptime(C_c_string(s), C_c_string(f), &C_tm) ? C_tm_get(v) : C_SCHEME_FALSE)
+#define C_strptime(s, f, v, stm) \
+ (strptime(C_c_string(s), C_c_string(f), ((struct tm *)(stm))) ? C_tm_get((v), (stm)) : C_SCHEME_FALSE)
static gid_t *C_groups = NULL;
@@ -1631,34 +1581,22 @@ EOF
;;; Time related things:
-(define time->string
- (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)]
- [strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object)])
- (lambda (tm #!optional fmt)
- (check-time-vector 'time->string tm)
- (if fmt
- (begin
- (##sys#check-string fmt 'time->string)
- (or (strftime tm (##sys#make-c-string fmt 'time->string))
- (##sys#error 'time->string "time formatting overflows buffer" tm)) )
- (let ([str (asctime tm)])
- (if str
- (##sys#substring str 0 (fx- (##sys#size str) 1))
- (##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
-
(define string->time
- (let ([strptime (foreign-lambda scheme-object "C_strptime" scheme-object scheme-object scheme-object)])
+ (let ((strptime (foreign-lambda scheme-object "C_strptime" scheme-object scheme-object scheme-object scheme-pointer))
+ (tm-size (foreign-value "sizeof(struct tm)" int)))
(lambda (tim #!optional (fmt "%a %b %e %H:%M:%S %Z %Y"))
(##sys#check-string tim 'string->time)
(##sys#check-string fmt 'string->time)
- (strptime (##sys#make-c-string tim 'string->time) (##sys#make-c-string fmt) (make-vector 10 #f)) ) ) )
-
-(define (utc-time->seconds tm)
- (check-time-vector 'utc-time->seconds tm)
- (let ((t (##core#inline_allocate ("C_a_timegm" 4) tm)))
- (if (fp= -1.0 t)
- (##sys#error 'utc-time->seconds "cannot convert time vector to seconds" tm)
- t)))
+ (strptime (##sys#make-c-string tim 'string->time) (##sys#make-c-string fmt) (make-vector 10 #f) (##sys#make-string tm-size #\nul)) ) ) )
+
+(define utc-time->seconds
+ (let ((tm-size (foreign-value "sizeof(struct tm)" int)))
+ (lambda (tm)
+ (check-time-vector 'utc-time->seconds tm)
+ (let ((t (##core#inline_allocate ("C_a_timegm" 4) tm (##sys#make-string tm-size #\nul))))
+ (if (fp= -1.0 t)
+ (##sys#error 'utc-time->seconds "cannot convert time vector to seconds" tm)
+ t)))))
(define local-timezone-abbreviation
(foreign-lambda* c-string ()
diff --git a/posixwin.scm b/posixwin.scm
index 3d28e642..08e62d35 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -101,7 +101,6 @@ static C_TLS char *C_exec_env[ ENV_MAX ];
static C_TLS struct group *C_group;
static C_TLS int C_pipefds[ 2 ];
static C_TLS time_t C_secs;
-static C_TLS struct tm C_tm;
/* pipe handles */
static C_TLS HANDLE C_rd0, C_wr0, C_wr0_, C_rd1, C_wr1, C_rd1_;
@@ -303,23 +302,6 @@ C_free_arg_string(char **where) {
#define C_ctime(n) (C_secs = (n), ctime(&C_secs))
-#define C_tm_set_08(v) \
- (memset(&C_tm, 0, sizeof(struct tm)), \
- C_tm.tm_sec = C_unfix(C_block_item(v, 0)), \
- C_tm.tm_min = C_unfix(C_block_item(v, 1)), \
- C_tm.tm_hour = C_unfix(C_block_item(v, 2)), \
- C_tm.tm_mday = C_unfix(C_block_item(v, 3)), \
- C_tm.tm_mon = C_unfix(C_block_item(v, 4)), \
- C_tm.tm_year = C_unfix(C_block_item(v, 5)), \
- C_tm.tm_wday = C_unfix(C_block_item(v, 6)), \
- C_tm.tm_yday = C_unfix(C_block_item(v, 7)), \
- C_tm.tm_isdst = (C_block_item(v, 8) != C_SCHEME_FALSE))
-
-#define C_tm_set(v) (C_tm_set_08(v), &C_tm)
-
-#define C_asctime(v) (asctime(C_tm_set(v)))
-#define C_a_mktime(ptr, c, v) C_flonum(ptr, mktime(C_tm_set(v)))
-
#define TIME_STRING_MAXLENGTH 255
static char C_time_string [TIME_STRING_MAXLENGTH + 1];
#undef TIME_STRING_MAXLENGTH
Trap