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