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