1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
;;; -*- Mode: Lisp -*-
;;; $Id: tests.lisp,v 1.5 2001/11/12 19:48:20 jesse Exp $
;;;
;;; Copyright (c) 2000, 2001 onShore Development, Inc.
;;;
;;; Test the implementation of local-time
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage :local-time-tests
(:nicknames :lt-tests)
(:use :cl-user :common-lisp :local-time :xptest)))
(in-package :lt-tests)
(defvar lt-test-suite (make-test-suite "LT Tests"
"Tests for local time package"))
(def-test-fixture lt-fixture ()
())
(defparameter +failed-match-by-days+
"times not equal from days ~A: ~A --vs-- ~A")
(make-test-case
"Iterate Days" 'lt-fixture
:test-suite lt-test-suite
:description "day by day, make a new local time"
:test-thunk
(lambda (test)
(declare (ignore test))
(labels ((tester (days)
(let* ((lt1 (local-time::%make-local-time :day days :sec 7724 :msec 0))
(stream (make-string-output-stream)))
(format-timestring stream lt1)
(let* ((formatted (get-output-stream-string stream))
(lt2 (parse-timestring formatted)))
(if (local-time/= lt1 lt2)
(let ((msg (format nil +failed-match-by-days+
days
(format-timestring nil lt1)
(format-timestring nil lt2))))
(failure msg)))))))
(dotimes (x 10000 t)
(tester x)
(tester (- x))))))
#|
;; to run the test suite do:
;; (in-package :xptest)
;; (report-result (run-test lt-tests::lt-test-suite :handle-errors NIL))
;; or
;; (summarize-results (run-test lt-tests::lt-test-suite :handle-errors nil))
(labels ((tester (days)
(let* ((lt1 (local-time::%make-local-time :days days :secs 7724 :msecs 0))
(stream (make-string-output-stream)))
(format-timestring stream lt1)
(let* ((formatted (get-output-stream-string stream))
(xxx (format t "formatted: ~A ~%" formatted))
(lt2 (parse-timestring formatted)))
(if (local-time/= lt1 lt2)
(error "times not equal"))))))
(tester 1766))
(defun test-cycle ()
(dotimes (x 365)
(multiple-value-bind (month day)
(lt-cycle-month-day x)
(format t ";; ~d => ~d ~d~%" x (month-name month) (1+ day)))))
|#
(defun test-lt-greg-isomorphic ()
(declare (optimize (speed 3)
(safety 1)))
(dotimes (year 4000)
(declare (type fixnum year))
(format t ";; Year: ~d~%" year)
(dotimes (m 12)
(declare (type fixnum m))
(let ((month (1+ m)))
(declare (type fixnum month))
(dotimes (d (days-in-month month year))
(let* ((day (1+ d))
(local-day (%lt-date year month day)))
(multiple-value-bind (year2 month2 day2)
(%gregorian-date local-day)
(when (not (= year year2))
(error "year wrong"))
(when (not (= month month2))
(error "month wrong"))
(when (not (= day day2))
(error "day wrong")))))))))
#|
(read-with-delimiter-list '(#\D #\H) (make-string-input-stream "P100EDEE"))
(read-n-characters 88 (make-string-input-stream "P100EDEE")
:keep-from 2 :keep-to 5)
(parse-timestring "P10D23H60M60S")
(syntax-parse-iso-8601 "2000-03-01 00:00:00-06") ;; 0
(parse-timestring "2000-03-01 00:00:00-00") ;; 0
(parse-timestring "2000-02-29 00:00:00-06") ;; -1
(parse-timestring "2000-02-28 00:00:00-06") ;; -2
(parse-timestring "1999-02-28 00:00:00-06") ;; -367
(parse-timestring "1999-12-31 00:00:00-06") ;;
(parse-timestring "2000-02-01 00:00:00-06") ;;
(parse-timestring "2005-12-31 00:00:00-06") ;;
(parse-timestring "2004-03-01 00:00:00-06") ;; 1461
(parse-timestring "2000-03-25 00:00:00-06") ;; 24
(parse-timestring "2000-04-01 00:00:00-06") ;; 31
(local-time-to-string
(month-first-day (parse-timestring "2000-05-10 00:00:00-06")))
(local-time-ymd (parse-timestring "2000-03-25 00:00:00-06"))
(local-time-ymd (parse-timestring "1971-03-25 00:00:00-06"))
(local-time-ymd (parse-timestring "2004-02-29 00:00:00-06"))
(local-time-ymd (parse-timestring "2004-03-01 00:00:00-06"))
(local-time-ymd (parse-timestring "2004-02-28 00:00:00-06"))
(local-time-ymd (parse-timestring "2003-05-31 00:00:00-06"))
(local-time-year (parse-timestring "2000-12-31 00:00:00-06"))
(local-time-year (parse-timestring "2000-03-01 00:00:00-06"))
(local-time-year (parse-timestring "1999-12-31 00:00:00-06"))
(local-time-year (parse-timestring "1999-02-29 00:00:00-06"))
(dolist (month (month-span (parse-timestring "2000-02-29 00:00:00-06")
(parse-timestring "P1D")))
(format t (local-time-to-string month))
(format t "~%"))
(let ((stream (make-string-output-stream)))
(format-timestring stream (parse-timestring "2000-02-29 00:00:00-06"))
(get-output-stream-string stream))
(local-time-to-string (parse-timestring "2000-02-20 01:30:00-06") :pretty t)
(local-time-to-string (parse-timestring "2000-02-20 01:30:00-06") :short-pretty t)
(local-time-to-string
(%universal-to-local-time
(encode-universal-time 0 0 0 3 4 2000)))
(let ((stream (make-string-output-stream)))
(format-timestring stream (parse-timestring "2000-05-02 00:00:00-06"))
(get-output-stream-string stream))
(let ((stream (make-string-output-stream)))
(format-timestring stream (parse-timestring "2000-03-31 00:00:00-06"))
(get-output-stream-string stream))
(let ((stream (make-string-output-stream)))
(format-timestring stream (parse-timestring "1999-04-01 11:32:21-06"))
(get-output-stream-string stream))
(local-time= (parse-timestring "1999-04-01 11:32:21-06")
(parse-timestring "1999-04-01 11:32:21-06"))
(local-time-hms (local-time::%make-local-time :days 0 :secs 7724 :msecs 0))
|#
|