|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- A D A . C A L E N D A R . F O R M A T T I N G --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 2006-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with Ada.Calendar; use Ada.Calendar;
|
|
|
33 with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
|
|
|
34
|
|
|
35 package body Ada.Calendar.Formatting is
|
|
|
36
|
|
|
37 --------------------------
|
|
|
38 -- Implementation Notes --
|
|
|
39 --------------------------
|
|
|
40
|
|
|
41 -- All operations in this package are target and time representation
|
|
|
42 -- independent, thus only one source file is needed for multiple targets.
|
|
|
43
|
|
|
44 procedure Check_Char (S : String; C : Character; Index : Integer);
|
|
|
45 -- Subsidiary to the two versions of Value. Determine whether the input
|
|
|
46 -- string S has character C at position Index. Raise Constraint_Error if
|
|
|
47 -- there is a mismatch.
|
|
|
48
|
|
|
49 procedure Check_Digit (S : String; Index : Integer);
|
|
|
50 -- Subsidiary to the two versions of Value. Determine whether the character
|
|
|
51 -- of string S at position Index is a digit. This catches invalid input
|
|
|
52 -- such as 1983-*1-j3 u5:n7:k9 which should be 1983-01-03 05:07:09. Raise
|
|
|
53 -- Constraint_Error if there is a mismatch.
|
|
|
54
|
|
145
|
55 procedure Split_Duration
|
|
|
56 (Seconds : Duration;
|
|
|
57 Hour : out Natural;
|
|
|
58 Minute : out Minute_Number;
|
|
|
59 Second : out Second_Number;
|
|
|
60 Sub_Second : out Second_Duration);
|
|
|
61 -- Version of Split that allows durations < 100 hours.
|
|
|
62 -- Will raise Time_Error if Seconds >= 100 hours.
|
|
|
63
|
|
111
|
64 ----------------
|
|
|
65 -- Check_Char --
|
|
|
66 ----------------
|
|
|
67
|
|
|
68 procedure Check_Char (S : String; C : Character; Index : Integer) is
|
|
|
69 begin
|
|
|
70 if S (Index) /= C then
|
|
|
71 raise Constraint_Error;
|
|
|
72 end if;
|
|
|
73 end Check_Char;
|
|
|
74
|
|
|
75 -----------------
|
|
|
76 -- Check_Digit --
|
|
|
77 -----------------
|
|
|
78
|
|
|
79 procedure Check_Digit (S : String; Index : Integer) is
|
|
|
80 begin
|
|
|
81 if S (Index) not in '0' .. '9' then
|
|
|
82 raise Constraint_Error;
|
|
|
83 end if;
|
|
|
84 end Check_Digit;
|
|
|
85
|
|
|
86 ---------
|
|
|
87 -- Day --
|
|
|
88 ---------
|
|
|
89
|
|
|
90 function Day
|
|
|
91 (Date : Time;
|
|
|
92 Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
|
|
|
93 is
|
|
|
94 Y : Year_Number;
|
|
|
95 Mo : Month_Number;
|
|
|
96 D : Day_Number;
|
|
|
97 H : Hour_Number;
|
|
|
98 Mi : Minute_Number;
|
|
|
99 Se : Second_Number;
|
|
|
100 Ss : Second_Duration;
|
|
|
101 Le : Boolean;
|
|
|
102
|
|
|
103 pragma Unreferenced (Y, Mo, H, Mi);
|
|
|
104
|
|
|
105 begin
|
|
|
106 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
|
|
|
107 return D;
|
|
|
108 end Day;
|
|
|
109
|
|
|
110 -----------------
|
|
|
111 -- Day_Of_Week --
|
|
|
112 -----------------
|
|
|
113
|
|
|
114 function Day_Of_Week (Date : Time) return Day_Name is
|
|
|
115 begin
|
|
|
116 return Day_Name'Val (Formatting_Operations.Day_Of_Week (Date));
|
|
|
117 end Day_Of_Week;
|
|
|
118
|
|
|
119 ----------
|
|
|
120 -- Hour --
|
|
|
121 ----------
|
|
|
122
|
|
|
123 function Hour
|
|
|
124 (Date : Time;
|
|
|
125 Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
|
|
|
126 is
|
|
|
127 Y : Year_Number;
|
|
|
128 Mo : Month_Number;
|
|
|
129 D : Day_Number;
|
|
|
130 H : Hour_Number;
|
|
|
131 Mi : Minute_Number;
|
|
|
132 Se : Second_Number;
|
|
|
133 Ss : Second_Duration;
|
|
|
134 Le : Boolean;
|
|
|
135
|
|
|
136 pragma Unreferenced (Y, Mo, D, Mi);
|
|
|
137
|
|
|
138 begin
|
|
|
139 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
|
|
|
140 return H;
|
|
|
141 end Hour;
|
|
|
142
|
|
|
143 -----------
|
|
|
144 -- Image --
|
|
|
145 -----------
|
|
|
146
|
|
|
147 function Image
|
|
|
148 (Elapsed_Time : Duration;
|
|
|
149 Include_Time_Fraction : Boolean := False) return String
|
|
|
150 is
|
|
|
151 To_Char : constant array (0 .. 9) of Character := "0123456789";
|
|
145
|
152 Hour : Natural;
|
|
111
|
153 Minute : Minute_Number;
|
|
|
154 Second : Second_Number;
|
|
|
155 Sub_Second : Duration;
|
|
|
156 SS_Nat : Natural;
|
|
|
157
|
|
|
158 -- Determine the two slice bounds for the result string depending on
|
|
|
159 -- whether the input is negative and whether fractions are requested.
|
|
|
160
|
|
|
161 First : constant Integer := (if Elapsed_Time < 0.0 then 1 else 2);
|
|
|
162 Last : constant Integer := (if Include_Time_Fraction then 12 else 9);
|
|
|
163
|
|
|
164 Result : String := "-00:00:00.00";
|
|
|
165
|
|
|
166 begin
|
|
145
|
167 Split_Duration (abs Elapsed_Time, Hour, Minute, Second, Sub_Second);
|
|
111
|
168
|
|
|
169 -- Hour processing, positions 2 and 3
|
|
|
170
|
|
|
171 Result (2) := To_Char (Hour / 10);
|
|
|
172 Result (3) := To_Char (Hour mod 10);
|
|
|
173
|
|
|
174 -- Minute processing, positions 5 and 6
|
|
|
175
|
|
|
176 Result (5) := To_Char (Minute / 10);
|
|
|
177 Result (6) := To_Char (Minute mod 10);
|
|
|
178
|
|
|
179 -- Second processing, positions 8 and 9
|
|
|
180
|
|
|
181 Result (8) := To_Char (Second / 10);
|
|
|
182 Result (9) := To_Char (Second mod 10);
|
|
|
183
|
|
|
184 -- Optional sub second processing, positions 11 and 12
|
|
|
185
|
|
|
186 if Include_Time_Fraction and then Sub_Second > 0.0 then
|
|
|
187
|
|
|
188 -- Prevent rounding up when converting to natural, avoiding the zero
|
|
|
189 -- case to prevent rounding down to a negative number.
|
|
|
190
|
|
|
191 SS_Nat := Natural (Duration'(Sub_Second * 100.0) - 0.5);
|
|
|
192
|
|
|
193 Result (11) := To_Char (SS_Nat / 10);
|
|
|
194 Result (12) := To_Char (SS_Nat mod 10);
|
|
|
195 end if;
|
|
|
196
|
|
|
197 return Result (First .. Last);
|
|
|
198 end Image;
|
|
|
199
|
|
|
200 -----------
|
|
|
201 -- Image --
|
|
|
202 -----------
|
|
|
203
|
|
|
204 function Image
|
|
|
205 (Date : Time;
|
|
|
206 Include_Time_Fraction : Boolean := False;
|
|
|
207 Time_Zone : Time_Zones.Time_Offset := 0) return String
|
|
|
208 is
|
|
|
209 To_Char : constant array (0 .. 9) of Character := "0123456789";
|
|
|
210
|
|
|
211 Year : Year_Number;
|
|
|
212 Month : Month_Number;
|
|
|
213 Day : Day_Number;
|
|
|
214 Hour : Hour_Number;
|
|
|
215 Minute : Minute_Number;
|
|
|
216 Second : Second_Number;
|
|
|
217 Sub_Second : Duration;
|
|
|
218 SS_Nat : Natural;
|
|
|
219 Leap_Second : Boolean;
|
|
|
220
|
|
|
221 -- The result length depends on whether fractions are requested.
|
|
|
222
|
|
|
223 Result : String := "0000-00-00 00:00:00.00";
|
|
|
224 Last : constant Positive :=
|
|
|
225 Result'Last - (if Include_Time_Fraction then 0 else 3);
|
|
|
226
|
|
|
227 begin
|
|
|
228 Split (Date, Year, Month, Day,
|
|
|
229 Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
|
|
|
230
|
|
|
231 -- Year processing, positions 1, 2, 3 and 4
|
|
|
232
|
|
|
233 Result (1) := To_Char (Year / 1000);
|
|
|
234 Result (2) := To_Char (Year / 100 mod 10);
|
|
|
235 Result (3) := To_Char (Year / 10 mod 10);
|
|
|
236 Result (4) := To_Char (Year mod 10);
|
|
|
237
|
|
|
238 -- Month processing, positions 6 and 7
|
|
|
239
|
|
|
240 Result (6) := To_Char (Month / 10);
|
|
|
241 Result (7) := To_Char (Month mod 10);
|
|
|
242
|
|
|
243 -- Day processing, positions 9 and 10
|
|
|
244
|
|
|
245 Result (9) := To_Char (Day / 10);
|
|
|
246 Result (10) := To_Char (Day mod 10);
|
|
|
247
|
|
|
248 Result (12) := To_Char (Hour / 10);
|
|
|
249 Result (13) := To_Char (Hour mod 10);
|
|
|
250
|
|
|
251 -- Minute processing, positions 15 and 16
|
|
|
252
|
|
|
253 Result (15) := To_Char (Minute / 10);
|
|
|
254 Result (16) := To_Char (Minute mod 10);
|
|
|
255
|
|
|
256 -- Second processing, positions 18 and 19
|
|
|
257
|
|
|
258 Result (18) := To_Char (Second / 10);
|
|
|
259 Result (19) := To_Char (Second mod 10);
|
|
|
260
|
|
|
261 -- Optional sub second processing, positions 21 and 22
|
|
|
262
|
|
|
263 if Include_Time_Fraction and then Sub_Second > 0.0 then
|
|
|
264
|
|
|
265 -- Prevent rounding up when converting to natural, avoiding the zero
|
|
|
266 -- case to prevent rounding down to a negative number.
|
|
|
267
|
|
|
268 SS_Nat := Natural (Duration'(Sub_Second * 100.0) - 0.5);
|
|
|
269
|
|
|
270 Result (21) := To_Char (SS_Nat / 10);
|
|
|
271 Result (22) := To_Char (SS_Nat mod 10);
|
|
|
272 end if;
|
|
|
273
|
|
|
274 return Result (Result'First .. Last);
|
|
|
275 end Image;
|
|
|
276
|
|
|
277 ------------
|
|
|
278 -- Minute --
|
|
|
279 ------------
|
|
|
280
|
|
|
281 function Minute
|
|
|
282 (Date : Time;
|
|
|
283 Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
|
|
|
284 is
|
|
|
285 Y : Year_Number;
|
|
|
286 Mo : Month_Number;
|
|
|
287 D : Day_Number;
|
|
|
288 H : Hour_Number;
|
|
|
289 Mi : Minute_Number;
|
|
|
290 Se : Second_Number;
|
|
|
291 Ss : Second_Duration;
|
|
|
292 Le : Boolean;
|
|
|
293
|
|
|
294 pragma Unreferenced (Y, Mo, D, H);
|
|
|
295
|
|
|
296 begin
|
|
|
297 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
|
|
|
298 return Mi;
|
|
|
299 end Minute;
|
|
|
300
|
|
|
301 -----------
|
|
|
302 -- Month --
|
|
|
303 -----------
|
|
|
304
|
|
|
305 function Month
|
|
|
306 (Date : Time;
|
|
|
307 Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
|
|
|
308 is
|
|
|
309 Y : Year_Number;
|
|
|
310 Mo : Month_Number;
|
|
|
311 D : Day_Number;
|
|
|
312 H : Hour_Number;
|
|
|
313 Mi : Minute_Number;
|
|
|
314 Se : Second_Number;
|
|
|
315 Ss : Second_Duration;
|
|
|
316 Le : Boolean;
|
|
|
317
|
|
|
318 pragma Unreferenced (Y, D, H, Mi);
|
|
|
319
|
|
|
320 begin
|
|
|
321 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
|
|
|
322 return Mo;
|
|
|
323 end Month;
|
|
|
324
|
|
|
325 ------------
|
|
|
326 -- Second --
|
|
|
327 ------------
|
|
|
328
|
|
|
329 function Second (Date : Time) return Second_Number is
|
|
|
330 Y : Year_Number;
|
|
|
331 Mo : Month_Number;
|
|
|
332 D : Day_Number;
|
|
|
333 H : Hour_Number;
|
|
|
334 Mi : Minute_Number;
|
|
|
335 Se : Second_Number;
|
|
|
336 Ss : Second_Duration;
|
|
|
337 Le : Boolean;
|
|
|
338
|
|
|
339 pragma Unreferenced (Y, Mo, D, H, Mi);
|
|
|
340
|
|
|
341 begin
|
|
|
342 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
|
|
|
343 return Se;
|
|
|
344 end Second;
|
|
|
345
|
|
|
346 ----------------
|
|
|
347 -- Seconds_Of --
|
|
|
348 ----------------
|
|
|
349
|
|
|
350 function Seconds_Of
|
|
|
351 (Hour : Hour_Number;
|
|
|
352 Minute : Minute_Number;
|
|
|
353 Second : Second_Number := 0;
|
|
|
354 Sub_Second : Second_Duration := 0.0) return Day_Duration is
|
|
|
355
|
|
|
356 begin
|
|
|
357 -- Validity checks
|
|
|
358
|
|
|
359 if not Hour'Valid
|
|
|
360 or else not Minute'Valid
|
|
|
361 or else not Second'Valid
|
|
|
362 or else not Sub_Second'Valid
|
|
|
363 then
|
|
|
364 raise Constraint_Error;
|
|
|
365 end if;
|
|
|
366
|
|
|
367 return Day_Duration (Hour * 3_600) +
|
|
|
368 Day_Duration (Minute * 60) +
|
|
|
369 Day_Duration (Second) +
|
|
|
370 Sub_Second;
|
|
|
371 end Seconds_Of;
|
|
|
372
|
|
145
|
373 --------------------
|
|
|
374 -- Split_Duration --
|
|
|
375 --------------------
|
|
|
376
|
|
|
377 procedure Split_Duration
|
|
|
378 (Seconds : Duration;
|
|
|
379 Hour : out Natural;
|
|
|
380 Minute : out Minute_Number;
|
|
|
381 Second : out Second_Number;
|
|
|
382 Sub_Second : out Second_Duration)
|
|
|
383 is
|
|
|
384 Secs : Natural;
|
|
|
385 begin
|
|
|
386 -- Check that Seconds is below 100 hours
|
|
|
387
|
|
|
388 if Seconds >= 3600.0 * 100.0 then
|
|
|
389 raise Time_Error;
|
|
|
390 end if;
|
|
|
391
|
|
|
392 Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5));
|
|
|
393
|
|
|
394 Sub_Second := Second_Duration (Seconds - Duration (Secs));
|
|
|
395 Hour := Natural (Secs / 3_600);
|
|
|
396 Secs := Secs mod 3_600;
|
|
|
397 Minute := Minute_Number (Secs / 60);
|
|
|
398 Second := Second_Number (Secs mod 60);
|
|
|
399 end Split_Duration;
|
|
|
400
|
|
111
|
401 -----------
|
|
|
402 -- Split --
|
|
|
403 -----------
|
|
|
404
|
|
|
405 procedure Split
|
|
|
406 (Seconds : Day_Duration;
|
|
|
407 Hour : out Hour_Number;
|
|
|
408 Minute : out Minute_Number;
|
|
|
409 Second : out Second_Number;
|
|
|
410 Sub_Second : out Second_Duration)
|
|
|
411 is
|
|
145
|
412 Unchecked_Hour : Natural;
|
|
111
|
413 begin
|
|
|
414 -- Validity checks
|
|
|
415
|
|
|
416 if not Seconds'Valid then
|
|
|
417 raise Constraint_Error;
|
|
|
418 end if;
|
|
|
419
|
|
145
|
420 Split_Duration (Seconds, Unchecked_Hour, Minute, Second, Sub_Second);
|
|
111
|
421
|
|
145
|
422 if Unchecked_Hour > Hour_Number'Last then
|
|
111
|
423 raise Time_Error;
|
|
|
424 end if;
|
|
145
|
425
|
|
|
426 Hour := Unchecked_Hour;
|
|
111
|
427 end Split;
|
|
|
428
|
|
|
429 -----------
|
|
|
430 -- Split --
|
|
|
431 -----------
|
|
|
432
|
|
|
433 procedure Split
|
|
|
434 (Date : Time;
|
|
|
435 Year : out Year_Number;
|
|
|
436 Month : out Month_Number;
|
|
|
437 Day : out Day_Number;
|
|
|
438 Seconds : out Day_Duration;
|
|
|
439 Leap_Second : out Boolean;
|
|
|
440 Time_Zone : Time_Zones.Time_Offset := 0)
|
|
|
441 is
|
|
|
442 H : Integer;
|
|
|
443 M : Integer;
|
|
|
444 Se : Integer;
|
|
|
445 Su : Duration;
|
|
|
446 Tz : constant Long_Integer := Long_Integer (Time_Zone);
|
|
|
447
|
|
|
448 begin
|
|
|
449 Formatting_Operations.Split
|
|
|
450 (Date => Date,
|
|
|
451 Year => Year,
|
|
|
452 Month => Month,
|
|
|
453 Day => Day,
|
|
|
454 Day_Secs => Seconds,
|
|
|
455 Hour => H,
|
|
|
456 Minute => M,
|
|
|
457 Second => Se,
|
|
|
458 Sub_Sec => Su,
|
|
|
459 Leap_Sec => Leap_Second,
|
|
|
460 Use_TZ => True,
|
|
|
461 Is_Historic => True,
|
|
|
462 Time_Zone => Tz);
|
|
|
463
|
|
|
464 -- Validity checks
|
|
|
465
|
|
|
466 if not Year'Valid
|
|
|
467 or else not Month'Valid
|
|
|
468 or else not Day'Valid
|
|
|
469 or else not Seconds'Valid
|
|
|
470 then
|
|
|
471 raise Time_Error;
|
|
|
472 end if;
|
|
|
473 end Split;
|
|
|
474
|
|
|
475 -----------
|
|
|
476 -- Split --
|
|
|
477 -----------
|
|
|
478
|
|
|
479 procedure Split
|
|
|
480 (Date : Time;
|
|
|
481 Year : out Year_Number;
|
|
|
482 Month : out Month_Number;
|
|
|
483 Day : out Day_Number;
|
|
|
484 Hour : out Hour_Number;
|
|
|
485 Minute : out Minute_Number;
|
|
|
486 Second : out Second_Number;
|
|
|
487 Sub_Second : out Second_Duration;
|
|
|
488 Time_Zone : Time_Zones.Time_Offset := 0)
|
|
|
489 is
|
|
|
490 Dd : Day_Duration;
|
|
|
491 Le : Boolean;
|
|
|
492 Tz : constant Long_Integer := Long_Integer (Time_Zone);
|
|
|
493
|
|
|
494 begin
|
|
|
495 Formatting_Operations.Split
|
|
|
496 (Date => Date,
|
|
|
497 Year => Year,
|
|
|
498 Month => Month,
|
|
|
499 Day => Day,
|
|
|
500 Day_Secs => Dd,
|
|
|
501 Hour => Hour,
|
|
|
502 Minute => Minute,
|
|
|
503 Second => Second,
|
|
|
504 Sub_Sec => Sub_Second,
|
|
|
505 Leap_Sec => Le,
|
|
|
506 Use_TZ => True,
|
|
|
507 Is_Historic => True,
|
|
|
508 Time_Zone => Tz);
|
|
|
509
|
|
|
510 -- Validity checks
|
|
|
511
|
|
|
512 if not Year'Valid
|
|
|
513 or else not Month'Valid
|
|
|
514 or else not Day'Valid
|
|
|
515 or else not Hour'Valid
|
|
|
516 or else not Minute'Valid
|
|
|
517 or else not Second'Valid
|
|
|
518 or else not Sub_Second'Valid
|
|
|
519 then
|
|
|
520 raise Time_Error;
|
|
|
521 end if;
|
|
|
522 end Split;
|
|
|
523
|
|
|
524 -----------
|
|
|
525 -- Split --
|
|
|
526 -----------
|
|
|
527
|
|
|
528 procedure Split
|
|
|
529 (Date : Time;
|
|
|
530 Year : out Year_Number;
|
|
|
531 Month : out Month_Number;
|
|
|
532 Day : out Day_Number;
|
|
|
533 Hour : out Hour_Number;
|
|
|
534 Minute : out Minute_Number;
|
|
|
535 Second : out Second_Number;
|
|
|
536 Sub_Second : out Second_Duration;
|
|
|
537 Leap_Second : out Boolean;
|
|
|
538 Time_Zone : Time_Zones.Time_Offset := 0)
|
|
|
539 is
|
|
|
540 Dd : Day_Duration;
|
|
|
541 Tz : constant Long_Integer := Long_Integer (Time_Zone);
|
|
|
542
|
|
|
543 begin
|
|
|
544 Formatting_Operations.Split
|
|
|
545 (Date => Date,
|
|
|
546 Year => Year,
|
|
|
547 Month => Month,
|
|
|
548 Day => Day,
|
|
|
549 Day_Secs => Dd,
|
|
|
550 Hour => Hour,
|
|
|
551 Minute => Minute,
|
|
|
552 Second => Second,
|
|
|
553 Sub_Sec => Sub_Second,
|
|
|
554 Leap_Sec => Leap_Second,
|
|
|
555 Use_TZ => True,
|
|
|
556 Is_Historic => True,
|
|
|
557 Time_Zone => Tz);
|
|
|
558
|
|
|
559 -- Validity checks
|
|
|
560
|
|
|
561 if not Year'Valid
|
|
|
562 or else not Month'Valid
|
|
|
563 or else not Day'Valid
|
|
|
564 or else not Hour'Valid
|
|
|
565 or else not Minute'Valid
|
|
|
566 or else not Second'Valid
|
|
|
567 or else not Sub_Second'Valid
|
|
|
568 then
|
|
|
569 raise Time_Error;
|
|
|
570 end if;
|
|
|
571 end Split;
|
|
|
572
|
|
|
573 ----------------
|
|
|
574 -- Sub_Second --
|
|
|
575 ----------------
|
|
|
576
|
|
|
577 function Sub_Second (Date : Time) return Second_Duration is
|
|
|
578 Y : Year_Number;
|
|
|
579 Mo : Month_Number;
|
|
|
580 D : Day_Number;
|
|
|
581 H : Hour_Number;
|
|
|
582 Mi : Minute_Number;
|
|
|
583 Se : Second_Number;
|
|
|
584 Ss : Second_Duration;
|
|
|
585 Le : Boolean;
|
|
|
586
|
|
|
587 pragma Unreferenced (Y, Mo, D, H, Mi);
|
|
|
588
|
|
|
589 begin
|
|
|
590 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
|
|
|
591 return Ss;
|
|
|
592 end Sub_Second;
|
|
|
593
|
|
|
594 -------------
|
|
|
595 -- Time_Of --
|
|
|
596 -------------
|
|
|
597
|
|
|
598 function Time_Of
|
|
|
599 (Year : Year_Number;
|
|
|
600 Month : Month_Number;
|
|
|
601 Day : Day_Number;
|
|
|
602 Seconds : Day_Duration := 0.0;
|
|
|
603 Leap_Second : Boolean := False;
|
|
|
604 Time_Zone : Time_Zones.Time_Offset := 0) return Time
|
|
|
605 is
|
|
|
606 Adj_Year : Year_Number := Year;
|
|
|
607 Adj_Month : Month_Number := Month;
|
|
|
608 Adj_Day : Day_Number := Day;
|
|
|
609
|
|
|
610 H : constant Integer := 1;
|
|
|
611 M : constant Integer := 1;
|
|
|
612 Se : constant Integer := 1;
|
|
|
613 Ss : constant Duration := 0.1;
|
|
|
614 Tz : constant Long_Integer := Long_Integer (Time_Zone);
|
|
|
615
|
|
|
616 begin
|
|
|
617 -- Validity checks
|
|
|
618
|
|
|
619 if not Year'Valid
|
|
|
620 or else not Month'Valid
|
|
|
621 or else not Day'Valid
|
|
|
622 or else not Seconds'Valid
|
|
|
623 or else not Time_Zone'Valid
|
|
|
624 then
|
|
|
625 raise Constraint_Error;
|
|
|
626 end if;
|
|
|
627
|
|
|
628 -- A Seconds value of 86_400 denotes a new day. This case requires an
|
|
|
629 -- adjustment to the input values.
|
|
|
630
|
|
|
631 if Seconds = 86_400.0 then
|
|
|
632 if Day < Days_In_Month (Month)
|
|
|
633 or else (Is_Leap (Year)
|
|
|
634 and then Month = 2)
|
|
|
635 then
|
|
|
636 Adj_Day := Day + 1;
|
|
|
637 else
|
|
|
638 Adj_Day := 1;
|
|
|
639
|
|
|
640 if Month < 12 then
|
|
|
641 Adj_Month := Month + 1;
|
|
|
642 else
|
|
|
643 Adj_Month := 1;
|
|
|
644 Adj_Year := Year + 1;
|
|
|
645 end if;
|
|
|
646 end if;
|
|
|
647 end if;
|
|
|
648
|
|
|
649 return
|
|
|
650 Formatting_Operations.Time_Of
|
|
|
651 (Year => Adj_Year,
|
|
|
652 Month => Adj_Month,
|
|
|
653 Day => Adj_Day,
|
|
|
654 Day_Secs => Seconds,
|
|
|
655 Hour => H,
|
|
|
656 Minute => M,
|
|
|
657 Second => Se,
|
|
|
658 Sub_Sec => Ss,
|
|
|
659 Leap_Sec => Leap_Second,
|
|
|
660 Use_Day_Secs => True,
|
|
|
661 Use_TZ => True,
|
|
|
662 Is_Historic => True,
|
|
|
663 Time_Zone => Tz);
|
|
|
664 end Time_Of;
|
|
|
665
|
|
|
666 -------------
|
|
|
667 -- Time_Of --
|
|
|
668 -------------
|
|
|
669
|
|
|
670 function Time_Of
|
|
|
671 (Year : Year_Number;
|
|
|
672 Month : Month_Number;
|
|
|
673 Day : Day_Number;
|
|
|
674 Hour : Hour_Number;
|
|
|
675 Minute : Minute_Number;
|
|
|
676 Second : Second_Number;
|
|
|
677 Sub_Second : Second_Duration := 0.0;
|
|
|
678 Leap_Second : Boolean := False;
|
|
|
679 Time_Zone : Time_Zones.Time_Offset := 0) return Time
|
|
|
680 is
|
|
|
681 Dd : constant Day_Duration := Day_Duration'First;
|
|
|
682 Tz : constant Long_Integer := Long_Integer (Time_Zone);
|
|
|
683
|
|
|
684 begin
|
|
|
685 -- Validity checks
|
|
|
686
|
|
|
687 if not Year'Valid
|
|
|
688 or else not Month'Valid
|
|
|
689 or else not Day'Valid
|
|
|
690 or else not Hour'Valid
|
|
|
691 or else not Minute'Valid
|
|
|
692 or else not Second'Valid
|
|
|
693 or else not Sub_Second'Valid
|
|
|
694 or else not Time_Zone'Valid
|
|
|
695 then
|
|
|
696 raise Constraint_Error;
|
|
|
697 end if;
|
|
|
698
|
|
|
699 return
|
|
|
700 Formatting_Operations.Time_Of
|
|
|
701 (Year => Year,
|
|
|
702 Month => Month,
|
|
|
703 Day => Day,
|
|
|
704 Day_Secs => Dd,
|
|
|
705 Hour => Hour,
|
|
|
706 Minute => Minute,
|
|
|
707 Second => Second,
|
|
|
708 Sub_Sec => Sub_Second,
|
|
|
709 Leap_Sec => Leap_Second,
|
|
|
710 Use_Day_Secs => False,
|
|
|
711 Use_TZ => True,
|
|
|
712 Is_Historic => True,
|
|
|
713 Time_Zone => Tz);
|
|
|
714 end Time_Of;
|
|
|
715
|
|
|
716 -----------
|
|
|
717 -- Value --
|
|
|
718 -----------
|
|
|
719
|
|
|
720 function Value
|
|
|
721 (Date : String;
|
|
|
722 Time_Zone : Time_Zones.Time_Offset := 0) return Time
|
|
|
723 is
|
|
|
724 D : String (1 .. 22);
|
|
|
725 Year : Year_Number;
|
|
|
726 Month : Month_Number;
|
|
|
727 Day : Day_Number;
|
|
|
728 Hour : Hour_Number;
|
|
|
729 Minute : Minute_Number;
|
|
|
730 Second : Second_Number;
|
|
|
731 Sub_Second : Second_Duration := 0.0;
|
|
|
732
|
|
|
733 begin
|
|
|
734 -- Validity checks
|
|
|
735
|
|
|
736 if not Time_Zone'Valid then
|
|
|
737 raise Constraint_Error;
|
|
|
738 end if;
|
|
|
739
|
|
|
740 -- Length checks
|
|
|
741
|
|
|
742 if Date'Length /= 19
|
|
|
743 and then Date'Length /= 22
|
|
|
744 then
|
|
|
745 raise Constraint_Error;
|
|
|
746 end if;
|
|
|
747
|
|
|
748 -- After the correct length has been determined, it is safe to copy the
|
|
|
749 -- Date in order to avoid Date'First + N indexing.
|
|
|
750
|
|
|
751 D (1 .. Date'Length) := Date;
|
|
|
752
|
|
|
753 -- Format checks
|
|
|
754
|
|
|
755 Check_Char (D, '-', 5);
|
|
|
756 Check_Char (D, '-', 8);
|
|
|
757 Check_Char (D, ' ', 11);
|
|
|
758 Check_Char (D, ':', 14);
|
|
|
759 Check_Char (D, ':', 17);
|
|
|
760
|
|
|
761 if Date'Length = 22 then
|
|
|
762 Check_Char (D, '.', 20);
|
|
|
763 end if;
|
|
|
764
|
|
|
765 -- Leading zero checks
|
|
|
766
|
|
|
767 Check_Digit (D, 6);
|
|
|
768 Check_Digit (D, 9);
|
|
|
769 Check_Digit (D, 12);
|
|
|
770 Check_Digit (D, 15);
|
|
|
771 Check_Digit (D, 18);
|
|
|
772
|
|
|
773 if Date'Length = 22 then
|
|
|
774 Check_Digit (D, 21);
|
|
|
775 end if;
|
|
|
776
|
|
|
777 -- Value extraction
|
|
|
778
|
|
|
779 Year := Year_Number (Year_Number'Value (D (1 .. 4)));
|
|
|
780 Month := Month_Number (Month_Number'Value (D (6 .. 7)));
|
|
|
781 Day := Day_Number (Day_Number'Value (D (9 .. 10)));
|
|
|
782 Hour := Hour_Number (Hour_Number'Value (D (12 .. 13)));
|
|
|
783 Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
|
|
|
784 Second := Second_Number (Second_Number'Value (D (18 .. 19)));
|
|
|
785
|
|
|
786 -- Optional part
|
|
|
787
|
|
|
788 if Date'Length = 22 then
|
|
|
789 Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
|
|
|
790 end if;
|
|
|
791
|
|
|
792 -- Sanity checks
|
|
|
793
|
|
|
794 if not Year'Valid
|
|
|
795 or else not Month'Valid
|
|
|
796 or else not Day'Valid
|
|
|
797 or else not Hour'Valid
|
|
|
798 or else not Minute'Valid
|
|
|
799 or else not Second'Valid
|
|
|
800 or else not Sub_Second'Valid
|
|
|
801 then
|
|
|
802 raise Constraint_Error;
|
|
|
803 end if;
|
|
|
804
|
|
|
805 return Time_Of (Year, Month, Day,
|
|
|
806 Hour, Minute, Second, Sub_Second, False, Time_Zone);
|
|
|
807
|
|
|
808 exception
|
|
|
809 when others => raise Constraint_Error;
|
|
|
810 end Value;
|
|
|
811
|
|
|
812 -----------
|
|
|
813 -- Value --
|
|
|
814 -----------
|
|
|
815
|
|
|
816 function Value (Elapsed_Time : String) return Duration is
|
|
|
817 D : String (1 .. 11);
|
|
|
818 Hour : Hour_Number;
|
|
|
819 Minute : Minute_Number;
|
|
|
820 Second : Second_Number;
|
|
|
821 Sub_Second : Second_Duration := 0.0;
|
|
|
822
|
|
|
823 begin
|
|
|
824 -- Length checks
|
|
|
825
|
|
|
826 if Elapsed_Time'Length /= 8
|
|
|
827 and then Elapsed_Time'Length /= 11
|
|
|
828 then
|
|
|
829 raise Constraint_Error;
|
|
|
830 end if;
|
|
|
831
|
|
|
832 -- After the correct length has been determined, it is safe to copy the
|
|
|
833 -- Elapsed_Time in order to avoid Date'First + N indexing.
|
|
|
834
|
|
|
835 D (1 .. Elapsed_Time'Length) := Elapsed_Time;
|
|
|
836
|
|
|
837 -- Format checks
|
|
|
838
|
|
|
839 Check_Char (D, ':', 3);
|
|
|
840 Check_Char (D, ':', 6);
|
|
|
841
|
|
|
842 if Elapsed_Time'Length = 11 then
|
|
|
843 Check_Char (D, '.', 9);
|
|
|
844 end if;
|
|
|
845
|
|
|
846 -- Leading zero checks
|
|
|
847
|
|
|
848 Check_Digit (D, 1);
|
|
|
849 Check_Digit (D, 4);
|
|
|
850 Check_Digit (D, 7);
|
|
|
851
|
|
|
852 if Elapsed_Time'Length = 11 then
|
|
|
853 Check_Digit (D, 10);
|
|
|
854 end if;
|
|
|
855
|
|
|
856 -- Value extraction
|
|
|
857
|
|
|
858 Hour := Hour_Number (Hour_Number'Value (D (1 .. 2)));
|
|
|
859 Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
|
|
|
860 Second := Second_Number (Second_Number'Value (D (7 .. 8)));
|
|
|
861
|
|
|
862 -- Optional part
|
|
|
863
|
|
|
864 if Elapsed_Time'Length = 11 then
|
|
|
865 Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
|
|
|
866 end if;
|
|
|
867
|
|
|
868 -- Sanity checks
|
|
|
869
|
|
|
870 if not Hour'Valid
|
|
|
871 or else not Minute'Valid
|
|
|
872 or else not Second'Valid
|
|
|
873 or else not Sub_Second'Valid
|
|
|
874 then
|
|
|
875 raise Constraint_Error;
|
|
|
876 end if;
|
|
|
877
|
|
|
878 return Seconds_Of (Hour, Minute, Second, Sub_Second);
|
|
|
879
|
|
|
880 exception
|
|
|
881 when others => raise Constraint_Error;
|
|
|
882 end Value;
|
|
|
883
|
|
|
884 ----------
|
|
|
885 -- Year --
|
|
|
886 ----------
|
|
|
887
|
|
|
888 function Year
|
|
|
889 (Date : Time;
|
|
|
890 Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
|
|
|
891 is
|
|
|
892 Y : Year_Number;
|
|
|
893 Mo : Month_Number;
|
|
|
894 D : Day_Number;
|
|
|
895 H : Hour_Number;
|
|
|
896 Mi : Minute_Number;
|
|
|
897 Se : Second_Number;
|
|
|
898 Ss : Second_Duration;
|
|
|
899 Le : Boolean;
|
|
|
900
|
|
|
901 pragma Unreferenced (Mo, D, H, Mi);
|
|
|
902
|
|
|
903 begin
|
|
|
904 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
|
|
|
905 return Y;
|
|
|
906 end Year;
|
|
|
907
|
|
|
908 end Ada.Calendar.Formatting;
|
