Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/a-calfor.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
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 -- -- | |
9 -- Copyright (C) 2006-2017, Free Software Foundation, Inc. -- | |
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; |