gcc/ada/a-calfor.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --              A D A . C A L E N D A R . F O R M A T T I N G               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2006, Free Software Foundation, Inc.            --
  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 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Ada.Calendar;            use Ada.Calendar;
  35 with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
  36 with Unchecked_Conversion;
  37
  38 package body Ada.Calendar.Formatting is
  39
  40    use Leap_Sec_Ops;
  41
  42    Days_In_4_Years          : constant := 365 * 3 + 366;
  43    Seconds_In_Day           : constant := 86_400;
  44    Seconds_In_4_Years       : constant := Days_In_4_Years * Seconds_In_Day;
  45    Seconds_In_Non_Leap_Year : constant := 365 * Seconds_In_Day;
  46
  47    --  Exact time bounds for the range of Ada time: January 1, 1901 -
  48    --  December 31, 2099. These bounds are based on the Unix Time of Epoc,
  49    --  January 1, 1970. Start of Time is -69 years from TOE while End of
  50    --  time is +130 years and one second from TOE.
  51
  52    Start_Of_Time : constant Time :=
  53                      Time (-(17 * Seconds_In_4_Years +
  54                                   Seconds_In_Non_Leap_Year));
  55
  56    End_Of_Time   : constant Time :=
  57                      Time (32 * Seconds_In_4_Years +
  58                             2 * Seconds_In_Non_Leap_Year) +
  59                                 All_Leap_Seconds;
  60
  61    Days_In_Month : constant array (Month_Number) of Day_Number :=
  62      (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  63
  64    procedure Check_Char (S : String; C : Character; Index : Integer);
  65    --  Subsidiary to the two versions of Value. Determine whether the
  66    --  input strint S has character C at position Index. Raise
  67    --  Constraint_Error if there is a mismatch.
  68
  69    procedure Check_Digit (S : String; Index : Integer);
  70    --  Subsidiary to the two versions of Value. Determine whether the
  71    --  character of string S at position Index is a digit. This catches
  72    --  invalid input such as 1983-*1-j3 u5:n7:k9 which should be
  73    --  1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
  74
  75    ----------------
  76    -- Check_Char --
  77    ----------------
  78
  79    procedure Check_Char (S : String; C : Character; Index : Integer) is
  80    begin
  81       if S (Index) /= C then
  82          raise Constraint_Error;
  83       end if;
  84    end Check_Char;
  85
  86    -----------------
  87    -- Check_Digit --
  88    -----------------
  89
  90    procedure Check_Digit (S : String; Index : Integer) is
  91    begin
  92       if S (Index) not in '0' .. '9' then
  93          raise Constraint_Error;
  94       end if;
  95    end Check_Digit;
  96
  97    ---------
  98    -- Day --
  99    ---------
 100
 101    function Day
 102      (Date      : Time;
 103       Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
 104    is
 105       Year        : Year_Number;
 106       Month       : Month_Number;
 107       Day         : Day_Number;
 108       Hour        : Hour_Number;
 109       Minute      : Minute_Number;
 110       Second      : Second_Number;
 111       Sub_Second  : Second_Duration;
 112       Leap_Second : Boolean;
 113
 114    begin
 115       Split (Date, Year, Month, Day,
 116              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 117       return Day;
 118    end Day;
 119
 120    -----------------
 121    -- Day_Of_Week --
 122    -----------------
 123
 124    function Day_Of_Week (Date : Time) return Day_Name is
 125       Year        : Year_Number;
 126       Month       : Month_Number;
 127       Day         : Day_Number;
 128       Hour        : Hour_Number;
 129       Minute      : Minute_Number;
 130       Second      : Second_Number;
 131       Sub_Second  : Second_Duration;
 132       Leap_Second : Boolean;
 133
 134       D           : Duration;
 135       Day_Count   : Long_Long_Integer;
 136       Midday_Date : Time;
 137       Secs_Count  : Long_Long_Integer;
 138
 139    begin
 140       --  Split the Date to obtain the year, month and day, then build a time
 141       --  value for the middle of the same day, so that we don't have to worry
 142       --  about leap seconds in the subsequent arithmetic.
 143
 144       Split (Date, Year, Month, Day,
 145              Hour, Minute, Second, Sub_Second, Leap_Second);
 146
 147       Midday_Date := Time_Of (Year, Month, Day, 12, 0, 0);
 148       D           := Midday_Date - Start_Of_Time;
 149
 150       --  D is a positive Duration value counting seconds since 1901. Convert
 151       --  it into an integer for ease of arithmetic.
 152
 153       declare
 154          type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
 155          for D_Int'Size use Duration'Size;
 156
 157          function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
 158
 159          D_As_Int  : constant D_Int := To_D_Int (D);
 160          Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
 161
 162       begin
 163          Secs_Count := Long_Long_Integer (D_As_Int / Small_Div);
 164       end;
 165
 166       Day_Count := Secs_Count / Seconds_In_Day;
 167       Day_Count := Day_Count + 1;  --  Jan 1, 1901 was a Tuesday;
 168
 169       return Day_Name'Val (Day_Count mod 7);
 170    end Day_Of_Week;
 171
 172    ----------
 173    -- Hour --
 174    ----------
 175
 176    function Hour
 177      (Date      : Time;
 178       Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
 179    is
 180       Year        : Year_Number;
 181       Month       : Month_Number;
 182       Day         : Day_Number;
 183       Hour        : Hour_Number;
 184       Minute      : Minute_Number;
 185       Second      : Second_Number;
 186       Sub_Second  : Second_Duration;
 187       Leap_Second : Boolean;
 188
 189    begin
 190       Split (Date, Year, Month, Day,
 191              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 192       return Hour;
 193    end Hour;
 194
 195    -----------
 196    -- Image --
 197    -----------
 198
 199    function Image
 200      (Elapsed_Time          : Duration;
 201       Include_Time_Fraction : Boolean := False) return String
 202    is
 203       Hour       : Hour_Number;
 204       Minute     : Minute_Number;
 205       Second     : Second_Number;
 206       Sub_Second : Second_Duration;
 207       SS_Nat     : Natural;
 208
 209       Result : String := "00:00:00.00";
 210
 211    begin
 212       Split (Elapsed_Time, Hour, Minute, Second, Sub_Second);
 213       SS_Nat := Natural (Sub_Second * 100.0);
 214
 215       declare
 216          Hour_Str   : constant String := Hour_Number'Image (Hour);
 217          Minute_Str : constant String := Minute_Number'Image (Minute);
 218          Second_Str : constant String := Second_Number'Image (Second);
 219          SS_Str     : constant String := Natural'Image (SS_Nat);
 220
 221       begin
 222          --  Hour processing, positions 1 and 2
 223
 224          if Hour < 10 then
 225             Result (2) := Hour_Str (2);
 226          else
 227             Result (1) := Hour_Str (2);
 228             Result (2) := Hour_Str (3);
 229          end if;
 230
 231          --  Minute processing, positions 4 and 5
 232
 233          if Minute < 10 then
 234             Result (5) := Minute_Str (2);
 235          else
 236             Result (4) := Minute_Str (2);
 237             Result (5) := Minute_Str (3);
 238          end if;
 239
 240          --  Second processing, positions 7 and 8
 241
 242          if Second < 10 then
 243             Result (8) := Second_Str (2);
 244          else
 245             Result (7) := Second_Str (2);
 246             Result (8) := Second_Str (3);
 247          end if;
 248
 249          --  Optional sub second processing, positions 10 and 11
 250
 251          if Include_Time_Fraction then
 252             if SS_Nat < 10 then
 253                Result (11) := SS_Str (2);
 254             else
 255                Result (10) := SS_Str (2);
 256                Result (11) := SS_Str (3);
 257             end if;
 258
 259             return Result;
 260          else
 261             return Result (1 .. 8);
 262          end if;
 263       end;
 264    end Image;
 265
 266    -----------
 267    -- Image --
 268    -----------
 269
 270    function Image
 271      (Date                  : Time;
 272       Include_Time_Fraction : Boolean := False;
 273       Time_Zone             : Time_Zones.Time_Offset := 0) return String
 274    is
 275       Year        : Year_Number;
 276       Month       : Month_Number;
 277       Day         : Day_Number;
 278       Hour        : Hour_Number;
 279       Minute      : Minute_Number;
 280       Second      : Second_Number;
 281       Sub_Second  : Second_Duration;
 282       SS_Nat      : Natural;
 283       Leap_Second : Boolean;
 284
 285       Result : String := "0000-00-00 00:00:00.00";
 286
 287    begin
 288       Split (Date, Year, Month, Day,
 289              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 290
 291       SS_Nat := Natural (Sub_Second * 100.0);
 292
 293       declare
 294          Year_Str   : constant String := Year_Number'Image (Year);
 295          Month_Str  : constant String := Month_Number'Image (Month);
 296          Day_Str    : constant String := Day_Number'Image (Day);
 297          Hour_Str   : constant String := Hour_Number'Image (Hour);
 298          Minute_Str : constant String := Minute_Number'Image (Minute);
 299          Second_Str : constant String := Second_Number'Image (Second);
 300          SS_Str     : constant String := Natural'Image (SS_Nat);
 301
 302       begin
 303          --  Year processing, positions 1, 2, 3 and 4
 304
 305          Result (1) := Year_Str (2);
 306          Result (2) := Year_Str (3);
 307          Result (3) := Year_Str (4);
 308          Result (4) := Year_Str (5);
 309
 310          --  Month processing, positions 6 and 7
 311
 312          if Month < 10 then
 313             Result (7) := Month_Str (2);
 314          else
 315             Result (6) := Month_Str (2);
 316             Result (7) := Month_Str (3);
 317          end if;
 318
 319          --  Day processing, positions 9 and 10
 320
 321          if Day < 10 then
 322             Result (10) := Day_Str (2);
 323          else
 324             Result (9)  := Day_Str (2);
 325             Result (10) := Day_Str (3);
 326          end if;
 327
 328          --  Hour processing, positions 12 and 13
 329
 330          if Hour < 10 then
 331             Result (13) := Hour_Str (2);
 332          else
 333             Result (12) := Hour_Str (2);
 334             Result (13) := Hour_Str (3);
 335          end if;
 336
 337          --  Minute processing, positions 15 and 16
 338
 339          if Minute < 10 then
 340             Result (16) := Minute_Str (2);
 341          else
 342             Result (15) := Minute_Str (2);
 343             Result (16) := Minute_Str (3);
 344          end if;
 345
 346          --  Second processing, positions 18 and 19
 347
 348          if Second < 10 then
 349             Result (19) := Second_Str (2);
 350          else
 351             Result (18) := Second_Str (2);
 352             Result (19) := Second_Str (3);
 353          end if;
 354
 355          --  Optional sub second processing, positions 21 and 22
 356
 357          if Include_Time_Fraction then
 358             if SS_Nat < 10 then
 359                Result (22) := SS_Str (2);
 360             else
 361                Result (21) := SS_Str (2);
 362                Result (22) := SS_Str (3);
 363             end if;
 364
 365             return Result;
 366          else
 367             return Result (1 .. 19);
 368          end if;
 369       end;
 370    end Image;
 371
 372    ------------
 373    -- Minute --
 374    ------------
 375
 376    function Minute
 377      (Date      : Time;
 378       Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
 379    is
 380       Year        : Year_Number;
 381       Month       : Month_Number;
 382       Day         : Day_Number;
 383       Hour        : Hour_Number;
 384       Minute      : Minute_Number;
 385       Second      : Second_Number;
 386       Sub_Second  : Second_Duration;
 387       Leap_Second : Boolean;
 388
 389    begin
 390       Split (Date, Year, Month, Day,
 391              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 392       return Minute;
 393    end Minute;
 394
 395    -----------
 396    -- Month --
 397    -----------
 398
 399    function Month
 400      (Date      : Time;
 401       Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
 402    is
 403       Year        : Year_Number;
 404       Month       : Month_Number;
 405       Day         : Day_Number;
 406       Hour        : Hour_Number;
 407       Minute      : Minute_Number;
 408       Second      : Second_Number;
 409       Sub_Second  : Second_Duration;
 410       Leap_Second : Boolean;
 411
 412    begin
 413       Split (Date, Year, Month, Day,
 414              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 415       return Month;
 416    end Month;
 417
 418    ------------
 419    -- Second --
 420    ------------
 421
 422    function Second (Date : Time) return Second_Number is
 423       Year        : Year_Number;
 424       Month       : Month_Number;
 425       Day         : Day_Number;
 426       Hour        : Hour_Number;
 427       Minute      : Minute_Number;
 428       Second      : Second_Number;
 429       Sub_Second  : Second_Duration;
 430       Leap_Second : Boolean;
 431
 432    begin
 433       Split (Date, Year, Month, Day,
 434              Hour, Minute, Second, Sub_Second, Leap_Second);
 435       return Second;
 436    end Second;
 437
 438    ----------------
 439    -- Seconds_Of --
 440    ----------------
 441
 442    function Seconds_Of
 443      (Hour       : Hour_Number;
 444       Minute     : Minute_Number;
 445       Second     : Second_Number := 0;
 446       Sub_Second : Second_Duration := 0.0) return Day_Duration is
 447
 448    begin
 449       --  Validity checks
 450
 451       if not Hour'Valid
 452         or else not Minute'Valid
 453         or else not Second'Valid
 454         or else not Sub_Second'Valid
 455       then
 456          raise Constraint_Error;
 457       end if;
 458
 459       return Day_Duration (Hour   * 3600) +
 460              Day_Duration (Minute *   60) +
 461              Day_Duration (Second)        +
 462                            Sub_Second;
 463    end Seconds_Of;
 464
 465    -----------
 466    -- Split --
 467    -----------
 468
 469    procedure Split
 470      (Seconds    : Day_Duration;
 471       Hour       : out Hour_Number;
 472       Minute     : out Minute_Number;
 473       Second     : out Second_Number;
 474       Sub_Second : out Second_Duration)
 475    is
 476       Secs : Natural;
 477
 478    begin
 479       --  Validity checks
 480
 481       if not Seconds'Valid then
 482          raise Constraint_Error;
 483       end if;
 484
 485       if Seconds = 0.0 then
 486          Secs := 0;
 487       else
 488          Secs := Natural (Seconds - 0.5);
 489       end if;
 490
 491       Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
 492       Hour       := Hour_Number (Secs / 3600);
 493       Secs       := Secs mod 3600;
 494       Minute     := Minute_Number (Secs / 60);
 495       Second     := Second_Number (Secs mod 60);
 496    end Split;
 497
 498    -----------
 499    -- Split --
 500    -----------
 501
 502    procedure Split
 503      (Date        : Time;
 504       Year        : out Year_Number;
 505       Month       : out Month_Number;
 506       Day         : out Day_Number;
 507       Seconds     : out Day_Duration;
 508       Leap_Second : out Boolean;
 509       Time_Zone   : Time_Zones.Time_Offset := 0)
 510    is
 511       Hour        : Hour_Number;
 512       Minute      : Minute_Number;
 513       Second      : Second_Number;
 514       Sub_Second  : Second_Duration;
 515
 516    begin
 517       Split (Date, Year, Month, Day,
 518              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 519
 520       Seconds := Seconds_Of (Hour, Minute, Second, Sub_Second);
 521    end Split;
 522
 523    -----------
 524    -- Split --
 525    -----------
 526
 527    procedure Split
 528      (Date       : Time;
 529       Year       : out Year_Number;
 530       Month      : out Month_Number;
 531       Day        : out Day_Number;
 532       Hour       : out Hour_Number;
 533       Minute     : out Minute_Number;
 534       Second     : out Second_Number;
 535       Sub_Second : out Second_Duration;
 536       Time_Zone  : Time_Zones.Time_Offset := 0)
 537    is
 538       Leap_Second : Boolean;
 539
 540    begin
 541       Split (Date, Year, Month, Day,
 542              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 543    end Split;
 544
 545    -----------
 546    -- Split --
 547    -----------
 548
 549    procedure Split
 550      (Date        : Time;
 551       Year        : out Year_Number;
 552       Month       : out Month_Number;
 553       Day         : out Day_Number;
 554       Hour        : out Hour_Number;
 555       Minute      : out Minute_Number;
 556       Second      : out Second_Number;
 557       Sub_Second  : out Second_Duration;
 558       Leap_Second : out Boolean;
 559       Time_Zone   : Time_Zones.Time_Offset := 0)
 560    is
 561       Ada_Year_Min    : constant Year_Number := Year_Number'First;
 562       Day_In_Year     : Integer;
 563       Day_Second      : Integer;
 564       Elapsed_Leaps   : Duration;
 565       Hour_Second     : Integer;
 566       In_Leap_Year    : Boolean;
 567       Modified_Date   : Time;
 568       Next_Leap       : Time;
 569       Remaining_Years : Integer;
 570       Seconds_Count   : Long_Long_Integer;
 571
 572    begin
 573       --  Our measurement of time is the number of seconds that have elapsed
 574       --  since the Unix TOE. To calculate a UTC date from this we do a
 575       --  sequence of divides and mods to get the components of a date based
 576       --  on 86,400 seconds in each day. Since, UTC time depends upon the
 577       --  occasional insertion of leap seconds, the number of leap seconds
 578       --  that have been added prior to the input time are then subtracted
 579       --  from the previous calculation. In fact, it is easier to do the
 580       --  subtraction first, so a more accurate discription of what is
 581       --  actually done, is that the number of added leap seconds is looked
 582       --  up using the input Time value, than that number of seconds is
 583       --  subtracted before the sequence of divides and mods.
 584       --
 585       --  If the input date turns out to be a leap second, we don't add it to
 586       --  date (we want to return 23:59:59) but we set the Leap_Second output
 587       --  to true.
 588
 589       --  Is there a need to account for a difference from Unix time prior
 590       --  to the first leap second ???
 591
 592       --  Step 1: Determine the number of leap seconds since the start
 593       --  of Ada time and the input date as well as the next leap second
 594       --  occurence and process accordingly.
 595
 596       Cumulative_Leap_Secs (Start_Of_Time, Date, Elapsed_Leaps, Next_Leap);
 597
 598       Leap_Second   := Date >= Next_Leap;
 599       Modified_Date := Date - Elapsed_Leaps;
 600
 601       if Leap_Second then
 602          Modified_Date := Modified_Date - Duration (1.0);
 603       end if;
 604
 605       --  Step 2: Process the time zone
 606
 607       Modified_Date := Modified_Date + Duration (Time_Zone * 60);
 608
 609       --  Step 3: Sanity check on the calculated date. Since the leap
 610       --  seconds and the time zone have been eliminated, the result needs
 611       --  to be within the range of Ada time.
 612
 613       if Modified_Date < Start_Of_Time
 614         or else Modified_Date >= (End_Of_Time - All_Leap_Seconds)
 615       then
 616          raise Time_Error;
 617       end if;
 618
 619       Modified_Date := Modified_Date - Start_Of_Time;
 620
 621       declare
 622          type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
 623          for D_Int'Size use Duration'Size;
 624
 625          function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
 626          function To_Duration is new Unchecked_Conversion (D_Int, Duration);
 627          function To_Duration is new Unchecked_Conversion (Time, Duration);
 628
 629          D_As_Int  : constant D_Int := To_D_Int (To_Duration (Modified_Date));
 630          Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
 631
 632       begin
 633          Seconds_Count := Long_Long_Integer (D_As_Int / Small_Div);
 634          Sub_Second    := Second_Duration
 635                             (To_Duration (D_As_Int rem Small_Div));
 636       end;
 637
 638       --  Step 4: Calculate the number of years since the start of Ada time.
 639       --  First consider sequences of four years, then the remaining years.
 640
 641       Year := Ada_Year_Min + 4 * Integer (Seconds_Count / Seconds_In_4_Years);
 642       Seconds_Count   := Seconds_Count mod Seconds_In_4_Years;
 643       Remaining_Years := Integer (Seconds_Count / Seconds_In_Non_Leap_Year);
 644
 645       if Remaining_Years > 3 then
 646          Remaining_Years := 3;
 647       end if;
 648
 649       Year := Year + Remaining_Years;
 650
 651       --  Remove the seconds elapsed in those remaining years
 652
 653       Seconds_Count := Seconds_Count - Long_Long_Integer
 654                          (Remaining_Years * Seconds_In_Non_Leap_Year);
 655       In_Leap_Year := (Year mod 4) = 0;
 656
 657       --  Step 5: Month and day processing. Determine the day to which the
 658       --  remaining seconds map to.
 659
 660       Day_In_Year := Integer (Seconds_Count / Seconds_In_Day) + 1;
 661
 662       Month := 1;
 663
 664       if Day_In_Year > 31 then
 665          Month       := 2;
 666          Day_In_Year := Day_In_Year - 31;
 667
 668          if Day_In_Year > 28
 669            and then ((not In_Leap_Year)
 670                         or else Day_In_Year > 29)
 671          then
 672             Month       := 3;
 673             Day_In_Year := Day_In_Year - 28;
 674
 675             if In_Leap_Year then
 676                Day_In_Year := Day_In_Year - 1;
 677             end if;
 678
 679             while Day_In_Year > Days_In_Month (Month) loop
 680                Day_In_Year := Day_In_Year - Days_In_Month (Month);
 681                Month := Month + 1;
 682             end loop;
 683          end if;
 684       end if;
 685
 686       --  Step 6: Hour, minute and second processing
 687
 688       Day         := Day_In_Year;
 689       Day_Second  := Integer (Seconds_Count mod Seconds_In_Day);
 690       Hour        := Day_Second / 3600;
 691       Hour_Second := Day_Second mod 3600;
 692       Minute      := Hour_Second / 60;
 693       Second      := Hour_Second mod 60;
 694    end Split;
 695
 696    ----------------
 697    -- Sub_Second --
 698    ----------------
 699
 700    function Sub_Second (Date : Time) return Second_Duration is
 701       Year        : Year_Number;
 702       Month       : Month_Number;
 703       Day         : Day_Number;
 704       Hour        : Hour_Number;
 705       Minute      : Minute_Number;
 706       Second      : Second_Number;
 707       Sub_Second  : Second_Duration;
 708       Leap_Second : Boolean;
 709
 710    begin
 711       Split (Date, Year, Month, Day,
 712              Hour, Minute, Second, Sub_Second, Leap_Second);
 713
 714       return Sub_Second;
 715    end Sub_Second;
 716
 717    -------------
 718    -- Time_Of --
 719    -------------
 720
 721    function Time_Of
 722      (Year        : Year_Number;
 723       Month       : Month_Number;
 724       Day         : Day_Number;
 725       Seconds     : Day_Duration := 0.0;
 726       Leap_Second : Boolean := False;
 727       Time_Zone   : Time_Zones.Time_Offset := 0) return Time
 728    is
 729       Hour       : Hour_Number;
 730       Minute     : Minute_Number;
 731       Sec_Num    : Second_Number;
 732       Sub_Sec    : Second_Duration;
 733       Whole_Part : Integer;
 734
 735    begin
 736       if not Seconds'Valid then
 737          raise Constraint_Error;
 738       end if;
 739
 740       --  The fact that Seconds can go to 86,400 creates all this extra work.
 741       --  Perhaps a Time_Of just like the next one but allowing the Second_
 742       --  Number input to reach 60 should become an internal version that this
 743       --  and the next version call.... but for now we do the ugly bumping up
 744       --  of Day, Month and Year;
 745
 746       if Seconds = 86_400.0 then
 747          declare
 748             Adj_Year  : Year_Number  := Year;
 749             Adj_Month : Month_Number := Month;
 750             Adj_Day   : Day_Number   := Day;
 751
 752          begin
 753             Hour    := 0;
 754             Minute  := 0;
 755             Sec_Num := 0;
 756             Sub_Sec := 0.0;
 757
 758             if Day < Days_In_Month (Month)
 759               or else (Month = 2
 760                          and then Year mod 4 = 0)
 761             then
 762                Adj_Day := Day + 1;
 763             else
 764                Adj_Day := 1;
 765
 766                if Month < 12 then
 767                   Adj_Month := Month + 1;
 768                else
 769                   Adj_Month := 1;
 770                   Adj_Year  := Year + 1;
 771                end if;
 772             end if;
 773
 774             return Time_Of (Adj_Year, Adj_Month, Adj_Day, Hour, Minute,
 775                             Sec_Num, Sub_Sec, Leap_Second, Time_Zone);
 776          end;
 777       end if;
 778
 779       declare
 780          type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
 781          for D_Int'Size use Duration'Size;
 782
 783          function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
 784          function To_Duration is new Unchecked_Conversion (D_Int, Duration);
 785
 786          D_As_Int  : constant D_Int := To_D_Int (Seconds);
 787          Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
 788
 789       begin
 790          Whole_Part := Integer (D_As_Int / Small_Div);
 791          Sub_Sec    := Second_Duration
 792                          (To_Duration (D_As_Int rem Small_Div));
 793       end;
 794
 795       Hour       := Hour_Number (Whole_Part / 3600);
 796       Whole_Part := Whole_Part mod 3600;
 797       Minute     := Minute_Number (Whole_Part / 60);
 798       Sec_Num    := Second_Number (Whole_Part mod 60);
 799
 800       return Time_Of (Year, Month, Day,
 801                       Hour, Minute, Sec_Num, Sub_Sec, Leap_Second, Time_Zone);
 802    end Time_Of;
 803
 804    -------------
 805    -- Time_Of --
 806    -------------
 807
 808    function Time_Of
 809      (Year        : Year_Number;
 810       Month       : Month_Number;
 811       Day         : Day_Number;
 812       Hour        : Hour_Number;
 813       Minute      : Minute_Number;
 814       Second      : Second_Number;
 815       Sub_Second  : Second_Duration := 0.0;
 816       Leap_Second : Boolean := False;
 817       Time_Zone   : Time_Zones.Time_Offset := 0) return Time
 818    is
 819       Cumulative_Days_Before_Month :
 820         constant array (Month_Number) of Natural :=
 821           (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
 822
 823       Ada_Year_Min         : constant Year_Number := Year_Number'First;
 824       Count                : Integer;
 825       Elapsed_Leap_Seconds : Duration;
 826       Fractional_Second    : Duration;
 827       Next_Leap            : Time;
 828       Result               : Time;
 829
 830    begin
 831       --  The following checks are redundant with respect to the constraint
 832       --  error checks that should normally be made on parameters, but we
 833       --  decide to raise Constraint_Error in any case if bad values come in
 834       --  (as a result of checks being off in the caller, or for other
 835       --  erroneous or bounded error cases).
 836
 837       if not Year'Valid
 838         or else not Month'Valid
 839         or else not Day'Valid
 840         or else not Hour'Valid
 841         or else not Minute'Valid
 842         or else not Second'Valid
 843         or else not Sub_Second'Valid
 844         or else not Time_Zone'Valid
 845       then
 846          raise Constraint_Error;
 847       end if;
 848
 849       --  Start the accumulation from the beginning of Ada time
 850
 851       Result := Start_Of_Time;
 852
 853       --  Step 1: Determine the number of leap and non-leap years since 1901
 854       --  and the input date.
 855
 856       --  Count the number of four year segments
 857
 858       Count  := (Year - Ada_Year_Min) / 4;
 859       Result := Result + Duration (Count * Seconds_In_4_Years);
 860
 861       --  Count the number of remaining non-leap years
 862
 863       Count  := (Year - Ada_Year_Min) mod 4;
 864       Result := Result + Duration (Count * Seconds_In_Non_Leap_Year);
 865
 866       --  Step 2: Determine the number of days elapsed singe the start of the
 867       --  input year and add them to the result.
 868
 869       --  Do not include the current day since it is not over yet
 870
 871       Count := Cumulative_Days_Before_Month (Month) + Day - 1;
 872
 873       --  The input year is a leap year and we have passed February
 874
 875       if (Year mod 4) = 0
 876         and then Month > 2
 877       then
 878          Count := Count + 1;
 879       end if;
 880
 881       Result := Result + Duration (Count * Seconds_In_Day);
 882
 883       --  Step 3: Hour, minute and second processing
 884
 885       Result := Result + Duration (Hour   * 3600) +
 886                          Duration (Minute *   60) +
 887                          Duration (Second);
 888
 889       --  The sub second may designate a whole second
 890
 891       if Sub_Second = 1.0 then
 892          Result            := Result + Duration (1.0);
 893          Fractional_Second := 0.0;
 894       else
 895          Fractional_Second := Sub_Second;
 896       end if;
 897
 898       --  Step 4: Time zone processing
 899
 900       Result := Result - Duration (Time_Zone * 60);
 901
 902       --  Step 5: The caller wants a leap second
 903
 904       if Leap_Second then
 905          Result := Result + Duration (1.0);
 906       end if;
 907
 908       --  Step 6: Calculate the number of leap seconds occured since the
 909       --  start of Ada time and the current point in time. The following
 910       --  is an approximation which does not yet count leap seconds. It
 911       --  can be pushed beyond 1 leap second, but not more.
 912
 913       Cumulative_Leap_Secs
 914         (Start_Of_Time, Result, Elapsed_Leap_Seconds, Next_Leap);
 915
 916       Result := Result + Elapsed_Leap_Seconds;
 917
 918       --  Step 7: Validity check of a leap second occurence. It requires an
 919       --  additional comparison to Next_Leap to ensure that we landed right
 920       --  on a valid occurence and that Elapsed_Leap_Seconds did not shoot
 921       --  past it.
 922
 923       if Leap_Second
 924         and then
 925            not (Result >= Next_Leap
 926                   and then Result - Duration (1.0) < Next_Leap)
 927       then
 928          raise Time_Error;
 929       end if;
 930
 931       --  Step 8: Final sanity check on the calculated duration value
 932
 933       if Result < Start_Of_Time
 934         or else Result >= End_Of_Time
 935       then
 936          raise Time_Error;
 937       end if;
 938
 939       --  Step 9: Lastly, add the sub second part
 940
 941       return Result + Fractional_Second;
 942    end Time_Of;
 943
 944    -----------
 945    -- Value --
 946    -----------
 947
 948    function Value
 949      (Date      : String;
 950       Time_Zone : Time_Zones.Time_Offset := 0) return Time
 951    is
 952       D          : String (1 .. 22);
 953       Year       : Year_Number;
 954       Month      : Month_Number;
 955       Day        : Day_Number;
 956       Hour       : Hour_Number;
 957       Minute     : Minute_Number;
 958       Second     : Second_Number;
 959       Sub_Second : Second_Duration := 0.0;
 960
 961    begin
 962       --  Validity checks
 963
 964       if not Time_Zone'Valid then
 965          raise Constraint_Error;
 966       end if;
 967
 968       --  Length checks
 969
 970       if Date'Length /= 19
 971         and then Date'Length /= 22
 972       then
 973          raise Constraint_Error;
 974       end if;
 975
 976       --  After the correct length has been determined, it is safe to
 977       --  copy the Date in order to avoid Date'First + N indexing.
 978
 979       D (1 .. Date'Length) := Date;
 980
 981       --  Format checks
 982
 983       Check_Char (D, '-', 5);
 984       Check_Char (D, '-', 8);
 985       Check_Char (D, ' ', 11);
 986       Check_Char (D, ':', 14);
 987       Check_Char (D, ':', 17);
 988
 989       if Date'Length = 22 then
 990          Check_Char (D, '.', 20);
 991       end if;
 992
 993       --  Leading zero checks
 994
 995       Check_Digit (D, 6);
 996       Check_Digit (D, 9);
 997       Check_Digit (D, 12);
 998       Check_Digit (D, 15);
 999       Check_Digit (D, 18);
1000
1001       if Date'Length = 22 then
1002          Check_Digit (D, 21);
1003       end if;
1004
1005       --  Value extraction
1006
1007       Year   := Year_Number   (Year_Number'Value   (D (1 .. 4)));
1008       Month  := Month_Number  (Month_Number'Value  (D (6 .. 7)));
1009       Day    := Day_Number    (Day_Number'Value    (D (9 .. 10)));
1010       Hour   := Hour_Number   (Hour_Number'Value   (D (12 .. 13)));
1011       Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
1012       Second := Second_Number (Second_Number'Value (D (18 .. 19)));
1013
1014       --  Optional part
1015
1016       if Date'Length = 22 then
1017          Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
1018       end if;
1019
1020       --  Sanity checks
1021
1022       if not Year'Valid
1023         or else not Month'Valid
1024         or else not Day'Valid
1025         or else not Hour'Valid
1026         or else not Minute'Valid
1027         or else not Second'Valid
1028         or else not Sub_Second'Valid
1029       then
1030          raise Constraint_Error;
1031       end if;
1032
1033       return Time_Of (Year, Month, Day,
1034                       Hour, Minute, Second, Sub_Second, False, Time_Zone);
1035
1036    exception
1037       when others => raise Constraint_Error;
1038    end Value;
1039
1040    -----------
1041    -- Value --
1042    -----------
1043
1044    function Value (Elapsed_Time : String) return Duration is
1045       D          : String (1 .. 11);
1046       Hour       : Hour_Number;
1047       Minute     : Minute_Number;
1048       Second     : Second_Number;
1049       Sub_Second : Second_Duration := 0.0;
1050
1051    begin
1052       --  Length checks
1053
1054       if Elapsed_Time'Length /= 8
1055         and then Elapsed_Time'Length /= 11
1056       then
1057          raise Constraint_Error;
1058       end if;
1059
1060       --  After the correct length has been determined, it is safe to
1061       --  copy the Elapsed_Time in order to avoid Date'First + N indexing.
1062
1063       D (1 .. Elapsed_Time'Length) := Elapsed_Time;
1064
1065       --  Format checks
1066
1067       Check_Char (D, ':', 3);
1068       Check_Char (D, ':', 6);
1069
1070       if Elapsed_Time'Length = 11 then
1071          Check_Char (D, '.', 9);
1072       end if;
1073
1074       --  Leading zero checks
1075
1076       Check_Digit (D, 1);
1077       Check_Digit (D, 4);
1078       Check_Digit (D, 7);
1079
1080       if Elapsed_Time'Length = 11 then
1081          Check_Digit (D, 10);
1082       end if;
1083
1084       --  Value extraction
1085
1086       Hour   := Hour_Number   (Hour_Number'Value   (D (1 .. 2)));
1087       Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
1088       Second := Second_Number (Second_Number'Value (D (7 .. 8)));
1089
1090       --  Optional part
1091
1092       if Elapsed_Time'Length = 11 then
1093          Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
1094       end if;
1095
1096       --  Sanity checks
1097
1098       if not Hour'Valid
1099         or else not Minute'Valid
1100         or else not Second'Valid
1101         or else not Sub_Second'Valid
1102       then
1103          raise Constraint_Error;
1104       end if;
1105
1106       return Seconds_Of (Hour, Minute, Second, Sub_Second);
1107
1108    exception
1109       when others => raise Constraint_Error;
1110    end Value;
1111
1112    ----------
1113    -- Year --
1114    ----------
1115
1116    function Year
1117      (Date      : Time;
1118       Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
1119    is
1120       Year        : Year_Number;
1121       Month       : Month_Number;
1122       Day         : Day_Number;
1123       Hour        : Hour_Number;
1124       Minute      : Minute_Number;
1125       Second      : Second_Number;
1126       Sub_Second  : Second_Duration;
1127       Leap_Second : Boolean;
1128
1129    begin
1130       Split (Date, Year, Month, Day,
1131              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
1132       return Year;
1133    end Year;
1134
1135 end Ada.Calendar.Formatting;