g-catiio.ads, [...] (Value): New function.

2006-10-31  Hristian Kirtchev  <kirtchev@adacore.com>

	* g-catiio.ads, g-catiio.adb (Value): New function.
	Given an input String, try and parse a valid Time value.

From-SVN: r118274

gcc/ada/g-catiio.adb

@@ -8,10 +8,6 @@
 --                                                                          --
 --                     Copyright (C) 1999-2006, AdaCore                     --
 --                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
---                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
@@ -76,7 +72,7 @@ package body GNAT.Calendar.Time_IO is
 
    function Image (Str : String; Length : Natural := 0) return String;
    --  Return Str capitalized and cut to length number of characters. If
-   --  length is set to 0 it does not cut it.
+   --  length is 0, then no cut operation is performed.
 
    function Image
      (N       : Sec_Number;
@@ -129,7 +125,8 @@ package body GNAT.Calendar.Time_IO is
    is
       use Ada.Characters.Handling;
       Local : constant String :=
-                To_Upper (Str (1)) & To_Lower (Str (2 .. Str'Last));
+                To_Upper (Str (Str'First)) &
+                  To_Lower (Str (Str'First + 1 .. Str'Last));
    begin
       if Length = 0 then
          return Local;
@@ -214,7 +211,6 @@ package body GNAT.Calendar.Time_IO is
          --  A directive has the following format "%[-_]."
 
          if Picture (P) = '%' then
-
             Padding := Zero;
 
             if P = Picture'Last then
@@ -297,8 +293,8 @@ package body GNAT.Calendar.Time_IO is
                when 's' =>
                   declare
                      Sec : constant Sec_Number :=
-                             Sec_Number (Julian_Day (Year, Month, Day) -
-                                       Julian_Day (1970, 1, 1)) * 86_400
+                             Sec_Number (Julian_Day (Year, Month, Day)
+                                          - Julian_Day (1970, 1, 1)) * 86_400
                                           + Sec_Number (Hour) * 3_600
                                           + Sec_Number (Minute) * 60
                                           + Sec_Number (Second);
@@ -373,7 +369,7 @@ package body GNAT.Calendar.Time_IO is
                     Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
 
                --  Locale's full month name, variable length
-               --  (January..December)
+               --  (January..December).
 
                when 'B' =>
                   Result := Result &
@@ -483,6 +479,181 @@ package body GNAT.Calendar.Time_IO is
       return To_String (Result);
    end Image;
 
+   -----------
+   -- Value --
+   -----------
+
+   function Value (Date : String) return Ada.Calendar.Time is
+      D          : String (1 .. 19);
+      D_Length   : constant Natural := Date'Length;
+
+      Year       : Year_Number;
+      Month      : Month_Number;
+      Day        : Day_Number;
+      Hour       : Hour_Number;
+      Minute     : Minute_Number;
+      Second     : Second_Number;
+      Sub_Second : Second_Duration;
+
+      procedure Extract_Date
+        (Year  : out Year_Number;
+         Month : out Month_Number;
+         Day   : out Day_Number;
+         Y2K   : Boolean := False);
+      --  Try and extract a date value from string D. Set Y2K to True to
+      --  account for the 20YY case. Raise Constraint_Error if the portion
+      --  of D corresponding to the date is not well formatted.
+
+      procedure Extract_Time
+        (Index       : Positive;
+         Hour        : out Hour_Number;
+         Minute      : out Minute_Number;
+         Second      : out Second_Number;
+         Check_Space : Boolean := False);
+      --  Try and extract a time value from string D starting from position
+      --  Index. Set Check_Space to True to check whether the character at
+      --  Index - 1 is a space. Raise Constraint_Error if the portion of D
+      --  corresponding to the date is not well formatted.
+
+      ------------------
+      -- Extract_Date --
+      ------------------
+
+      procedure Extract_Date
+        (Year  : out Year_Number;
+         Month : out Month_Number;
+         Day   : out Day_Number;
+         Y2K   : Boolean := False)
+      is
+         Delim_Index : Positive := 5;
+
+      begin
+         if Y2K then
+            Delim_Index := 3;
+         end if;
+
+         if (D (Delim_Index) /= '-' or else D (Delim_Index + 3) /= '-')
+           and then
+            (D (Delim_Index) /= '/' or else D (Delim_Index + 3) /= '/')
+         then
+            raise Constraint_Error;
+         end if;
+
+         if Y2K then
+            Year  := Year_Number'Value ("20" & D (1 .. 2));
+            Month := Month_Number'Value       (D (4 .. 5));
+            Day   := Day_Number'Value         (D (7 .. 8));
+         else
+            Year  := Year_Number'Value  (D (1 .. 4));
+            Month := Month_Number'Value (D (6 .. 7));
+            Day   := Day_Number'Value   (D (9 .. 10));
+         end if;
+      end Extract_Date;
+
+      ------------------
+      -- Extract_Time --
+      ------------------
+
+      procedure Extract_Time
+        (Index       : Positive;
+         Hour        : out Hour_Number;
+         Minute      : out Minute_Number;
+         Second      : out Second_Number;
+         Check_Space : Boolean := False) is
+
+      begin
+         if Check_Space and then D (Index - 1) /= ' ' then
+            raise Constraint_Error;
+         end if;
+
+         if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
+            raise Constraint_Error;
+         end if;
+
+         Hour   := Hour_Number'Value   (D (Index     .. Index + 1));
+         Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
+         Second := Second_Number'Value (D (Index + 6 .. Index + 7));
+      end Extract_Time;
+
+   --  Start of processing for Value
+
+   begin
+      Split (Clock, Year, Month, Day, Hour, Minute, Second, Sub_Second);
+      Sub_Second := 0.0;
+
+      --  Length checks
+
+      if D_Length /= 8
+        and then D_Length /= 10
+        and then D_Length /= 17
+        and then D_Length /= 19
+      then
+         raise Constraint_Error;
+      end if;
+
+      --  After the correct length has been determined, it is safe to create
+      --  a local string copy in order to avoid String'First N arithmetic.
+
+      D (1 .. D_Length) := Date;
+
+      --  Case 1:
+
+      --    hh:mm:ss
+      --    yy*mm*dd
+
+      if D_Length = 8 then
+
+         if D (3) = ':' then
+            Extract_Time (1, Hour, Minute, Second);
+         else
+            Extract_Date (Year, Month, Day, True);
+            Hour   := 0;
+            Minute := 0;
+            Second := 0;
+         end if;
+
+      --  Case 2:
+
+      --    yyyy*mm*dd
+
+      elsif D_Length = 10 then
+         Extract_Date (Year, Month, Day);
+         Hour   := 0;
+         Minute := 0;
+         Second := 0;
+
+      --  Case 3:
+
+      --    yy*mm*dd hh:mm:ss
+
+      elsif D_Length = 17 then
+         Extract_Date (Year, Month, Day, True);
+         Extract_Time (10, Hour, Minute, Second, True);
+
+      --  Case 4:
+
+      --    yyyy*mm*dd hh:mm:ss
+
+      else
+         Extract_Date (Year, Month, Day);
+         Extract_Time (12, Hour, Minute, Second, True);
+      end if;
+
+      --  Sanity checks
+
+      if not Year'Valid
+        or else not Month'Valid
+        or else not Day'Valid
+        or else not Hour'Valid
+        or else not Minute'Valid
+        or else not Second'Valid
+      then
+         raise Constraint_Error;
+      end if;
+
+      return Time_Of (Year, Month, Day, Hour, Minute, Second, Sub_Second);
+   end Value;
+
    --------------
    -- Put_Time --
    --------------

gcc/ada/g-catiio.ads

@@ -6,11 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1999-2005, AdaCore                     --
---                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
+--                     Copyright (C) 1999-2006, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -120,6 +116,21 @@ package GNAT.Calendar.Time_IO is
    --  Return Date as a string with format Picture. Raise Picture_Error if
    --  picture string is wrong.
 
+   function Value (Date : String) return Ada.Calendar.Time;
+   --  Parse the string Date and return its equivalent as a Time value. The
+   --  following formats are supported:
+   --
+   --     yyyy*mm*dd hh:mm:ss  - Delimiter '*' is either '-' or '/'
+   --     yyyy*mm*dd           - The time of day is set to 00:00:00
+   --
+   --     yy*mm*dd hh:mm:ss    - Year is assumend to be 20YY
+   --     yy*mm*dd             - The time of day is set to 00:00:00
+   --
+   --     hh:mm:ss             - Date is the current date
+   --
+   --  Constraint_Error is raised if the input string is malformatted or
+   --  the resulting time is not valid.
+
    procedure Put_Time
      (Date    : Ada.Calendar.Time;
       Picture : Picture_String);