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