|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- A D A . C A L E N D A R --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
17 -- --
|
|
|
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. --
|
|
|
21 -- --
|
|
|
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/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with Ada.Unchecked_Conversion;
|
|
|
33
|
|
|
34 with Interfaces.C;
|
|
|
35
|
|
|
36 with System.OS_Primitives;
|
|
|
37
|
|
|
38 package body Ada.Calendar with
|
|
|
39 SPARK_Mode => Off
|
|
|
40 is
|
|
|
41 --------------------------
|
|
|
42 -- Implementation Notes --
|
|
|
43 --------------------------
|
|
|
44
|
|
|
45 -- In complex algorithms, some variables of type Ada.Calendar.Time carry
|
|
|
46 -- suffix _S or _N to denote units of seconds or nanoseconds.
|
|
|
47 --
|
|
|
48 -- Because time is measured in different units and from different origins
|
|
|
49 -- on various targets, a system independent model is incorporated into
|
|
|
50 -- Ada.Calendar. The idea behind the design is to encapsulate all target
|
|
|
51 -- dependent machinery in a single package, thus providing a uniform
|
|
|
52 -- interface to all existing and any potential children.
|
|
|
53
|
|
|
54 -- package Ada.Calendar
|
|
|
55 -- procedure Split (5 parameters) -------+
|
|
|
56 -- | Call from local routine
|
|
|
57 -- private |
|
|
|
58 -- package Formatting_Operations |
|
|
|
59 -- procedure Split (11 parameters) <--+
|
|
|
60 -- end Formatting_Operations |
|
|
|
61 -- end Ada.Calendar |
|
|
|
62 -- |
|
|
|
63 -- package Ada.Calendar.Formatting | Call from child routine
|
|
|
64 -- procedure Split (9 or 10 parameters) -+
|
|
|
65 -- end Ada.Calendar.Formatting
|
|
|
66
|
|
|
67 -- The behavior of the interfacing routines is controlled via various
|
|
|
68 -- flags. All new Ada 2005 types from children of Ada.Calendar are
|
|
|
69 -- emulated by a similar type. For instance, type Day_Number is replaced
|
|
|
70 -- by Integer in various routines. One ramification of this model is that
|
|
|
71 -- the caller site must perform validity checks on returned results.
|
|
|
72 -- The end result of this model is the lack of target specific files per
|
|
|
73 -- child of Ada.Calendar (e.g. a-calfor).
|
|
|
74
|
|
|
75 -----------------------
|
|
|
76 -- Local Subprograms --
|
|
|
77 -----------------------
|
|
|
78
|
|
|
79 procedure Check_Within_Time_Bounds (T : Time_Rep);
|
|
|
80 -- Ensure that a time representation value falls withing the bounds of Ada
|
|
|
81 -- time. Leap seconds support is taken into account.
|
|
|
82
|
|
|
83 procedure Cumulative_Leap_Seconds
|
|
|
84 (Start_Date : Time_Rep;
|
|
|
85 End_Date : Time_Rep;
|
|
|
86 Elapsed_Leaps : out Natural;
|
|
|
87 Next_Leap : out Time_Rep);
|
|
|
88 -- Elapsed_Leaps is the sum of the leap seconds that have occurred on or
|
|
|
89 -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
|
|
|
90 -- represents the next leap second occurrence on or after End_Date. If
|
|
|
91 -- there are no leaps seconds after End_Date, End_Of_Time is returned.
|
|
|
92 -- End_Of_Time can be used as End_Date to count all the leap seconds that
|
|
|
93 -- have occurred on or after Start_Date.
|
|
|
94 --
|
|
|
95 -- Note: Any sub seconds of Start_Date and End_Date are discarded before
|
|
|
96 -- the calculations are done. For instance: if 113 seconds is a leap
|
|
|
97 -- second (it isn't) and 113.5 is input as an End_Date, the leap second
|
|
|
98 -- at 113 will not be counted in Leaps_Between, but it will be returned
|
|
|
99 -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
|
|
|
100 -- a leap second, the comparison should be:
|
|
|
101 --
|
|
|
102 -- End_Date >= Next_Leap_Sec;
|
|
|
103 --
|
|
|
104 -- After_Last_Leap is designed so that this comparison works without
|
|
|
105 -- having to first check if Next_Leap_Sec is a valid leap second.
|
|
|
106
|
|
|
107 function Duration_To_Time_Rep is
|
|
|
108 new Ada.Unchecked_Conversion (Duration, Time_Rep);
|
|
|
109 -- Convert a duration value into a time representation value
|
|
|
110
|
|
|
111 function Time_Rep_To_Duration is
|
|
|
112 new Ada.Unchecked_Conversion (Time_Rep, Duration);
|
|
|
113 -- Convert a time representation value into a duration value
|
|
|
114
|
|
|
115 function UTC_Time_Offset
|
|
|
116 (Date : Time;
|
|
|
117 Is_Historic : Boolean) return Long_Integer;
|
|
|
118 -- This routine acts as an Ada wrapper around __gnat_localtime_tzoff which
|
|
|
119 -- in turn utilizes various OS-dependent mechanisms to calculate the time
|
|
|
120 -- zone offset of a date. Formal parameter Date represents an arbitrary
|
|
|
121 -- time stamp, either in the past, now, or in the future. If the flag
|
|
|
122 -- Is_Historic is set, this routine would try to calculate to the best of
|
|
|
123 -- the OS's abilities the time zone offset that was or will be in effect
|
|
|
124 -- on Date. If the flag is set to False, the routine returns the current
|
|
|
125 -- time zone with Date effectively set to Clock.
|
|
|
126 --
|
|
|
127 -- NOTE: Targets which support localtime_r will aways return a historic
|
|
|
128 -- time zone even if flag Is_Historic is set to False because this is how
|
|
|
129 -- localtime_r operates.
|
|
|
130
|
|
|
131 -----------------
|
|
|
132 -- Local Types --
|
|
|
133 -----------------
|
|
|
134
|
|
|
135 -- An integer time duration. The type is used whenever a positive elapsed
|
|
|
136 -- duration is needed, for instance when splitting a time value. Here is
|
|
|
137 -- how Time_Rep and Time_Dur are related:
|
|
|
138
|
|
|
139 -- 'First Ada_Low Ada_High 'Last
|
|
|
140 -- Time_Rep: +-------+------------------------+---------+
|
|
|
141 -- Time_Dur: +------------------------+---------+
|
|
|
142 -- 0 'Last
|
|
|
143
|
|
|
144 type Time_Dur is range 0 .. 2 ** 63 - 1;
|
|
|
145
|
|
|
146 --------------------------
|
|
|
147 -- Leap seconds control --
|
|
|
148 --------------------------
|
|
|
149
|
|
|
150 Flag : Integer;
|
|
|
151 pragma Import (C, Flag, "__gl_leap_seconds_support");
|
|
|
152 -- This imported value is used to determine whether the compilation had
|
|
|
153 -- binder flag "-y" present which enables leap seconds. A value of zero
|
|
|
154 -- signifies no leap seconds support while a value of one enables support.
|
|
|
155
|
|
|
156 Leap_Support : constant Boolean := (Flag = 1);
|
|
|
157 -- Flag to controls the usage of leap seconds in all Ada.Calendar routines
|
|
|
158
|
|
145
|
159 Leap_Seconds_Count : constant Natural := 27;
|
|
111
|
160
|
|
|
161 ---------------------
|
|
|
162 -- Local Constants --
|
|
|
163 ---------------------
|
|
|
164
|
|
|
165 Ada_Min_Year : constant Year_Number := Year_Number'First;
|
|
|
166 Secs_In_Four_Years : constant := (3 * 365 + 366) * Secs_In_Day;
|
|
|
167 Secs_In_Non_Leap_Year : constant := 365 * Secs_In_Day;
|
|
|
168 Nanos_In_Four_Years : constant := Secs_In_Four_Years * Nano;
|
|
|
169
|
|
|
170 -- Lower and upper bound of Ada time. The zero (0) value of type Time is
|
|
|
171 -- positioned at year 2150. Note that the lower and upper bound account
|
|
|
172 -- for the non-leap centennial years.
|
|
|
173
|
|
|
174 Ada_Low : constant Time_Rep := -(61 * 366 + 188 * 365) * Nanos_In_Day;
|
|
|
175 Ada_High : constant Time_Rep := (60 * 366 + 190 * 365) * Nanos_In_Day;
|
|
|
176
|
|
|
177 -- Even though the upper bound of time is 2399-12-31 23:59:59.999999999
|
|
|
178 -- UTC, it must be increased to include all leap seconds.
|
|
|
179
|
|
|
180 Ada_High_And_Leaps : constant Time_Rep :=
|
|
|
181 Ada_High + Time_Rep (Leap_Seconds_Count) * Nano;
|
|
|
182
|
|
|
183 -- Two constants used in the calculations of elapsed leap seconds.
|
|
|
184 -- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time
|
|
|
185 -- is earlier than Ada_Low in time zone +28.
|
|
|
186
|
|
|
187 End_Of_Time : constant Time_Rep :=
|
|
|
188 Ada_High + Time_Rep (3) * Nanos_In_Day;
|
|
|
189 Start_Of_Time : constant Time_Rep :=
|
|
|
190 Ada_Low - Time_Rep (3) * Nanos_In_Day;
|
|
|
191
|
|
|
192 -- The Unix lower time bound expressed as nanoseconds since the start of
|
|
|
193 -- Ada time in UTC.
|
|
|
194
|
|
|
195 Unix_Min : constant Time_Rep :=
|
|
|
196 Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
|
|
|
197
|
|
|
198 -- The Unix upper time bound expressed as nanoseconds since the start of
|
|
|
199 -- Ada time in UTC.
|
|
|
200
|
|
|
201 Unix_Max : constant Time_Rep :=
|
|
|
202 Ada_Low + Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day +
|
|
|
203 Time_Rep (Leap_Seconds_Count) * Nano;
|
|
|
204
|
|
|
205 Cumulative_Days_Before_Month :
|
|
|
206 constant array (Month_Number) of Natural :=
|
|
|
207 (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
|
|
|
208
|
|
|
209 -- The following table contains the hard time values of all existing leap
|
|
|
210 -- seconds. The values are produced by the utility program xleaps.adb. This
|
|
|
211 -- must be updated when additional leap second times are defined.
|
|
|
212
|
|
|
213 Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of Time_Rep :=
|
|
|
214 (-5601484800000000000,
|
|
|
215 -5585587199000000000,
|
|
|
216 -5554051198000000000,
|
|
|
217 -5522515197000000000,
|
|
|
218 -5490979196000000000,
|
|
|
219 -5459356795000000000,
|
|
|
220 -5427820794000000000,
|
|
|
221 -5396284793000000000,
|
|
|
222 -5364748792000000000,
|
|
|
223 -5317487991000000000,
|
|
|
224 -5285951990000000000,
|
|
|
225 -5254415989000000000,
|
|
|
226 -5191257588000000000,
|
|
|
227 -5112287987000000000,
|
|
|
228 -5049129586000000000,
|
|
|
229 -5017593585000000000,
|
|
|
230 -4970332784000000000,
|
|
|
231 -4938796783000000000,
|
|
|
232 -4907260782000000000,
|
|
|
233 -4859827181000000000,
|
|
|
234 -4812566380000000000,
|
|
|
235 -4765132779000000000,
|
|
|
236 -4544207978000000000,
|
|
|
237 -4449513577000000000,
|
|
145
|
238 -4339180776000000000,
|
|
|
239 -4244572775000000000,
|
|
|
240 -4197052774000000000);
|
|
111
|
241
|
|
|
242 ---------
|
|
|
243 -- "+" --
|
|
|
244 ---------
|
|
|
245
|
|
|
246 function "+" (Left : Time; Right : Duration) return Time is
|
|
|
247 pragma Unsuppress (Overflow_Check);
|
|
|
248 Left_N : constant Time_Rep := Time_Rep (Left);
|
|
|
249 begin
|
|
|
250 return Time (Left_N + Duration_To_Time_Rep (Right));
|
|
|
251 exception
|
|
|
252 when Constraint_Error =>
|
|
|
253 raise Time_Error;
|
|
|
254 end "+";
|
|
|
255
|
|
|
256 function "+" (Left : Duration; Right : Time) return Time is
|
|
|
257 begin
|
|
|
258 return Right + Left;
|
|
|
259 end "+";
|
|
|
260
|
|
|
261 ---------
|
|
|
262 -- "-" --
|
|
|
263 ---------
|
|
|
264
|
|
|
265 function "-" (Left : Time; Right : Duration) return Time is
|
|
|
266 pragma Unsuppress (Overflow_Check);
|
|
|
267 Left_N : constant Time_Rep := Time_Rep (Left);
|
|
|
268 begin
|
|
|
269 return Time (Left_N - Duration_To_Time_Rep (Right));
|
|
|
270 exception
|
|
|
271 when Constraint_Error =>
|
|
|
272 raise Time_Error;
|
|
|
273 end "-";
|
|
|
274
|
|
|
275 function "-" (Left : Time; Right : Time) return Duration is
|
|
|
276 pragma Unsuppress (Overflow_Check);
|
|
|
277
|
|
|
278 Dur_Low : constant Time_Rep := Duration_To_Time_Rep (Duration'First);
|
|
|
279 Dur_High : constant Time_Rep := Duration_To_Time_Rep (Duration'Last);
|
|
|
280 -- The bounds of type Duration expressed as time representations
|
|
|
281
|
|
|
282 Res_N : Time_Rep;
|
|
|
283
|
|
|
284 begin
|
|
|
285 Res_N := Time_Rep (Left) - Time_Rep (Right);
|
|
|
286
|
|
|
287 -- Due to the extended range of Ada time, "-" is capable of producing
|
|
|
288 -- results which may exceed the range of Duration. In order to prevent
|
|
|
289 -- the generation of bogus values by the Unchecked_Conversion, we apply
|
|
|
290 -- the following check.
|
|
|
291
|
|
|
292 if Res_N < Dur_Low or else Res_N > Dur_High then
|
|
|
293 raise Time_Error;
|
|
|
294 end if;
|
|
|
295
|
|
|
296 return Time_Rep_To_Duration (Res_N);
|
|
|
297
|
|
|
298 exception
|
|
|
299 when Constraint_Error =>
|
|
|
300 raise Time_Error;
|
|
|
301 end "-";
|
|
|
302
|
|
|
303 ---------
|
|
|
304 -- "<" --
|
|
|
305 ---------
|
|
|
306
|
|
|
307 function "<" (Left, Right : Time) return Boolean is
|
|
|
308 begin
|
|
|
309 return Time_Rep (Left) < Time_Rep (Right);
|
|
|
310 end "<";
|
|
|
311
|
|
|
312 ----------
|
|
|
313 -- "<=" --
|
|
|
314 ----------
|
|
|
315
|
|
|
316 function "<=" (Left, Right : Time) return Boolean is
|
|
|
317 begin
|
|
|
318 return Time_Rep (Left) <= Time_Rep (Right);
|
|
|
319 end "<=";
|
|
|
320
|
|
|
321 ---------
|
|
|
322 -- ">" --
|
|
|
323 ---------
|
|
|
324
|
|
|
325 function ">" (Left, Right : Time) return Boolean is
|
|
|
326 begin
|
|
|
327 return Time_Rep (Left) > Time_Rep (Right);
|
|
|
328 end ">";
|
|
|
329
|
|
|
330 ----------
|
|
|
331 -- ">=" --
|
|
|
332 ----------
|
|
|
333
|
|
|
334 function ">=" (Left, Right : Time) return Boolean is
|
|
|
335 begin
|
|
|
336 return Time_Rep (Left) >= Time_Rep (Right);
|
|
|
337 end ">=";
|
|
|
338
|
|
|
339 ------------------------------
|
|
|
340 -- Check_Within_Time_Bounds --
|
|
|
341 ------------------------------
|
|
|
342
|
|
|
343 procedure Check_Within_Time_Bounds (T : Time_Rep) is
|
|
|
344 begin
|
|
|
345 if Leap_Support then
|
|
|
346 if T < Ada_Low or else T > Ada_High_And_Leaps then
|
|
|
347 raise Time_Error;
|
|
|
348 end if;
|
|
|
349 else
|
|
|
350 if T < Ada_Low or else T > Ada_High then
|
|
|
351 raise Time_Error;
|
|
|
352 end if;
|
|
|
353 end if;
|
|
|
354 end Check_Within_Time_Bounds;
|
|
|
355
|
|
|
356 -----------
|
|
|
357 -- Clock --
|
|
|
358 -----------
|
|
|
359
|
|
|
360 function Clock return Time is
|
|
|
361 Elapsed_Leaps : Natural;
|
|
|
362 Next_Leap_N : Time_Rep;
|
|
|
363
|
|
|
364 -- The system clock returns the time in UTC since the Unix Epoch of
|
|
|
365 -- 1970-01-01 00:00:00.0. We perform an origin shift to the Ada Epoch
|
|
|
366 -- by adding the number of nanoseconds between the two origins.
|
|
|
367
|
|
|
368 Res_N : Time_Rep :=
|
|
|
369 Duration_To_Time_Rep (System.OS_Primitives.Clock) + Unix_Min;
|
|
|
370
|
|
|
371 begin
|
|
|
372 -- If the target supports leap seconds, determine the number of leap
|
|
|
373 -- seconds elapsed until this moment.
|
|
|
374
|
|
|
375 if Leap_Support then
|
|
|
376 Cumulative_Leap_Seconds
|
|
|
377 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
378
|
|
|
379 -- The system clock may fall exactly on a leap second
|
|
|
380
|
|
|
381 if Res_N >= Next_Leap_N then
|
|
|
382 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
383 end if;
|
|
|
384
|
|
|
385 -- The target does not support leap seconds
|
|
|
386
|
|
|
387 else
|
|
|
388 Elapsed_Leaps := 0;
|
|
|
389 end if;
|
|
|
390
|
|
|
391 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
392
|
|
|
393 return Time (Res_N);
|
|
|
394 end Clock;
|
|
|
395
|
|
|
396 -----------------------------
|
|
|
397 -- Cumulative_Leap_Seconds --
|
|
|
398 -----------------------------
|
|
|
399
|
|
|
400 procedure Cumulative_Leap_Seconds
|
|
|
401 (Start_Date : Time_Rep;
|
|
|
402 End_Date : Time_Rep;
|
|
|
403 Elapsed_Leaps : out Natural;
|
|
|
404 Next_Leap : out Time_Rep)
|
|
|
405 is
|
|
|
406 End_Index : Positive;
|
|
|
407 End_T : Time_Rep := End_Date;
|
|
|
408 Start_Index : Positive;
|
|
|
409 Start_T : Time_Rep := Start_Date;
|
|
|
410
|
|
|
411 begin
|
|
|
412 -- Both input dates must be normalized to UTC
|
|
|
413
|
|
|
414 pragma Assert (Leap_Support and then End_Date >= Start_Date);
|
|
|
415
|
|
|
416 Next_Leap := End_Of_Time;
|
|
|
417
|
|
|
418 -- Make sure that the end date does not exceed the upper bound
|
|
|
419 -- of Ada time.
|
|
|
420
|
|
|
421 if End_Date > Ada_High then
|
|
|
422 End_T := Ada_High;
|
|
|
423 end if;
|
|
|
424
|
|
|
425 -- Remove the sub seconds from both dates
|
|
|
426
|
|
|
427 Start_T := Start_T - (Start_T mod Nano);
|
|
|
428 End_T := End_T - (End_T mod Nano);
|
|
|
429
|
|
|
430 -- Some trivial cases:
|
|
|
431 -- Leap 1 . . . Leap N
|
|
|
432 -- ---+========+------+############+-------+========+-----
|
|
|
433 -- Start_T End_T Start_T End_T
|
|
|
434
|
|
|
435 if End_T < Leap_Second_Times (1) then
|
|
|
436 Elapsed_Leaps := 0;
|
|
|
437 Next_Leap := Leap_Second_Times (1);
|
|
|
438 return;
|
|
|
439
|
|
|
440 elsif Start_T > Leap_Second_Times (Leap_Seconds_Count) then
|
|
|
441 Elapsed_Leaps := 0;
|
|
|
442 Next_Leap := End_Of_Time;
|
|
|
443 return;
|
|
|
444 end if;
|
|
|
445
|
|
|
446 -- Perform the calculations only if the start date is within the leap
|
|
|
447 -- second occurrences table.
|
|
|
448
|
|
|
449 if Start_T <= Leap_Second_Times (Leap_Seconds_Count) then
|
|
|
450
|
|
|
451 -- 1 2 N - 1 N
|
|
|
452 -- +----+----+-- . . . --+-------+---+
|
|
|
453 -- | T1 | T2 | | N - 1 | N |
|
|
|
454 -- +----+----+-- . . . --+-------+---+
|
|
|
455 -- ^ ^
|
|
|
456 -- | Start_Index | End_Index
|
|
|
457 -- +-------------------+
|
|
|
458 -- Leaps_Between
|
|
|
459
|
|
|
460 -- The idea behind the algorithm is to iterate and find two
|
|
|
461 -- closest dates which are after Start_T and End_T. Their
|
|
|
462 -- corresponding index difference denotes the number of leap
|
|
|
463 -- seconds elapsed.
|
|
|
464
|
|
|
465 Start_Index := 1;
|
|
|
466 loop
|
|
|
467 exit when Leap_Second_Times (Start_Index) >= Start_T;
|
|
|
468 Start_Index := Start_Index + 1;
|
|
|
469 end loop;
|
|
|
470
|
|
|
471 End_Index := Start_Index;
|
|
|
472 loop
|
|
|
473 exit when End_Index > Leap_Seconds_Count
|
|
|
474 or else Leap_Second_Times (End_Index) >= End_T;
|
|
|
475 End_Index := End_Index + 1;
|
|
|
476 end loop;
|
|
|
477
|
|
|
478 if End_Index <= Leap_Seconds_Count then
|
|
|
479 Next_Leap := Leap_Second_Times (End_Index);
|
|
|
480 end if;
|
|
|
481
|
|
|
482 Elapsed_Leaps := End_Index - Start_Index;
|
|
|
483
|
|
|
484 else
|
|
|
485 Elapsed_Leaps := 0;
|
|
|
486 end if;
|
|
|
487 end Cumulative_Leap_Seconds;
|
|
|
488
|
|
|
489 ---------
|
|
|
490 -- Day --
|
|
|
491 ---------
|
|
|
492
|
|
|
493 function Day (Date : Time) return Day_Number is
|
|
|
494 D : Day_Number;
|
|
|
495 Y : Year_Number;
|
|
|
496 M : Month_Number;
|
|
|
497 S : Day_Duration;
|
|
|
498 pragma Unreferenced (Y, M, S);
|
|
|
499 begin
|
|
|
500 Split (Date, Y, M, D, S);
|
|
|
501 return D;
|
|
|
502 end Day;
|
|
|
503
|
|
131
|
504 ------------------
|
|
|
505 -- Epoch_Offset --
|
|
|
506 ------------------
|
|
|
507
|
|
|
508 function Epoch_Offset return Time_Rep is
|
|
|
509 begin
|
|
|
510 return (136 * 365 + 44 * 366) * Nanos_In_Day;
|
|
|
511 end Epoch_Offset;
|
|
|
512
|
|
111
|
513 -------------
|
|
|
514 -- Is_Leap --
|
|
|
515 -------------
|
|
|
516
|
|
|
517 function Is_Leap (Year : Year_Number) return Boolean is
|
|
|
518 begin
|
|
|
519 -- Leap centennial years
|
|
|
520
|
|
|
521 if Year mod 400 = 0 then
|
|
|
522 return True;
|
|
|
523
|
|
|
524 -- Non-leap centennial years
|
|
|
525
|
|
|
526 elsif Year mod 100 = 0 then
|
|
|
527 return False;
|
|
|
528
|
|
|
529 -- Regular years
|
|
|
530
|
|
|
531 else
|
|
|
532 return Year mod 4 = 0;
|
|
|
533 end if;
|
|
|
534 end Is_Leap;
|
|
|
535
|
|
|
536 -----------
|
|
|
537 -- Month --
|
|
|
538 -----------
|
|
|
539
|
|
|
540 function Month (Date : Time) return Month_Number is
|
|
|
541 Y : Year_Number;
|
|
|
542 M : Month_Number;
|
|
|
543 D : Day_Number;
|
|
|
544 S : Day_Duration;
|
|
|
545 pragma Unreferenced (Y, D, S);
|
|
|
546 begin
|
|
|
547 Split (Date, Y, M, D, S);
|
|
|
548 return M;
|
|
|
549 end Month;
|
|
|
550
|
|
|
551 -------------
|
|
|
552 -- Seconds --
|
|
|
553 -------------
|
|
|
554
|
|
|
555 function Seconds (Date : Time) return Day_Duration is
|
|
|
556 Y : Year_Number;
|
|
|
557 M : Month_Number;
|
|
|
558 D : Day_Number;
|
|
|
559 S : Day_Duration;
|
|
|
560 pragma Unreferenced (Y, M, D);
|
|
|
561 begin
|
|
|
562 Split (Date, Y, M, D, S);
|
|
|
563 return S;
|
|
|
564 end Seconds;
|
|
|
565
|
|
|
566 -----------
|
|
|
567 -- Split --
|
|
|
568 -----------
|
|
|
569
|
|
|
570 procedure Split
|
|
|
571 (Date : Time;
|
|
|
572 Year : out Year_Number;
|
|
|
573 Month : out Month_Number;
|
|
|
574 Day : out Day_Number;
|
|
|
575 Seconds : out Day_Duration)
|
|
|
576 is
|
|
|
577 H : Integer;
|
|
|
578 M : Integer;
|
|
|
579 Se : Integer;
|
|
|
580 Ss : Duration;
|
|
|
581 Le : Boolean;
|
|
|
582
|
|
|
583 pragma Unreferenced (H, M, Se, Ss, Le);
|
|
|
584
|
|
|
585 begin
|
|
|
586 -- Even though the input time zone is UTC (0), the flag Use_TZ will
|
|
|
587 -- ensure that Split picks up the local time zone.
|
|
|
588
|
|
|
589 Formatting_Operations.Split
|
|
|
590 (Date => Date,
|
|
|
591 Year => Year,
|
|
|
592 Month => Month,
|
|
|
593 Day => Day,
|
|
|
594 Day_Secs => Seconds,
|
|
|
595 Hour => H,
|
|
|
596 Minute => M,
|
|
|
597 Second => Se,
|
|
|
598 Sub_Sec => Ss,
|
|
|
599 Leap_Sec => Le,
|
|
|
600 Use_TZ => False,
|
|
|
601 Is_Historic => True,
|
|
|
602 Time_Zone => 0);
|
|
|
603
|
|
|
604 -- Validity checks
|
|
|
605
|
|
|
606 if not Year'Valid or else
|
|
|
607 not Month'Valid or else
|
|
|
608 not Day'Valid or else
|
|
|
609 not Seconds'Valid
|
|
|
610 then
|
|
|
611 raise Time_Error;
|
|
|
612 end if;
|
|
|
613 end Split;
|
|
|
614
|
|
|
615 -------------
|
|
|
616 -- Time_Of --
|
|
|
617 -------------
|
|
|
618
|
|
|
619 function Time_Of
|
|
|
620 (Year : Year_Number;
|
|
|
621 Month : Month_Number;
|
|
|
622 Day : Day_Number;
|
|
|
623 Seconds : Day_Duration := 0.0) return Time
|
|
|
624 is
|
|
|
625 -- The values in the following constants are irrelevant, they are just
|
|
|
626 -- placeholders; the choice of constructing a Day_Duration value is
|
|
|
627 -- controlled by the Use_Day_Secs flag.
|
|
|
628
|
|
|
629 H : constant Integer := 1;
|
|
|
630 M : constant Integer := 1;
|
|
|
631 Se : constant Integer := 1;
|
|
|
632 Ss : constant Duration := 0.1;
|
|
|
633
|
|
|
634 begin
|
|
|
635 -- Validity checks
|
|
|
636
|
|
|
637 if not Year'Valid or else
|
|
|
638 not Month'Valid or else
|
|
|
639 not Day'Valid or else
|
|
|
640 not Seconds'Valid
|
|
|
641 then
|
|
|
642 raise Time_Error;
|
|
|
643 end if;
|
|
|
644
|
|
|
645 -- Even though the input time zone is UTC (0), the flag Use_TZ will
|
|
|
646 -- ensure that Split picks up the local time zone.
|
|
|
647
|
|
|
648 return
|
|
|
649 Formatting_Operations.Time_Of
|
|
|
650 (Year => Year,
|
|
|
651 Month => Month,
|
|
|
652 Day => Day,
|
|
|
653 Day_Secs => Seconds,
|
|
|
654 Hour => H,
|
|
|
655 Minute => M,
|
|
|
656 Second => Se,
|
|
|
657 Sub_Sec => Ss,
|
|
|
658 Leap_Sec => False,
|
|
|
659 Use_Day_Secs => True,
|
|
|
660 Use_TZ => False,
|
|
|
661 Is_Historic => True,
|
|
|
662 Time_Zone => 0);
|
|
|
663 end Time_Of;
|
|
|
664
|
|
|
665 ---------------------
|
|
|
666 -- UTC_Time_Offset --
|
|
|
667 ---------------------
|
|
|
668
|
|
|
669 function UTC_Time_Offset
|
|
|
670 (Date : Time;
|
|
|
671 Is_Historic : Boolean) return Long_Integer
|
|
|
672 is
|
|
|
673 -- The following constants denote February 28 during non-leap centennial
|
|
|
674 -- years, the units are nanoseconds.
|
|
|
675
|
|
|
676 T_2100_2_28 : constant Time_Rep := Ada_Low +
|
|
|
677 (Time_Rep (49 * 366 + 150 * 365 + 59) * Secs_In_Day +
|
|
|
678 Time_Rep (Leap_Seconds_Count)) * Nano;
|
|
|
679
|
|
|
680 T_2200_2_28 : constant Time_Rep := Ada_Low +
|
|
|
681 (Time_Rep (73 * 366 + 226 * 365 + 59) * Secs_In_Day +
|
|
|
682 Time_Rep (Leap_Seconds_Count)) * Nano;
|
|
|
683
|
|
|
684 T_2300_2_28 : constant Time_Rep := Ada_Low +
|
|
|
685 (Time_Rep (97 * 366 + 302 * 365 + 59) * Secs_In_Day +
|
|
|
686 Time_Rep (Leap_Seconds_Count)) * Nano;
|
|
|
687
|
|
|
688 -- 56 years (14 leap years + 42 non-leap years) in nanoseconds:
|
|
|
689
|
|
|
690 Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day;
|
|
|
691
|
|
|
692 type int_Pointer is access all Interfaces.C.int;
|
|
|
693 type long_Pointer is access all Interfaces.C.long;
|
|
|
694
|
|
|
695 type time_t is
|
|
|
696 range -(2 ** (Standard'Address_Size - Integer'(1))) ..
|
|
|
697 +(2 ** (Standard'Address_Size - Integer'(1)) - 1);
|
|
|
698 type time_t_Pointer is access all time_t;
|
|
|
699
|
|
|
700 procedure localtime_tzoff
|
|
|
701 (timer : time_t_Pointer;
|
|
|
702 is_historic : int_Pointer;
|
|
|
703 off : long_Pointer);
|
|
|
704 pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
|
|
|
705 -- This routine is a interfacing wrapper around the library function
|
|
|
706 -- __gnat_localtime_tzoff. Parameter 'timer' represents a Unix-based
|
|
|
707 -- time equivalent of the input date. If flag 'is_historic' is set, this
|
|
|
708 -- routine would try to calculate to the best of the OS's abilities the
|
|
|
709 -- time zone offset that was or will be in effect on 'timer'. If the
|
|
|
710 -- flag is set to False, the routine returns the current time zone
|
|
|
711 -- regardless of what 'timer' designates. Parameter 'off' captures the
|
|
|
712 -- UTC offset of 'timer'.
|
|
|
713
|
|
|
714 Adj_Cent : Integer;
|
|
|
715 Date_N : Time_Rep;
|
|
|
716 Flag : aliased Interfaces.C.int;
|
|
|
717 Offset : aliased Interfaces.C.long;
|
|
|
718 Secs_T : aliased time_t;
|
|
|
719
|
|
|
720 -- Start of processing for UTC_Time_Offset
|
|
|
721
|
|
|
722 begin
|
|
|
723 Date_N := Time_Rep (Date);
|
|
|
724
|
|
|
725 -- Dates which are 56 years apart fall on the same day, day light saving
|
|
|
726 -- and so on. Non-leap centennial years violate this rule by one day and
|
|
|
727 -- as a consequence, special adjustment is needed.
|
|
|
728
|
|
|
729 Adj_Cent :=
|
|
|
730 (if Date_N <= T_2100_2_28 then 0
|
|
|
731 elsif Date_N <= T_2200_2_28 then 1
|
|
|
732 elsif Date_N <= T_2300_2_28 then 2
|
|
|
733 else 3);
|
|
|
734
|
|
|
735 if Adj_Cent > 0 then
|
|
|
736 Date_N := Date_N - Time_Rep (Adj_Cent) * Nanos_In_Day;
|
|
|
737 end if;
|
|
|
738
|
|
|
739 -- Shift the date within bounds of Unix time
|
|
|
740
|
|
|
741 while Date_N < Unix_Min loop
|
|
|
742 Date_N := Date_N + Nanos_In_56_Years;
|
|
|
743 end loop;
|
|
|
744
|
|
|
745 while Date_N >= Unix_Max loop
|
|
|
746 Date_N := Date_N - Nanos_In_56_Years;
|
|
|
747 end loop;
|
|
|
748
|
|
|
749 -- Perform a shift in origins from Ada to Unix
|
|
|
750
|
|
|
751 Date_N := Date_N - Unix_Min;
|
|
|
752
|
|
|
753 -- Convert the date into seconds
|
|
|
754
|
|
|
755 Secs_T := time_t (Date_N / Nano);
|
|
|
756
|
|
|
757 -- Determine whether to treat the input date as historical or not. A
|
|
|
758 -- value of "0" signifies that the date is NOT historic.
|
|
|
759
|
|
|
760 Flag := (if Is_Historic then 1 else 0);
|
|
|
761
|
|
|
762 localtime_tzoff
|
|
|
763 (Secs_T'Unchecked_Access,
|
|
|
764 Flag'Unchecked_Access,
|
|
|
765 Offset'Unchecked_Access);
|
|
|
766
|
|
|
767 return Long_Integer (Offset);
|
|
|
768 end UTC_Time_Offset;
|
|
|
769
|
|
|
770 ----------
|
|
|
771 -- Year --
|
|
|
772 ----------
|
|
|
773
|
|
|
774 function Year (Date : Time) return Year_Number is
|
|
|
775 Y : Year_Number;
|
|
|
776 M : Month_Number;
|
|
|
777 D : Day_Number;
|
|
|
778 S : Day_Duration;
|
|
|
779 pragma Unreferenced (M, D, S);
|
|
|
780 begin
|
|
|
781 Split (Date, Y, M, D, S);
|
|
|
782 return Y;
|
|
|
783 end Year;
|
|
|
784
|
|
|
785 -- The following packages assume that Time is a signed 64 bit integer
|
|
|
786 -- type, the units are nanoseconds and the origin is the start of Ada
|
|
|
787 -- time (1901-01-01 00:00:00.0 UTC).
|
|
|
788
|
|
|
789 ---------------------------
|
|
|
790 -- Arithmetic_Operations --
|
|
|
791 ---------------------------
|
|
|
792
|
|
|
793 package body Arithmetic_Operations is
|
|
|
794
|
|
|
795 ---------
|
|
|
796 -- Add --
|
|
|
797 ---------
|
|
|
798
|
|
|
799 function Add (Date : Time; Days : Long_Integer) return Time is
|
|
|
800 pragma Unsuppress (Overflow_Check);
|
|
|
801 Date_N : constant Time_Rep := Time_Rep (Date);
|
|
|
802 begin
|
|
|
803 return Time (Date_N + Time_Rep (Days) * Nanos_In_Day);
|
|
|
804 exception
|
|
|
805 when Constraint_Error =>
|
|
|
806 raise Time_Error;
|
|
|
807 end Add;
|
|
|
808
|
|
|
809 ----------------
|
|
|
810 -- Difference --
|
|
|
811 ----------------
|
|
|
812
|
|
|
813 procedure Difference
|
|
|
814 (Left : Time;
|
|
|
815 Right : Time;
|
|
|
816 Days : out Long_Integer;
|
|
|
817 Seconds : out Duration;
|
|
|
818 Leap_Seconds : out Integer)
|
|
|
819 is
|
|
|
820 Res_Dur : Time_Dur;
|
|
|
821 Earlier : Time_Rep;
|
|
|
822 Elapsed_Leaps : Natural;
|
|
|
823 Later : Time_Rep;
|
|
|
824 Negate : Boolean := False;
|
|
|
825 Next_Leap_N : Time_Rep;
|
|
|
826 Sub_Secs : Duration;
|
|
|
827 Sub_Secs_Diff : Time_Rep;
|
|
|
828
|
|
|
829 begin
|
|
|
830 -- Both input time values are assumed to be in UTC
|
|
|
831
|
|
|
832 if Left >= Right then
|
|
|
833 Later := Time_Rep (Left);
|
|
|
834 Earlier := Time_Rep (Right);
|
|
|
835 else
|
|
|
836 Later := Time_Rep (Right);
|
|
|
837 Earlier := Time_Rep (Left);
|
|
|
838 Negate := True;
|
|
|
839 end if;
|
|
|
840
|
|
|
841 -- If the target supports leap seconds, process them
|
|
|
842
|
|
|
843 if Leap_Support then
|
|
|
844 Cumulative_Leap_Seconds
|
|
|
845 (Earlier, Later, Elapsed_Leaps, Next_Leap_N);
|
|
|
846
|
|
|
847 if Later >= Next_Leap_N then
|
|
|
848 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
849 end if;
|
|
|
850
|
|
|
851 -- The target does not support leap seconds
|
|
|
852
|
|
|
853 else
|
|
|
854 Elapsed_Leaps := 0;
|
|
|
855 end if;
|
|
|
856
|
|
|
857 -- Sub seconds processing. We add the resulting difference to one
|
|
|
858 -- of the input dates in order to account for any potential rounding
|
|
|
859 -- of the difference in the next step.
|
|
|
860
|
|
|
861 Sub_Secs_Diff := Later mod Nano - Earlier mod Nano;
|
|
|
862 Earlier := Earlier + Sub_Secs_Diff;
|
|
|
863 Sub_Secs := Duration (Sub_Secs_Diff) / Nano_F;
|
|
|
864
|
|
|
865 -- Difference processing. This operation should be able to calculate
|
|
|
866 -- the difference between opposite values which are close to the end
|
|
|
867 -- and start of Ada time. To accommodate the large range, we convert
|
|
|
868 -- to seconds. This action may potentially round the two values and
|
|
|
869 -- either add or drop a second. We compensate for this issue in the
|
|
|
870 -- previous step.
|
|
|
871
|
|
|
872 Res_Dur :=
|
|
|
873 Time_Dur (Later / Nano - Earlier / Nano) - Time_Dur (Elapsed_Leaps);
|
|
|
874
|
|
|
875 Days := Long_Integer (Res_Dur / Secs_In_Day);
|
|
|
876 Seconds := Duration (Res_Dur mod Secs_In_Day) + Sub_Secs;
|
|
|
877 Leap_Seconds := Integer (Elapsed_Leaps);
|
|
|
878
|
|
|
879 if Negate then
|
|
|
880 Days := -Days;
|
|
|
881 Seconds := -Seconds;
|
|
|
882
|
|
|
883 if Leap_Seconds /= 0 then
|
|
|
884 Leap_Seconds := -Leap_Seconds;
|
|
|
885 end if;
|
|
|
886 end if;
|
|
|
887 end Difference;
|
|
|
888
|
|
|
889 --------------
|
|
|
890 -- Subtract --
|
|
|
891 --------------
|
|
|
892
|
|
|
893 function Subtract (Date : Time; Days : Long_Integer) return Time is
|
|
|
894 pragma Unsuppress (Overflow_Check);
|
|
|
895 Date_N : constant Time_Rep := Time_Rep (Date);
|
|
|
896 begin
|
|
|
897 return Time (Date_N - Time_Rep (Days) * Nanos_In_Day);
|
|
|
898 exception
|
|
|
899 when Constraint_Error =>
|
|
|
900 raise Time_Error;
|
|
|
901 end Subtract;
|
|
|
902
|
|
|
903 end Arithmetic_Operations;
|
|
|
904
|
|
|
905 ---------------------------
|
|
|
906 -- Conversion_Operations --
|
|
|
907 ---------------------------
|
|
|
908
|
|
|
909 package body Conversion_Operations is
|
|
|
910
|
|
|
911 -----------------
|
|
|
912 -- To_Ada_Time --
|
|
|
913 -----------------
|
|
|
914
|
|
|
915 function To_Ada_Time (Unix_Time : Long_Integer) return Time is
|
|
|
916 pragma Unsuppress (Overflow_Check);
|
|
|
917 Unix_Rep : constant Time_Rep := Time_Rep (Unix_Time) * Nano;
|
|
|
918 begin
|
|
|
919 return Time (Unix_Rep - Epoch_Offset);
|
|
|
920 exception
|
|
|
921 when Constraint_Error =>
|
|
|
922 raise Time_Error;
|
|
|
923 end To_Ada_Time;
|
|
|
924
|
|
|
925 -----------------
|
|
|
926 -- To_Ada_Time --
|
|
|
927 -----------------
|
|
|
928
|
|
|
929 function To_Ada_Time
|
|
|
930 (tm_year : Integer;
|
|
|
931 tm_mon : Integer;
|
|
|
932 tm_day : Integer;
|
|
|
933 tm_hour : Integer;
|
|
|
934 tm_min : Integer;
|
|
|
935 tm_sec : Integer;
|
|
|
936 tm_isdst : Integer) return Time
|
|
|
937 is
|
|
|
938 pragma Unsuppress (Overflow_Check);
|
|
|
939 Year : Year_Number;
|
|
|
940 Month : Month_Number;
|
|
|
941 Day : Day_Number;
|
|
|
942 Second : Integer;
|
|
|
943 Leap : Boolean;
|
|
|
944 Result : Time_Rep;
|
|
|
945
|
|
|
946 begin
|
|
|
947 -- Input processing
|
|
|
948
|
|
|
949 Year := Year_Number (1900 + tm_year);
|
|
|
950 Month := Month_Number (1 + tm_mon);
|
|
|
951 Day := Day_Number (tm_day);
|
|
|
952
|
|
|
953 -- Step 1: Validity checks of input values
|
|
|
954
|
|
|
955 if not Year'Valid or else not Month'Valid or else not Day'Valid
|
|
|
956 or else tm_hour not in 0 .. 24
|
|
|
957 or else tm_min not in 0 .. 59
|
|
|
958 or else tm_sec not in 0 .. 60
|
|
|
959 or else tm_isdst not in -1 .. 1
|
|
|
960 then
|
|
|
961 raise Time_Error;
|
|
|
962 end if;
|
|
|
963
|
|
|
964 -- Step 2: Potential leap second
|
|
|
965
|
|
|
966 if tm_sec = 60 then
|
|
|
967 Leap := True;
|
|
|
968 Second := 59;
|
|
|
969 else
|
|
|
970 Leap := False;
|
|
|
971 Second := tm_sec;
|
|
|
972 end if;
|
|
|
973
|
|
|
974 -- Step 3: Calculate the time value
|
|
|
975
|
|
|
976 Result :=
|
|
|
977 Time_Rep
|
|
|
978 (Formatting_Operations.Time_Of
|
|
|
979 (Year => Year,
|
|
|
980 Month => Month,
|
|
|
981 Day => Day,
|
|
|
982 Day_Secs => 0.0, -- Time is given in h:m:s
|
|
|
983 Hour => tm_hour,
|
|
|
984 Minute => tm_min,
|
|
|
985 Second => Second,
|
|
|
986 Sub_Sec => 0.0, -- No precise sub second given
|
|
|
987 Leap_Sec => Leap,
|
|
|
988 Use_Day_Secs => False, -- Time is given in h:m:s
|
|
|
989 Use_TZ => True, -- Force usage of explicit time zone
|
|
|
990 Is_Historic => True,
|
|
|
991 Time_Zone => 0)); -- Place the value in UTC
|
|
|
992
|
|
|
993 -- Step 4: Daylight Savings Time
|
|
|
994
|
|
|
995 if tm_isdst = 1 then
|
|
|
996 Result := Result + Time_Rep (3_600) * Nano;
|
|
|
997 end if;
|
|
|
998
|
|
|
999 return Time (Result);
|
|
|
1000
|
|
|
1001 exception
|
|
|
1002 when Constraint_Error =>
|
|
|
1003 raise Time_Error;
|
|
|
1004 end To_Ada_Time;
|
|
|
1005
|
|
|
1006 -----------------
|
|
|
1007 -- To_Duration --
|
|
|
1008 -----------------
|
|
|
1009
|
|
|
1010 function To_Duration
|
|
|
1011 (tv_sec : Long_Integer;
|
|
|
1012 tv_nsec : Long_Integer) return Duration
|
|
|
1013 is
|
|
|
1014 pragma Unsuppress (Overflow_Check);
|
|
|
1015 begin
|
|
|
1016 return Duration (tv_sec) + Duration (tv_nsec) / Nano_F;
|
|
|
1017 end To_Duration;
|
|
|
1018
|
|
|
1019 ------------------------
|
|
|
1020 -- To_Struct_Timespec --
|
|
|
1021 ------------------------
|
|
|
1022
|
|
|
1023 procedure To_Struct_Timespec
|
|
|
1024 (D : Duration;
|
|
|
1025 tv_sec : out Long_Integer;
|
|
|
1026 tv_nsec : out Long_Integer)
|
|
|
1027 is
|
|
|
1028 pragma Unsuppress (Overflow_Check);
|
|
|
1029 Secs : Duration;
|
|
|
1030 Nano_Secs : Duration;
|
|
|
1031
|
|
|
1032 begin
|
|
|
1033 -- Seconds extraction, avoid potential rounding errors
|
|
|
1034
|
|
|
1035 Secs := D - 0.5;
|
|
|
1036 tv_sec := Long_Integer (Secs);
|
|
|
1037
|
|
|
1038 -- Nanoseconds extraction
|
|
|
1039
|
|
|
1040 Nano_Secs := D - Duration (tv_sec);
|
|
|
1041 tv_nsec := Long_Integer (Nano_Secs * Nano);
|
|
|
1042 end To_Struct_Timespec;
|
|
|
1043
|
|
|
1044 ------------------
|
|
|
1045 -- To_Struct_Tm --
|
|
|
1046 ------------------
|
|
|
1047
|
|
|
1048 procedure To_Struct_Tm
|
|
|
1049 (T : Time;
|
|
|
1050 tm_year : out Integer;
|
|
|
1051 tm_mon : out Integer;
|
|
|
1052 tm_day : out Integer;
|
|
|
1053 tm_hour : out Integer;
|
|
|
1054 tm_min : out Integer;
|
|
|
1055 tm_sec : out Integer)
|
|
|
1056 is
|
|
|
1057 pragma Unsuppress (Overflow_Check);
|
|
|
1058 Year : Year_Number;
|
|
|
1059 Month : Month_Number;
|
|
|
1060 Second : Integer;
|
|
|
1061 Day_Secs : Day_Duration;
|
|
|
1062 Sub_Sec : Duration;
|
|
|
1063 Leap_Sec : Boolean;
|
|
|
1064
|
|
|
1065 begin
|
|
|
1066 -- Step 1: Split the input time
|
|
|
1067
|
|
|
1068 Formatting_Operations.Split
|
|
|
1069 (Date => T,
|
|
|
1070 Year => Year,
|
|
|
1071 Month => Month,
|
|
|
1072 Day => tm_day,
|
|
|
1073 Day_Secs => Day_Secs,
|
|
|
1074 Hour => tm_hour,
|
|
|
1075 Minute => tm_min,
|
|
|
1076 Second => Second,
|
|
|
1077 Sub_Sec => Sub_Sec,
|
|
|
1078 Leap_Sec => Leap_Sec,
|
|
|
1079 Use_TZ => True,
|
|
|
1080 Is_Historic => False,
|
|
|
1081 Time_Zone => 0);
|
|
|
1082
|
|
|
1083 -- Step 2: Correct the year and month
|
|
|
1084
|
|
|
1085 tm_year := Year - 1900;
|
|
|
1086 tm_mon := Month - 1;
|
|
|
1087
|
|
|
1088 -- Step 3: Handle leap second occurrences
|
|
|
1089
|
|
|
1090 tm_sec := (if Leap_Sec then 60 else Second);
|
|
|
1091 end To_Struct_Tm;
|
|
|
1092
|
|
|
1093 ------------------
|
|
|
1094 -- To_Unix_Time --
|
|
|
1095 ------------------
|
|
|
1096
|
|
|
1097 function To_Unix_Time (Ada_Time : Time) return Long_Integer is
|
|
|
1098 pragma Unsuppress (Overflow_Check);
|
|
|
1099 Ada_Rep : constant Time_Rep := Time_Rep (Ada_Time);
|
|
|
1100 begin
|
|
|
1101 return Long_Integer ((Ada_Rep + Epoch_Offset) / Nano);
|
|
|
1102 exception
|
|
|
1103 when Constraint_Error =>
|
|
|
1104 raise Time_Error;
|
|
|
1105 end To_Unix_Time;
|
|
|
1106 end Conversion_Operations;
|
|
|
1107
|
|
|
1108 ----------------------
|
|
|
1109 -- Delay_Operations --
|
|
|
1110 ----------------------
|
|
|
1111
|
|
|
1112 package body Delay_Operations is
|
|
|
1113
|
|
|
1114 -----------------
|
|
|
1115 -- To_Duration --
|
|
|
1116 -----------------
|
|
|
1117
|
|
|
1118 function To_Duration (Date : Time) return Duration is
|
|
|
1119 pragma Unsuppress (Overflow_Check);
|
|
|
1120
|
|
|
1121 Safe_Ada_High : constant Time_Rep := Ada_High - Epoch_Offset;
|
|
|
1122 -- This value represents a "safe" end of time. In order to perform a
|
|
|
1123 -- proper conversion to Unix duration, we will have to shift origins
|
|
|
1124 -- at one point. For very distant dates, this means an overflow check
|
|
|
1125 -- failure. To prevent this, the function returns the "safe" end of
|
|
|
1126 -- time (roughly 2219) which is still distant enough.
|
|
|
1127
|
|
|
1128 Elapsed_Leaps : Natural;
|
|
|
1129 Next_Leap_N : Time_Rep;
|
|
|
1130 Res_N : Time_Rep;
|
|
|
1131
|
|
|
1132 begin
|
|
|
1133 Res_N := Time_Rep (Date);
|
|
|
1134
|
|
|
1135 -- Step 1: If the target supports leap seconds, remove any leap
|
|
|
1136 -- seconds elapsed up to the input date.
|
|
|
1137
|
|
|
1138 if Leap_Support then
|
|
|
1139 Cumulative_Leap_Seconds
|
|
|
1140 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
1141
|
|
|
1142 -- The input time value may fall on a leap second occurrence
|
|
|
1143
|
|
|
1144 if Res_N >= Next_Leap_N then
|
|
|
1145 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
1146 end if;
|
|
|
1147
|
|
|
1148 -- The target does not support leap seconds
|
|
|
1149
|
|
|
1150 else
|
|
|
1151 Elapsed_Leaps := 0;
|
|
|
1152 end if;
|
|
|
1153
|
|
|
1154 Res_N := Res_N - Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
1155
|
|
|
1156 -- Step 2: Perform a shift in origins to obtain a Unix equivalent of
|
|
|
1157 -- the input. Guard against very large delay values such as the end
|
|
|
1158 -- of time since the computation will overflow.
|
|
|
1159
|
|
|
1160 Res_N := (if Res_N > Safe_Ada_High then Safe_Ada_High
|
|
|
1161 else Res_N + Epoch_Offset);
|
|
|
1162
|
|
|
1163 return Time_Rep_To_Duration (Res_N);
|
|
|
1164 end To_Duration;
|
|
|
1165
|
|
|
1166 end Delay_Operations;
|
|
|
1167
|
|
|
1168 ---------------------------
|
|
|
1169 -- Formatting_Operations --
|
|
|
1170 ---------------------------
|
|
|
1171
|
|
|
1172 package body Formatting_Operations is
|
|
|
1173
|
|
|
1174 -----------------
|
|
|
1175 -- Day_Of_Week --
|
|
|
1176 -----------------
|
|
|
1177
|
|
|
1178 function Day_Of_Week (Date : Time) return Integer is
|
|
|
1179 Date_N : constant Time_Rep := Time_Rep (Date);
|
|
|
1180 Time_Zone : constant Long_Integer := UTC_Time_Offset (Date, True);
|
|
|
1181 Ada_Low_N : Time_Rep;
|
|
|
1182 Day_Count : Long_Integer;
|
|
|
1183 Day_Dur : Time_Dur;
|
|
|
1184 High_N : Time_Rep;
|
|
|
1185 Low_N : Time_Rep;
|
|
|
1186
|
|
|
1187 begin
|
|
|
1188 -- As declared, the Ada Epoch is set in UTC. For this calculation to
|
|
|
1189 -- work properly, both the Epoch and the input date must be in the
|
|
|
1190 -- same time zone. The following places the Epoch in the input date's
|
|
|
1191 -- time zone.
|
|
|
1192
|
|
|
1193 Ada_Low_N := Ada_Low - Time_Rep (Time_Zone) * Nano;
|
|
|
1194
|
|
|
1195 if Date_N > Ada_Low_N then
|
|
|
1196 High_N := Date_N;
|
|
|
1197 Low_N := Ada_Low_N;
|
|
|
1198 else
|
|
|
1199 High_N := Ada_Low_N;
|
|
|
1200 Low_N := Date_N;
|
|
|
1201 end if;
|
|
|
1202
|
|
|
1203 -- Determine the elapsed seconds since the start of Ada time
|
|
|
1204
|
|
|
1205 Day_Dur := Time_Dur (High_N / Nano - Low_N / Nano);
|
|
|
1206
|
|
|
1207 -- Count the number of days since the start of Ada time. 1901-01-01
|
|
|
1208 -- GMT was a Tuesday.
|
|
|
1209
|
|
|
1210 Day_Count := Long_Integer (Day_Dur / Secs_In_Day) + 1;
|
|
|
1211
|
|
|
1212 return Integer (Day_Count mod 7);
|
|
|
1213 end Day_Of_Week;
|
|
|
1214
|
|
|
1215 -----------
|
|
|
1216 -- Split --
|
|
|
1217 -----------
|
|
|
1218
|
|
|
1219 procedure Split
|
|
|
1220 (Date : Time;
|
|
|
1221 Year : out Year_Number;
|
|
|
1222 Month : out Month_Number;
|
|
|
1223 Day : out Day_Number;
|
|
|
1224 Day_Secs : out Day_Duration;
|
|
|
1225 Hour : out Integer;
|
|
|
1226 Minute : out Integer;
|
|
|
1227 Second : out Integer;
|
|
|
1228 Sub_Sec : out Duration;
|
|
|
1229 Leap_Sec : out Boolean;
|
|
|
1230 Use_TZ : Boolean;
|
|
|
1231 Is_Historic : Boolean;
|
|
|
1232 Time_Zone : Long_Integer)
|
|
|
1233 is
|
|
|
1234 -- The following constants represent the number of nanoseconds
|
|
|
1235 -- elapsed since the start of Ada time to and including the non
|
|
|
1236 -- leap centennial years.
|
|
|
1237
|
|
|
1238 Year_2101 : constant Time_Rep := Ada_Low +
|
|
|
1239 Time_Rep (49 * 366 + 151 * 365) * Nanos_In_Day;
|
|
|
1240 Year_2201 : constant Time_Rep := Ada_Low +
|
|
|
1241 Time_Rep (73 * 366 + 227 * 365) * Nanos_In_Day;
|
|
|
1242 Year_2301 : constant Time_Rep := Ada_Low +
|
|
|
1243 Time_Rep (97 * 366 + 303 * 365) * Nanos_In_Day;
|
|
|
1244
|
|
|
1245 Date_Dur : Time_Dur;
|
|
|
1246 Date_N : Time_Rep;
|
|
|
1247 Day_Seconds : Natural;
|
|
|
1248 Elapsed_Leaps : Natural;
|
|
|
1249 Four_Year_Segs : Natural;
|
|
|
1250 Hour_Seconds : Natural;
|
|
|
1251 Is_Leap_Year : Boolean;
|
|
|
1252 Next_Leap_N : Time_Rep;
|
|
|
1253 Rem_Years : Natural;
|
|
|
1254 Sub_Sec_N : Time_Rep;
|
|
|
1255 Year_Day : Natural;
|
|
|
1256
|
|
|
1257 begin
|
|
|
1258 Date_N := Time_Rep (Date);
|
|
|
1259
|
|
|
1260 -- Step 1: Leap seconds processing in UTC
|
|
|
1261
|
|
|
1262 if Leap_Support then
|
|
|
1263 Cumulative_Leap_Seconds
|
|
|
1264 (Start_Of_Time, Date_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
1265
|
|
|
1266 Leap_Sec := Date_N >= Next_Leap_N;
|
|
|
1267
|
|
|
1268 if Leap_Sec then
|
|
|
1269 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
1270 end if;
|
|
|
1271
|
|
|
1272 -- The target does not support leap seconds
|
|
|
1273
|
|
|
1274 else
|
|
|
1275 Elapsed_Leaps := 0;
|
|
|
1276 Leap_Sec := False;
|
|
|
1277 end if;
|
|
|
1278
|
|
|
1279 Date_N := Date_N - Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
1280
|
|
|
1281 -- Step 2: Time zone processing. This action converts the input date
|
|
|
1282 -- from GMT to the requested time zone. Applies from Ada 2005 on.
|
|
|
1283
|
|
|
1284 if Use_TZ then
|
|
|
1285 if Time_Zone /= 0 then
|
|
|
1286 Date_N := Date_N + Time_Rep (Time_Zone) * 60 * Nano;
|
|
|
1287 end if;
|
|
|
1288
|
|
|
1289 -- Ada 83 and 95
|
|
|
1290
|
|
|
1291 else
|
|
|
1292 declare
|
|
|
1293 Off : constant Long_Integer :=
|
|
|
1294 UTC_Time_Offset (Time (Date_N), Is_Historic);
|
|
|
1295
|
|
|
1296 begin
|
|
|
1297 Date_N := Date_N + Time_Rep (Off) * Nano;
|
|
|
1298 end;
|
|
|
1299 end if;
|
|
|
1300
|
|
|
1301 -- Step 3: Non-leap centennial year adjustment in local time zone
|
|
|
1302
|
|
|
1303 -- In order for all divisions to work properly and to avoid more
|
|
|
1304 -- complicated arithmetic, we add fake February 29s to dates which
|
|
|
1305 -- occur after a non-leap centennial year.
|
|
|
1306
|
|
|
1307 if Date_N >= Year_2301 then
|
|
|
1308 Date_N := Date_N + Time_Rep (3) * Nanos_In_Day;
|
|
|
1309
|
|
|
1310 elsif Date_N >= Year_2201 then
|
|
|
1311 Date_N := Date_N + Time_Rep (2) * Nanos_In_Day;
|
|
|
1312
|
|
|
1313 elsif Date_N >= Year_2101 then
|
|
|
1314 Date_N := Date_N + Time_Rep (1) * Nanos_In_Day;
|
|
|
1315 end if;
|
|
|
1316
|
|
|
1317 -- Step 4: Sub second processing in local time zone
|
|
|
1318
|
|
|
1319 Sub_Sec_N := Date_N mod Nano;
|
|
|
1320 Sub_Sec := Duration (Sub_Sec_N) / Nano_F;
|
|
|
1321 Date_N := Date_N - Sub_Sec_N;
|
|
|
1322
|
|
|
1323 -- Convert Date_N into a time duration value, changing the units
|
|
|
1324 -- to seconds.
|
|
|
1325
|
|
|
1326 Date_Dur := Time_Dur (Date_N / Nano - Ada_Low / Nano);
|
|
|
1327
|
|
|
1328 -- Step 5: Year processing in local time zone. Determine the number
|
|
|
1329 -- of four year segments since the start of Ada time and the input
|
|
|
1330 -- date.
|
|
|
1331
|
|
|
1332 Four_Year_Segs := Natural (Date_Dur / Secs_In_Four_Years);
|
|
|
1333
|
|
|
1334 if Four_Year_Segs > 0 then
|
|
|
1335 Date_Dur := Date_Dur - Time_Dur (Four_Year_Segs) *
|
|
|
1336 Secs_In_Four_Years;
|
|
|
1337 end if;
|
|
|
1338
|
|
|
1339 -- Calculate the remaining non-leap years
|
|
|
1340
|
|
|
1341 Rem_Years := Natural (Date_Dur / Secs_In_Non_Leap_Year);
|
|
|
1342
|
|
|
1343 if Rem_Years > 3 then
|
|
|
1344 Rem_Years := 3;
|
|
|
1345 end if;
|
|
|
1346
|
|
|
1347 Date_Dur := Date_Dur - Time_Dur (Rem_Years) * Secs_In_Non_Leap_Year;
|
|
|
1348
|
|
|
1349 Year := Ada_Min_Year + Natural (4 * Four_Year_Segs + Rem_Years);
|
|
|
1350 Is_Leap_Year := Is_Leap (Year);
|
|
|
1351
|
|
|
1352 -- Step 6: Month and day processing in local time zone
|
|
|
1353
|
|
|
1354 Year_Day := Natural (Date_Dur / Secs_In_Day) + 1;
|
|
|
1355
|
|
|
1356 Month := 1;
|
|
|
1357
|
|
|
1358 -- Processing for months after January
|
|
|
1359
|
|
|
1360 if Year_Day > 31 then
|
|
|
1361 Month := 2;
|
|
|
1362 Year_Day := Year_Day - 31;
|
|
|
1363
|
|
|
1364 -- Processing for a new month or a leap February
|
|
|
1365
|
|
|
1366 if Year_Day > 28
|
|
|
1367 and then (not Is_Leap_Year or else Year_Day > 29)
|
|
|
1368 then
|
|
|
1369 Month := 3;
|
|
|
1370 Year_Day := Year_Day - 28;
|
|
|
1371
|
|
|
1372 if Is_Leap_Year then
|
|
|
1373 Year_Day := Year_Day - 1;
|
|
|
1374 end if;
|
|
|
1375
|
|
|
1376 -- Remaining months
|
|
|
1377
|
|
|
1378 while Year_Day > Days_In_Month (Month) loop
|
|
|
1379 Year_Day := Year_Day - Days_In_Month (Month);
|
|
|
1380 Month := Month + 1;
|
|
|
1381 end loop;
|
|
|
1382 end if;
|
|
|
1383 end if;
|
|
|
1384
|
|
|
1385 -- Step 7: Hour, minute, second and sub second processing in local
|
|
|
1386 -- time zone.
|
|
|
1387
|
|
|
1388 Day := Day_Number (Year_Day);
|
|
|
1389 Day_Seconds := Integer (Date_Dur mod Secs_In_Day);
|
|
|
1390 Day_Secs := Duration (Day_Seconds) + Sub_Sec;
|
|
|
1391 Hour := Day_Seconds / 3_600;
|
|
|
1392 Hour_Seconds := Day_Seconds mod 3_600;
|
|
|
1393 Minute := Hour_Seconds / 60;
|
|
|
1394 Second := Hour_Seconds mod 60;
|
|
|
1395
|
|
|
1396 exception
|
|
|
1397 when Constraint_Error =>
|
|
|
1398 raise Time_Error;
|
|
|
1399 end Split;
|
|
|
1400
|
|
|
1401 -------------
|
|
|
1402 -- Time_Of --
|
|
|
1403 -------------
|
|
|
1404
|
|
|
1405 function Time_Of
|
|
|
1406 (Year : Year_Number;
|
|
|
1407 Month : Month_Number;
|
|
|
1408 Day : Day_Number;
|
|
|
1409 Day_Secs : Day_Duration;
|
|
|
1410 Hour : Integer;
|
|
|
1411 Minute : Integer;
|
|
|
1412 Second : Integer;
|
|
|
1413 Sub_Sec : Duration;
|
|
|
1414 Leap_Sec : Boolean;
|
|
|
1415 Use_Day_Secs : Boolean;
|
|
|
1416 Use_TZ : Boolean;
|
|
|
1417 Is_Historic : Boolean;
|
|
|
1418 Time_Zone : Long_Integer) return Time
|
|
|
1419 is
|
|
|
1420 Count : Integer;
|
|
|
1421 Elapsed_Leaps : Natural;
|
|
|
1422 Next_Leap_N : Time_Rep;
|
|
|
1423 Res_N : Time_Rep;
|
|
|
1424 Rounded_Res_N : Time_Rep;
|
|
|
1425
|
|
|
1426 begin
|
|
|
1427 -- Step 1: Check whether the day, month and year form a valid date
|
|
|
1428
|
|
|
1429 if Day > Days_In_Month (Month)
|
|
|
1430 and then (Day /= 29 or else Month /= 2 or else not Is_Leap (Year))
|
|
|
1431 then
|
|
|
1432 raise Time_Error;
|
|
|
1433 end if;
|
|
|
1434
|
|
|
1435 -- Start accumulating nanoseconds from the low bound of Ada time
|
|
|
1436
|
|
|
1437 Res_N := Ada_Low;
|
|
|
1438
|
|
|
1439 -- Step 2: Year processing and centennial year adjustment. Determine
|
|
|
1440 -- the number of four year segments since the start of Ada time and
|
|
|
1441 -- the input date.
|
|
|
1442
|
|
|
1443 Count := (Year - Year_Number'First) / 4;
|
|
|
1444
|
|
|
1445 for Four_Year_Segments in 1 .. Count loop
|
|
|
1446 Res_N := Res_N + Nanos_In_Four_Years;
|
|
|
1447 end loop;
|
|
|
1448
|
|
|
1449 -- Note that non-leap centennial years are automatically considered
|
|
|
1450 -- leap in the operation above. An adjustment of several days is
|
|
|
1451 -- required to compensate for this.
|
|
|
1452
|
|
|
1453 if Year > 2300 then
|
|
|
1454 Res_N := Res_N - Time_Rep (3) * Nanos_In_Day;
|
|
|
1455
|
|
|
1456 elsif Year > 2200 then
|
|
|
1457 Res_N := Res_N - Time_Rep (2) * Nanos_In_Day;
|
|
|
1458
|
|
|
1459 elsif Year > 2100 then
|
|
|
1460 Res_N := Res_N - Time_Rep (1) * Nanos_In_Day;
|
|
|
1461 end if;
|
|
|
1462
|
|
|
1463 -- Add the remaining non-leap years
|
|
|
1464
|
|
|
1465 Count := (Year - Year_Number'First) mod 4;
|
|
|
1466 Res_N := Res_N + Time_Rep (Count) * Secs_In_Non_Leap_Year * Nano;
|
|
|
1467
|
|
|
1468 -- Step 3: Day of month processing. Determine the number of days
|
|
|
1469 -- since the start of the current year. Do not add the current
|
|
|
1470 -- day since it has not elapsed yet.
|
|
|
1471
|
|
|
1472 Count := Cumulative_Days_Before_Month (Month) + Day - 1;
|
|
|
1473
|
|
|
1474 -- The input year is leap and we have passed February
|
|
|
1475
|
|
|
1476 if Is_Leap (Year)
|
|
|
1477 and then Month > 2
|
|
|
1478 then
|
|
|
1479 Count := Count + 1;
|
|
|
1480 end if;
|
|
|
1481
|
|
|
1482 Res_N := Res_N + Time_Rep (Count) * Nanos_In_Day;
|
|
|
1483
|
|
|
1484 -- Step 4: Hour, minute, second and sub second processing
|
|
|
1485
|
|
|
1486 if Use_Day_Secs then
|
|
|
1487 Res_N := Res_N + Duration_To_Time_Rep (Day_Secs);
|
|
|
1488
|
|
|
1489 else
|
|
|
1490 Res_N :=
|
|
|
1491 Res_N + Time_Rep (Hour * 3_600 + Minute * 60 + Second) * Nano;
|
|
|
1492
|
|
|
1493 if Sub_Sec = 1.0 then
|
|
|
1494 Res_N := Res_N + Time_Rep (1) * Nano;
|
|
|
1495 else
|
|
|
1496 Res_N := Res_N + Duration_To_Time_Rep (Sub_Sec);
|
|
|
1497 end if;
|
|
|
1498 end if;
|
|
|
1499
|
|
|
1500 -- At this point, the generated time value should be withing the
|
|
|
1501 -- bounds of Ada time.
|
|
|
1502
|
|
|
1503 Check_Within_Time_Bounds (Res_N);
|
|
|
1504
|
|
|
1505 -- Step 4: Time zone processing. At this point we have built an
|
|
|
1506 -- arbitrary time value which is not related to any time zone.
|
|
|
1507 -- For simplicity, the time value is normalized to GMT, producing
|
|
|
1508 -- a uniform representation which can be treated by arithmetic
|
|
|
1509 -- operations for instance without any additional corrections.
|
|
|
1510
|
|
|
1511 if Use_TZ then
|
|
|
1512 if Time_Zone /= 0 then
|
|
|
1513 Res_N := Res_N - Time_Rep (Time_Zone) * 60 * Nano;
|
|
|
1514 end if;
|
|
|
1515
|
|
|
1516 -- Ada 83 and 95
|
|
|
1517
|
|
|
1518 else
|
|
|
1519 declare
|
|
|
1520 Cur_Off : constant Long_Integer :=
|
|
|
1521 UTC_Time_Offset (Time (Res_N), Is_Historic);
|
|
|
1522 Cur_Res_N : constant Time_Rep :=
|
|
|
1523 Res_N - Time_Rep (Cur_Off) * Nano;
|
|
|
1524 Off : constant Long_Integer :=
|
|
|
1525 UTC_Time_Offset (Time (Cur_Res_N), Is_Historic);
|
|
|
1526
|
|
|
1527 begin
|
|
|
1528 Res_N := Res_N - Time_Rep (Off) * Nano;
|
|
|
1529 end;
|
|
|
1530 end if;
|
|
|
1531
|
|
|
1532 -- Step 5: Leap seconds processing in GMT
|
|
|
1533
|
|
|
1534 if Leap_Support then
|
|
|
1535 Cumulative_Leap_Seconds
|
|
|
1536 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
1537
|
|
|
1538 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
1539
|
|
|
1540 -- An Ada 2005 caller requesting an explicit leap second or an
|
|
|
1541 -- Ada 95 caller accounting for an invisible leap second.
|
|
|
1542
|
|
|
1543 if Leap_Sec or else Res_N >= Next_Leap_N then
|
|
|
1544 Res_N := Res_N + Time_Rep (1) * Nano;
|
|
|
1545 end if;
|
|
|
1546
|
|
|
1547 -- Leap second validity check
|
|
|
1548
|
|
|
1549 Rounded_Res_N := Res_N - (Res_N mod Nano);
|
|
|
1550
|
|
|
1551 if Use_TZ
|
|
|
1552 and then Leap_Sec
|
|
|
1553 and then Rounded_Res_N /= Next_Leap_N
|
|
|
1554 then
|
|
|
1555 raise Time_Error;
|
|
|
1556 end if;
|
|
|
1557 end if;
|
|
|
1558
|
|
|
1559 return Time (Res_N);
|
|
|
1560 end Time_Of;
|
|
|
1561
|
|
|
1562 end Formatting_Operations;
|
|
|
1563
|
|
|
1564 ---------------------------
|
|
|
1565 -- Time_Zones_Operations --
|
|
|
1566 ---------------------------
|
|
|
1567
|
|
|
1568 package body Time_Zones_Operations is
|
|
|
1569
|
|
|
1570 ---------------------
|
|
|
1571 -- UTC_Time_Offset --
|
|
|
1572 ---------------------
|
|
|
1573
|
|
|
1574 function UTC_Time_Offset (Date : Time) return Long_Integer is
|
|
|
1575 begin
|
|
|
1576 return UTC_Time_Offset (Date, True);
|
|
|
1577 end UTC_Time_Offset;
|
|
|
1578
|
|
|
1579 end Time_Zones_Operations;
|
|
|
1580
|
|
|
1581 -- Start of elaboration code for Ada.Calendar
|
|
|
1582
|
|
|
1583 begin
|
|
|
1584 System.OS_Primitives.Initialize;
|
|
|
1585
|
|
|
1586 end Ada.Calendar;
|
