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