1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker
4    E-mail:        J.Wielemaker@vu.nl
5    WWW:           www.swi-prolog.org
6    Copyright (c)  2006-2017, University of Amsterdam
7                              VU University Amsterdam
8    All rights reserved.
9
10    Redistribution and use in source and binary forms, with or without
11    modification, are permitted provided that the following conditions
12    are met:
13
14    1. Redistributions of source code must retain the above copyright
15       notice, this list of conditions and the following disclaimer.
16
17    2. Redistributions in binary form must reproduce the above copyright
18       notice, this list of conditions and the following disclaimer in
19       the documentation and/or other materials provided with the
20       distribution.
21
22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33    POSSIBILITY OF SUCH DAMAGE.
34*/
35
36:- module(test_date,
37	  [ test_date/0
38	  ]).
39:- use_module(library(lists)).
40:- use_module(library(plunit)).
41:- use_module(library(date)).
42
43:- dynamic
44	error/1.
45
46test_date :-
47	non_unit_tests,
48	run_tests([ parse_time,
49		    format_time
50		  ]).
51
52non_unit_tests :-
53	retractall(error(_)),
54	(   catch((test_format, test_trip), E, true)
55	->  (   var(E)
56	    ->  \+ error(_)
57	    ;	print_message(error, E),
58		fail
59	    )
60	).
61
62
63		 /*******************************
64		 *      TIME_FORMAT/3 TESTS	*
65		 *******************************/
66
67ok(1152794050, '%a', 'Thu').
68ok(1152794050, '%A', 'Thursday').
69ok(1152794050, '%b', 'Jul').
70ok(1152794050, '%B', 'July').
71ok(1152794050, '%c', 'Thu Jul 13 14:34:10 2006').
72ok(1152794050, '%p', ['P', 'PM']).
73%ok(1152794050, '%P', 'pm').		% non-standard
74ok(1152794050, '%x', '07/13/06').
75ok(1152794050, '%X', '14:34:10').
76ok(1152794050, '%C', '20').
77ok(1152794050, '%d', '13').
78ok(1152794050, '%D', '07/13/06').
79ok(1152794050, '%e', '13').
80%ok(1152794050, '%E', '').
81ok(1152794050, '%F', '2006-07-13').
82ok(1152794050, '%g', '06').
83ok(1152794050, '%G', '2006').
84ok(1152794050, '%V', '28').
85ok(1152794050, '%h', 'Jul').
86ok(1152794050, '%H', '14').
87ok(1152794050, '%I', '02').
88ok(1152794050, '%j', '194').
89ok(1152794050, '%k', '14').
90ok(1152794050, '%l', ' 2').
91ok(1152794050, '%m', '07').
92ok(1152794050, '%M', '34').
93ok(1152794050, '%n', '\n').
94%ok(1152794050, '%O', '').
95ok(1152794050, '%r', '02:34:10 PM').
96ok(1152794050, '%R', '14:34').
97ok(1152794050, '%s', '1152794050').
98ok(1152794050, '%S', '10').
99ok(1152794050, '%t', '\t').
100ok(1152794050, '%T', '14:34:10').
101ok(1152794050, '%u', '4').
102ok(1152794050, '%U', '28').
103ok(1152794050, '%w', '4').
104ok(1152794050, '%W', '28').
105ok(1152794050, '%y', '06').
106ok(1152794050, '%Y', '2006').
107ok(1152794050, '%z', '+0200').
108ok(1152794050, '%Z', 'CEST').
109ok(1152794050, '%+', 'Thu Jul 13 14:34:10 2006').
110ok(1152794050, '%%', '%').
111
112%%	test_format/0
113%
114%	Extensively test the output of all supported formats.  We must
115%	run this in the C locale to get reproducable answers.
116
117test_format :-
118	setlocale(time, OldLocale, 'C'),
119	(   ok(Time, Fmt, Atom),
120	    (	format_time(atom(A), Fmt, Time)
121	    ->	(   (   A == Atom
122		    ;	is_list(Atom),
123			memberchk(A, Atom)
124		    )
125		->  true
126		;   format('~q: got ~q, expected ~q~n', [Fmt, A, Atom])
127		)
128	    ;	format('format_time(~q, ~q, ~q) failed~n', [atom(_), Fmt, Time])
129	    ),
130	    fail
131	;   true
132	),
133	setlocale(time, _, OldLocale).
134
135
136		 /*******************************
137		 *	  GENERAL TESTS		*
138		 *******************************/
139
140%	test_date(+Date, +Time, -FormatTests).
141
142test_date(1970-1-1, 0:0:0.0,		% Epoch
143	  [ '%s' = '0'
144	  ]).
145test_date(0-1-1, 0:0:0.0, []).		% Year 0
146test_date(2000-1-1, 0:0:0.0, []).	% Year 2000
147test_date(-10000-1-1, 0:0:0.0, []).	% Year 10,000BC
148test_date(10000-1-1, 0:0:0.0, []).	% Year 10,000AD
149
150%	test_trip/0
151%
152%	Run all round-trip tests and verify formats on them
153
154test_trip :-
155	forall(test_date(Date, Time, FormatTests),
156	       test_trip(Date, Time, FormatTests)).
157
158test_trip(Y-M-D, H:Min:S, FormatTests) :-
159	Date = date(Y,M,D,H,Min,S,0,-,-),
160	date_time_stamp(Date, Stamp),
161	stamp_date_time(Stamp, Date2, 0),
162	(   Date2 = Date
163	->  true
164	;   error('~q: Tripped as ~q', [Date, Date2])
165	),
166	(   member(Fmt = Val, FormatTests),
167	    (	format_time(atom(A), Fmt, Stamp),
168		A == Val
169	    ->	true
170	    ;	error('Format failed: ~q ~q ~q', [Date, Fmt, Val])
171	    ),
172	    fail
173	;   true
174	).
175
176
177		 /*******************************
178		 *	       KEEP		*
179		 *******************************/
180
181russian_day(A) :-
182	setlocale(time, Old, 'ru_RU.utf8'),
183	get_time(X),
184	format_time(atom(A), '%A', X),
185	setlocale(time, _, Old).
186
187utc :-
188	get_time(Stamp),
189	stamp_date_time(Stamp, DateTime, 'UTC'),
190	format_time(current_output, '%F %T %Z', DateTime).
191
192		 /*******************************
193		 *	      ERROR		*
194		 *******************************/
195
196
197error(Fmt, Args) :-
198	assert(error(Fmt-Args)),
199	format(user_error, Fmt, Args),
200	nl(user_error).
201
202
203		 /*******************************
204		 *	     UNIT TESTS		*
205		 *******************************/
206
207:- begin_tests(parse_time).
208
209test(iso_8601, T =:= 1165591784) :-
210	parse_time('2006-12-08T17:29:44+02:00', iso_8601, T).
211test(iso_8601, T =:= 1165591784) :-
212	parse_time('20061208T172944+0200', iso_8601, T).
213test(iso_8601, T =:= 1165591740) :-
214	parse_time('2006-12-08T15:29Z', iso_8601, T).
215test(iso_8601, T =:= 1165536000) :-
216	parse_time('2006-12-08', iso_8601, T).
217test(iso_8601, T =:= 1165536000) :-
218	parse_time('20061208', iso_8601, T).
219test(iso_8601, T =:= 1164844800) :-
220	parse_time('2006-12', iso_8601, T).
221test(iso_8601, T =:= 1165536000) :-
222	parse_time('2006-W49-5', iso_8601, T).
223test(iso_8601, T =:= 1165536000) :-
224	parse_time('2006-342', iso_8601, T).
225
226:- end_tests(parse_time).
227
228:- begin_tests(format_time).
229
230test(fraction) :-
231	forall(member(T, [100000.0, 100000.9, 100000.99,
232			  100000.999, 100000.9999]),
233	       ( format_time(string(S), '%3f', T),
234	         assertion(fok(S)))).
235test(negfraction) :-
236	forall(member(T, [-100000.0, -100000.9, -100000.99,
237			  -100000.999, -100000.9999]),
238	       ( format_time(string(S), '%3f', T),
239	         assertion(fok(S)))).
240
241fok("000").
242fok("900").
243fok("990").
244fok("999").
245
246:- end_tests(format_time).
247
248:- begin_tests(timestamp_roundtrip).
249
250test(roundtrip_local, T =:= T2) :-
251	T = 1165591784,
252	stamp_date_time(T, D, local),
253	date_time_stamp(D, T2).
254test(roundtrip_utc, T =:= T2) :-
255	T = 1165591784,
256	stamp_date_time(T, D, 'UTC'),
257	date_time_stamp(D, T2).
258test(roundtrip_epoch, T =:= T2) :-
259	T = 0,
260	stamp_date_time(T, D, 0),
261	date_time_stamp(D, T2).
262
263:- end_tests(timestamp_roundtrip).
264