gcc/ada/g-calend.adb

   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 --                                                                          --
   9 --                     Copyright (C) 1999-2014, AdaCore                     --
  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;