gcc/ada/g-catiio.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                G N A T . C A L E N D A R . T I M E _ I O                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 1999-2007, AdaCore                     --
  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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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.Characters.Handling;
  36 with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
  37 with Ada.Text_IO;
  38
  39 with GNAT.Case_Util;
  40
  41 package body GNAT.Calendar.Time_IO is
  42
  43    type Month_Name is
  44      (January,
  45       February,
  46       March,
  47       April,
  48       May,
  49       June,
  50       July,
  51       August,
  52       September,
  53       October,
  54       November,
  55       December);
  56
  57    function Month_Name_To_Number
  58      (Str : String) return Ada.Calendar.Month_Number;
  59    --  Converts a string that contains an abbreviated month name to a month
  60    --  number. Constraint_Error is raised if Str is not a valid month name.
  61    --  Comparison is case insensitive
  62
  63    type Padding_Mode is (None, Zero, Space);
  64
  65    type Sec_Number is mod 2 ** 64;
  66    --  Type used to compute the number of seconds since 01/01/1970. A 32 bit
  67    --  number will cover only a period of 136 years. This means that for date
  68    --  past 2106 the computation is not possible. A 64 bits number should be
  69    --  enough for a very large period of time.
  70
  71    -----------------------
  72    -- Local Subprograms --
  73    -----------------------
  74
  75    function Am_Pm (H : Natural) return String;
  76    --  Return AM or PM depending on the hour H
  77
  78    function Hour_12 (H : Natural) return Positive;
  79    --  Convert a 1-24h format to a 0-12 hour format
  80
  81    function Image (Str : String; Length : Natural := 0) return String;
  82    --  Return Str capitalized and cut to length number of characters. If
  83    --  length is 0, then no cut operation is performed.
  84
  85    function Image
  86      (N       : Sec_Number;
  87       Padding : Padding_Mode := Zero;
  88       Length  : Natural := 0) return String;
  89    --  Return image of N. This number is eventually padded with zeros or spaces
  90    --  depending of the length required. If length is 0 then no padding occurs.
  91
  92    function Image
  93      (N       : Natural;
  94       Padding : Padding_Mode := Zero;
  95       Length  : Natural := 0) return String;
  96    --  As above with N provided in Integer format
  97
  98    -----------
  99    -- Am_Pm --
 100    -----------
 101
 102    function Am_Pm (H : Natural) return String is
 103    begin
 104       if H = 0 or else H > 12 then
 105          return "PM";
 106       else
 107          return "AM";
 108       end if;
 109    end Am_Pm;
 110
 111    -------------
 112    -- Hour_12 --
 113    -------------
 114
 115    function Hour_12 (H : Natural) return Positive is
 116    begin
 117       if H = 0 then
 118          return 12;
 119       elsif H <= 12 then
 120          return H;
 121       else --  H > 12
 122          return H - 12;
 123       end if;
 124    end Hour_12;
 125
 126    -----------
 127    -- Image --
 128    -----------
 129
 130    function Image
 131      (Str    : String;
 132       Length : Natural := 0) return String
 133    is
 134       use Ada.Characters.Handling;
 135       Local : constant String :=
 136                 To_Upper (Str (Str'First)) &
 137                   To_Lower (Str (Str'First + 1 .. Str'Last));
 138    begin
 139       if Length = 0 then
 140          return Local;
 141       else
 142          return Local (1 .. Length);
 143       end if;
 144    end Image;
 145
 146    -----------
 147    -- Image --
 148    -----------
 149
 150    function Image
 151      (N       : Natural;
 152       Padding : Padding_Mode := Zero;
 153       Length  : Natural := 0) return String
 154    is
 155    begin
 156       return Image (Sec_Number (N), Padding, Length);
 157    end Image;
 158
 159    function Image
 160      (N       : Sec_Number;
 161       Padding : Padding_Mode := Zero;
 162       Length  : Natural := 0) return String
 163    is
 164       function Pad_Char return String;
 165
 166       --------------
 167       -- Pad_Char --
 168       --------------
 169
 170       function Pad_Char return String is
 171       begin
 172          case Padding is
 173             when None  => return "";
 174             when Zero  => return "00";
 175             when Space => return "  ";
 176          end case;
 177       end Pad_Char;
 178
 179       --  Local Declarations
 180
 181       NI  : constant String := Sec_Number'Image (N);
 182       NIP : constant String := Pad_Char & NI (2 .. NI'Last);
 183
 184    --  Start of processing for Image
 185
 186    begin
 187       if Length = 0 or else Padding = None then
 188          return NI (2 .. NI'Last);
 189       else
 190          return NIP (NIP'Last - Length + 1 .. NIP'Last);
 191       end if;
 192    end Image;
 193
 194    -----------
 195    -- Image --
 196    -----------
 197
 198    function Image
 199      (Date    : Ada.Calendar.Time;
 200       Picture : Picture_String) return String
 201    is
 202       Padding : Padding_Mode := Zero;
 203       --  Padding is set for one directive
 204
 205       Result : Unbounded_String;
 206
 207       Year       : Year_Number;
 208       Month      : Month_Number;
 209       Day        : Day_Number;
 210       Hour       : Hour_Number;
 211       Minute     : Minute_Number;
 212       Second     : Second_Number;
 213       Sub_Second : Second_Duration;
 214
 215       P : Positive;
 216
 217    begin
 218       --  Get current time in split format
 219
 220       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
 221
 222       --  Null picture string is error
 223
 224       if Picture = "" then
 225          raise Picture_Error with "null picture string";
 226       end if;
 227
 228       --  Loop through characters of picture string, building result
 229
 230       Result := Null_Unbounded_String;
 231       P := Picture'First;
 232       while P <= Picture'Last loop
 233
 234          --  A directive has the following format "%[-_]."
 235
 236          if Picture (P) = '%' then
 237             Padding := Zero;
 238
 239             if P = Picture'Last then
 240                raise Picture_Error with "picture string ends with '%";
 241             end if;
 242
 243             --  Check for GNU extension to change the padding
 244
 245             if Picture (P + 1) = '-' then
 246                Padding := None;
 247                P := P + 1;
 248
 249             elsif Picture (P + 1) = '_' then
 250                Padding := Space;
 251                P := P + 1;
 252             end if;
 253
 254             if P = Picture'Last then
 255                raise Picture_Error with "picture string ends with '- or '_";
 256             end if;
 257
 258             case Picture (P + 1) is
 259
 260                --  Literal %
 261
 262                when '%' =>
 263                   Result := Result & '%';
 264
 265                --  A newline
 266
 267                when 'n' =>
 268                   Result := Result & ASCII.LF;
 269
 270                --  A horizontal tab
 271
 272                when 't' =>
 273                   Result := Result & ASCII.HT;
 274
 275                --  Hour (00..23)
 276
 277                when 'H' =>
 278                   Result := Result & Image (Hour, Padding, 2);
 279
 280                --  Hour (01..12)
 281
 282                when 'I' =>
 283                   Result := Result & Image (Hour_12 (Hour), Padding, 2);
 284
 285                --  Hour ( 0..23)
 286
 287                when 'k' =>
 288                   Result := Result & Image (Hour, Space, 2);
 289
 290                --  Hour ( 1..12)
 291
 292                when 'l' =>
 293                   Result := Result & Image (Hour_12 (Hour), Space, 2);
 294
 295                --  Minute (00..59)
 296
 297                when 'M' =>
 298                   Result := Result & Image (Minute, Padding, 2);
 299
 300                --  AM/PM
 301
 302                when 'p' =>
 303                   Result := Result & Am_Pm (Hour);
 304
 305                --  Time, 12-hour (hh:mm:ss [AP]M)
 306
 307                when 'r' =>
 308                   Result := Result &
 309                     Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
 310                     Image (Minute, Padding, Length => 2) & ':' &
 311                     Image (Second, Padding, Length => 2) & ' ' &
 312                     Am_Pm (Hour);
 313
 314                --   Seconds since 1970-01-01  00:00:00 UTC
 315                --   (a nonstandard extension)
 316
 317                when 's' =>
 318                   declare
 319                      --  Compute the number of seconds using Ada.Calendar.Time
 320                      --  values rather than Julian days to account for Daylight
 321                      --  Savings Time.
 322
 323                      Neg : Boolean  := False;
 324                      Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);
 325
 326                   begin
 327                      --  Avoid rounding errors and perform special processing
 328                      --  for dates earlier than the Unix Epoc.
 329
 330                      if Sec > 0.0 then
 331                         Sec := Sec - 0.5;
 332                      elsif Sec < 0.0 then
 333                         Neg := True;
 334                         Sec := abs (Sec + 0.5);
 335                      end if;
 336
 337                      --  Prepend a minus sign to the result since Sec_Number
 338                      --  cannot handle negative numbers.
 339
 340                      if Neg then
 341                         Result :=
 342                           Result & "-" & Image (Sec_Number (Sec), None);
 343                      else
 344                         Result := Result & Image (Sec_Number (Sec), None);
 345                      end if;
 346                   end;
 347
 348                --  Second (00..59)
 349
 350                when 'S' =>
 351                   Result := Result & Image (Second, Padding, Length => 2);
 352
 353                --  Milliseconds (3 digits)
 354                --  Microseconds (6 digits)
 355                --  Nanoseconds  (9 digits)
 356
 357                when 'i' | 'e' | 'o' =>
 358                   declare
 359                      Sub_Sec : constant Long_Integer :=
 360                                  Long_Integer (Sub_Second * 1_000_000_000);
 361
 362                      Img1  : constant String := Sub_Sec'Img;
 363                      Img2  : constant String :=
 364                                "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
 365                      Nanos : constant String :=
 366                                Img2 (Img2'Last - 8 .. Img2'Last);
 367
 368                   begin
 369                      case Picture (P + 1) is
 370                         when 'i' =>
 371                            Result := Result &
 372                              Nanos (Nanos'First .. Nanos'First + 2);
 373
 374                         when 'e' =>
 375                            Result := Result &
 376                              Nanos (Nanos'First .. Nanos'First + 5);
 377
 378                         when 'o' =>
 379                            Result := Result & Nanos;
 380
 381                         when others =>
 382                            null;
 383                      end case;
 384                   end;
 385
 386                --  Time, 24-hour (hh:mm:ss)
 387
 388                when 'T' =>
 389                   Result := Result &
 390                     Image (Hour, Padding, Length => 2)   & ':' &
 391                     Image (Minute, Padding, Length => 2) & ':' &
 392                     Image (Second, Padding, Length => 2);
 393
 394                --  Locale's abbreviated weekday name (Sun..Sat)
 395
 396                when 'a' =>
 397                   Result := Result &
 398                     Image (Day_Name'Image (Day_Of_Week (Date)), 3);
 399
 400                --  Locale's full weekday name, variable length
 401                --  (Sunday..Saturday)
 402
 403                when 'A' =>
 404                   Result := Result &
 405                     Image (Day_Name'Image (Day_Of_Week (Date)));
 406
 407                --  Locale's abbreviated month name (Jan..Dec)
 408
 409                when 'b' | 'h' =>
 410                   Result := Result &
 411                     Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
 412
 413                --  Locale's full month name, variable length
 414                --  (January..December).
 415
 416                when 'B' =>
 417                   Result := Result &
 418                     Image (Month_Name'Image (Month_Name'Val (Month - 1)));
 419
 420                --  Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
 421
 422                when 'c' =>
 423                   case Padding is
 424                      when Zero =>
 425                         Result := Result & Image (Date, "%a %b %d %T %Y");
 426                      when Space =>
 427                         Result := Result & Image (Date, "%a %b %_d %_T %Y");
 428                      when None =>
 429                         Result := Result & Image (Date, "%a %b %-d %-T %Y");
 430                   end case;
 431
 432                --   Day of month (01..31)
 433
 434                when 'd' =>
 435                   Result := Result & Image (Day, Padding, 2);
 436
 437                --  Date (mm/dd/yy)
 438
 439                when 'D' | 'x' =>
 440                   Result := Result &
 441                               Image (Month, Padding, 2) & '/' &
 442                               Image (Day, Padding, 2) & '/' &
 443                               Image (Year, Padding, 2);
 444
 445                --  Day of year (001..366)
 446
 447                when 'j' =>
 448                   Result := Result & Image (Day_In_Year (Date), Padding, 3);
 449
 450                --  Month (01..12)
 451
 452                when 'm' =>
 453                   Result := Result & Image (Month, Padding, 2);
 454
 455                --  Week number of year with Sunday as first day of week
 456                --  (00..53)
 457
 458                when 'U' =>
 459                   declare
 460                      Offset : constant Natural :=
 461                                 (Julian_Day (Year, 1, 1) + 1) mod 7;
 462
 463                      Week : constant Natural :=
 464                               1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
 465
 466                   begin
 467                      Result := Result & Image (Week, Padding, 2);
 468                   end;
 469
 470                --  Day of week (0..6) with 0 corresponding to Sunday
 471
 472                when 'w' =>
 473                   declare
 474                      DOW : Natural range 0 .. 6;
 475
 476                   begin
 477                      if Day_Of_Week (Date) = Sunday then
 478                         DOW := 0;
 479                      else
 480                         DOW := Day_Name'Pos (Day_Of_Week (Date));
 481                      end if;
 482
 483                      Result := Result & Image (DOW, Length => 1);
 484                   end;
 485
 486                --  Week number of year with Monday as first day of week
 487                --  (00..53)
 488
 489                when 'W' =>
 490                   Result := Result & Image (Week_In_Year (Date), Padding, 2);
 491
 492                --  Last two digits of year (00..99)
 493
 494                when 'y' =>
 495                   declare
 496                      Y : constant Natural := Year - (Year / 100) * 100;
 497                   begin
 498                      Result := Result & Image (Y, Padding, 2);
 499                   end;
 500
 501                --   Year (1970...)
 502
 503                when 'Y' =>
 504                   Result := Result & Image (Year, None, 4);
 505
 506                when others =>
 507                   raise Picture_Error with
 508                     "unknown format character in picture string";
 509
 510             end case;
 511
 512             --  Skip past % and format character
 513
 514             P := P + 2;
 515
 516          --  Character other than % is copied into the result
 517
 518          else
 519             Result := Result & Picture (P);
 520             P := P + 1;
 521          end if;
 522       end loop;
 523
 524       return To_String (Result);
 525    end Image;
 526
 527    --------------------------
 528    -- Month_Name_To_Number --
 529    --------------------------
 530
 531    function Month_Name_To_Number
 532      (Str : String) return Ada.Calendar.Month_Number
 533    is
 534       subtype String3 is String (1 .. 3);
 535       Abbrev_Upper_Month_Names :
 536         constant array (Ada.Calendar.Month_Number) of String3 :=
 537          ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
 538           "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");
 539       --  Short version of the month names, used when parsing date strings
 540
 541       S                                                     : String := Str;
 542
 543    begin
 544       GNAT.Case_Util.To_Upper (S);
 545
 546       for J in Abbrev_Upper_Month_Names'Range loop
 547          if Abbrev_Upper_Month_Names (J) = S then
 548             return J;
 549          end if;
 550       end loop;
 551
 552       return Abbrev_Upper_Month_Names'First;
 553    end Month_Name_To_Number;
 554
 555    -----------
 556    -- Value --
 557    -----------
 558
 559    function Value (Date : String) return Ada.Calendar.Time is
 560       D          : String (1 .. 21);
 561       D_Length   : constant Natural := Date'Length;
 562
 563       Year       : Year_Number;
 564       Month      : Month_Number;
 565       Day        : Day_Number;
 566       Hour       : Hour_Number;
 567       Minute     : Minute_Number;
 568       Second     : Second_Number;
 569       Sub_Second : Second_Duration;
 570
 571       procedure Extract_Date
 572         (Year       : out Year_Number;
 573          Month      : out Month_Number;
 574          Day        : out Day_Number;
 575          Time_Start : out Natural);
 576       --  Try and extract a date value from string D. Time_Start is set to the
 577       --  first character that could be the start of time data.
 578
 579       procedure Extract_Time
 580         (Index       : Positive;
 581          Hour        : out Hour_Number;
 582          Minute      : out Minute_Number;
 583          Second      : out Second_Number;
 584          Check_Space : Boolean := False);
 585       --  Try and extract a time value from string D starting from position
 586       --  Index. Set Check_Space to True to check whether the character at
 587       --  Index - 1 is a space. Raise Constraint_Error if the portion of D
 588       --  corresponding to the date is not well formatted.
 589
 590       ------------------
 591       -- Extract_Date --
 592       ------------------
 593
 594       procedure Extract_Date
 595         (Year       : out Year_Number;
 596          Month      : out Month_Number;
 597          Day        : out Day_Number;
 598          Time_Start : out Natural)
 599       is
 600       begin
 601          if D (3) = '-' or else D (3) = '/' then
 602             if D_Length = 8 or else D_Length = 17 then
 603
 604                --  Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
 605
 606                if D (6) /= D (3) then
 607                   raise Constraint_Error;
 608                end if;
 609
 610                Year  := Year_Number'Value ("20" & D (1 .. 2));
 611                Month := Month_Number'Value       (D (4 .. 5));
 612                Day   := Day_Number'Value         (D (7 .. 8));
 613                Time_Start := 10;
 614
 615             elsif D_Length = 10 or else D_Length = 19 then
 616
 617                --  Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
 618
 619                if D (6) /= D (3) then
 620                   raise Constraint_Error;
 621                end if;
 622
 623                Year  := Year_Number'Value  (D (7 .. 10));
 624                Month := Month_Number'Value (D (1 .. 2));
 625                Day   := Day_Number'Value   (D (4 .. 5));
 626                Time_Start := 12;
 627
 628             elsif D_Length = 11 or else D_Length = 20 then
 629
 630                --  Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
 631
 632                if D (7) /= D (3) then
 633                   raise Constraint_Error;
 634                end if;
 635
 636                Year  := Year_Number'Value  (D (8 .. 11));
 637                Month := Month_Name_To_Number (D (4 .. 6));
 638                Day   := Day_Number'Value   (D (1 .. 2));
 639                Time_Start := 13;
 640
 641             else
 642                raise Constraint_Error;
 643             end if;
 644
 645          elsif D (3) = ' ' then
 646             if D_Length = 11 or else D_Length = 20 then
 647
 648                --  Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
 649
 650                if D (7) /= ' ' then
 651                   raise Constraint_Error;
 652                end if;
 653
 654                Year  := Year_Number'Value  (D (8 .. 11));
 655                Month := Month_Name_To_Number (D (4 .. 6));
 656                Day   := Day_Number'Value   (D (1 .. 2));
 657                Time_Start := 13;
 658
 659             else
 660                raise Constraint_Error;
 661             end if;
 662
 663          else
 664             if D_Length = 8 or else D_Length = 17 then
 665
 666                --  Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
 667
 668                Year  := Year_Number'Value (D (1 .. 4));
 669                Month := Month_Number'Value (D (5 .. 6));
 670                Day   := Day_Number'Value (D (7 .. 8));
 671                Time_Start := 10;
 672
 673             elsif D_Length = 10 or else D_Length = 19 then
 674
 675                --  Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
 676
 677                if (D (5) /= '-' and then D (5) /= '/')
 678                  or else D (8) /= D (5)
 679                then
 680                   raise Constraint_Error;
 681                end if;
 682
 683                Year  := Year_Number'Value (D (1 .. 4));
 684                Month := Month_Number'Value (D (6 .. 7));
 685                Day   := Day_Number'Value (D (9 .. 10));
 686                Time_Start := 12;
 687
 688             elsif D_Length = 11 or else D_Length = 20 then
 689
 690                --  Possible formats are "yyyy*mmm*dd"
 691
 692                if (D (5) /= '-' and then D (5) /= '/')
 693                  or else D (9) /= D (5)
 694                then
 695                   raise Constraint_Error;
 696                end if;
 697
 698                Year  := Year_Number'Value (D (1 .. 4));
 699                Month := Month_Name_To_Number (D (6 .. 8));
 700                Day   := Day_Number'Value (D (10 .. 11));
 701                Time_Start := 13;
 702
 703             elsif D_Length = 12 or else D_Length = 21 then
 704
 705                --  Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
 706
 707                if D (4) /= ' '
 708                  or else D (7) /= ','
 709                  or else D (8) /= ' '
 710                then
 711                   raise Constraint_Error;
 712                end if;
 713
 714                Year  := Year_Number'Value (D (9 .. 12));
 715                Month := Month_Name_To_Number (D (1 .. 3));
 716                Day   := Day_Number'Value (D (5 .. 6));
 717                Time_Start := 14;
 718
 719             else
 720                raise Constraint_Error;
 721             end if;
 722          end if;
 723       end Extract_Date;
 724
 725       ------------------
 726       -- Extract_Time --
 727       ------------------
 728
 729       procedure Extract_Time
 730         (Index       : Positive;
 731          Hour        : out Hour_Number;
 732          Minute      : out Minute_Number;
 733          Second      : out Second_Number;
 734          Check_Space : Boolean := False)
 735       is
 736       begin
 737          --  If no time was specified in the string (do not allow trailing
 738          --  character either)
 739
 740          if Index = D_Length + 2 then
 741             Hour   := 0;
 742             Minute := 0;
 743             Second := 0;
 744
 745          else
 746             --  Not enough characters left ?
 747
 748             if Index /= D_Length - 7 then
 749                raise Constraint_Error;
 750             end if;
 751
 752             if Check_Space and then D (Index - 1) /= ' ' then
 753                raise Constraint_Error;
 754             end if;
 755
 756             if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
 757                raise Constraint_Error;
 758             end if;
 759
 760             Hour   := Hour_Number'Value   (D (Index     .. Index + 1));
 761             Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
 762             Second := Second_Number'Value (D (Index + 6 .. Index + 7));
 763          end if;
 764       end Extract_Time;
 765
 766       --  Local Declarations
 767
 768       Time_Start : Natural := 1;
 769
 770    --  Start of processing for Value
 771
 772    begin
 773       Split (Clock, Year, Month, Day, Hour, Minute, Second, Sub_Second);
 774       Sub_Second := 0.0;
 775
 776       --  Length checks
 777
 778       if D_Length /= 8
 779         and then D_Length /= 10
 780         and then D_Length /= 11
 781         and then D_Length /= 12
 782         and then D_Length /= 17
 783         and then D_Length /= 19
 784         and then D_Length /= 20
 785         and then D_Length /= 21
 786       then
 787          raise Constraint_Error;
 788       end if;
 789
 790       --  After the correct length has been determined, it is safe to create
 791       --  a local string copy in order to avoid String'First N arithmetic.
 792
 793       D (1 .. D_Length) := Date;
 794
 795       if D_Length /= 8
 796         or else D (3) /= ':'
 797       then
 798          Extract_Date (Year, Month, Day, Time_Start);
 799          Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
 800       else
 801          Extract_Time (1, Hour, Minute, Second, Check_Space => False);
 802       end if;
 803
 804       --  Sanity checks
 805
 806       if not Year'Valid
 807         or else not Month'Valid
 808         or else not Day'Valid
 809         or else not Hour'Valid
 810         or else not Minute'Valid
 811         or else not Second'Valid
 812       then
 813          raise Constraint_Error;
 814       end if;
 815
 816       return Time_Of (Year, Month, Day, Hour, Minute, Second, Sub_Second);
 817    end Value;
 818
 819    --------------
 820    -- Put_Time --
 821    --------------
 822
 823    procedure Put_Time
 824      (Date    : Ada.Calendar.Time;
 825       Picture : Picture_String)
 826    is
 827    begin
 828       Ada.Text_IO.Put (Image (Date, Picture));
 829    end Put_Time;
 830
 831 end GNAT.Calendar.Time_IO;