test-suite/tests/time.test

   1 ;;;; time.test --- test suite for Guile's time functions     -*- scheme -*-
   2 ;;;; Jim Blandy <jimb@red-bean.com> --- June 1999, 2004
   3 ;;;;
   4 ;;;;    Copyright (C) 1999, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (define-module (test-suite test-time)
  21   #:use-module (test-suite lib)
  22   #:use-module (ice-9 threads))
  23
  24 ;;;
  25 ;;; gmtime
  26 ;;;
  27
  28 (with-test-prefix "gmtime"
  29
  30   (for-each (lambda (t)
  31               (pass-if (list "in another thread after error" t)
  32                 (or (provided? 'threads) (throw 'unsupported))
  33
  34                 (alarm 5)
  35                 (false-if-exception (gmtime t))
  36                 (join-thread (begin-thread (catch #t
  37                                              (lambda () (gmtime t))
  38                                              (lambda args #f))))
  39                 (alarm 0)
  40                 #t))
  41
  42             ;; time values that might provoke an error from libc
  43             ;; on 32-bit glibc all values (which fit) are fine
  44             ;; on 64-bit glibc apparently 2^63 can overflow a 32-bit tm_year
  45             (list (1- (ash 1 31)) (1- (ash 1 63))
  46                   -1 (- (ash 1 31)) (- (ash 1 63)))))
  47
  48 ;;;
  49 ;;; internal-time-units-per-second
  50 ;;;
  51
  52 (with-test-prefix "internal-time-units-per-second"
  53
  54   ;; Check that sleep 1 gives about internal-time-units-per-second worth of
  55   ;; elapsed time from times:clock.  This mainly ensures
  56   ;; internal-time-units-per-second correctly indicates CLK_TCK units.
  57   ;;
  58   (pass-if "versus times and sleep"
  59     (or (defined? 'times) (throw 'unsupported))
  60
  61     (let ((old (times)))
  62       (sleep 1)
  63       (let* ((new (times))
  64              (elapsed (- (tms:clock new) (tms:clock old))))
  65         (<= (* 0.5 internal-time-units-per-second)
  66             elapsed
  67             (* 2 internal-time-units-per-second))))))
  68
  69 ;;;
  70 ;;; localtime
  71 ;;;
  72
  73 (with-test-prefix "localtime"
  74
  75   ;; gmtoff is calculated with some explicit code, try to exercise that
  76   ;; here, looking at cases where the localtime and gmtime are within the same
  77   ;; day, or crossing midnight, or crossing new year
  78
  79   (pass-if "gmtoff of EST+5 at GMT 10:00am on 10 Jan 2000"
  80     (let ((tm (gmtime 0)))
  81       (set-tm:hour tm 10)
  82       (set-tm:mday tm 10)
  83       (set-tm:mon  tm 0)
  84       (set-tm:year tm 100)
  85       (let* ((t  (car (mktime tm "GMT")))
  86              (tm (localtime t "EST+5")))
  87         (eqv? (* 5 3600) (tm:gmtoff tm)))))
  88
  89   ;; crossing forward over day boundary
  90   (pass-if "gmtoff of EST+5 at GMT 3am on 10 Jan 2000"
  91     (let ((tm (gmtime 0)))
  92       (set-tm:hour tm 3)
  93       (set-tm:mday tm 10)
  94       (set-tm:mon  tm 0)
  95       (set-tm:year tm 100)
  96       (let* ((t  (car (mktime tm "GMT")))
  97              (tm (localtime t "EST+5")))
  98         (eqv? (* 5 3600) (tm:gmtoff tm)))))
  99
 100   ;; crossing backward over day boundary
 101   (pass-if "gmtoff of AST-10 at GMT 10pm on 10 Jan 2000"
 102     (let ((tm (gmtime 0)))
 103       (set-tm:hour tm 22)
 104       (set-tm:mday tm 10)
 105       (set-tm:mon  tm 0)
 106       (set-tm:year tm 100)
 107       (let* ((t  (car (mktime tm "GMT")))
 108              (tm (localtime t "AST-10")))
 109         (eqv? (* -10 3600) (tm:gmtoff tm)))))
 110
 111   ;; crossing forward over year boundary
 112   (pass-if "gmtoff of EST+5 at GMT 3am on 1 Jan 2000"
 113     (let ((tm (gmtime 0)))
 114       (set-tm:hour tm 3)
 115       (set-tm:mday tm 1)
 116       (set-tm:mon  tm 0)
 117       (set-tm:year tm 100)
 118       (let* ((t  (car (mktime tm "GMT")))
 119              (tm (localtime t "EST+5")))
 120         (eqv? (* 5 3600) (tm:gmtoff tm)))))
 121
 122   ;; crossing backward over day boundary
 123   (pass-if "gmtoff of AST-10 at GMT 10pm on 31 Dec 2000"
 124     (let ((tm (gmtime 0)))
 125       (set-tm:hour tm 22)
 126       (set-tm:mday tm 31)
 127       (set-tm:mon  tm 11)
 128       (set-tm:year tm 100)
 129       (let* ((t  (car (mktime tm "GMT")))
 130              (tm (localtime t "AST-10")))
 131         (eqv? (* -10 3600) (tm:gmtoff tm))))))
 132
 133 ;;;
 134 ;;; mktime
 135 ;;;
 136
 137 (with-test-prefix "mktime"
 138
 139   ;; gmtoff is calculated with some explicit code, try to exercise that
 140   ;; here, looking at cases where the mktime and gmtime are within the same
 141   ;; day, or crossing midnight, or crossing new year
 142
 143   (pass-if "gmtoff of EST+5 at 10:00am on 10 Jan 2000"
 144     (let ((tm (gmtime 0)))
 145       (set-tm:hour tm 10)
 146       (set-tm:mday tm 10)
 147       (set-tm:mon  tm 0)
 148       (set-tm:year tm 100)
 149       (let ((tm (cdr (mktime tm "EST+5"))))
 150         (eqv? (* 5 3600) (tm:gmtoff tm)))))
 151
 152   ;; crossing forward over day boundary
 153   (pass-if "gmtoff of EST+5 at 10:00pm on 10 Jan 2000"
 154     (let ((tm (gmtime 0)))
 155       (set-tm:hour tm 22)
 156       (set-tm:mday tm 10)
 157       (set-tm:mon  tm 0)
 158       (set-tm:year tm 100)
 159       (let ((tm (cdr (mktime tm "EST+5"))))
 160         (eqv? (* 5 3600) (tm:gmtoff tm)))))
 161
 162   ;; crossing backward over day boundary
 163   (pass-if "gmtoff of AST-10 at 3:00am on 10 Jan 2000"
 164     (let ((tm (gmtime 0)))
 165       (set-tm:hour tm 3)
 166       (set-tm:mday tm 10)
 167       (set-tm:mon  tm 0)
 168       (set-tm:year tm 100)
 169       (let ((tm (cdr (mktime tm "AST-10"))))
 170         (eqv? (* -10 3600) (tm:gmtoff tm)))))
 171
 172   ;; crossing forward over year boundary
 173   (pass-if "gmtoff of EST+5 at 10:00pm on 31 Dec 2000"
 174     (let ((tm (gmtime 0)))
 175       (set-tm:hour tm 22)
 176       (set-tm:mday tm 31)
 177       (set-tm:mon  tm 11)
 178       (set-tm:year tm 100)
 179       (let ((tm (cdr (mktime tm "EST+5"))))
 180         (eqv? (* 5 3600) (tm:gmtoff tm)))))
 181
 182   ;; crossing backward over day boundary
 183   (pass-if "gmtoff of AST-10 at 3:00am on 1 Jan 2000"
 184     (let ((tm (gmtime 0)))
 185       (set-tm:hour tm 3)
 186       (set-tm:mday tm 1)
 187       (set-tm:mon  tm 0)
 188       (set-tm:year tm 100)
 189       (let ((tm (cdr (mktime tm "AST-10"))))
 190         (eqv? (* -10 3600) (tm:gmtoff tm))))))
 191
 192 ;;;
 193 ;;; strftime
 194 ;;;
 195
 196 (with-test-prefix "strftime"
 197
 198   (pass-if "strftime %Z doesn't return garbage"
 199     (let ((t (localtime (current-time))))
 200       (set-tm:zone t "ZOW")
 201       (set-tm:isdst t 0)
 202       (string=? (strftime "%Z" t)
 203                 "ZOW")))
 204
 205   (pass-if "strftime passes wide characters"
 206     (let ((t (localtime (current-time))))
 207       (string=? (substring (strftime "\u0100%Z" t) 0 1)
 208                 "\u0100")))
 209
 210   (with-test-prefix "C99 %z format"
 211
 212     ;; %z here is quite possibly affected by the same tm:gmtoff vs current
 213     ;; zone as %Z above is, so in the following tests we make them the same.
 214
 215     (pass-if "GMT"
 216       (putenv "TZ=GMT+0")
 217       (tzset)
 218       (let ((tm (localtime 86400)))
 219         (string=? "+0000" (strftime "%z" tm))))
 220
 221     ;; prior to guile 1.6.9 and 1.8.1 this test failed, getting "+0500",
 222     ;; because we didn't adjust for tm:gmtoff being west of Greenwich versus
 223     ;; tm_gmtoff being east of Greenwich
 224     (pass-if "EST+5"
 225       (putenv "TZ=EST+5")
 226       (tzset)
 227       (let ((tm (localtime 86400)))
 228         (string=? "-0500" (strftime "%z" tm))))))
 229
 230 ;;;
 231 ;;; strptime
 232 ;;;
 233
 234 (with-test-prefix "strptime"
 235
 236   (pass-if "in another thread after error"
 237     (or (defined? 'strptime) (throw 'unsupported))
 238     (or (provided? 'threads) (throw 'unsupported))
 239
 240     (alarm 5)
 241     (false-if-exception
 242      (strptime "%a" "nosuchday"))
 243     (join-thread (begin-thread (strptime "%d" "1")))
 244     (alarm 0)
 245     #t)
 246
 247   (with-test-prefix "GNU %s format"
 248
 249     ;; "%s" to parse a count of seconds since 1970 is a GNU extension
 250     (define have-strptime-%s
 251       (false-if-exception (strptime "%s" "0")))
 252
 253     (pass-if "gmtoff on GMT"
 254       (or have-strptime-%s (throw 'unsupported))
 255       (putenv "TZ=GMT+0")
 256       (tzset)
 257       (let ((tm (car (strptime "%s" "86400"))))
 258         (eqv? 0 (tm:gmtoff tm))))
 259
 260     ;; prior to guile 1.6.9 and 1.8.1 we didn't pass tm_gmtoff back from
 261     ;; strptime
 262     (pass-if "gmtoff on EST+5"
 263       (or have-strptime-%s (throw 'unsupported))
 264       (putenv "TZ=EST+5")
 265       (tzset)
 266       (let ((tm (car (strptime "%s" "86400"))))
 267         (eqv? (* 5 3600) (tm:gmtoff tm))))))