|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T . C A L E N D A R --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1999-2018, AdaCore --
|
|
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 Interfaces.C.Extensions;
|
|
|
33
|
|
|
34 package body GNAT.Calendar is
|
|
|
35 use Ada.Calendar;
|
|
|
36 use Interfaces;
|
|
|
37
|
|
|
38 -----------------
|
|
|
39 -- Day_In_Year --
|
|
|
40 -----------------
|
|
|
41
|
|
|
42 function Day_In_Year (Date : Time) return Day_In_Year_Number is
|
|
|
43 Year : Year_Number;
|
|
|
44 Month : Month_Number;
|
|
|
45 Day : Day_Number;
|
|
|
46 Day_Secs : Day_Duration;
|
|
|
47 pragma Unreferenced (Day_Secs);
|
|
|
48 begin
|
|
|
49 Split (Date, Year, Month, Day, Day_Secs);
|
|
|
50 return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1;
|
|
|
51 end Day_In_Year;
|
|
|
52
|
|
|
53 -----------------
|
|
|
54 -- Day_Of_Week --
|
|
|
55 -----------------
|
|
|
56
|
|
|
57 function Day_Of_Week (Date : Time) return Day_Name is
|
|
|
58 Year : Year_Number;
|
|
|
59 Month : Month_Number;
|
|
|
60 Day : Day_Number;
|
|
|
61 Day_Secs : Day_Duration;
|
|
|
62 pragma Unreferenced (Day_Secs);
|
|
|
63 begin
|
|
|
64 Split (Date, Year, Month, Day, Day_Secs);
|
|
|
65 return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7);
|
|
|
66 end Day_Of_Week;
|
|
|
67
|
|
|
68 ----------
|
|
|
69 -- Hour --
|
|
|
70 ----------
|
|
|
71
|
|
|
72 function Hour (Date : Time) return Hour_Number is
|
|
|
73 Year : Year_Number;
|
|
|
74 Month : Month_Number;
|
|
|
75 Day : Day_Number;
|
|
|
76 Hour : Hour_Number;
|
|
|
77 Minute : Minute_Number;
|
|
|
78 Second : Second_Number;
|
|
|
79 Sub_Second : Second_Duration;
|
|
|
80 pragma Unreferenced (Year, Month, Day, Minute, Second, Sub_Second);
|
|
|
81 begin
|
|
|
82 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
|
|
|
83 return Hour;
|
|
|
84 end Hour;
|
|
|
85
|
|
|
86 ----------------
|
|
|
87 -- Julian_Day --
|
|
|
88 ----------------
|
|
|
89
|
|
|
90 -- Julian_Day is used to by Day_Of_Week and Day_In_Year. Note that this
|
|
|
91 -- implementation is not expensive.
|
|
|
92
|
|
|
93 function Julian_Day
|
|
|
94 (Year : Year_Number;
|
|
|
95 Month : Month_Number;
|
|
|
96 Day : Day_Number) return Integer
|
|
|
97 is
|
|
|
98 Internal_Year : Integer;
|
|
|
99 Internal_Month : Integer;
|
|
|
100 Internal_Day : Integer;
|
|
|
101 Julian_Date : Integer;
|
|
|
102 C : Integer;
|
|
|
103 Ya : Integer;
|
|
|
104
|
|
|
105 begin
|
|
|
106 Internal_Year := Integer (Year);
|
|
|
107 Internal_Month := Integer (Month);
|
|
|
108 Internal_Day := Integer (Day);
|
|
|
109
|
|
|
110 if Internal_Month > 2 then
|
|
|
111 Internal_Month := Internal_Month - 3;
|
|
|
112 else
|
|
|
113 Internal_Month := Internal_Month + 9;
|
|
|
114 Internal_Year := Internal_Year - 1;
|
|
|
115 end if;
|
|
|
116
|
|
|
117 C := Internal_Year / 100;
|
|
|
118 Ya := Internal_Year - (100 * C);
|
|
|
119
|
|
|
120 Julian_Date := (146_097 * C) / 4 +
|
|
|
121 (1_461 * Ya) / 4 +
|
|
|
122 (153 * Internal_Month + 2) / 5 +
|
|
|
123 Internal_Day + 1_721_119;
|
|
|
124
|
|
|
125 return Julian_Date;
|
|
|
126 end Julian_Day;
|
|
|
127
|
|
|
128 ------------
|
|
|
129 -- Minute --
|
|
|
130 ------------
|
|
|
131
|
|
|
132 function Minute (Date : Time) return Minute_Number is
|
|
|
133 Year : Year_Number;
|
|
|
134 Month : Month_Number;
|
|
|
135 Day : Day_Number;
|
|
|
136 Hour : Hour_Number;
|
|
|
137 Minute : Minute_Number;
|
|
|
138 Second : Second_Number;
|
|
|
139 Sub_Second : Second_Duration;
|
|
|
140 pragma Unreferenced (Year, Month, Day, Hour, Second, Sub_Second);
|
|
|
141 begin
|
|
|
142 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
|
|
|
143 return Minute;
|
|
|
144 end Minute;
|
|
|
145
|
|
|
146 ------------
|
|
|
147 -- Second --
|
|
|
148 ------------
|
|
|
149
|
|
|
150 function Second (Date : Time) return Second_Number is
|
|
|
151 Year : Year_Number;
|
|
|
152 Month : Month_Number;
|
|
|
153 Day : Day_Number;
|
|
|
154 Hour : Hour_Number;
|
|
|
155 Minute : Minute_Number;
|
|
|
156 Second : Second_Number;
|
|
|
157 Sub_Second : Second_Duration;
|
|
|
158 pragma Unreferenced (Year, Month, Day, Hour, Minute, Sub_Second);
|
|
|
159 begin
|
|
|
160 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
|
|
|
161 return Second;
|
|
|
162 end Second;
|
|
|
163
|
|
|
164 -----------
|
|
|
165 -- Split --
|
|
|
166 -----------
|
|
|
167
|
|
|
168 procedure Split
|
|
|
169 (Date : Time;
|
|
|
170 Year : out Year_Number;
|
|
|
171 Month : out Month_Number;
|
|
|
172 Day : out Day_Number;
|
|
|
173 Hour : out Hour_Number;
|
|
|
174 Minute : out Minute_Number;
|
|
|
175 Second : out Second_Number;
|
|
|
176 Sub_Second : out Second_Duration)
|
|
|
177 is
|
|
|
178 Day_Secs : Day_Duration;
|
|
|
179 Secs : Natural;
|
|
|
180
|
|
|
181 begin
|
|
|
182 Split (Date, Year, Month, Day, Day_Secs);
|
|
|
183
|
|
|
184 Secs := (if Day_Secs = 0.0 then 0 else Natural (Day_Secs - 0.5));
|
|
|
185 Sub_Second := Second_Duration (Day_Secs - Day_Duration (Secs));
|
|
|
186 Hour := Hour_Number (Secs / 3_600);
|
|
|
187 Secs := Secs mod 3_600;
|
|
|
188 Minute := Minute_Number (Secs / 60);
|
|
|
189 Second := Second_Number (Secs mod 60);
|
|
|
190 end Split;
|
|
|
191
|
|
|
192 ---------------------
|
|
|
193 -- Split_At_Locale --
|
|
|
194 ---------------------
|
|
|
195
|
|
|
196 procedure Split_At_Locale
|
|
|
197 (Date : Time;
|
|
|
198 Year : out Year_Number;
|
|
|
199 Month : out Month_Number;
|
|
|
200 Day : out Day_Number;
|
|
|
201 Hour : out Hour_Number;
|
|
|
202 Minute : out Minute_Number;
|
|
|
203 Second : out Second_Number;
|
|
|
204 Sub_Second : out Second_Duration)
|
|
|
205 is
|
|
|
206 procedure Ada_Calendar_Split
|
|
|
207 (Date : Time;
|
|
|
208 Year : out Year_Number;
|
|
|
209 Month : out Month_Number;
|
|
|
210 Day : out Day_Number;
|
|
|
211 Day_Secs : out Day_Duration;
|
|
|
212 Hour : out Integer;
|
|
|
213 Minute : out Integer;
|
|
|
214 Second : out Integer;
|
|
|
215 Sub_Sec : out Duration;
|
|
|
216 Leap_Sec : out Boolean;
|
|
|
217 Use_TZ : Boolean;
|
|
|
218 Is_Historic : Boolean;
|
|
|
219 Time_Zone : Long_Integer);
|
|
|
220 pragma Import (Ada, Ada_Calendar_Split, "__gnat_split");
|
|
|
221
|
|
|
222 Ds : Day_Duration;
|
|
|
223 Le : Boolean;
|
|
|
224
|
|
|
225 pragma Unreferenced (Ds, Le);
|
|
|
226
|
|
|
227 begin
|
|
|
228 -- Even though the input time zone is UTC (0), the flag Use_TZ will
|
|
|
229 -- ensure that Split picks up the local time zone.
|
|
|
230
|
|
|
231 Ada_Calendar_Split
|
|
|
232 (Date => Date,
|
|
|
233 Year => Year,
|
|
|
234 Month => Month,
|
|
|
235 Day => Day,
|
|
|
236 Day_Secs => Ds,
|
|
|
237 Hour => Hour,
|
|
|
238 Minute => Minute,
|
|
|
239 Second => Second,
|
|
|
240 Sub_Sec => Sub_Second,
|
|
|
241 Leap_Sec => Le,
|
|
|
242 Use_TZ => False,
|
|
|
243 Is_Historic => False,
|
|
|
244 Time_Zone => 0);
|
|
|
245 end Split_At_Locale;
|
|
|
246
|
|
|
247 ----------------
|
|
|
248 -- Sub_Second --
|
|
|
249 ----------------
|
|
|
250
|
|
|
251 function Sub_Second (Date : Time) return Second_Duration is
|
|
|
252 Year : Year_Number;
|
|
|
253 Month : Month_Number;
|
|
|
254 Day : Day_Number;
|
|
|
255 Hour : Hour_Number;
|
|
|
256 Minute : Minute_Number;
|
|
|
257 Second : Second_Number;
|
|
|
258 Sub_Second : Second_Duration;
|
|
|
259 pragma Unreferenced (Year, Month, Day, Hour, Minute, Second);
|
|
|
260 begin
|
|
|
261 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
|
|
|
262 return Sub_Second;
|
|
|
263 end Sub_Second;
|
|
|
264
|
|
|
265 -------------
|
|
|
266 -- Time_Of --
|
|
|
267 -------------
|
|
|
268
|
|
|
269 function Time_Of
|
|
|
270 (Year : Year_Number;
|
|
|
271 Month : Month_Number;
|
|
|
272 Day : Day_Number;
|
|
|
273 Hour : Hour_Number;
|
|
|
274 Minute : Minute_Number;
|
|
|
275 Second : Second_Number;
|
|
|
276 Sub_Second : Second_Duration := 0.0) return Time
|
|
|
277 is
|
|
|
278 Day_Secs : constant Day_Duration :=
|
|
|
279 Day_Duration (Hour * 3_600) +
|
|
|
280 Day_Duration (Minute * 60) +
|
|
|
281 Day_Duration (Second) +
|
|
|
282 Sub_Second;
|
|
|
283 begin
|
|
|
284 return Time_Of (Year, Month, Day, Day_Secs);
|
|
|
285 end Time_Of;
|
|
|
286
|
|
|
287 -----------------------
|
|
|
288 -- Time_Of_At_Locale --
|
|
|
289 -----------------------
|
|
|
290
|
|
|
291 function Time_Of_At_Locale
|
|
|
292 (Year : Year_Number;
|
|
|
293 Month : Month_Number;
|
|
|
294 Day : Day_Number;
|
|
|
295 Hour : Hour_Number;
|
|
|
296 Minute : Minute_Number;
|
|
|
297 Second : Second_Number;
|
|
|
298 Sub_Second : Second_Duration := 0.0) return Time
|
|
|
299 is
|
|
|
300 function Ada_Calendar_Time_Of
|
|
|
301 (Year : Year_Number;
|
|
|
302 Month : Month_Number;
|
|
|
303 Day : Day_Number;
|
|
|
304 Day_Secs : Day_Duration;
|
|
|
305 Hour : Integer;
|
|
|
306 Minute : Integer;
|
|
|
307 Second : Integer;
|
|
|
308 Sub_Sec : Duration;
|
|
|
309 Leap_Sec : Boolean;
|
|
|
310 Use_Day_Secs : Boolean;
|
|
|
311 Use_TZ : Boolean;
|
|
|
312 Is_Historic : Boolean;
|
|
|
313 Time_Zone : Long_Integer) return Time;
|
|
|
314 pragma Import (Ada, Ada_Calendar_Time_Of, "__gnat_time_of");
|
|
|
315
|
|
|
316 begin
|
|
|
317 -- Even though the input time zone is UTC (0), the flag Use_TZ will
|
|
|
318 -- ensure that Split picks up the local time zone.
|
|
|
319
|
|
|
320 return
|
|
|
321 Ada_Calendar_Time_Of
|
|
|
322 (Year => Year,
|
|
|
323 Month => Month,
|
|
|
324 Day => Day,
|
|
|
325 Day_Secs => 0.0,
|
|
|
326 Hour => Hour,
|
|
|
327 Minute => Minute,
|
|
|
328 Second => Second,
|
|
|
329 Sub_Sec => Sub_Second,
|
|
|
330 Leap_Sec => False,
|
|
|
331 Use_Day_Secs => False,
|
|
|
332 Use_TZ => False,
|
|
|
333 Is_Historic => False,
|
|
|
334 Time_Zone => 0);
|
|
|
335 end Time_Of_At_Locale;
|
|
|
336
|
|
|
337 -----------------
|
|
|
338 -- To_Duration --
|
|
|
339 -----------------
|
|
|
340
|
|
|
341 function To_Duration (T : not null access timeval) return Duration is
|
|
|
342
|
|
|
343 procedure timeval_to_duration
|
|
|
344 (T : not null access timeval;
|
|
|
345 sec : not null access C.Extensions.long_long;
|
|
|
346 usec : not null access C.long);
|
|
|
347 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
|
|
|
348
|
|
|
349 Micro : constant := 10**6;
|
|
|
350 sec : aliased C.Extensions.long_long;
|
|
|
351 usec : aliased C.long;
|
|
|
352
|
|
|
353 begin
|
|
|
354 timeval_to_duration (T, sec'Access, usec'Access);
|
|
|
355 return Duration (sec) + Duration (usec) / Micro;
|
|
|
356 end To_Duration;
|
|
|
357
|
|
|
358 ----------------
|
|
|
359 -- To_Timeval --
|
|
|
360 ----------------
|
|
|
361
|
|
|
362 function To_Timeval (D : Duration) return timeval is
|
|
|
363
|
|
|
364 procedure duration_to_timeval
|
|
|
365 (Sec : C.Extensions.long_long;
|
|
|
366 Usec : C.long;
|
|
|
367 T : not null access timeval);
|
|
|
368 pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
|
|
|
369
|
|
|
370 Micro : constant := 10**6;
|
|
|
371 Result : aliased timeval;
|
|
|
372 sec : C.Extensions.long_long;
|
|
|
373 usec : C.long;
|
|
|
374
|
|
|
375 begin
|
|
|
376 if D = 0.0 then
|
|
|
377 sec := 0;
|
|
|
378 usec := 0;
|
|
|
379 else
|
|
|
380 sec := C.Extensions.long_long (D - 0.5);
|
|
|
381 usec := C.long ((D - Duration (sec)) * Micro - 0.5);
|
|
|
382 end if;
|
|
|
383
|
|
|
384 duration_to_timeval (sec, usec, Result'Access);
|
|
|
385
|
|
|
386 return Result;
|
|
|
387 end To_Timeval;
|
|
|
388
|
|
|
389 ------------------
|
|
|
390 -- Week_In_Year --
|
|
|
391 ------------------
|
|
|
392
|
|
|
393 function Week_In_Year (Date : Time) return Week_In_Year_Number is
|
|
|
394 Year : Year_Number;
|
|
|
395 Week : Week_In_Year_Number;
|
|
|
396 pragma Unreferenced (Year);
|
|
|
397 begin
|
|
|
398 Year_Week_In_Year (Date, Year, Week);
|
|
|
399 return Week;
|
|
|
400 end Week_In_Year;
|
|
|
401
|
|
|
402 -----------------------
|
|
|
403 -- Year_Week_In_Year --
|
|
|
404 -----------------------
|
|
|
405
|
|
|
406 procedure Year_Week_In_Year
|
|
|
407 (Date : Time;
|
|
|
408 Year : out Year_Number;
|
|
|
409 Week : out Week_In_Year_Number)
|
|
|
410 is
|
|
|
411 Month : Month_Number;
|
|
|
412 Day : Day_Number;
|
|
|
413 Hour : Hour_Number;
|
|
|
414 Minute : Minute_Number;
|
|
|
415 Second : Second_Number;
|
|
|
416 Sub_Second : Second_Duration;
|
|
|
417 Jan_1 : Day_Name;
|
|
|
418 Shift : Week_In_Year_Number;
|
|
|
419 Start_Week : Week_In_Year_Number;
|
|
|
420
|
|
|
421 pragma Unreferenced (Hour, Minute, Second, Sub_Second);
|
|
|
422
|
|
|
423 function Is_Leap (Year : Year_Number) return Boolean;
|
|
|
424 -- Return True if Year denotes a leap year. Leap centennial years are
|
|
|
425 -- properly handled.
|
|
|
426
|
|
|
427 function Jan_1_Day_Of_Week
|
|
|
428 (Jan_1 : Day_Name;
|
|
|
429 Year : Year_Number;
|
|
|
430 Last_Year : Boolean := False;
|
|
|
431 Next_Year : Boolean := False) return Day_Name;
|
|
|
432 -- Given the weekday of January 1 in Year, determine the weekday on
|
|
|
433 -- which January 1 fell last year or will fall next year as set by
|
|
|
434 -- the two flags. This routine does not call Time_Of or Split.
|
|
|
435
|
|
|
436 function Last_Year_Has_53_Weeks
|
|
|
437 (Jan_1 : Day_Name;
|
|
|
438 Year : Year_Number) return Boolean;
|
|
|
439 -- Given the weekday of January 1 in Year, determine whether last year
|
|
|
440 -- has 53 weeks. A False value implies that the year has 52 weeks.
|
|
|
441
|
|
|
442 -------------
|
|
|
443 -- Is_Leap --
|
|
|
444 -------------
|
|
|
445
|
|
|
446 function Is_Leap (Year : Year_Number) return Boolean is
|
|
|
447 begin
|
|
|
448 if Year mod 400 = 0 then
|
|
|
449 return True;
|
|
|
450 elsif Year mod 100 = 0 then
|
|
|
451 return False;
|
|
|
452 else
|
|
|
453 return Year mod 4 = 0;
|
|
|
454 end if;
|
|
|
455 end Is_Leap;
|
|
|
456
|
|
|
457 -----------------------
|
|
|
458 -- Jan_1_Day_Of_Week --
|
|
|
459 -----------------------
|
|
|
460
|
|
|
461 function Jan_1_Day_Of_Week
|
|
|
462 (Jan_1 : Day_Name;
|
|
|
463 Year : Year_Number;
|
|
|
464 Last_Year : Boolean := False;
|
|
|
465 Next_Year : Boolean := False) return Day_Name
|
|
|
466 is
|
|
|
467 Shift : Integer := 0;
|
|
|
468
|
|
|
469 begin
|
|
|
470 if Last_Year then
|
|
|
471 Shift := (if Is_Leap (Year - 1) then -2 else -1);
|
|
|
472 elsif Next_Year then
|
|
|
473 Shift := (if Is_Leap (Year) then 2 else 1);
|
|
|
474 end if;
|
|
|
475
|
|
|
476 return Day_Name'Val ((Day_Name'Pos (Jan_1) + Shift) mod 7);
|
|
|
477 end Jan_1_Day_Of_Week;
|
|
|
478
|
|
|
479 ----------------------------
|
|
|
480 -- Last_Year_Has_53_Weeks --
|
|
|
481 ----------------------------
|
|
|
482
|
|
|
483 function Last_Year_Has_53_Weeks
|
|
|
484 (Jan_1 : Day_Name;
|
|
|
485 Year : Year_Number) return Boolean
|
|
|
486 is
|
|
|
487 Last_Jan_1 : constant Day_Name :=
|
|
|
488 Jan_1_Day_Of_Week (Jan_1, Year, Last_Year => True);
|
|
|
489
|
|
|
490 begin
|
|
|
491 -- These two cases are illustrated in the table below
|
|
|
492
|
|
|
493 return
|
|
|
494 Last_Jan_1 = Thursday
|
|
|
495 or else (Last_Jan_1 = Wednesday and then Is_Leap (Year - 1));
|
|
|
496 end Last_Year_Has_53_Weeks;
|
|
|
497
|
|
|
498 -- Start of processing for Week_In_Year
|
|
|
499
|
|
|
500 begin
|
|
|
501 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
|
|
|
502
|
|
|
503 -- According to ISO 8601, the first week of year Y is the week that
|
|
|
504 -- contains the first Thursday in year Y. The following table contains
|
|
|
505 -- all possible combinations of years and weekdays along with examples.
|
|
|
506
|
|
|
507 -- +-------+------+-------+---------+
|
|
|
508 -- | Jan 1 | Leap | Weeks | Example |
|
|
|
509 -- +-------+------+-------+---------+
|
|
|
510 -- | Mon | No | 52 | 2007 |
|
|
|
511 -- +-------+------+-------+---------+
|
|
|
512 -- | Mon | Yes | 52 | 1996 |
|
|
|
513 -- +-------+------+-------+---------+
|
|
|
514 -- | Tue | No | 52 | 2002 |
|
|
|
515 -- +-------+------+-------+---------+
|
|
|
516 -- | Tue | Yes | 52 | 1980 |
|
|
|
517 -- +-------+------+-------+---------+
|
|
|
518 -- | Wed | No | 52 | 2003 |
|
|
|
519 -- +-------+------#########---------+
|
|
|
520 -- | Wed | Yes # 53 # 1992 |
|
|
|
521 -- +-------+------#-------#---------+
|
|
|
522 -- | Thu | No # 53 # 1998 |
|
|
|
523 -- +-------+------#-------#---------+
|
|
|
524 -- | Thu | Yes # 53 # 2004 |
|
|
|
525 -- +-------+------#########---------+
|
|
|
526 -- | Fri | No | 52 | 1999 |
|
|
|
527 -- +-------+------+-------+---------+
|
|
|
528 -- | Fri | Yes | 52 | 1988 |
|
|
|
529 -- +-------+------+-------+---------+
|
|
|
530 -- | Sat | No | 52 | 1994 |
|
|
|
531 -- +-------+------+-------+---------+
|
|
|
532 -- | Sat | Yes | 52 | 1972 |
|
|
|
533 -- +-------+------+-------+---------+
|
|
|
534 -- | Sun | No | 52 | 1995 |
|
|
|
535 -- +-------+------+-------+---------+
|
|
|
536 -- | Sun | Yes | 52 | 1956 |
|
|
|
537 -- +-------+------+-------+---------+
|
|
|
538
|
|
|
539 -- A small optimization, the input date is January 1. Note that this
|
|
|
540 -- is a key day since it determines the number of weeks and is used
|
|
|
541 -- when special casing the first week of January and the last week of
|
|
|
542 -- December.
|
|
|
543
|
|
|
544 Jan_1 := Day_Of_Week (if Day = 1 and then Month = 1
|
|
|
545 then Date
|
|
|
546 else (Time_Of (Year, 1, 1, 0.0)));
|
|
|
547
|
|
|
548 -- Special cases for January
|
|
|
549
|
|
|
550 if Month = 1 then
|
|
|
551
|
|
|
552 -- Special case 1: January 1, 2 and 3. These three days may belong
|
|
|
553 -- to last year's last week which can be week number 52 or 53.
|
|
|
554
|
|
|
555 -- +-----+-----+-----+=====+-----+-----+-----+
|
|
|
556 -- | Mon | Tue | Wed # Thu # Fri | Sat | Sun |
|
|
|
557 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
558 -- | 26 | 27 | 28 # 29 # 30 | 31 | 1 |
|
|
|
559 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
560 -- | 27 | 28 | 29 # 30 # 31 | 1 | 2 |
|
|
|
561 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
562 -- | 28 | 29 | 30 # 31 # 1 | 2 | 3 |
|
|
|
563 -- +-----+-----+-----+=====+-----+-----+-----+
|
|
|
564
|
|
|
565 if (Day = 1 and then Jan_1 in Friday .. Sunday)
|
|
|
566 or else
|
|
|
567 (Day = 2 and then Jan_1 in Friday .. Saturday)
|
|
|
568 or else
|
|
|
569 (Day = 3 and then Jan_1 = Friday)
|
|
|
570 then
|
|
|
571 Week := (if Last_Year_Has_53_Weeks (Jan_1, Year) then 53 else 52);
|
|
|
572
|
|
|
573 -- January 1, 2 and 3 belong to the previous year
|
|
|
574
|
|
|
575 Year := Year - 1;
|
|
|
576 return;
|
|
|
577
|
|
|
578 -- Special case 2: January 1, 2, 3, 4, 5, 6 and 7 of the first week
|
|
|
579
|
|
|
580 -- +-----+-----+-----+=====+-----+-----+-----+
|
|
|
581 -- | Mon | Tue | Wed # Thu # Fri | Sat | Sun |
|
|
|
582 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
583 -- | 29 | 30 | 31 # 1 # 2 | 3 | 4 |
|
|
|
584 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
585 -- | 30 | 31 | 1 # 2 # 3 | 4 | 5 |
|
|
|
586 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
587 -- | 31 | 1 | 2 # 3 # 4 | 5 | 6 |
|
|
|
588 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
589 -- | 1 | 2 | 3 # 4 # 5 | 6 | 7 |
|
|
|
590 -- +-----+-----+-----+=====+-----+-----+-----+
|
|
|
591
|
|
|
592 elsif (Day <= 4 and then Jan_1 in Monday .. Thursday)
|
|
|
593 or else
|
|
|
594 (Day = 5 and then Jan_1 in Monday .. Wednesday)
|
|
|
595 or else
|
|
|
596 (Day = 6 and then Jan_1 in Monday .. Tuesday)
|
|
|
597 or else
|
|
|
598 (Day = 7 and then Jan_1 = Monday)
|
|
|
599 then
|
|
|
600 Week := 1;
|
|
|
601 return;
|
|
|
602 end if;
|
|
|
603
|
|
|
604 -- Month other than 1
|
|
|
605
|
|
|
606 -- Special case 3: December 29, 30 and 31. These days may belong to
|
|
|
607 -- next year's first week.
|
|
|
608
|
|
|
609 -- +-----+-----+-----+=====+-----+-----+-----+
|
|
|
610 -- | Mon | Tue | Wed # Thu # Fri | Sat | Sun |
|
|
|
611 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
612 -- | 29 | 30 | 31 # 1 # 2 | 3 | 4 |
|
|
|
613 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
614 -- | 30 | 31 | 1 # 2 # 3 | 4 | 5 |
|
|
|
615 -- +-----+-----+-----+-----+-----+-----+-----+
|
|
|
616 -- | 31 | 1 | 2 # 3 # 4 | 5 | 6 |
|
|
|
617 -- +-----+-----+-----+=====+-----+-----+-----+
|
|
|
618
|
|
|
619 elsif Month = 12 and then Day > 28 then
|
|
|
620 declare
|
|
|
621 Next_Jan_1 : constant Day_Name :=
|
|
|
622 Jan_1_Day_Of_Week (Jan_1, Year, Next_Year => True);
|
|
|
623 begin
|
|
|
624 if (Day = 29 and then Next_Jan_1 = Thursday)
|
|
|
625 or else
|
|
|
626 (Day = 30 and then Next_Jan_1 in Wednesday .. Thursday)
|
|
|
627 or else
|
|
|
628 (Day = 31 and then Next_Jan_1 in Tuesday .. Thursday)
|
|
|
629 then
|
|
|
630 Year := Year + 1;
|
|
|
631 Week := 1;
|
|
|
632 return;
|
|
|
633 end if;
|
|
|
634 end;
|
|
|
635 end if;
|
|
|
636
|
|
|
637 -- Determine the week from which to start counting. If January 1 does
|
|
|
638 -- not belong to the first week of the input year, then the next week
|
|
|
639 -- is the first week.
|
|
|
640
|
|
|
641 Start_Week := (if Jan_1 in Friday .. Sunday then 1 else 2);
|
|
|
642
|
|
|
643 -- At this point all special combinations have been accounted for and
|
|
|
644 -- the proper start week has been found. Since January 1 may not fall
|
|
|
645 -- on a Monday, shift 7 - Day_Name'Pos (Jan_1). This action ensures an
|
|
|
646 -- origin which falls on Monday.
|
|
|
647
|
|
|
648 Shift := 7 - Day_Name'Pos (Jan_1);
|
|
|
649 Week := Start_Week + (Day_In_Year (Date) - Shift - 1) / 7;
|
|
|
650 end Year_Week_In_Year;
|
|
|
651
|
|
|
652 end GNAT.Calendar;
|
