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-2014, 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
 504             end case;
 505
 506             --  Skip past % and format character
 507
 508             P := P + 2;
 509
 510          --  Character other than % is copied into the result
 511
 512          else
 513             Result := Result & Picture (P);
 514             P := P + 1;
 515          end if;
 516       end loop;
 517
 518       return To_String (Result);
 519    end Image;
 520
 521    --------------------------
 522    -- Month_Name_To_Number --
 523    --------------------------
 524
 525    function Month_Name_To_Number
 526      (Str : String) return Ada.Calendar.Month_Number
 527    is
 528       subtype String3 is String (1 .. 3);
 529       Abbrev_Upper_Month_Names :
 530         constant array (Ada.Calendar.Month_Number) of String3 :=
 531          ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
 532           "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");
 533       --  Short version of the month names, used when parsing date strings
 534
 535       S                                                     : String := Str;
 536
 537    begin
 538       GNAT.Case_Util.To_Upper (S);
 539
 540       for J in Abbrev_Upper_Month_Names'Range loop
 541          if Abbrev_Upper_Month_Names (J) = S then
 542             return J;
 543          end if;
 544       end loop;
 545
 546       return Abbrev_Upper_Month_Names'First;
 547    end Month_Name_To_Number;
 548
 549    -----------
 550    -- Value --
 551    -----------
 552
 553    function Value (Date : String) return Ada.Calendar.Time is
 554       D          : String (1 .. 21);
 555       D_Length   : constant Natural := Date'Length;
 556
 557       Year   : Year_Number;
 558       Month  : Month_Number;
 559       Day    : Day_Number;
 560       Hour   : Hour_Number;
 561       Minute : Minute_Number;
 562       Second : Second_Number;
 563
 564       procedure Extract_Date
 565         (Year       : out Year_Number;
 566          Month      : out Month_Number;
 567          Day        : out Day_Number;
 568          Time_Start : out Natural);
 569       --  Try and extract a date value from string D. Time_Start is set to the
 570       --  first character that could be the start of time data.
 571
 572       procedure Extract_Time
 573         (Index       : Positive;
 574          Hour        : out Hour_Number;
 575          Minute      : out Minute_Number;
 576          Second      : out Second_Number;
 577          Check_Space : Boolean := False);
 578       --  Try and extract a time value from string D starting from position
 579       --  Index. Set Check_Space to True to check whether the character at
 580       --  Index - 1 is a space. Raise Constraint_Error if the portion of D
 581       --  corresponding to the date is not well formatted.
 582
 583       ------------------
 584       -- Extract_Date --
 585       ------------------
 586
 587       procedure Extract_Date
 588         (Year       : out Year_Number;
 589          Month      : out Month_Number;
 590          Day        : out Day_Number;
 591          Time_Start : out Natural)
 592       is
 593       begin
 594          if D (3) = '-' or else D (3) = '/' then
 595             if D_Length = 8 or else D_Length = 17 then
 596
 597                --  Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
 598
 599                if D (6) /= D (3) then
 600                   raise Constraint_Error;
 601                end if;
 602
 603                Year  := Year_Number'Value ("20" & D (1 .. 2));
 604                Month := Month_Number'Value       (D (4 .. 5));
 605                Day   := Day_Number'Value         (D (7 .. 8));
 606                Time_Start := 10;
 607
 608             elsif D_Length = 10 or else D_Length = 19 then
 609
 610                --  Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
 611
 612                if D (6) /= D (3) then
 613                   raise Constraint_Error;
 614                end if;
 615
 616                Year  := Year_Number'Value  (D (7 .. 10));
 617                Month := Month_Number'Value (D (1 .. 2));
 618                Day   := Day_Number'Value   (D (4 .. 5));
 619                Time_Start := 12;
 620
 621             elsif D_Length = 11 or else D_Length = 20 then
 622
 623                --  Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
 624
 625                if D (7) /= D (3) then
 626                   raise Constraint_Error;
 627                end if;
 628
 629                Year  := Year_Number'Value  (D (8 .. 11));
 630                Month := Month_Name_To_Number (D (4 .. 6));
 631                Day   := Day_Number'Value   (D (1 .. 2));
 632                Time_Start := 13;
 633
 634             else
 635                raise Constraint_Error;
 636             end if;
 637
 638          elsif D (3) = ' ' then
 639             if D_Length = 11 or else D_Length = 20 then
 640
 641                --  Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
 642
 643                if D (7) /= ' ' then
 644                   raise Constraint_Error;
 645                end if;
 646
 647                Year  := Year_Number'Value  (D (8 .. 11));
 648                Month := Month_Name_To_Number (D (4 .. 6));
 649                Day   := Day_Number'Value   (D (1 .. 2));
 650                Time_Start := 13;
 651
 652             else
 653                raise Constraint_Error;
 654             end if;
 655
 656          else
 657             if D_Length = 8 or else D_Length = 17 then
 658
 659                --  Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
 660
 661                Year  := Year_Number'Value (D (1 .. 4));
 662                Month := Month_Number'Value (D (5 .. 6));
 663                Day   := Day_Number'Value (D (7 .. 8));
 664                Time_Start := 10;
 665
 666             elsif D_Length = 10 or else D_Length = 19 then
 667
 668                --  Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
 669
 670                if (D (5) /= '-' and then D (5) /= '/')
 671                  or else D (8) /= D (5)
 672                then
 673                   raise Constraint_Error;
 674                end if;
 675
 676                Year  := Year_Number'Value (D (1 .. 4));
 677                Month := Month_Number'Value (D (6 .. 7));
 678                Day   := Day_Number'Value (D (9 .. 10));
 679                Time_Start := 12;
 680
 681             elsif D_Length = 11 or else D_Length = 20 then
 682
 683                --  Possible formats are "yyyy*mmm*dd"
 684
 685                if (D (5) /= '-' and then D (5) /= '/')
 686                  or else D (9) /= D (5)
 687                then
 688                   raise Constraint_Error;
 689                end if;
 690
 691                Year  := Year_Number'Value (D (1 .. 4));
 692                Month := Month_Name_To_Number (D (6 .. 8));
 693                Day   := Day_Number'Value (D (10 .. 11));
 694                Time_Start := 13;
 695
 696             elsif D_Length = 12 or else D_Length = 21 then
 697
 698                --  Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
 699
 700                if D (4) /= ' '
 701                  or else D (7) /= ','
 702                  or else D (8) /= ' '
 703                then
 704                   raise Constraint_Error;
 705                end if;
 706
 707                Year  := Year_Number'Value (D (9 .. 12));
 708                Month := Month_Name_To_Number (D (1 .. 3));
 709                Day   := Day_Number'Value (D (5 .. 6));
 710                Time_Start := 14;
 711
 712             else
 713                raise Constraint_Error;
 714             end if;
 715          end if;
 716       end Extract_Date;
 717
 718       ------------------
 719       -- Extract_Time --
 720       ------------------
 721
 722       procedure Extract_Time
 723         (Index       : Positive;
 724          Hour        : out Hour_Number;
 725          Minute      : out Minute_Number;
 726          Second      : out Second_Number;
 727          Check_Space : Boolean := False)
 728       is
 729       begin
 730          --  If no time was specified in the string (do not allow trailing
 731          --  character either)
 732
 733          if Index = D_Length + 2 then
 734             Hour   := 0;
 735             Minute := 0;
 736             Second := 0;
 737
 738          else
 739             --  Not enough characters left ?
 740
 741             if Index /= D_Length - 7 then
 742                raise Constraint_Error;
 743             end if;
 744
 745             if Check_Space and then D (Index - 1) /= ' ' then
 746                raise Constraint_Error;
 747             end if;
 748
 749             if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
 750                raise Constraint_Error;
 751             end if;
 752
 753             Hour   := Hour_Number'Value   (D (Index     .. Index + 1));
 754             Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
 755             Second := Second_Number'Value (D (Index + 6 .. Index + 7));
 756          end if;
 757       end Extract_Time;
 758
 759       --  Local Declarations
 760
 761       Time_Start : Natural := 1;
 762
 763    --  Start of processing for Value
 764
 765    begin
 766       --  Length checks
 767
 768       if D_Length /= 8
 769         and then D_Length /= 10
 770         and then D_Length /= 11
 771         and then D_Length /= 12
 772         and then D_Length /= 17
 773         and then D_Length /= 19
 774         and then D_Length /= 20
 775         and then D_Length /= 21
 776       then
 777          raise Constraint_Error;
 778       end if;
 779
 780       --  After the correct length has been determined, it is safe to create
 781       --  a local string copy in order to avoid String'First N arithmetic.
 782
 783       D (1 .. D_Length) := Date;
 784
 785       if D_Length /= 8 or else D (3) /= ':' then
 786          Extract_Date (Year, Month, Day, Time_Start);
 787          Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
 788
 789       else
 790          declare
 791             Discard : Second_Duration;
 792          begin
 793             Split (Clock, Year, Month, Day, Hour, Minute, Second,
 794                    Sub_Second => Discard);
 795          end;
 796
 797          Extract_Time (1, Hour, Minute, Second, Check_Space => False);
 798       end if;
 799
 800       --  Sanity checks
 801
 802       if not Year'Valid
 803         or else not Month'Valid
 804         or else not Day'Valid
 805         or else not Hour'Valid
 806         or else not Minute'Valid
 807         or else not Second'Valid
 808       then
 809          raise Constraint_Error;
 810       end if;
 811
 812       return Time_Of (Year, Month, Day, Hour, Minute, Second);
 813    end Value;
 814
 815    --------------
 816    -- Put_Time --
 817    --------------
 818
 819    procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
 820    begin
 821       Ada.Text_IO.Put (Image (Date, Picture));
 822    end Put_Time;
 823
 824 end GNAT.Calendar.Time_IO;