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, 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
;
36 with Unchecked_Conversion
;
38 package body Ada
.Calendar
.Formatting
is
42 Days_In_4_Years
: constant := 365 * 3 + 366;
43 Seconds_In_Day
: constant := 86_400
;
44 Seconds_In_4_Years
: constant := Days_In_4_Years
* Seconds_In_Day
;
45 Seconds_In_Non_Leap_Year
: constant := 365 * Seconds_In_Day
;
47 -- Exact time bounds for the range of Ada time: January 1, 1901 -
48 -- December 31, 2099. These bounds are based on the Unix Time of Epoc,
49 -- January 1, 1970. Start of Time is -69 years from TOE while End of
50 -- time is +130 years and one second from TOE.
52 Start_Of_Time
: constant Time
:=
53 Time
(-(17 * Seconds_In_4_Years
+
54 Seconds_In_Non_Leap_Year
));
56 End_Of_Time
: constant Time
:=
57 Time
(32 * Seconds_In_4_Years
+
58 2 * Seconds_In_Non_Leap_Year
) +
61 Days_In_Month
: constant array (Month_Number
) of Day_Number
:=
62 (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
64 procedure Check_Char
(S
: String; C
: Character; Index
: Integer);
65 -- Subsidiary to the two versions of Value. Determine whether the
66 -- input strint S has character C at position Index. Raise
67 -- Constraint_Error if there is a mismatch.
69 procedure Check_Digit
(S
: String; Index
: Integer);
70 -- Subsidiary to the two versions of Value. Determine whether the
71 -- character of string S at position Index is a digit. This catches
72 -- invalid input such as 1983-*1-j3 u5:n7:k9 which should be
73 -- 1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
79 procedure Check_Char
(S
: String; C
: Character; Index
: Integer) is
81 if S
(Index
) /= C
then
82 raise Constraint_Error
;
90 procedure Check_Digit
(S
: String; Index
: Integer) is
92 if S
(Index
) not in '0' .. '9' then
93 raise Constraint_Error
;
103 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Day_Number
106 Month
: Month_Number
;
109 Minute
: Minute_Number
;
110 Second
: Second_Number
;
111 Sub_Second
: Second_Duration
;
112 Leap_Second
: Boolean;
115 Split
(Date
, Year
, Month
, Day
,
116 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
124 function Day_Of_Week
(Date
: Time
) return Day_Name
is
126 Month
: Month_Number
;
129 Minute
: Minute_Number
;
130 Second
: Second_Number
;
131 Sub_Second
: Second_Duration
;
132 Leap_Second
: Boolean;
135 Day_Count
: Long_Long_Integer;
137 Secs_Count
: Long_Long_Integer;
140 -- Split the Date to obtain the year, month and day, then build a time
141 -- value for the middle of the same day, so that we don't have to worry
142 -- about leap seconds in the subsequent arithmetic.
144 Split
(Date
, Year
, Month
, Day
,
145 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
);
147 Midday_Date
:= Time_Of
(Year
, Month
, Day
, 12, 0, 0);
148 D
:= Midday_Date
- Start_Of_Time
;
150 -- D is a positive Duration value counting seconds since 1901. Convert
151 -- it into an integer for ease of arithmetic.
154 type D_Int
is range 0 .. 2 ** (Duration'Size - 1) - 1;
155 for D_Int
'Size use Duration'Size;
157 function To_D_Int
is new Unchecked_Conversion
(Duration, D_Int
);
159 D_As_Int
: constant D_Int
:= To_D_Int
(D
);
160 Small_Div
: constant D_Int
:= D_Int
(1.0 / Duration'Small);
163 Secs_Count
:= Long_Long_Integer (D_As_Int
/ Small_Div
);
166 Day_Count
:= Secs_Count
/ Seconds_In_Day
;
167 Day_Count
:= Day_Count
+ 1; -- Jan 1, 1901 was a Tuesday;
169 return Day_Name
'Val (Day_Count
mod 7);
178 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Hour_Number
181 Month
: Month_Number
;
184 Minute
: Minute_Number
;
185 Second
: Second_Number
;
186 Sub_Second
: Second_Duration
;
187 Leap_Second
: Boolean;
190 Split
(Date
, Year
, Month
, Day
,
191 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
200 (Elapsed_Time
: Duration;
201 Include_Time_Fraction
: Boolean := False) return String
204 Minute
: Minute_Number
;
205 Second
: Second_Number
;
206 Sub_Second
: Second_Duration
;
209 Result
: String := "00:00:00.00";
212 Split
(Elapsed_Time
, Hour
, Minute
, Second
, Sub_Second
);
213 SS_Nat
:= Natural (Sub_Second
* 100.0);
216 Hour_Str
: constant String := Hour_Number
'Image (Hour
);
217 Minute_Str
: constant String := Minute_Number
'Image (Minute
);
218 Second_Str
: constant String := Second_Number
'Image (Second
);
219 SS_Str
: constant String := Natural'Image (SS_Nat
);
222 -- Hour processing, positions 1 and 2
225 Result
(2) := Hour_Str
(2);
227 Result
(1) := Hour_Str
(2);
228 Result
(2) := Hour_Str
(3);
231 -- Minute processing, positions 4 and 5
234 Result
(5) := Minute_Str
(2);
236 Result
(4) := Minute_Str
(2);
237 Result
(5) := Minute_Str
(3);
240 -- Second processing, positions 7 and 8
243 Result
(8) := Second_Str
(2);
245 Result
(7) := Second_Str
(2);
246 Result
(8) := Second_Str
(3);
249 -- Optional sub second processing, positions 10 and 11
251 if Include_Time_Fraction
then
253 Result
(11) := SS_Str
(2);
255 Result
(10) := SS_Str
(2);
256 Result
(11) := SS_Str
(3);
261 return Result
(1 .. 8);
272 Include_Time_Fraction
: Boolean := False;
273 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return String
276 Month
: Month_Number
;
279 Minute
: Minute_Number
;
280 Second
: Second_Number
;
281 Sub_Second
: Second_Duration
;
283 Leap_Second
: Boolean;
285 Result
: String := "0000-00-00 00:00:00.00";
288 Split
(Date
, Year
, Month
, Day
,
289 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
291 SS_Nat
:= Natural (Sub_Second
* 100.0);
294 Year_Str
: constant String := Year_Number
'Image (Year
);
295 Month_Str
: constant String := Month_Number
'Image (Month
);
296 Day_Str
: constant String := Day_Number
'Image (Day
);
297 Hour_Str
: constant String := Hour_Number
'Image (Hour
);
298 Minute_Str
: constant String := Minute_Number
'Image (Minute
);
299 Second_Str
: constant String := Second_Number
'Image (Second
);
300 SS_Str
: constant String := Natural'Image (SS_Nat
);
303 -- Year processing, positions 1, 2, 3 and 4
305 Result
(1) := Year_Str
(2);
306 Result
(2) := Year_Str
(3);
307 Result
(3) := Year_Str
(4);
308 Result
(4) := Year_Str
(5);
310 -- Month processing, positions 6 and 7
313 Result
(7) := Month_Str
(2);
315 Result
(6) := Month_Str
(2);
316 Result
(7) := Month_Str
(3);
319 -- Day processing, positions 9 and 10
322 Result
(10) := Day_Str
(2);
324 Result
(9) := Day_Str
(2);
325 Result
(10) := Day_Str
(3);
328 -- Hour processing, positions 12 and 13
331 Result
(13) := Hour_Str
(2);
333 Result
(12) := Hour_Str
(2);
334 Result
(13) := Hour_Str
(3);
337 -- Minute processing, positions 15 and 16
340 Result
(16) := Minute_Str
(2);
342 Result
(15) := Minute_Str
(2);
343 Result
(16) := Minute_Str
(3);
346 -- Second processing, positions 18 and 19
349 Result
(19) := Second_Str
(2);
351 Result
(18) := Second_Str
(2);
352 Result
(19) := Second_Str
(3);
355 -- Optional sub second processing, positions 21 and 22
357 if Include_Time_Fraction
then
359 Result
(22) := SS_Str
(2);
361 Result
(21) := SS_Str
(2);
362 Result
(22) := SS_Str
(3);
367 return Result
(1 .. 19);
378 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Minute_Number
381 Month
: Month_Number
;
384 Minute
: Minute_Number
;
385 Second
: Second_Number
;
386 Sub_Second
: Second_Duration
;
387 Leap_Second
: Boolean;
390 Split
(Date
, Year
, Month
, Day
,
391 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
401 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Month_Number
404 Month
: Month_Number
;
407 Minute
: Minute_Number
;
408 Second
: Second_Number
;
409 Sub_Second
: Second_Duration
;
410 Leap_Second
: Boolean;
413 Split
(Date
, Year
, Month
, Day
,
414 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
422 function Second
(Date
: Time
) return Second_Number
is
424 Month
: Month_Number
;
427 Minute
: Minute_Number
;
428 Second
: Second_Number
;
429 Sub_Second
: Second_Duration
;
430 Leap_Second
: Boolean;
433 Split
(Date
, Year
, Month
, Day
,
434 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
);
444 Minute
: Minute_Number
;
445 Second
: Second_Number
:= 0;
446 Sub_Second
: Second_Duration
:= 0.0) return Day_Duration
is
452 or else not Minute
'Valid
453 or else not Second
'Valid
454 or else not Sub_Second
'Valid
456 raise Constraint_Error
;
459 return Day_Duration
(Hour
* 3600) +
460 Day_Duration
(Minute
* 60) +
461 Day_Duration
(Second
) +
470 (Seconds
: Day_Duration
;
471 Hour
: out Hour_Number
;
472 Minute
: out Minute_Number
;
473 Second
: out Second_Number
;
474 Sub_Second
: out Second_Duration
)
481 if not Seconds
'Valid then
482 raise Constraint_Error
;
485 if Seconds
= 0.0 then
488 Secs
:= Natural (Seconds
- 0.5);
491 Sub_Second
:= Second_Duration
(Seconds
- Day_Duration
(Secs
));
492 Hour
:= Hour_Number
(Secs
/ 3600);
493 Secs
:= Secs
mod 3600;
494 Minute
:= Minute_Number
(Secs
/ 60);
495 Second
:= Second_Number
(Secs
mod 60);
504 Year
: out Year_Number
;
505 Month
: out Month_Number
;
506 Day
: out Day_Number
;
507 Seconds
: out Day_Duration
;
508 Leap_Second
: out Boolean;
509 Time_Zone
: Time_Zones
.Time_Offset
:= 0)
512 Minute
: Minute_Number
;
513 Second
: Second_Number
;
514 Sub_Second
: Second_Duration
;
517 Split
(Date
, Year
, Month
, Day
,
518 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
520 Seconds
:= Seconds_Of
(Hour
, Minute
, Second
, Sub_Second
);
529 Year
: out Year_Number
;
530 Month
: out Month_Number
;
531 Day
: out Day_Number
;
532 Hour
: out Hour_Number
;
533 Minute
: out Minute_Number
;
534 Second
: out Second_Number
;
535 Sub_Second
: out Second_Duration
;
536 Time_Zone
: Time_Zones
.Time_Offset
:= 0)
538 Leap_Second
: Boolean;
541 Split
(Date
, Year
, Month
, Day
,
542 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
551 Year
: out Year_Number
;
552 Month
: out Month_Number
;
553 Day
: out Day_Number
;
554 Hour
: out Hour_Number
;
555 Minute
: out Minute_Number
;
556 Second
: out Second_Number
;
557 Sub_Second
: out Second_Duration
;
558 Leap_Second
: out Boolean;
559 Time_Zone
: Time_Zones
.Time_Offset
:= 0)
561 Ada_Year_Min
: constant Year_Number
:= Year_Number
'First;
562 Day_In_Year
: Integer;
563 Day_Second
: Integer;
564 Elapsed_Leaps
: Duration;
565 Hour_Second
: Integer;
566 In_Leap_Year
: Boolean;
567 Modified_Date
: Time
;
569 Remaining_Years
: Integer;
570 Seconds_Count
: Long_Long_Integer;
573 -- Our measurement of time is the number of seconds that have elapsed
574 -- since the Unix TOE. To calculate a UTC date from this we do a
575 -- sequence of divides and mods to get the components of a date based
576 -- on 86,400 seconds in each day. Since, UTC time depends upon the
577 -- occasional insertion of leap seconds, the number of leap seconds
578 -- that have been added prior to the input time are then subtracted
579 -- from the previous calculation. In fact, it is easier to do the
580 -- subtraction first, so a more accurate discription of what is
581 -- actually done, is that the number of added leap seconds is looked
582 -- up using the input Time value, than that number of seconds is
583 -- subtracted before the sequence of divides and mods.
585 -- If the input date turns out to be a leap second, we don't add it to
586 -- date (we want to return 23:59:59) but we set the Leap_Second output
589 -- Is there a need to account for a difference from Unix time prior
590 -- to the first leap second ???
592 -- Step 1: Determine the number of leap seconds since the start
593 -- of Ada time and the input date as well as the next leap second
594 -- occurence and process accordingly.
596 Cumulative_Leap_Secs
(Start_Of_Time
, Date
, Elapsed_Leaps
, Next_Leap
);
598 Leap_Second
:= Date
>= Next_Leap
;
599 Modified_Date
:= Date
- Elapsed_Leaps
;
602 Modified_Date
:= Modified_Date
- Duration (1.0);
605 -- Step 2: Process the time zone
607 Modified_Date
:= Modified_Date
+ Duration (Time_Zone
* 60);
609 -- Step 3: Sanity check on the calculated date. Since the leap
610 -- seconds and the time zone have been eliminated, the result needs
611 -- to be within the range of Ada time.
613 if Modified_Date
< Start_Of_Time
614 or else Modified_Date
>= (End_Of_Time
- All_Leap_Seconds
)
619 Modified_Date
:= Modified_Date
- Start_Of_Time
;
622 type D_Int
is range 0 .. 2 ** (Duration'Size - 1) - 1;
623 for D_Int
'Size use Duration'Size;
625 function To_D_Int
is new Unchecked_Conversion
(Duration, D_Int
);
626 function To_Duration
is new Unchecked_Conversion
(D_Int
, Duration);
627 function To_Duration
is new Unchecked_Conversion
(Time
, Duration);
629 D_As_Int
: constant D_Int
:= To_D_Int
(To_Duration
(Modified_Date
));
630 Small_Div
: constant D_Int
:= D_Int
(1.0 / Duration'Small);
633 Seconds_Count
:= Long_Long_Integer (D_As_Int
/ Small_Div
);
634 Sub_Second
:= Second_Duration
635 (To_Duration
(D_As_Int
rem Small_Div
));
638 -- Step 4: Calculate the number of years since the start of Ada time.
639 -- First consider sequences of four years, then the remaining years.
641 Year
:= Ada_Year_Min
+ 4 * Integer (Seconds_Count
/ Seconds_In_4_Years
);
642 Seconds_Count
:= Seconds_Count
mod Seconds_In_4_Years
;
643 Remaining_Years
:= Integer (Seconds_Count
/ Seconds_In_Non_Leap_Year
);
645 if Remaining_Years
> 3 then
646 Remaining_Years
:= 3;
649 Year
:= Year
+ Remaining_Years
;
651 -- Remove the seconds elapsed in those remaining years
653 Seconds_Count
:= Seconds_Count
- Long_Long_Integer
654 (Remaining_Years
* Seconds_In_Non_Leap_Year
);
655 In_Leap_Year
:= (Year
mod 4) = 0;
657 -- Step 5: Month and day processing. Determine the day to which the
658 -- remaining seconds map to.
660 Day_In_Year
:= Integer (Seconds_Count
/ Seconds_In_Day
) + 1;
664 if Day_In_Year
> 31 then
666 Day_In_Year
:= Day_In_Year
- 31;
669 and then ((not In_Leap_Year
)
670 or else Day_In_Year
> 29)
673 Day_In_Year
:= Day_In_Year
- 28;
676 Day_In_Year
:= Day_In_Year
- 1;
679 while Day_In_Year
> Days_In_Month
(Month
) loop
680 Day_In_Year
:= Day_In_Year
- Days_In_Month
(Month
);
686 -- Step 6: Hour, minute and second processing
689 Day_Second
:= Integer (Seconds_Count
mod Seconds_In_Day
);
690 Hour
:= Day_Second
/ 3600;
691 Hour_Second
:= Day_Second
mod 3600;
692 Minute
:= Hour_Second
/ 60;
693 Second
:= Hour_Second
mod 60;
700 function Sub_Second
(Date
: Time
) return Second_Duration
is
702 Month
: Month_Number
;
705 Minute
: Minute_Number
;
706 Second
: Second_Number
;
707 Sub_Second
: Second_Duration
;
708 Leap_Second
: Boolean;
711 Split
(Date
, Year
, Month
, Day
,
712 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
);
723 Month
: Month_Number
;
725 Seconds
: Day_Duration
:= 0.0;
726 Leap_Second
: Boolean := False;
727 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Time
730 Minute
: Minute_Number
;
731 Sec_Num
: Second_Number
;
732 Sub_Sec
: Second_Duration
;
733 Whole_Part
: Integer;
736 if not Seconds
'Valid then
737 raise Constraint_Error
;
740 -- The fact that Seconds can go to 86,400 creates all this extra work.
741 -- Perhaps a Time_Of just like the next one but allowing the Second_
742 -- Number input to reach 60 should become an internal version that this
743 -- and the next version call.... but for now we do the ugly bumping up
744 -- of Day, Month and Year;
746 if Seconds
= 86_400
.0
then
748 Adj_Year
: Year_Number
:= Year
;
749 Adj_Month
: Month_Number
:= Month
;
750 Adj_Day
: Day_Number
:= Day
;
758 if Day
< Days_In_Month
(Month
)
760 and then Year
mod 4 = 0)
767 Adj_Month
:= Month
+ 1;
770 Adj_Year
:= Year
+ 1;
774 return Time_Of
(Adj_Year
, Adj_Month
, Adj_Day
, Hour
, Minute
,
775 Sec_Num
, Sub_Sec
, Leap_Second
, Time_Zone
);
780 type D_Int
is range 0 .. 2 ** (Duration'Size - 1) - 1;
781 for D_Int
'Size use Duration'Size;
783 function To_D_Int
is new Unchecked_Conversion
(Duration, D_Int
);
784 function To_Duration
is new Unchecked_Conversion
(D_Int
, Duration);
786 D_As_Int
: constant D_Int
:= To_D_Int
(Seconds
);
787 Small_Div
: constant D_Int
:= D_Int
(1.0 / Duration'Small);
790 Whole_Part
:= Integer (D_As_Int
/ Small_Div
);
791 Sub_Sec
:= Second_Duration
792 (To_Duration
(D_As_Int
rem Small_Div
));
795 Hour
:= Hour_Number
(Whole_Part
/ 3600);
796 Whole_Part
:= Whole_Part
mod 3600;
797 Minute
:= Minute_Number
(Whole_Part
/ 60);
798 Sec_Num
:= Second_Number
(Whole_Part
mod 60);
800 return Time_Of
(Year
, Month
, Day
,
801 Hour
, Minute
, Sec_Num
, Sub_Sec
, Leap_Second
, Time_Zone
);
810 Month
: Month_Number
;
813 Minute
: Minute_Number
;
814 Second
: Second_Number
;
815 Sub_Second
: Second_Duration
:= 0.0;
816 Leap_Second
: Boolean := False;
817 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Time
819 Cumulative_Days_Before_Month
:
820 constant array (Month_Number
) of Natural :=
821 (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
823 Ada_Year_Min
: constant Year_Number
:= Year_Number
'First;
825 Elapsed_Leap_Seconds
: Duration;
826 Fractional_Second
: Duration;
831 -- The following checks are redundant with respect to the constraint
832 -- error checks that should normally be made on parameters, but we
833 -- decide to raise Constraint_Error in any case if bad values come in
834 -- (as a result of checks being off in the caller, or for other
835 -- erroneous or bounded error cases).
838 or else not Month
'Valid
839 or else not Day
'Valid
840 or else not Hour
'Valid
841 or else not Minute
'Valid
842 or else not Second
'Valid
843 or else not Sub_Second
'Valid
844 or else not Time_Zone
'Valid
846 raise Constraint_Error
;
849 -- Start the accumulation from the beginning of Ada time
851 Result
:= Start_Of_Time
;
853 -- Step 1: Determine the number of leap and non-leap years since 1901
854 -- and the input date.
856 -- Count the number of four year segments
858 Count
:= (Year
- Ada_Year_Min
) / 4;
859 Result
:= Result
+ Duration (Count
* Seconds_In_4_Years
);
861 -- Count the number of remaining non-leap years
863 Count
:= (Year
- Ada_Year_Min
) mod 4;
864 Result
:= Result
+ Duration (Count
* Seconds_In_Non_Leap_Year
);
866 -- Step 2: Determine the number of days elapsed singe the start of the
867 -- input year and add them to the result.
869 -- Do not include the current day since it is not over yet
871 Count
:= Cumulative_Days_Before_Month
(Month
) + Day
- 1;
873 -- The input year is a leap year and we have passed February
881 Result
:= Result
+ Duration (Count
* Seconds_In_Day
);
883 -- Step 3: Hour, minute and second processing
885 Result
:= Result
+ Duration (Hour
* 3600) +
886 Duration (Minute
* 60) +
889 -- The sub second may designate a whole second
891 if Sub_Second
= 1.0 then
892 Result
:= Result
+ Duration (1.0);
893 Fractional_Second
:= 0.0;
895 Fractional_Second
:= Sub_Second
;
898 -- Step 4: Time zone processing
900 Result
:= Result
- Duration (Time_Zone
* 60);
902 -- Step 5: The caller wants a leap second
905 Result
:= Result
+ Duration (1.0);
908 -- Step 6: Calculate the number of leap seconds occured since the
909 -- start of Ada time and the current point in time. The following
910 -- is an approximation which does not yet count leap seconds. It
911 -- can be pushed beyond 1 leap second, but not more.
914 (Start_Of_Time
, Result
, Elapsed_Leap_Seconds
, Next_Leap
);
916 Result
:= Result
+ Elapsed_Leap_Seconds
;
918 -- Step 7: Validity check of a leap second occurence. It requires an
919 -- additional comparison to Next_Leap to ensure that we landed right
920 -- on a valid occurence and that Elapsed_Leap_Seconds did not shoot
925 not (Result
>= Next_Leap
926 and then Result
- Duration (1.0) < Next_Leap
)
931 -- Step 8: Final sanity check on the calculated duration value
933 if Result
< Start_Of_Time
934 or else Result
>= End_Of_Time
939 -- Step 9: Lastly, add the sub second part
941 return Result
+ Fractional_Second
;
950 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Time
952 D
: String (1 .. 22);
954 Month
: Month_Number
;
957 Minute
: Minute_Number
;
958 Second
: Second_Number
;
959 Sub_Second
: Second_Duration
:= 0.0;
964 if not Time_Zone
'Valid then
965 raise Constraint_Error
;
971 and then Date
'Length /= 22
973 raise Constraint_Error
;
976 -- After the correct length has been determined, it is safe to
977 -- copy the Date in order to avoid Date'First + N indexing.
979 D
(1 .. Date
'Length) := Date
;
983 Check_Char
(D
, '-', 5);
984 Check_Char
(D
, '-', 8);
985 Check_Char
(D
, ' ', 11);
986 Check_Char
(D
, ':', 14);
987 Check_Char
(D
, ':', 17);
989 if Date
'Length = 22 then
990 Check_Char
(D
, '.', 20);
993 -- Leading zero checks
1001 if Date
'Length = 22 then
1002 Check_Digit
(D
, 21);
1007 Year
:= Year_Number
(Year_Number
'Value (D
(1 .. 4)));
1008 Month
:= Month_Number
(Month_Number
'Value (D
(6 .. 7)));
1009 Day
:= Day_Number
(Day_Number
'Value (D
(9 .. 10)));
1010 Hour
:= Hour_Number
(Hour_Number
'Value (D
(12 .. 13)));
1011 Minute
:= Minute_Number
(Minute_Number
'Value (D
(15 .. 16)));
1012 Second
:= Second_Number
(Second_Number
'Value (D
(18 .. 19)));
1016 if Date
'Length = 22 then
1017 Sub_Second
:= Second_Duration
(Second_Duration
'Value (D
(20 .. 22)));
1023 or else not Month
'Valid
1024 or else not Day
'Valid
1025 or else not Hour
'Valid
1026 or else not Minute
'Valid
1027 or else not Second
'Valid
1028 or else not Sub_Second
'Valid
1030 raise Constraint_Error
;
1033 return Time_Of
(Year
, Month
, Day
,
1034 Hour
, Minute
, Second
, Sub_Second
, False, Time_Zone
);
1037 when others => raise Constraint_Error
;
1044 function Value
(Elapsed_Time
: String) return Duration is
1045 D
: String (1 .. 11);
1047 Minute
: Minute_Number
;
1048 Second
: Second_Number
;
1049 Sub_Second
: Second_Duration
:= 0.0;
1054 if Elapsed_Time
'Length /= 8
1055 and then Elapsed_Time
'Length /= 11
1057 raise Constraint_Error
;
1060 -- After the correct length has been determined, it is safe to
1061 -- copy the Elapsed_Time in order to avoid Date'First + N indexing.
1063 D
(1 .. Elapsed_Time
'Length) := Elapsed_Time
;
1067 Check_Char
(D
, ':', 3);
1068 Check_Char
(D
, ':', 6);
1070 if Elapsed_Time
'Length = 11 then
1071 Check_Char
(D
, '.', 9);
1074 -- Leading zero checks
1080 if Elapsed_Time
'Length = 11 then
1081 Check_Digit
(D
, 10);
1086 Hour
:= Hour_Number
(Hour_Number
'Value (D
(1 .. 2)));
1087 Minute
:= Minute_Number
(Minute_Number
'Value (D
(4 .. 5)));
1088 Second
:= Second_Number
(Second_Number
'Value (D
(7 .. 8)));
1092 if Elapsed_Time
'Length = 11 then
1093 Sub_Second
:= Second_Duration
(Second_Duration
'Value (D
(9 .. 11)));
1099 or else not Minute
'Valid
1100 or else not Second
'Valid
1101 or else not Sub_Second
'Valid
1103 raise Constraint_Error
;
1106 return Seconds_Of
(Hour
, Minute
, Second
, Sub_Second
);
1109 when others => raise Constraint_Error
;
1118 Time_Zone
: Time_Zones
.Time_Offset
:= 0) return Year_Number
1121 Month
: Month_Number
;
1124 Minute
: Minute_Number
;
1125 Second
: Second_Number
;
1126 Sub_Second
: Second_Duration
;
1127 Leap_Second
: Boolean;
1130 Split
(Date
, Year
, Month
, Day
,
1131 Hour
, Minute
, Second
, Sub_Second
, Leap_Second
, Time_Zone
);
1135 end Ada
.Calendar
.Formatting
;