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