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-2009, 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 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Calendar; use Ada.Calendar;
33 with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
35 package body Ada.Calendar.Formatting is
37 --------------------------
38 -- Implementation Notes --
39 --------------------------
41 -- All operations in this package are target and time representation
42 -- independent, thus only one source file is needed for multiple targets.
44 procedure Check_Char (S : String; C : Character; Index : Integer);
45 -- Subsidiary to the two versions of Value. Determine whether the
46 -- input string S has character C at position Index. Raise
47 -- Constraint_Error if there is a mismatch.
49 procedure Check_Digit (S : String; Index : Integer);
50 -- Subsidiary to the two versions of Value. Determine whether the
51 -- character of string S at position Index is a digit. This catches
52 -- invalid input such as 1983-*1-j3 u5:n7:k9 which should be
53 -- 1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
59 procedure Check_Char (S : String; C : Character; Index : Integer) is
61 if S (Index) /= C then
62 raise Constraint_Error;
70 procedure Check_Digit (S : String; Index : Integer) is
72 if S (Index) not in '0' .. '9' then
73 raise Constraint_Error;
83 Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
94 pragma Unreferenced (Y, Mo, H, Mi);
97 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
105 function Day_Of_Week (Date : Time) return Day_Name is
107 return Day_Name'Val (Formatting_Operations.Day_Of_Week (Date));
116 Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
124 Ss : Second_Duration;
127 pragma Unreferenced (Y, Mo, D, Mi);
130 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
139 (Elapsed_Time : Duration;
140 Include_Time_Fraction : Boolean := False) return String
143 Minute : Minute_Number;
144 Second : Second_Number;
145 Sub_Second : Duration;
151 Result : String := "-00:00:00.00";
154 Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second);
156 -- Determine the two slice bounds for the result string depending on
157 -- whether the input is negative and whether fractions are requested.
159 Low := (if Elapsed_Time < 0.0 then 1 else 2);
160 High := (if Include_Time_Fraction then 12 else 9);
162 -- Prevent rounding when converting to natural
164 Sub_Second := Sub_Second * 100.0;
166 if Sub_Second > 0.0 then
167 Sub_Second := Sub_Second - 0.5;
170 SS_Nat := Natural (Sub_Second);
173 Hour_Str : constant String := Hour_Number'Image (Hour);
174 Minute_Str : constant String := Minute_Number'Image (Minute);
175 Second_Str : constant String := Second_Number'Image (Second);
176 SS_Str : constant String := Natural'Image (SS_Nat);
179 -- Hour processing, positions 2 and 3
182 Result (3) := Hour_Str (2);
184 Result (2) := Hour_Str (2);
185 Result (3) := Hour_Str (3);
188 -- Minute processing, positions 5 and 6
191 Result (6) := Minute_Str (2);
193 Result (5) := Minute_Str (2);
194 Result (6) := Minute_Str (3);
197 -- Second processing, positions 8 and 9
200 Result (9) := Second_Str (2);
202 Result (8) := Second_Str (2);
203 Result (9) := Second_Str (3);
206 -- Optional sub second processing, positions 11 and 12
208 if Include_Time_Fraction then
210 Result (12) := SS_Str (2);
212 Result (11) := SS_Str (2);
213 Result (12) := SS_Str (3);
217 return Result (Low .. High);
227 Include_Time_Fraction : Boolean := False;
228 Time_Zone : Time_Zones.Time_Offset := 0) return String
231 Month : Month_Number;
234 Minute : Minute_Number;
235 Second : Second_Number;
236 Sub_Second : Duration;
238 Leap_Second : Boolean;
240 Result : String := "0000-00-00 00:00:00.00";
243 Split (Date, Year, Month, Day,
244 Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
246 -- Prevent rounding when converting to natural
248 Sub_Second := Sub_Second * 100.0;
250 if Sub_Second > 0.0 then
251 Sub_Second := Sub_Second - 0.5;
254 SS_Nat := Natural (Sub_Second);
257 Year_Str : constant String := Year_Number'Image (Year);
258 Month_Str : constant String := Month_Number'Image (Month);
259 Day_Str : constant String := Day_Number'Image (Day);
260 Hour_Str : constant String := Hour_Number'Image (Hour);
261 Minute_Str : constant String := Minute_Number'Image (Minute);
262 Second_Str : constant String := Second_Number'Image (Second);
263 SS_Str : constant String := Natural'Image (SS_Nat);
266 -- Year processing, positions 1, 2, 3 and 4
268 Result (1) := Year_Str (2);
269 Result (2) := Year_Str (3);
270 Result (3) := Year_Str (4);
271 Result (4) := Year_Str (5);
273 -- Month processing, positions 6 and 7
276 Result (7) := Month_Str (2);
278 Result (6) := Month_Str (2);
279 Result (7) := Month_Str (3);
282 -- Day processing, positions 9 and 10
285 Result (10) := Day_Str (2);
287 Result (9) := Day_Str (2);
288 Result (10) := Day_Str (3);
291 -- Hour processing, positions 12 and 13
294 Result (13) := Hour_Str (2);
296 Result (12) := Hour_Str (2);
297 Result (13) := Hour_Str (3);
300 -- Minute processing, positions 15 and 16
303 Result (16) := Minute_Str (2);
305 Result (15) := Minute_Str (2);
306 Result (16) := Minute_Str (3);
309 -- Second processing, positions 18 and 19
312 Result (19) := Second_Str (2);
314 Result (18) := Second_Str (2);
315 Result (19) := Second_Str (3);
318 -- Optional sub second processing, positions 21 and 22
320 if Include_Time_Fraction then
322 Result (22) := SS_Str (2);
324 Result (21) := SS_Str (2);
325 Result (22) := SS_Str (3);
330 return Result (1 .. 19);
341 Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
349 Ss : Second_Duration;
352 pragma Unreferenced (Y, Mo, D, H);
355 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
365 Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
373 Ss : Second_Duration;
376 pragma Unreferenced (Y, D, H, Mi);
379 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
387 function Second (Date : Time) return Second_Number is
394 Ss : Second_Duration;
397 pragma Unreferenced (Y, Mo, D, H, Mi);
400 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
410 Minute : Minute_Number;
411 Second : Second_Number := 0;
412 Sub_Second : Second_Duration := 0.0) return Day_Duration is
418 or else not Minute'Valid
419 or else not Second'Valid
420 or else not Sub_Second'Valid
422 raise Constraint_Error;
425 return Day_Duration (Hour * 3_600) +
426 Day_Duration (Minute * 60) +
427 Day_Duration (Second) +
436 (Seconds : Day_Duration;
437 Hour : out Hour_Number;
438 Minute : out Minute_Number;
439 Second : out Second_Number;
440 Sub_Second : out Second_Duration)
447 if not Seconds'Valid then
448 raise Constraint_Error;
451 Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5));
453 Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
454 Hour := Hour_Number (Secs / 3_600);
455 Secs := Secs mod 3_600;
456 Minute := Minute_Number (Secs / 60);
457 Second := Second_Number (Secs mod 60);
462 or else not Minute'Valid
463 or else not Second'Valid
464 or else not Sub_Second'Valid
476 Year : out Year_Number;
477 Month : out Month_Number;
478 Day : out Day_Number;
479 Seconds : out Day_Duration;
480 Leap_Second : out Boolean;
481 Time_Zone : Time_Zones.Time_Offset := 0)
487 Tz : constant Long_Integer := Long_Integer (Time_Zone);
490 Formatting_Operations.Split
500 Leap_Sec => Leap_Second,
507 or else not Month'Valid
508 or else not Day'Valid
509 or else not Seconds'Valid
521 Year : out Year_Number;
522 Month : out Month_Number;
523 Day : out Day_Number;
524 Hour : out Hour_Number;
525 Minute : out Minute_Number;
526 Second : out Second_Number;
527 Sub_Second : out Second_Duration;
528 Time_Zone : Time_Zones.Time_Offset := 0)
532 Tz : constant Long_Integer := Long_Integer (Time_Zone);
535 Formatting_Operations.Split
544 Sub_Sec => Sub_Second,
552 or else not Month'Valid
553 or else not Day'Valid
554 or else not Hour'Valid
555 or else not Minute'Valid
556 or else not Second'Valid
557 or else not Sub_Second'Valid
569 Year : out Year_Number;
570 Month : out Month_Number;
571 Day : out Day_Number;
572 Hour : out Hour_Number;
573 Minute : out Minute_Number;
574 Second : out Second_Number;
575 Sub_Second : out Second_Duration;
576 Leap_Second : out Boolean;
577 Time_Zone : Time_Zones.Time_Offset := 0)
580 Tz : constant Long_Integer := Long_Integer (Time_Zone);
583 Formatting_Operations.Split
592 Sub_Sec => Sub_Second,
593 Leap_Sec => Leap_Second,
600 or else not Month'Valid
601 or else not Day'Valid
602 or else not Hour'Valid
603 or else not Minute'Valid
604 or else not Second'Valid
605 or else not Sub_Second'Valid
615 function Sub_Second (Date : Time) return Second_Duration is
622 Ss : Second_Duration;
625 pragma Unreferenced (Y, Mo, D, H, Mi);
628 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
638 Month : Month_Number;
640 Seconds : Day_Duration := 0.0;
641 Leap_Second : Boolean := False;
642 Time_Zone : Time_Zones.Time_Offset := 0) return Time
644 Adj_Year : Year_Number := Year;
645 Adj_Month : Month_Number := Month;
646 Adj_Day : Day_Number := Day;
648 H : constant Integer := 1;
649 M : constant Integer := 1;
650 Se : constant Integer := 1;
651 Ss : constant Duration := 0.1;
652 Tz : constant Long_Integer := Long_Integer (Time_Zone);
658 or else not Month'Valid
659 or else not Day'Valid
660 or else not Seconds'Valid
661 or else not Time_Zone'Valid
663 raise Constraint_Error;
666 -- A Seconds value of 86_400 denotes a new day. This case requires an
667 -- adjustment to the input values.
669 if Seconds = 86_400.0 then
670 if Day < Days_In_Month (Month)
671 or else (Is_Leap (Year)
679 Adj_Month := Month + 1;
682 Adj_Year := Year + 1;
688 Formatting_Operations.Time_Of
697 Leap_Sec => Leap_Second,
698 Use_Day_Secs => True,
709 Month : Month_Number;
712 Minute : Minute_Number;
713 Second : Second_Number;
714 Sub_Second : Second_Duration := 0.0;
715 Leap_Second : Boolean := False;
716 Time_Zone : Time_Zones.Time_Offset := 0) return Time
718 Dd : constant Day_Duration := Day_Duration'First;
719 Tz : constant Long_Integer := Long_Integer (Time_Zone);
725 or else not Month'Valid
726 or else not Day'Valid
727 or else not Hour'Valid
728 or else not Minute'Valid
729 or else not Second'Valid
730 or else not Sub_Second'Valid
731 or else not Time_Zone'Valid
733 raise Constraint_Error;
737 Formatting_Operations.Time_Of
745 Sub_Sec => Sub_Second,
746 Leap_Sec => Leap_Second,
747 Use_Day_Secs => False,
758 Time_Zone : Time_Zones.Time_Offset := 0) return Time
760 D : String (1 .. 22);
762 Month : Month_Number;
765 Minute : Minute_Number;
766 Second : Second_Number;
767 Sub_Second : Second_Duration := 0.0;
772 if not Time_Zone'Valid then
773 raise Constraint_Error;
779 and then Date'Length /= 22
781 raise Constraint_Error;
784 -- After the correct length has been determined, it is safe to
785 -- copy the Date in order to avoid Date'First + N indexing.
787 D (1 .. Date'Length) := Date;
791 Check_Char (D, '-', 5);
792 Check_Char (D, '-', 8);
793 Check_Char (D, ' ', 11);
794 Check_Char (D, ':', 14);
795 Check_Char (D, ':', 17);
797 if Date'Length = 22 then
798 Check_Char (D, '.', 20);
801 -- Leading zero checks
809 if Date'Length = 22 then
815 Year := Year_Number (Year_Number'Value (D (1 .. 4)));
816 Month := Month_Number (Month_Number'Value (D (6 .. 7)));
817 Day := Day_Number (Day_Number'Value (D (9 .. 10)));
818 Hour := Hour_Number (Hour_Number'Value (D (12 .. 13)));
819 Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
820 Second := Second_Number (Second_Number'Value (D (18 .. 19)));
824 if Date'Length = 22 then
825 Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
831 or else not Month'Valid
832 or else not Day'Valid
833 or else not Hour'Valid
834 or else not Minute'Valid
835 or else not Second'Valid
836 or else not Sub_Second'Valid
838 raise Constraint_Error;
841 return Time_Of (Year, Month, Day,
842 Hour, Minute, Second, Sub_Second, False, Time_Zone);
845 when others => raise Constraint_Error;
852 function Value (Elapsed_Time : String) return Duration is
853 D : String (1 .. 11);
855 Minute : Minute_Number;
856 Second : Second_Number;
857 Sub_Second : Second_Duration := 0.0;
862 if Elapsed_Time'Length /= 8
863 and then Elapsed_Time'Length /= 11
865 raise Constraint_Error;
868 -- After the correct length has been determined, it is safe to
869 -- copy the Elapsed_Time in order to avoid Date'First + N indexing.
871 D (1 .. Elapsed_Time'Length) := Elapsed_Time;
875 Check_Char (D, ':', 3);
876 Check_Char (D, ':', 6);
878 if Elapsed_Time'Length = 11 then
879 Check_Char (D, '.', 9);
882 -- Leading zero checks
888 if Elapsed_Time'Length = 11 then
894 Hour := Hour_Number (Hour_Number'Value (D (1 .. 2)));
895 Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
896 Second := Second_Number (Second_Number'Value (D (7 .. 8)));
900 if Elapsed_Time'Length = 11 then
901 Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
907 or else not Minute'Valid
908 or else not Second'Valid
909 or else not Sub_Second'Valid
911 raise Constraint_Error;
914 return Seconds_Of (Hour, Minute, Second, Sub_Second);
917 when others => raise Constraint_Error;
926 Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
934 Ss : Second_Duration;
937 pragma Unreferenced (Mo, D, H, Mi);
940 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
944 end Ada.Calendar.Formatting;