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