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