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