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