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-2007, 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
  37 pragma Warnings (Off); -- temp till we fix out param warnings ???
  38
  39 package body Ada.Calendar.Formatting is
  40
  41    --------------------------
  42    -- Implementation Notes --
  43    --------------------------
  44
  45    --  All operations in this package are target and time representation
  46    --  independent, thus only one source file is needed for multiple targets.
  47
  48    procedure Check_Char (S : String; C : Character; Index : Integer);
  49    --  Subsidiary to the two versions of Value. Determine whether the
  50    --  input strint S has character C at position Index. Raise
  51    --  Constraint_Error if there is a mismatch.
  52
  53    procedure Check_Digit (S : String; Index : Integer);
  54    --  Subsidiary to the two versions of Value. Determine whether the
  55    --  character of string S at position Index is a digit. This catches
  56    --  invalid input such as 1983-*1-j3 u5:n7:k9 which should be
  57    --  1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
  58
  59    ----------------
  60    -- Check_Char --
  61    ----------------
  62
  63    procedure Check_Char (S : String; C : Character; Index : Integer) is
  64    begin
  65       if S (Index) /= C then
  66          raise Constraint_Error;
  67       end if;
  68    end Check_Char;
  69
  70    -----------------
  71    -- Check_Digit --
  72    -----------------
  73
  74    procedure Check_Digit (S : String; Index : Integer) is
  75    begin
  76       if S (Index) not in '0' .. '9' then
  77          raise Constraint_Error;
  78       end if;
  79    end Check_Digit;
  80
  81    ---------
  82    -- Day --
  83    ---------
  84
  85    function Day
  86      (Date      : Time;
  87       Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
  88    is
  89       Y  : Year_Number;
  90       Mo : Month_Number;
  91       D  : Day_Number;
  92       H  : Hour_Number;
  93       Mi : Minute_Number;
  94       Se : Second_Number;
  95       Ss : Second_Duration;
  96       Le : Boolean;
  97
  98       pragma Unreferenced (Y, Mo, H, Mi);
  99
 100    begin
 101       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
 102       return D;
 103    end Day;
 104
 105    -----------------
 106    -- Day_Of_Week --
 107    -----------------
 108
 109    function Day_Of_Week (Date : Time) return Day_Name is
 110    begin
 111       return Day_Name'Val (Formatting_Operations.Day_Of_Week (Date));
 112    end Day_Of_Week;
 113
 114    ----------
 115    -- Hour --
 116    ----------
 117
 118    function Hour
 119      (Date      : Time;
 120       Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
 121    is
 122       Y  : Year_Number;
 123       Mo : Month_Number;
 124       D  : Day_Number;
 125       H  : Hour_Number;
 126       Mi : Minute_Number;
 127       Se : Second_Number;
 128       Ss : Second_Duration;
 129       Le : Boolean;
 130
 131       pragma Unreferenced (Y, Mo, D, Mi);
 132
 133    begin
 134       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
 135       return H;
 136    end Hour;
 137
 138    -----------
 139    -- Image --
 140    -----------
 141
 142    function Image
 143      (Elapsed_Time          : Duration;
 144       Include_Time_Fraction : Boolean := False) return String
 145    is
 146       Hour       : Hour_Number;
 147       Minute     : Minute_Number;
 148       Second     : Second_Number;
 149       Sub_Second : Duration;
 150       SS_Nat     : Natural;
 151
 152       Low  : Integer;
 153       High : Integer;
 154
 155       Result : String := "-00:00:00.00";
 156
 157    begin
 158       Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second);
 159
 160       --  Determine the two slice bounds for the result string depending on
 161       --  whether the input is negative and whether fractions are requested.
 162
 163       if Elapsed_Time < 0.0 then
 164          Low := 1;
 165       else
 166          Low := 2;
 167       end if;
 168
 169       if Include_Time_Fraction then
 170          High := 12;
 171       else
 172          High := 9;
 173       end if;
 174
 175       --  Prevent rounding when converting to natural
 176
 177       Sub_Second := Sub_Second * 100.0 - 0.5;
 178       SS_Nat := Natural (Sub_Second);
 179
 180       declare
 181          Hour_Str   : constant String := Hour_Number'Image (Hour);
 182          Minute_Str : constant String := Minute_Number'Image (Minute);
 183          Second_Str : constant String := Second_Number'Image (Second);
 184          SS_Str     : constant String := Natural'Image (SS_Nat);
 185
 186       begin
 187          --  Hour processing, positions 2 and 3
 188
 189          if Hour < 10 then
 190             Result (3) := Hour_Str (2);
 191          else
 192             Result (2) := Hour_Str (2);
 193             Result (3) := Hour_Str (3);
 194          end if;
 195
 196          --  Minute processing, positions 5 and 6
 197
 198          if Minute < 10 then
 199             Result (6) := Minute_Str (2);
 200          else
 201             Result (5) := Minute_Str (2);
 202             Result (6) := Minute_Str (3);
 203          end if;
 204
 205          --  Second processing, positions 8 and 9
 206
 207          if Second < 10 then
 208             Result (9) := Second_Str (2);
 209          else
 210             Result (8) := Second_Str (2);
 211             Result (9) := Second_Str (3);
 212          end if;
 213
 214          --  Optional sub second processing, positions 11 and 12
 215
 216          if Include_Time_Fraction then
 217             if SS_Nat < 10 then
 218                Result (12) := SS_Str (2);
 219             else
 220                Result (11) := SS_Str (2);
 221                Result (12) := SS_Str (3);
 222             end if;
 223          end if;
 224
 225          return Result (Low .. High);
 226       end;
 227    end Image;
 228
 229    -----------
 230    -- Image --
 231    -----------
 232
 233    function Image
 234      (Date                  : Time;
 235       Include_Time_Fraction : Boolean := False;
 236       Time_Zone             : Time_Zones.Time_Offset := 0) return String
 237    is
 238       Year        : Year_Number;
 239       Month       : Month_Number;
 240       Day         : Day_Number;
 241       Hour        : Hour_Number;
 242       Minute      : Minute_Number;
 243       Second      : Second_Number;
 244       Sub_Second  : Duration;
 245       SS_Nat      : Natural;
 246       Leap_Second : Boolean;
 247
 248       Result : String := "0000-00-00 00:00:00.00";
 249
 250    begin
 251       Split (Date, Year, Month, Day,
 252              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 253
 254       --  Prevent rounding when converting to natural
 255
 256       Sub_Second := Sub_Second * 100.0 - 0.5;
 257       SS_Nat := Natural (Sub_Second);
 258
 259       declare
 260          Year_Str   : constant String := Year_Number'Image (Year);
 261          Month_Str  : constant String := Month_Number'Image (Month);
 262          Day_Str    : constant String := Day_Number'Image (Day);
 263          Hour_Str   : constant String := Hour_Number'Image (Hour);
 264          Minute_Str : constant String := Minute_Number'Image (Minute);
 265          Second_Str : constant String := Second_Number'Image (Second);
 266          SS_Str     : constant String := Natural'Image (SS_Nat);
 267
 268       begin
 269          --  Year processing, positions 1, 2, 3 and 4
 270
 271          Result (1) := Year_Str (2);
 272          Result (2) := Year_Str (3);
 273          Result (3) := Year_Str (4);
 274          Result (4) := Year_Str (5);
 275
 276          --  Month processing, positions 6 and 7
 277
 278          if Month < 10 then
 279             Result (7) := Month_Str (2);
 280          else
 281             Result (6) := Month_Str (2);
 282             Result (7) := Month_Str (3);
 283          end if;
 284
 285          --  Day processing, positions 9 and 10
 286
 287          if Day < 10 then
 288             Result (10) := Day_Str (2);
 289          else
 290             Result (9)  := Day_Str (2);
 291             Result (10) := Day_Str (3);
 292          end if;
 293
 294          --  Hour processing, positions 12 and 13
 295
 296          if Hour < 10 then
 297             Result (13) := Hour_Str (2);
 298          else
 299             Result (12) := Hour_Str (2);
 300             Result (13) := Hour_Str (3);
 301          end if;
 302
 303          --  Minute processing, positions 15 and 16
 304
 305          if Minute < 10 then
 306             Result (16) := Minute_Str (2);
 307          else
 308             Result (15) := Minute_Str (2);
 309             Result (16) := Minute_Str (3);
 310          end if;
 311
 312          --  Second processing, positions 18 and 19
 313
 314          if Second < 10 then
 315             Result (19) := Second_Str (2);
 316          else
 317             Result (18) := Second_Str (2);
 318             Result (19) := Second_Str (3);
 319          end if;
 320
 321          --  Optional sub second processing, positions 21 and 22
 322
 323          if Include_Time_Fraction then
 324             if SS_Nat < 10 then
 325                Result (22) := SS_Str (2);
 326             else
 327                Result (21) := SS_Str (2);
 328                Result (22) := SS_Str (3);
 329             end if;
 330
 331             return Result;
 332          else
 333             return Result (1 .. 19);
 334          end if;
 335       end;
 336    end Image;
 337
 338    ------------
 339    -- Minute --
 340    ------------
 341
 342    function Minute
 343      (Date      : Time;
 344       Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
 345    is
 346       Y  : Year_Number;
 347       Mo : Month_Number;
 348       D  : Day_Number;
 349       H  : Hour_Number;
 350       Mi : Minute_Number;
 351       Se : Second_Number;
 352       Ss : Second_Duration;
 353       Le : Boolean;
 354
 355       pragma Unreferenced (Y, Mo, D, H);
 356
 357    begin
 358       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
 359       return Mi;
 360    end Minute;
 361
 362    -----------
 363    -- Month --
 364    -----------
 365
 366    function Month
 367      (Date      : Time;
 368       Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
 369    is
 370       Y  : Year_Number;
 371       Mo : Month_Number;
 372       D  : Day_Number;
 373       H  : Hour_Number;
 374       Mi : Minute_Number;
 375       Se : Second_Number;
 376       Ss : Second_Duration;
 377       Le : Boolean;
 378
 379       pragma Unreferenced (Y, D, H, Mi);
 380
 381    begin
 382       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
 383       return Mo;
 384    end Month;
 385
 386    ------------
 387    -- Second --
 388    ------------
 389
 390    function Second (Date : Time) return Second_Number is
 391       Y  : Year_Number;
 392       Mo : Month_Number;
 393       D  : Day_Number;
 394       H  : Hour_Number;
 395       Mi : Minute_Number;
 396       Se : Second_Number;
 397       Ss : Second_Duration;
 398       Le : Boolean;
 399
 400       pragma Unreferenced (Y, Mo, D, H, Mi);
 401
 402    begin
 403       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
 404       return Se;
 405    end Second;
 406
 407    ----------------
 408    -- Seconds_Of --
 409    ----------------
 410
 411    function Seconds_Of
 412      (Hour       : Hour_Number;
 413       Minute     : Minute_Number;
 414       Second     : Second_Number := 0;
 415       Sub_Second : Second_Duration := 0.0) return Day_Duration is
 416
 417    begin
 418       --  Validity checks
 419
 420       if not Hour'Valid
 421         or else not Minute'Valid
 422         or else not Second'Valid
 423         or else not Sub_Second'Valid
 424       then
 425          raise Constraint_Error;
 426       end if;
 427
 428       return Day_Duration (Hour   * 3_600) +
 429              Day_Duration (Minute *    60) +
 430              Day_Duration (Second)         +
 431              Sub_Second;
 432    end Seconds_Of;
 433
 434    -----------
 435    -- Split --
 436    -----------
 437
 438    procedure Split
 439      (Seconds    : Day_Duration;
 440       Hour       : out Hour_Number;
 441       Minute     : out Minute_Number;
 442       Second     : out Second_Number;
 443       Sub_Second : out Second_Duration)
 444    is
 445       Secs : Natural;
 446
 447    begin
 448       --  Validity checks
 449
 450       if not Seconds'Valid then
 451          raise Constraint_Error;
 452       end if;
 453
 454       if Seconds = 0.0 then
 455          Secs := 0;
 456       else
 457          Secs := Natural (Seconds - 0.5);
 458       end if;
 459
 460       Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
 461       Hour       := Hour_Number (Secs / 3_600);
 462       Secs       := Secs mod 3_600;
 463       Minute     := Minute_Number (Secs / 60);
 464       Second     := Second_Number (Secs mod 60);
 465
 466       --  Validity checks
 467
 468       if not Hour'Valid
 469         or else not Minute'Valid
 470         or else not Second'Valid
 471         or else not Sub_Second'Valid
 472       then
 473          raise Time_Error;
 474       end if;
 475    end Split;
 476
 477    -----------
 478    -- Split --
 479    -----------
 480
 481    procedure Split
 482      (Date        : Time;
 483       Year        : out Year_Number;
 484       Month       : out Month_Number;
 485       Day         : out Day_Number;
 486       Seconds     : out Day_Duration;
 487       Leap_Second : out Boolean;
 488       Time_Zone   : Time_Zones.Time_Offset := 0)
 489    is
 490       H  : Integer;
 491       M  : Integer;
 492       Se : Integer;
 493       Su : Duration;
 494       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 495
 496    begin
 497       Formatting_Operations.Split
 498         (Date      => Date,
 499          Year      => Year,
 500          Month     => Month,
 501          Day       => Day,
 502          Day_Secs  => Seconds,
 503          Hour      => H,
 504          Minute    => M,
 505          Second    => Se,
 506          Sub_Sec   => Su,
 507          Leap_Sec  => Leap_Second,
 508          Time_Zone => Tz,
 509          Is_Ada_05 => True);
 510
 511       --  Validity checks
 512
 513       if not Year'Valid
 514         or else not Month'Valid
 515         or else not Day'Valid
 516         or else not Seconds'Valid
 517       then
 518          raise Time_Error;
 519       end if;
 520    end Split;
 521
 522    -----------
 523    -- Split --
 524    -----------
 525
 526    procedure Split
 527      (Date       : Time;
 528       Year       : out Year_Number;
 529       Month      : out Month_Number;
 530       Day        : out Day_Number;
 531       Hour       : out Hour_Number;
 532       Minute     : out Minute_Number;
 533       Second     : out Second_Number;
 534       Sub_Second : out Second_Duration;
 535       Time_Zone  : Time_Zones.Time_Offset := 0)
 536    is
 537       Dd : Day_Duration;
 538       Le : Boolean;
 539       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 540
 541    begin
 542       Formatting_Operations.Split
 543         (Date      => Date,
 544          Year      => Year,
 545          Month     => Month,
 546          Day       => Day,
 547          Day_Secs  => Dd,
 548          Hour      => Hour,
 549          Minute    => Minute,
 550          Second    => Second,
 551          Sub_Sec   => Sub_Second,
 552          Leap_Sec  => Le,
 553          Time_Zone => Tz,
 554          Is_Ada_05 => True);
 555
 556       --  Validity checks
 557
 558       if not Year'Valid
 559         or else not Month'Valid
 560         or else not Day'Valid
 561         or else not Hour'Valid
 562         or else not Minute'Valid
 563         or else not Second'Valid
 564         or else not Sub_Second'Valid
 565       then
 566          raise Time_Error;
 567       end if;
 568    end Split;
 569
 570    -----------
 571    -- Split --
 572    -----------
 573
 574    procedure Split
 575      (Date        : Time;
 576       Year        : out Year_Number;
 577       Month       : out Month_Number;
 578       Day         : out Day_Number;
 579       Hour        : out Hour_Number;
 580       Minute      : out Minute_Number;
 581       Second      : out Second_Number;
 582       Sub_Second  : out Second_Duration;
 583       Leap_Second : out Boolean;
 584       Time_Zone   : Time_Zones.Time_Offset := 0)
 585    is
 586       Dd : Day_Duration;
 587       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 588
 589    begin
 590       Formatting_Operations.Split
 591        (Date      => Date,
 592         Year      => Year,
 593         Month     => Month,
 594         Day       => Day,
 595         Day_Secs  => Dd,
 596         Hour      => Hour,
 597         Minute    => Minute,
 598         Second    => Second,
 599         Sub_Sec   => Sub_Second,
 600         Leap_Sec  => Leap_Second,
 601         Time_Zone => Tz,
 602         Is_Ada_05 => True);
 603
 604       --  Validity checks
 605
 606       if not Year'Valid
 607         or else not Month'Valid
 608         or else not Day'Valid
 609         or else not Hour'Valid
 610         or else not Minute'Valid
 611         or else not Second'Valid
 612         or else not Sub_Second'Valid
 613       then
 614          raise Time_Error;
 615       end if;
 616    end Split;
 617
 618    ----------------
 619    -- Sub_Second --
 620    ----------------
 621
 622    function Sub_Second (Date : Time) return Second_Duration is
 623       Y  : Year_Number;
 624       Mo : Month_Number;
 625       D  : Day_Number;
 626       H  : Hour_Number;
 627       Mi : Minute_Number;
 628       Se : Second_Number;
 629       Ss : Second_Duration;
 630       Le : Boolean;
 631
 632       pragma Unreferenced (Y, Mo, D, H, Mi);
 633
 634    begin
 635       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
 636       return Ss;
 637    end Sub_Second;
 638
 639    -------------
 640    -- Time_Of --
 641    -------------
 642
 643    function Time_Of
 644      (Year        : Year_Number;
 645       Month       : Month_Number;
 646       Day         : Day_Number;
 647       Seconds     : Day_Duration := 0.0;
 648       Leap_Second : Boolean := False;
 649       Time_Zone   : Time_Zones.Time_Offset := 0) return Time
 650    is
 651       Adj_Year  : Year_Number  := Year;
 652       Adj_Month : Month_Number := Month;
 653       Adj_Day   : Day_Number   := Day;
 654
 655       H  : constant Integer := 1;
 656       M  : constant Integer := 1;
 657       Se : constant Integer := 1;
 658       Ss : constant Duration := 0.1;
 659       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 660
 661    begin
 662       --  Validity checks
 663
 664       if not Year'Valid
 665         or else not Month'Valid
 666         or else not Day'Valid
 667         or else not Seconds'Valid
 668         or else not Time_Zone'Valid
 669       then
 670          raise Constraint_Error;
 671       end if;
 672
 673       --  A Seconds value of 86_400 denotes a new day. This case requires an
 674       --  adjustment to the input values.
 675
 676       if Seconds = 86_400.0 then
 677          if Day < Days_In_Month (Month)
 678            or else (Is_Leap (Year)
 679                       and then Month = 2)
 680          then
 681             Adj_Day := Day + 1;
 682          else
 683             Adj_Day := 1;
 684
 685             if Month < 12 then
 686                Adj_Month := Month + 1;
 687             else
 688                Adj_Month := 1;
 689                Adj_Year  := Year + 1;
 690             end if;
 691          end if;
 692       end if;
 693
 694       return
 695         Formatting_Operations.Time_Of
 696           (Year         => Adj_Year,
 697            Month        => Adj_Month,
 698            Day          => Adj_Day,
 699            Day_Secs     => Seconds,
 700            Hour         => H,
 701            Minute       => M,
 702            Second       => Se,
 703            Sub_Sec      => Ss,
 704            Leap_Sec     => Leap_Second,
 705            Use_Day_Secs => True,
 706            Is_Ada_05    => True,
 707            Time_Zone    => Tz);
 708    end Time_Of;
 709
 710    -------------
 711    -- Time_Of --
 712    -------------
 713
 714    function Time_Of
 715      (Year        : Year_Number;
 716       Month       : Month_Number;
 717       Day         : Day_Number;
 718       Hour        : Hour_Number;
 719       Minute      : Minute_Number;
 720       Second      : Second_Number;
 721       Sub_Second  : Second_Duration := 0.0;
 722       Leap_Second : Boolean := False;
 723       Time_Zone   : Time_Zones.Time_Offset := 0) return Time
 724    is
 725       Dd : constant Day_Duration := Day_Duration'First;
 726       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 727
 728    begin
 729       --  Validity checks
 730
 731       if not Year'Valid
 732         or else not Month'Valid
 733         or else not Day'Valid
 734         or else not Hour'Valid
 735         or else not Minute'Valid
 736         or else not Second'Valid
 737         or else not Sub_Second'Valid
 738         or else not Time_Zone'Valid
 739       then
 740          raise Constraint_Error;
 741       end if;
 742
 743       return
 744         Formatting_Operations.Time_Of
 745           (Year         => Year,
 746            Month        => Month,
 747            Day          => Day,
 748            Day_Secs     => Dd,
 749            Hour         => Hour,
 750            Minute       => Minute,
 751            Second       => Second,
 752            Sub_Sec      => Sub_Second,
 753            Leap_Sec     => Leap_Second,
 754            Use_Day_Secs => False,
 755            Is_Ada_05    => True,
 756            Time_Zone    => Tz);
 757    end Time_Of;
 758
 759    -----------
 760    -- Value --
 761    -----------
 762
 763    function Value
 764      (Date      : String;
 765       Time_Zone : Time_Zones.Time_Offset := 0) return Time
 766    is
 767       D          : String (1 .. 22);
 768       Year       : Year_Number;
 769       Month      : Month_Number;
 770       Day        : Day_Number;
 771       Hour       : Hour_Number;
 772       Minute     : Minute_Number;
 773       Second     : Second_Number;
 774       Sub_Second : Second_Duration := 0.0;
 775
 776    begin
 777       --  Validity checks
 778
 779       if not Time_Zone'Valid then
 780          raise Constraint_Error;
 781       end if;
 782
 783       --  Length checks
 784
 785       if Date'Length /= 19
 786         and then Date'Length /= 22
 787       then
 788          raise Constraint_Error;
 789       end if;
 790
 791       --  After the correct length has been determined, it is safe to
 792       --  copy the Date in order to avoid Date'First + N indexing.
 793
 794       D (1 .. Date'Length) := Date;
 795
 796       --  Format checks
 797
 798       Check_Char (D, '-', 5);
 799       Check_Char (D, '-', 8);
 800       Check_Char (D, ' ', 11);
 801       Check_Char (D, ':', 14);
 802       Check_Char (D, ':', 17);
 803
 804       if Date'Length = 22 then
 805          Check_Char (D, '.', 20);
 806       end if;
 807
 808       --  Leading zero checks
 809
 810       Check_Digit (D, 6);
 811       Check_Digit (D, 9);
 812       Check_Digit (D, 12);
 813       Check_Digit (D, 15);
 814       Check_Digit (D, 18);
 815
 816       if Date'Length = 22 then
 817          Check_Digit (D, 21);
 818       end if;
 819
 820       --  Value extraction
 821
 822       Year   := Year_Number   (Year_Number'Value   (D (1 .. 4)));
 823       Month  := Month_Number  (Month_Number'Value  (D (6 .. 7)));
 824       Day    := Day_Number    (Day_Number'Value    (D (9 .. 10)));
 825       Hour   := Hour_Number   (Hour_Number'Value   (D (12 .. 13)));
 826       Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
 827       Second := Second_Number (Second_Number'Value (D (18 .. 19)));
 828
 829       --  Optional part
 830
 831       if Date'Length = 22 then
 832          Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
 833       end if;
 834
 835       --  Sanity checks
 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       then
 845          raise Constraint_Error;
 846       end if;
 847
 848       return Time_Of (Year, Month, Day,
 849                       Hour, Minute, Second, Sub_Second, False, Time_Zone);
 850
 851    exception
 852       when others => raise Constraint_Error;
 853    end Value;
 854
 855    -----------
 856    -- Value --
 857    -----------
 858
 859    function Value (Elapsed_Time : String) return Duration is
 860       D          : String (1 .. 11);
 861       Hour       : Hour_Number;
 862       Minute     : Minute_Number;
 863       Second     : Second_Number;
 864       Sub_Second : Second_Duration := 0.0;
 865
 866    begin
 867       --  Length checks
 868
 869       if Elapsed_Time'Length /= 8
 870         and then Elapsed_Time'Length /= 11
 871       then
 872          raise Constraint_Error;
 873       end if;
 874
 875       --  After the correct length has been determined, it is safe to
 876       --  copy the Elapsed_Time in order to avoid Date'First + N indexing.
 877
 878       D (1 .. Elapsed_Time'Length) := Elapsed_Time;
 879
 880       --  Format checks
 881
 882       Check_Char (D, ':', 3);
 883       Check_Char (D, ':', 6);
 884
 885       if Elapsed_Time'Length = 11 then
 886          Check_Char (D, '.', 9);
 887       end if;
 888
 889       --  Leading zero checks
 890
 891       Check_Digit (D, 1);
 892       Check_Digit (D, 4);
 893       Check_Digit (D, 7);
 894
 895       if Elapsed_Time'Length = 11 then
 896          Check_Digit (D, 10);
 897       end if;
 898
 899       --  Value extraction
 900
 901       Hour   := Hour_Number   (Hour_Number'Value   (D (1 .. 2)));
 902       Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
 903       Second := Second_Number (Second_Number'Value (D (7 .. 8)));
 904
 905       --  Optional part
 906
 907       if Elapsed_Time'Length = 11 then
 908          Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
 909       end if;
 910
 911       --  Sanity checks
 912
 913       if not Hour'Valid
 914         or else not Minute'Valid
 915         or else not Second'Valid
 916         or else not Sub_Second'Valid
 917       then
 918          raise Constraint_Error;
 919       end if;
 920
 921       return Seconds_Of (Hour, Minute, Second, Sub_Second);
 922
 923    exception
 924       when others => raise Constraint_Error;
 925    end Value;
 926
 927    ----------
 928    -- Year --
 929    ----------
 930
 931    function Year
 932      (Date      : Time;
 933       Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
 934    is
 935       Y  : Year_Number;
 936       Mo : Month_Number;
 937       D  : Day_Number;
 938       H  : Hour_Number;
 939       Mi : Minute_Number;
 940       Se : Second_Number;
 941       Ss : Second_Duration;
 942       Le : Boolean;
 943
 944       pragma Unreferenced (Mo, D, H, Mi);
 945
 946    begin
 947       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
 948       return Y;
 949    end Year;
 950
 951 end Ada.Calendar.Formatting;