gcc/ada/a-calfor.adb

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