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-2012, 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          Use_TZ      => True,
 435          Is_Historic => True,
 436          Time_Zone   => Tz);
 437
 438       --  Validity checks
 439
 440       if not Year'Valid
 441         or else not Month'Valid
 442         or else not Day'Valid
 443         or else not Seconds'Valid
 444       then
 445          raise Time_Error;
 446       end if;
 447    end Split;
 448
 449    -----------
 450    -- Split --
 451    -----------
 452
 453    procedure Split
 454      (Date       : Time;
 455       Year       : out Year_Number;
 456       Month      : out Month_Number;
 457       Day        : out Day_Number;
 458       Hour       : out Hour_Number;
 459       Minute     : out Minute_Number;
 460       Second     : out Second_Number;
 461       Sub_Second : out Second_Duration;
 462       Time_Zone  : Time_Zones.Time_Offset := 0)
 463    is
 464       Dd : Day_Duration;
 465       Le : Boolean;
 466       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 467
 468    begin
 469       Formatting_Operations.Split
 470         (Date        => Date,
 471          Year        => Year,
 472          Month       => Month,
 473          Day         => Day,
 474          Day_Secs    => Dd,
 475          Hour        => Hour,
 476          Minute      => Minute,
 477          Second      => Second,
 478          Sub_Sec     => Sub_Second,
 479          Leap_Sec    => Le,
 480          Use_TZ      => True,
 481          Is_Historic => True,
 482          Time_Zone   => Tz);
 483
 484       --  Validity checks
 485
 486       if not Year'Valid
 487         or else not Month'Valid
 488         or else not Day'Valid
 489         or else not Hour'Valid
 490         or else not Minute'Valid
 491         or else not Second'Valid
 492         or else not Sub_Second'Valid
 493       then
 494          raise Time_Error;
 495       end if;
 496    end Split;
 497
 498    -----------
 499    -- Split --
 500    -----------
 501
 502    procedure Split
 503      (Date        : Time;
 504       Year        : out Year_Number;
 505       Month       : out Month_Number;
 506       Day         : out Day_Number;
 507       Hour        : out Hour_Number;
 508       Minute      : out Minute_Number;
 509       Second      : out Second_Number;
 510       Sub_Second  : out Second_Duration;
 511       Leap_Second : out Boolean;
 512       Time_Zone   : Time_Zones.Time_Offset := 0)
 513    is
 514       Dd : Day_Duration;
 515       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 516
 517    begin
 518       Formatting_Operations.Split
 519        (Date        => Date,
 520         Year        => Year,
 521         Month       => Month,
 522         Day         => Day,
 523         Day_Secs    => Dd,
 524         Hour        => Hour,
 525         Minute      => Minute,
 526         Second      => Second,
 527         Sub_Sec     => Sub_Second,
 528         Leap_Sec    => Leap_Second,
 529         Use_TZ      => True,
 530         Is_Historic => True,
 531         Time_Zone   => Tz);
 532
 533       --  Validity checks
 534
 535       if not Year'Valid
 536         or else not Month'Valid
 537         or else not Day'Valid
 538         or else not Hour'Valid
 539         or else not Minute'Valid
 540         or else not Second'Valid
 541         or else not Sub_Second'Valid
 542       then
 543          raise Time_Error;
 544       end if;
 545    end Split;
 546
 547    ----------------
 548    -- Sub_Second --
 549    ----------------
 550
 551    function Sub_Second (Date : Time) return Second_Duration is
 552       Y  : Year_Number;
 553       Mo : Month_Number;
 554       D  : Day_Number;
 555       H  : Hour_Number;
 556       Mi : Minute_Number;
 557       Se : Second_Number;
 558       Ss : Second_Duration;
 559       Le : Boolean;
 560
 561       pragma Unreferenced (Y, Mo, D, H, Mi);
 562
 563    begin
 564       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
 565       return Ss;
 566    end Sub_Second;
 567
 568    -------------
 569    -- Time_Of --
 570    -------------
 571
 572    function Time_Of
 573      (Year        : Year_Number;
 574       Month       : Month_Number;
 575       Day         : Day_Number;
 576       Seconds     : Day_Duration := 0.0;
 577       Leap_Second : Boolean := False;
 578       Time_Zone   : Time_Zones.Time_Offset := 0) return Time
 579    is
 580       Adj_Year  : Year_Number  := Year;
 581       Adj_Month : Month_Number := Month;
 582       Adj_Day   : Day_Number   := Day;
 583
 584       H  : constant Integer := 1;
 585       M  : constant Integer := 1;
 586       Se : constant Integer := 1;
 587       Ss : constant Duration := 0.1;
 588       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 589
 590    begin
 591       --  Validity checks
 592
 593       if not Year'Valid
 594         or else not Month'Valid
 595         or else not Day'Valid
 596         or else not Seconds'Valid
 597         or else not Time_Zone'Valid
 598       then
 599          raise Constraint_Error;
 600       end if;
 601
 602       --  A Seconds value of 86_400 denotes a new day. This case requires an
 603       --  adjustment to the input values.
 604
 605       if Seconds = 86_400.0 then
 606          if Day < Days_In_Month (Month)
 607            or else (Is_Leap (Year)
 608                       and then Month = 2)
 609          then
 610             Adj_Day := Day + 1;
 611          else
 612             Adj_Day := 1;
 613
 614             if Month < 12 then
 615                Adj_Month := Month + 1;
 616             else
 617                Adj_Month := 1;
 618                Adj_Year  := Year + 1;
 619             end if;
 620          end if;
 621       end if;
 622
 623       return
 624         Formatting_Operations.Time_Of
 625           (Year         => Adj_Year,
 626            Month        => Adj_Month,
 627            Day          => Adj_Day,
 628            Day_Secs     => Seconds,
 629            Hour         => H,
 630            Minute       => M,
 631            Second       => Se,
 632            Sub_Sec      => Ss,
 633            Leap_Sec     => Leap_Second,
 634            Use_Day_Secs => True,
 635            Use_TZ       => True,
 636            Is_Historic  => True,
 637            Time_Zone    => Tz);
 638    end Time_Of;
 639
 640    -------------
 641    -- Time_Of --
 642    -------------
 643
 644    function Time_Of
 645      (Year        : Year_Number;
 646       Month       : Month_Number;
 647       Day         : Day_Number;
 648       Hour        : Hour_Number;
 649       Minute      : Minute_Number;
 650       Second      : Second_Number;
 651       Sub_Second  : Second_Duration := 0.0;
 652       Leap_Second : Boolean := False;
 653       Time_Zone   : Time_Zones.Time_Offset := 0) return Time
 654    is
 655       Dd : constant Day_Duration := Day_Duration'First;
 656       Tz : constant Long_Integer := Long_Integer (Time_Zone);
 657
 658    begin
 659       --  Validity checks
 660
 661       if not Year'Valid
 662         or else not Month'Valid
 663         or else not Day'Valid
 664         or else not Hour'Valid
 665         or else not Minute'Valid
 666         or else not Second'Valid
 667         or else not Sub_Second'Valid
 668         or else not Time_Zone'Valid
 669       then
 670          raise Constraint_Error;
 671       end if;
 672
 673       return
 674         Formatting_Operations.Time_Of
 675           (Year         => Year,
 676            Month        => Month,
 677            Day          => Day,
 678            Day_Secs     => Dd,
 679            Hour         => Hour,
 680            Minute       => Minute,
 681            Second       => Second,
 682            Sub_Sec      => Sub_Second,
 683            Leap_Sec     => Leap_Second,
 684            Use_Day_Secs => False,
 685            Use_TZ       => True,
 686            Is_Historic  => True,
 687            Time_Zone    => Tz);
 688    end Time_Of;
 689
 690    -----------
 691    -- Value --
 692    -----------
 693
 694    function Value
 695      (Date      : String;
 696       Time_Zone : Time_Zones.Time_Offset := 0) return Time
 697    is
 698       D          : String (1 .. 22);
 699       Year       : Year_Number;
 700       Month      : Month_Number;
 701       Day        : Day_Number;
 702       Hour       : Hour_Number;
 703       Minute     : Minute_Number;
 704       Second     : Second_Number;
 705       Sub_Second : Second_Duration := 0.0;
 706
 707    begin
 708       --  Validity checks
 709
 710       if not Time_Zone'Valid then
 711          raise Constraint_Error;
 712       end if;
 713
 714       --  Length checks
 715
 716       if Date'Length /= 19
 717         and then Date'Length /= 22
 718       then
 719          raise Constraint_Error;
 720       end if;
 721
 722       --  After the correct length has been determined, it is safe to copy the
 723       --  Date in order to avoid Date'First + N indexing.
 724
 725       D (1 .. Date'Length) := Date;
 726
 727       --  Format checks
 728
 729       Check_Char (D, '-', 5);
 730       Check_Char (D, '-', 8);
 731       Check_Char (D, ' ', 11);
 732       Check_Char (D, ':', 14);
 733       Check_Char (D, ':', 17);
 734
 735       if Date'Length = 22 then
 736          Check_Char (D, '.', 20);
 737       end if;
 738
 739       --  Leading zero checks
 740
 741       Check_Digit (D, 6);
 742       Check_Digit (D, 9);
 743       Check_Digit (D, 12);
 744       Check_Digit (D, 15);
 745       Check_Digit (D, 18);
 746
 747       if Date'Length = 22 then
 748          Check_Digit (D, 21);
 749       end if;
 750
 751       --  Value extraction
 752
 753       Year   := Year_Number   (Year_Number'Value   (D (1 .. 4)));
 754       Month  := Month_Number  (Month_Number'Value  (D (6 .. 7)));
 755       Day    := Day_Number    (Day_Number'Value    (D (9 .. 10)));
 756       Hour   := Hour_Number   (Hour_Number'Value   (D (12 .. 13)));
 757       Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
 758       Second := Second_Number (Second_Number'Value (D (18 .. 19)));
 759
 760       --  Optional part
 761
 762       if Date'Length = 22 then
 763          Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
 764       end if;
 765
 766       --  Sanity checks
 767
 768       if not Year'Valid
 769         or else not Month'Valid
 770         or else not Day'Valid
 771         or else not Hour'Valid
 772         or else not Minute'Valid
 773         or else not Second'Valid
 774         or else not Sub_Second'Valid
 775       then
 776          raise Constraint_Error;
 777       end if;
 778
 779       return Time_Of (Year, Month, Day,
 780                       Hour, Minute, Second, Sub_Second, False, Time_Zone);
 781
 782    exception
 783       when others => raise Constraint_Error;
 784    end Value;
 785
 786    -----------
 787    -- Value --
 788    -----------
 789
 790    function Value (Elapsed_Time : String) return Duration is
 791       D          : String (1 .. 11);
 792       Hour       : Hour_Number;
 793       Minute     : Minute_Number;
 794       Second     : Second_Number;
 795       Sub_Second : Second_Duration := 0.0;
 796
 797    begin
 798       --  Length checks
 799
 800       if Elapsed_Time'Length /= 8
 801         and then Elapsed_Time'Length /= 11
 802       then
 803          raise Constraint_Error;
 804       end if;
 805
 806       --  After the correct length has been determined, it is safe to copy the
 807       --  Elapsed_Time in order to avoid Date'First + N indexing.
 808
 809       D (1 .. Elapsed_Time'Length) := Elapsed_Time;
 810
 811       --  Format checks
 812
 813       Check_Char (D, ':', 3);
 814       Check_Char (D, ':', 6);
 815
 816       if Elapsed_Time'Length = 11 then
 817          Check_Char (D, '.', 9);
 818       end if;
 819
 820       --  Leading zero checks
 821
 822       Check_Digit (D, 1);
 823       Check_Digit (D, 4);
 824       Check_Digit (D, 7);
 825
 826       if Elapsed_Time'Length = 11 then
 827          Check_Digit (D, 10);
 828       end if;
 829
 830       --  Value extraction
 831
 832       Hour   := Hour_Number   (Hour_Number'Value   (D (1 .. 2)));
 833       Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
 834       Second := Second_Number (Second_Number'Value (D (7 .. 8)));
 835
 836       --  Optional part
 837
 838       if Elapsed_Time'Length = 11 then
 839          Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
 840       end if;
 841
 842       --  Sanity checks
 843
 844       if not Hour'Valid
 845         or else not Minute'Valid
 846         or else not Second'Valid
 847         or else not Sub_Second'Valid
 848       then
 849          raise Constraint_Error;
 850       end if;
 851
 852       return Seconds_Of (Hour, Minute, Second, Sub_Second);
 853
 854    exception
 855       when others => raise Constraint_Error;
 856    end Value;
 857
 858    ----------
 859    -- Year --
 860    ----------
 861
 862    function Year
 863      (Date      : Time;
 864       Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
 865    is
 866       Y  : Year_Number;
 867       Mo : Month_Number;
 868       D  : Day_Number;
 869       H  : Hour_Number;
 870       Mi : Minute_Number;
 871       Se : Second_Number;
 872       Ss : Second_Duration;
 873       Le : Boolean;
 874
 875       pragma Unreferenced (Mo, D, H, Mi);
 876
 877    begin
 878       Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
 879       return Y;
 880    end Year;
 881
 882 end Ada.Calendar.Formatting;