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-2008, 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
 570       procedure Extract_Date
 571         (Year       : out Year_Number;
 572          Month      : out Month_Number;
 573          Day        : out Day_Number;
 574          Time_Start : out Natural);
 575       --  Try and extract a date value from string D. Time_Start is set to the
 576       --  first character that could be the start of time data.
 577
 578       procedure Extract_Time
 579         (Index       : Positive;
 580          Hour        : out Hour_Number;
 581          Minute      : out Minute_Number;
 582          Second      : out Second_Number;
 583          Check_Space : Boolean := False);
 584       --  Try and extract a time value from string D starting from position
 585       --  Index. Set Check_Space to True to check whether the character at
 586       --  Index - 1 is a space. Raise Constraint_Error if the portion of D
 587       --  corresponding to the date is not well formatted.
 588
 589       ------------------
 590       -- Extract_Date --
 591       ------------------
 592
 593       procedure Extract_Date
 594         (Year       : out Year_Number;
 595          Month      : out Month_Number;
 596          Day        : out Day_Number;
 597          Time_Start : out Natural)
 598       is
 599       begin
 600          if D (3) = '-' or else D (3) = '/' then
 601             if D_Length = 8 or else D_Length = 17 then
 602
 603                --  Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
 604
 605                if D (6) /= D (3) then
 606                   raise Constraint_Error;
 607                end if;
 608
 609                Year  := Year_Number'Value ("20" & D (1 .. 2));
 610                Month := Month_Number'Value       (D (4 .. 5));
 611                Day   := Day_Number'Value         (D (7 .. 8));
 612                Time_Start := 10;
 613
 614             elsif D_Length = 10 or else D_Length = 19 then
 615
 616                --  Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
 617
 618                if D (6) /= D (3) then
 619                   raise Constraint_Error;
 620                end if;
 621
 622                Year  := Year_Number'Value  (D (7 .. 10));
 623                Month := Month_Number'Value (D (1 .. 2));
 624                Day   := Day_Number'Value   (D (4 .. 5));
 625                Time_Start := 12;
 626
 627             elsif D_Length = 11 or else D_Length = 20 then
 628
 629                --  Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
 630
 631                if D (7) /= D (3) then
 632                   raise Constraint_Error;
 633                end if;
 634
 635                Year  := Year_Number'Value  (D (8 .. 11));
 636                Month := Month_Name_To_Number (D (4 .. 6));
 637                Day   := Day_Number'Value   (D (1 .. 2));
 638                Time_Start := 13;
 639
 640             else
 641                raise Constraint_Error;
 642             end if;
 643
 644          elsif D (3) = ' ' then
 645             if D_Length = 11 or else D_Length = 20 then
 646
 647                --  Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
 648
 649                if D (7) /= ' ' then
 650                   raise Constraint_Error;
 651                end if;
 652
 653                Year  := Year_Number'Value  (D (8 .. 11));
 654                Month := Month_Name_To_Number (D (4 .. 6));
 655                Day   := Day_Number'Value   (D (1 .. 2));
 656                Time_Start := 13;
 657
 658             else
 659                raise Constraint_Error;
 660             end if;
 661
 662          else
 663             if D_Length = 8 or else D_Length = 17 then
 664
 665                --  Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
 666
 667                Year  := Year_Number'Value (D (1 .. 4));
 668                Month := Month_Number'Value (D (5 .. 6));
 669                Day   := Day_Number'Value (D (7 .. 8));
 670                Time_Start := 10;
 671
 672             elsif D_Length = 10 or else D_Length = 19 then
 673
 674                --  Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
 675
 676                if (D (5) /= '-' and then D (5) /= '/')
 677                  or else D (8) /= D (5)
 678                then
 679                   raise Constraint_Error;
 680                end if;
 681
 682                Year  := Year_Number'Value (D (1 .. 4));
 683                Month := Month_Number'Value (D (6 .. 7));
 684                Day   := Day_Number'Value (D (9 .. 10));
 685                Time_Start := 12;
 686
 687             elsif D_Length = 11 or else D_Length = 20 then
 688
 689                --  Possible formats are "yyyy*mmm*dd"
 690
 691                if (D (5) /= '-' and then D (5) /= '/')
 692                  or else D (9) /= D (5)
 693                then
 694                   raise Constraint_Error;
 695                end if;
 696
 697                Year  := Year_Number'Value (D (1 .. 4));
 698                Month := Month_Name_To_Number (D (6 .. 8));
 699                Day   := Day_Number'Value (D (10 .. 11));
 700                Time_Start := 13;
 701
 702             elsif D_Length = 12 or else D_Length = 21 then
 703
 704                --  Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
 705
 706                if D (4) /= ' '
 707                  or else D (7) /= ','
 708                  or else D (8) /= ' '
 709                then
 710                   raise Constraint_Error;
 711                end if;
 712
 713                Year  := Year_Number'Value (D (9 .. 12));
 714                Month := Month_Name_To_Number (D (1 .. 3));
 715                Day   := Day_Number'Value (D (5 .. 6));
 716                Time_Start := 14;
 717
 718             else
 719                raise Constraint_Error;
 720             end if;
 721          end if;
 722       end Extract_Date;
 723
 724       ------------------
 725       -- Extract_Time --
 726       ------------------
 727
 728       procedure Extract_Time
 729         (Index       : Positive;
 730          Hour        : out Hour_Number;
 731          Minute      : out Minute_Number;
 732          Second      : out Second_Number;
 733          Check_Space : Boolean := False)
 734       is
 735       begin
 736          --  If no time was specified in the string (do not allow trailing
 737          --  character either)
 738
 739          if Index = D_Length + 2 then
 740             Hour   := 0;
 741             Minute := 0;
 742             Second := 0;
 743
 744          else
 745             --  Not enough characters left ?
 746
 747             if Index /= D_Length - 7 then
 748                raise Constraint_Error;
 749             end if;
 750
 751             if Check_Space and then D (Index - 1) /= ' ' then
 752                raise Constraint_Error;
 753             end if;
 754
 755             if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
 756                raise Constraint_Error;
 757             end if;
 758
 759             Hour   := Hour_Number'Value   (D (Index     .. Index + 1));
 760             Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
 761             Second := Second_Number'Value (D (Index + 6 .. Index + 7));
 762          end if;
 763       end Extract_Time;
 764
 765       --  Local Declarations
 766
 767       Time_Start : Natural := 1;
 768
 769    --  Start of processing for Value
 770
 771    begin
 772       --  Length checks
 773
 774       if D_Length /= 8
 775         and then D_Length /= 10
 776         and then D_Length /= 11
 777         and then D_Length /= 12
 778         and then D_Length /= 17
 779         and then D_Length /= 19
 780         and then D_Length /= 20
 781         and then D_Length /= 21
 782       then
 783          raise Constraint_Error;
 784       end if;
 785
 786       --  After the correct length has been determined, it is safe to create
 787       --  a local string copy in order to avoid String'First N arithmetic.
 788
 789       D (1 .. D_Length) := Date;
 790
 791       if D_Length /= 8 or else D (3) /= ':' then
 792          Extract_Date (Year, Month, Day, Time_Start);
 793          Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
 794
 795       else
 796          declare
 797             Discard : Second_Duration;
 798             pragma Unreferenced (Discard);
 799          begin
 800             Split (Clock, Year, Month, Day, Hour, Minute, Second,
 801                    Sub_Second => Discard);
 802          end;
 803
 804          Extract_Time (1, Hour, Minute, Second, Check_Space => False);
 805       end if;
 806
 807       --  Sanity checks
 808
 809       if not Year'Valid
 810         or else not Month'Valid
 811         or else not Day'Valid
 812         or else not Hour'Valid
 813         or else not Minute'Valid
 814         or else not Second'Valid
 815       then
 816          raise Constraint_Error;
 817       end if;
 818
 819       return Time_Of (Year, Month, Day, Hour, Minute, Second);
 820    end Value;
 821
 822    --------------
 823    -- Put_Time --
 824    --------------
 825
 826    procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
 827    begin
 828       Ada.Text_IO.Put (Image (Date, Picture));
 829    end Put_Time;
 830
 831 end GNAT.Calendar.Time_IO;