1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . C A L E N D A R . F O R M A T T I N G --
9 -- Copyright (C) 2006-2007, Free Software Foundation, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada
.Calendar
; use Ada
.Calendar
;
35 with Ada
.Calendar
.Time_Zones
; use Ada
.Calendar
.Time_Zones
;
37 package body Ada
.Calendar
.Formatting
is
39 --------------------------
40 -- Implementation Notes --
41 --------------------------
43 -- All operations in this package are target and time representation
44 -- independent, thus only one source file is needed for multiple targets.
46 procedure Check_Char
(S
: String; C
: Character; Index
: Integer);
47 -- Subsidiary to the two versions of Value. Determine whether the
48 -- input string S has character C at position Index. Raise
49 -- Constraint_Error if there is a mismatch.
51 procedure Check_Digit
(S
: String; Index
: Integer);
52 -- Subsidiary to the two versions of Value. Determine whether the
53 -- character of string S at position Index is a digit. This catches
54 -- invalid input such as 1983-*1-j3 u5:n7:k9 which should be
55 -- 1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
61 procedure Check_Char
(S
: String; C
: Character; Index
: Integer) is
63 if S
(Index
) /= C
then
64 raise Constraint_Error
;
72 procedure Check_Digit
(S
: String; Index
: Integer) is
74 if S
(Index
) not in '0' .. '9' then
75 raise Constraint_Error
;
85 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Day_Number
96 pragma Unreferenced
(Y
, Mo
, H
, Mi
);
99 Split
(Date
, Y
, Mo
, D
, H
, Mi
, Se
, Ss
, Le
, Time_Zone
);
107 function Day_Of_Week
(Date
: Time
) return Day_Name
is
109 return Day_Name
'Val (Formatting_Operations
.Day_Of_Week
(Date
));
118 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Hour_Number
126 Ss
: Second_Duration
;
129 pragma Unreferenced
(Y
, Mo
, D
, Mi
);
132 Split
(Date
, Y
, Mo
, D
, H
, Mi
, Se
, Ss
, Le
, Time_Zone
);
141 (Elapsed_Time
: Duration;
142 Include_Time_Fraction
: Boolean := False) return String
145 Minute
: Minute_Number
;
146 Second
: Second_Number
;
147 Sub_Second
: Duration;
153 Result
: String := "-00:00:00.00";
156 Split
(abs (Elapsed_Time
), Hour
, Minute
, Second
, Sub_Second
);
158 -- Determine the two slice bounds for the result string depending on
159 -- whether the input is negative and whether fractions are requested.
161 if Elapsed_Time
< 0.0 then
167 if Include_Time_Fraction
then
173 -- Prevent rounding when converting to natural
175 Sub_Second
:= Sub_Second
* 100.0 - 0.5;
176 SS_Nat
:= Natural (Sub_Second
);
179 Hour_Str
: constant String := Hour_Number
'Image (Hour
);
180 Minute_Str
: constant String := Minute_Number
'Image (Minute
);
181 Second_Str
: constant String := Second_Number
'Image (Second
);
182 SS_Str
: constant String := Natural'Image (SS_Nat
);
185 -- Hour processing, positions 2 and 3
188 Result
(3) := Hour_Str
(2);
190 Result
(2) := Hour_Str
(2);
191 Result
(3) := Hour_Str
(3);
194 -- Minute processing, positions 5 and 6
197 Result
(6) := Minute_Str
(2);
199 Result
(5) := Minute_Str
(2);
200 Result
(6) := Minute_Str
(3);
203 -- Second processing, positions 8 and 9
206 Result
(9) := Second_Str
(2);
208 Result
(8) := Second_Str
(2);
209 Result
(9) := Second_Str
(3);
212 -- Optional sub second processing, positions 11 and 12
214 if Include_Time_Fraction
then
216 Result
(12) := SS_Str
(2);
218 Result
(11) := SS_Str
(2);
219 Result
(12) := SS_Str
(3);
223 return Result
(Low
.. High
);
233 Include_Time_Fraction
: Boolean := False;
234 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return String
237 Month
: Month_Number
;
240 Minute
: Minute_Number
;
241 Second
: Second_Number
;
242 Sub_Second
: Duration;
244 Leap_Second
: Boolean;
246 Result
: String := "0000-00-00 00:00:00.00";
249 Split
(Date
, Year
, Month
, Day
,
250 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
252 -- Prevent rounding when converting to natural
254 Sub_Second
:= Sub_Second
* 100.0 - 0.5;
255 SS_Nat
:= Natural (Sub_Second
);
258 Year_Str
: constant String := Year_Number
'Image (Year
);
259 Month_Str
: constant String := Month_Number
'Image (Month
);
260 Day_Str
: constant String := Day_Number
'Image (Day
);
261 Hour_Str
: constant String := Hour_Number
'Image (Hour
);
262 Minute_Str
: constant String := Minute_Number
'Image (Minute
);
263 Second_Str
: constant String := Second_Number
'Image (Second
);
264 SS_Str
: constant String := Natural'Image (SS_Nat
);
267 -- Year processing, positions 1, 2, 3 and 4
269 Result
(1) := Year_Str
(2);
270 Result
(2) := Year_Str
(3);
271 Result
(3) := Year_Str
(4);
272 Result
(4) := Year_Str
(5);
274 -- Month processing, positions 6 and 7
277 Result
(7) := Month_Str
(2);
279 Result
(6) := Month_Str
(2);
280 Result
(7) := Month_Str
(3);
283 -- Day processing, positions 9 and 10
286 Result
(10) := Day_Str
(2);
288 Result
(9) := Day_Str
(2);
289 Result
(10) := Day_Str
(3);
292 -- Hour processing, positions 12 and 13
295 Result
(13) := Hour_Str
(2);
297 Result
(12) := Hour_Str
(2);
298 Result
(13) := Hour_Str
(3);
301 -- Minute processing, positions 15 and 16
304 Result
(16) := Minute_Str
(2);
306 Result
(15) := Minute_Str
(2);
307 Result
(16) := Minute_Str
(3);
310 -- Second processing, positions 18 and 19
313 Result
(19) := Second_Str
(2);
315 Result
(18) := Second_Str
(2);
316 Result
(19) := Second_Str
(3);
319 -- Optional sub second processing, positions 21 and 22
321 if Include_Time_Fraction
then
323 Result
(22) := SS_Str
(2);
325 Result
(21) := SS_Str
(2);
326 Result
(22) := SS_Str
(3);
331 return Result
(1 .. 19);
342 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Minute_Number
350 Ss
: Second_Duration
;
353 pragma Unreferenced
(Y
, Mo
, D
, H
);
356 Split
(Date
, Y
, Mo
, D
, H
, Mi
, Se
, Ss
, Le
, Time_Zone
);
366 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Month_Number
374 Ss
: Second_Duration
;
377 pragma Unreferenced
(Y
, D
, H
, Mi
);
380 Split
(Date
, Y
, Mo
, D
, H
, Mi
, Se
, Ss
, Le
, Time_Zone
);
388 function Second
(Date
: Time
) return Second_Number
is
395 Ss
: Second_Duration
;
398 pragma Unreferenced
(Y
, Mo
, D
, H
, Mi
);
401 Split
(Date
, Y
, Mo
, D
, H
, Mi
, Se
, Ss
, Le
);
411 Minute
: Minute_Number
;
412 Second
: Second_Number
:= 0;
413 Sub_Second
: Second_Duration
:= 0.0) return Day_Duration
is
419 or else not Minute
'Valid
420 or else not Second
'Valid
421 or else not Sub_Second
'Valid
423 raise Constraint_Error
;
426 return Day_Duration
(Hour
* 3_600
) +
427 Day_Duration
(Minute
* 60) +
428 Day_Duration
(Second
) +
437 (Seconds
: Day_Duration
;
438 Hour
: out Hour_Number
;
439 Minute
: out Minute_Number
;
440 Second
: out Second_Number
;
441 Sub_Second
: out Second_Duration
)
448 if not Seconds
'Valid then
449 raise Constraint_Error
;
452 if Seconds
= 0.0 then
455 Secs
:= Natural (Seconds
- 0.5);
458 Sub_Second
:= Second_Duration
(Seconds
- Day_Duration
(Secs
));
459 Hour
:= Hour_Number
(Secs
/ 3_600
);
460 Secs
:= Secs
mod 3_600
;
461 Minute
:= Minute_Number
(Secs
/ 60);
462 Second
:= Second_Number
(Secs
mod 60);
467 or else not Minute
'Valid
468 or else not Second
'Valid
469 or else not Sub_Second
'Valid
481 Year
: out Year_Number
;
482 Month
: out Month_Number
;
483 Day
: out Day_Number
;
484 Seconds
: out Day_Duration
;
485 Leap_Second
: out Boolean;
486 Time_Zone
: Time_Zones
.Time_Offset
:= 0)
492 Tz
: constant Long_Integer := Long_Integer (Time_Zone
);
495 Formatting_Operations
.Split
505 Leap_Sec
=> Leap_Second
,
512 or else not Month
'Valid
513 or else not Day
'Valid
514 or else not Seconds
'Valid
526 Year
: out Year_Number
;
527 Month
: out Month_Number
;
528 Day
: out Day_Number
;
529 Hour
: out Hour_Number
;
530 Minute
: out Minute_Number
;
531 Second
: out Second_Number
;
532 Sub_Second
: out Second_Duration
;
533 Time_Zone
: Time_Zones
.Time_Offset
:= 0)
537 Tz
: constant Long_Integer := Long_Integer (Time_Zone
);
540 Formatting_Operations
.Split
549 Sub_Sec
=> Sub_Second
,
557 or else not Month
'Valid
558 or else not Day
'Valid
559 or else not Hour
'Valid
560 or else not Minute
'Valid
561 or else not Second
'Valid
562 or else not Sub_Second
'Valid
574 Year
: out Year_Number
;
575 Month
: out Month_Number
;
576 Day
: out Day_Number
;
577 Hour
: out Hour_Number
;
578 Minute
: out Minute_Number
;
579 Second
: out Second_Number
;
580 Sub_Second
: out Second_Duration
;
581 Leap_Second
: out Boolean;
582 Time_Zone
: Time_Zones
.Time_Offset
:= 0)
585 Tz
: constant Long_Integer := Long_Integer (Time_Zone
);
588 Formatting_Operations
.Split
597 Sub_Sec
=> Sub_Second
,
598 Leap_Sec
=> Leap_Second
,
605 or else not Month
'Valid
606 or else not Day
'Valid
607 or else not Hour
'Valid
608 or else not Minute
'Valid
609 or else not Second
'Valid
610 or else not Sub_Second
'Valid
620 function Sub_Second
(Date
: Time
) return Second_Duration
is
627 Ss
: Second_Duration
;
630 pragma Unreferenced
(Y
, Mo
, D
, H
, Mi
);
633 Split
(Date
, Y
, Mo
, D
, H
, Mi
, Se
, Ss
, Le
);
643 Month
: Month_Number
;
645 Seconds
: Day_Duration
:= 0.0;
646 Leap_Second
: Boolean := False;
647 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Time
649 Adj_Year
: Year_Number
:= Year
;
650 Adj_Month
: Month_Number
:= Month
;
651 Adj_Day
: Day_Number
:= Day
;
653 H
: constant Integer := 1;
654 M
: constant Integer := 1;
655 Se
: constant Integer := 1;
656 Ss
: constant Duration := 0.1;
657 Tz
: constant Long_Integer := Long_Integer (Time_Zone
);
663 or else not Month
'Valid
664 or else not Day
'Valid
665 or else not Seconds
'Valid
666 or else not Time_Zone
'Valid
668 raise Constraint_Error
;
671 -- A Seconds value of 86_400 denotes a new day. This case requires an
672 -- adjustment to the input values.
674 if Seconds
= 86_400
.0
then
675 if Day
< Days_In_Month
(Month
)
676 or else (Is_Leap
(Year
)
684 Adj_Month
:= Month
+ 1;
687 Adj_Year
:= Year
+ 1;
693 Formatting_Operations
.Time_Of
702 Leap_Sec
=> Leap_Second
,
703 Use_Day_Secs
=> True,
714 Month
: Month_Number
;
717 Minute
: Minute_Number
;
718 Second
: Second_Number
;
719 Sub_Second
: Second_Duration
:= 0.0;
720 Leap_Second
: Boolean := False;
721 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Time
723 Dd
: constant Day_Duration
:= Day_Duration
'First;
724 Tz
: constant Long_Integer := Long_Integer (Time_Zone
);
730 or else not Month
'Valid
731 or else not Day
'Valid
732 or else not Hour
'Valid
733 or else not Minute
'Valid
734 or else not Second
'Valid
735 or else not Sub_Second
'Valid
736 or else not Time_Zone
'Valid
738 raise Constraint_Error
;
742 Formatting_Operations
.Time_Of
750 Sub_Sec
=> Sub_Second
,
751 Leap_Sec
=> Leap_Second
,
752 Use_Day_Secs
=> False,
763 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Time
765 D
: String (1 .. 22);
767 Month
: Month_Number
;
770 Minute
: Minute_Number
;
771 Second
: Second_Number
;
772 Sub_Second
: Second_Duration
:= 0.0;
777 if not Time_Zone
'Valid then
778 raise Constraint_Error
;
784 and then Date
'Length /= 22
786 raise Constraint_Error
;
789 -- After the correct length has been determined, it is safe to
790 -- copy the Date in order to avoid Date'First + N indexing.
792 D
(1 .. Date
'Length) := Date
;
796 Check_Char
(D
, '-', 5);
797 Check_Char
(D
, '-', 8);
798 Check_Char
(D
, ' ', 11);
799 Check_Char
(D
, ':', 14);
800 Check_Char
(D
, ':', 17);
802 if Date
'Length = 22 then
803 Check_Char
(D
, '.', 20);
806 -- Leading zero checks
814 if Date
'Length = 22 then
820 Year
:= Year_Number
(Year_Number
'Value (D
(1 .. 4)));
821 Month
:= Month_Number
(Month_Number
'Value (D
(6 .. 7)));
822 Day
:= Day_Number
(Day_Number
'Value (D
(9 .. 10)));
823 Hour
:= Hour_Number
(Hour_Number
'Value (D
(12 .. 13)));
824 Minute
:= Minute_Number
(Minute_Number
'Value (D
(15 .. 16)));
825 Second
:= Second_Number
(Second_Number
'Value (D
(18 .. 19)));
829 if Date
'Length = 22 then
830 Sub_Second
:= Second_Duration
(Second_Duration
'Value (D
(20 .. 22)));
836 or else not Month
'Valid
837 or else not Day
'Valid
838 or else not Hour
'Valid
839 or else not Minute
'Valid
840 or else not Second
'Valid
841 or else not Sub_Second
'Valid
843 raise Constraint_Error
;
846 return Time_Of
(Year
, Month
, Day
,
847 Hour
, Minute
, Second
, Sub_Second
, False, Time_Zone
);
850 when others => raise Constraint_Error
;
857 function Value
(Elapsed_Time
: String) return Duration is
858 D
: String (1 .. 11);
860 Minute
: Minute_Number
;
861 Second
: Second_Number
;
862 Sub_Second
: Second_Duration
:= 0.0;
867 if Elapsed_Time
'Length /= 8
868 and then Elapsed_Time
'Length /= 11
870 raise Constraint_Error
;
873 -- After the correct length has been determined, it is safe to
874 -- copy the Elapsed_Time in order to avoid Date'First + N indexing.
876 D
(1 .. Elapsed_Time
'Length) := Elapsed_Time
;
880 Check_Char
(D
, ':', 3);
881 Check_Char
(D
, ':', 6);
883 if Elapsed_Time
'Length = 11 then
884 Check_Char
(D
, '.', 9);
887 -- Leading zero checks
893 if Elapsed_Time
'Length = 11 then
899 Hour
:= Hour_Number
(Hour_Number
'Value (D
(1 .. 2)));
900 Minute
:= Minute_Number
(Minute_Number
'Value (D
(4 .. 5)));
901 Second
:= Second_Number
(Second_Number
'Value (D
(7 .. 8)));
905 if Elapsed_Time
'Length = 11 then
906 Sub_Second
:= Second_Duration
(Second_Duration
'Value (D
(9 .. 11)));
912 or else not Minute
'Valid
913 or else not Second
'Valid
914 or else not Sub_Second
'Valid
916 raise Constraint_Error
;
919 return Seconds_Of
(Hour
, Minute
, Second
, Sub_Second
);
922 when others => raise Constraint_Error
;
931 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Year_Number
939 Ss
: Second_Duration
;
942 pragma Unreferenced
(Mo
, D
, H
, Mi
);
945 Split
(Date
, Y
, Mo
, D
, H
, Mi
, Se
, Ss
, Le
, Time_Zone
);
949 end Ada
.Calendar
.Formatting
;