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;