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-2019, 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 input
46 -- string S has character C at position Index. Raise Constraint_Error if
47 -- there is a mismatch.
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.
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
142 To_Char : constant array (0 .. 9) of Character := "0123456789";
144 Minute : Minute_Number;
145 Second : Second_Number;
146 Sub_Second : Duration;
149 -- Determine the two slice bounds for the result string depending on
150 -- whether the input is negative and whether fractions are requested.
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);
155 Result : String := "-00:00:00.00";
158 Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second);
160 -- Hour processing, positions 2 and 3
162 Result (2) := To_Char (Hour / 10);
163 Result (3) := To_Char (Hour mod 10);
165 -- Minute processing, positions 5 and 6
167 Result (5) := To_Char (Minute / 10);
168 Result (6) := To_Char (Minute mod 10);
170 -- Second processing, positions 8 and 9
172 Result (8) := To_Char (Second / 10);
173 Result (9) := To_Char (Second mod 10);
175 -- Optional sub second processing, positions 11 and 12
177 if Include_Time_Fraction and then Sub_Second > 0.0 then
179 -- Prevent rounding up when converting to natural, avoiding the zero
180 -- case to prevent rounding down to a negative number.
182 SS_Nat := Natural (Duration'(Sub_Second * 100.0) - 0.5);
184 Result (11) := To_Char (SS_Nat / 10);
185 Result (12) := To_Char (SS_Nat mod 10);
188 return Result (First .. Last);
197 Include_Time_Fraction : Boolean := False;
198 Time_Zone : Time_Zones.Time_Offset := 0) return String
200 To_Char : constant array (0 .. 9) of Character := "0123456789";
203 Month : Month_Number;
206 Minute : Minute_Number;
207 Second : Second_Number;
208 Sub_Second : Duration;
210 Leap_Second : Boolean;
212 -- The result length depends on whether fractions are requested.
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);
219 Split (Date, Year, Month, Day,
220 Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
222 -- Year processing, positions 1, 2, 3 and 4
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);
229 -- Month processing, positions 6 and 7
231 Result (6) := To_Char (Month / 10);
232 Result (7) := To_Char (Month mod 10);
234 -- Day processing, positions 9 and 10
236 Result (9) := To_Char (Day / 10);
237 Result (10) := To_Char (Day mod 10);
239 Result (12) := To_Char (Hour / 10);
240 Result (13) := To_Char (Hour mod 10);
242 -- Minute processing, positions 15 and 16
244 Result (15) := To_Char (Minute / 10);
245 Result (16) := To_Char (Minute mod 10);
247 -- Second processing, positions 18 and 19
249 Result (18) := To_Char (Second / 10);
250 Result (19) := To_Char (Second mod 10);
252 -- Optional sub second processing, positions 21 and 22
254 if Include_Time_Fraction and then Sub_Second > 0.0 then
256 -- Prevent rounding up when converting to natural, avoiding the zero
257 -- case to prevent rounding down to a negative number.
259 SS_Nat := Natural (Duration'(Sub_Second * 100.0) - 0.5);
261 Result (21) := To_Char (SS_Nat / 10);
262 Result (22) := To_Char (SS_Nat mod 10);
265 return Result (Result'First .. Last);
274 Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
282 Ss : Second_Duration;
285 pragma Unreferenced (Y, Mo, D, H);
288 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
298 Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
306 Ss : Second_Duration;
309 pragma Unreferenced (Y, D, H, Mi);
312 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
320 function Second (Date : Time) return Second_Number is
327 Ss : Second_Duration;
330 pragma Unreferenced (Y, Mo, D, H, Mi);
333 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
343 Minute : Minute_Number;
344 Second : Second_Number := 0;
345 Sub_Second : Second_Duration := 0.0) return Day_Duration is
351 or else not Minute'Valid
352 or else not Second'Valid
353 or else not Sub_Second'Valid
355 raise Constraint_Error;
358 return Day_Duration (Hour * 3_600) +
359 Day_Duration (Minute * 60) +
360 Day_Duration (Second) +
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)
380 if not Seconds'Valid then
381 raise Constraint_Error;
384 Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5));
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);
395 or else not Minute'Valid
396 or else not Second'Valid
397 or else not Sub_Second'Valid
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)
420 Tz : constant Long_Integer := Long_Integer (Time_Zone);
423 Formatting_Operations.Split
433 Leap_Sec => Leap_Second,
441 or else not Month'Valid
442 or else not Day'Valid
443 or else not Seconds'Valid
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)
466 Tz : constant Long_Integer := Long_Integer (Time_Zone);
469 Formatting_Operations.Split
478 Sub_Sec => Sub_Second,
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
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)
515 Tz : constant Long_Integer := Long_Integer (Time_Zone);
518 Formatting_Operations.Split
527 Sub_Sec => Sub_Second,
528 Leap_Sec => Leap_Second,
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
551 function Sub_Second (Date : Time) return Second_Duration is
558 Ss : Second_Duration;
561 pragma Unreferenced (Y, Mo, D, H, Mi);
564 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
574 Month : Month_Number;
576 Seconds : Day_Duration := 0.0;
577 Leap_Second : Boolean := False;
578 Time_Zone : Time_Zones.Time_Offset := 0) return Time
580 Adj_Year : Year_Number := Year;
581 Adj_Month : Month_Number := Month;
582 Adj_Day : Day_Number := Day;
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);
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
599 raise Constraint_Error;
602 -- A Seconds value of 86_400 denotes a new day. This case requires an
603 -- adjustment to the input values.
605 if Seconds = 86_400.0 then
606 if Day < Days_In_Month (Month)
607 or else (Is_Leap (Year)
615 Adj_Month := Month + 1;
618 Adj_Year := Year + 1;
624 Formatting_Operations.Time_Of
633 Leap_Sec => Leap_Second,
634 Use_Day_Secs => True,
646 Month : Month_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
655 Dd : constant Day_Duration := Day_Duration'First;
656 Tz : constant Long_Integer := Long_Integer (Time_Zone);
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
670 raise Constraint_Error;
674 Formatting_Operations.Time_Of
682 Sub_Sec => Sub_Second,
683 Leap_Sec => Leap_Second,
684 Use_Day_Secs => False,
696 Time_Zone : Time_Zones.Time_Offset := 0) return Time
698 D : String (1 .. 22);
700 Month : Month_Number;
703 Minute : Minute_Number;
704 Second : Second_Number;
705 Sub_Second : Second_Duration := 0.0;
710 if not Time_Zone'Valid then
711 raise Constraint_Error;
717 and then Date'Length /= 22
719 raise Constraint_Error;
722 -- After the correct length has been determined, it is safe to copy the
723 -- Date in order to avoid Date'First + N indexing.
725 D (1 .. Date'Length) := Date;
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);
735 if Date'Length = 22 then
736 Check_Char (D, '.', 20);
739 -- Leading zero checks
747 if Date'Length = 22 then
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)));
762 if Date'Length = 22 then
763 Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
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
776 raise Constraint_Error;
779 return Time_Of (Year, Month, Day,
780 Hour, Minute, Second, Sub_Second, False, Time_Zone);
783 when others => raise Constraint_Error;
790 function Value (Elapsed_Time : String) return Duration is
791 D : String (1 .. 11);
793 Minute : Minute_Number;
794 Second : Second_Number;
795 Sub_Second : Second_Duration := 0.0;
800 if Elapsed_Time'Length /= 8
801 and then Elapsed_Time'Length /= 11
803 raise Constraint_Error;
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.
809 D (1 .. Elapsed_Time'Length) := Elapsed_Time;
813 Check_Char (D, ':', 3);
814 Check_Char (D, ':', 6);
816 if Elapsed_Time'Length = 11 then
817 Check_Char (D, '.', 9);
820 -- Leading zero checks
826 if Elapsed_Time'Length = 11 then
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)));
838 if Elapsed_Time'Length = 11 then
839 Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
845 or else not Minute'Valid
846 or else not Second'Valid
847 or else not Sub_Second'Valid
849 raise Constraint_Error;
852 return Seconds_Of (Hour, Minute, Second, Sub_Second);
855 when others => raise Constraint_Error;
864 Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
872 Ss : Second_Duration;
875 pragma Unreferenced (Mo, D, H, Mi);
878 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
882 end Ada.Calendar.Formatting;