Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT RUN-TIME COMPONENTS                         --

--                                                                          --

--                G N A T . C A L E N D A R . T I M E _ I O                 --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--                     Copyright (C) 1999-2010, 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- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --

--                                                                          --

-- As a special exception under Section 7 of GPL version 3, you are granted --

-- additional permissions described in the GCC Runtime Library Exception,   --

-- version 3.1, as published by the Free Software Foundation.               --

--                                                                          --

-- You should have received a copy of the GNU General Public License and    --

-- a copy of the GCC Runtime Library Exception along with this program;     --

-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --

-- <http://www.gnu.org/licenses/>.                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Ada.Calendar;            use Ada.Calendar;

with Ada.Characters.Handling;

with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;

with Ada.Text_IO;

with GNAT.Case_Util;

package body GNAT.Calendar.Time_IO is

   type Month_Name is

     (January,

      February,

      March,

      April,

      May,

      June,

      July,

      August,

      September,

      October,

      November,

      December);

   function Month_Name_To_Number

     (Str : String) return Ada.Calendar.Month_Number;

   --  Converts a string that contains an abbreviated month name to a month

   --  number. Constraint_Error is raised if Str is not a valid month name.

   --  Comparison is case insensitive

   type Padding_Mode is (None, Zero, Space);

   type Sec_Number is mod 2 ** 64;

   --  Type used to compute the number of seconds since 01/01/1970. A 32 bit

   --  number will cover only a period of 136 years. This means that for date

   --  past 2106 the computation is not possible. A 64 bits number should be

   --  enough for a very large period of time.

   -----------------------

   -- Local Subprograms --

   -----------------------

   function Am_Pm (H : Natural) return String;

   --  Return AM or PM depending on the hour H

   function Hour_12 (H : Natural) return Positive;

   --  Convert a 1-24h format to a 0-12 hour format

   function Image (Str : String; Length : Natural := 0) return String;

   --  Return Str capitalized and cut to length number of characters. If

   --  length is 0, then no cut operation is performed.

   function Image

     (N       : Sec_Number;

      Padding : Padding_Mode := Zero;

      Length  : Natural := 0) return String;

   --  Return image of N. This number is eventually padded with zeros or spaces

   --  depending of the length required. If length is 0 then no padding occurs.

   function Image

     (N       : Natural;

      Padding : Padding_Mode := Zero;

      Length  : Natural := 0) return String;

   --  As above with N provided in Integer format

   -----------

   -- Am_Pm --

   -----------

   function Am_Pm (H : Natural) return String is

   begin

      if H = 0 or else H > 12 then

         return "PM";

      else

         return "AM";

      end if;

   end Am_Pm;

   -------------

   -- Hour_12 --

   -------------

   function Hour_12 (H : Natural) return Positive is

   begin

      if H = 0 then

         return 12;

      elsif H <= 12 then

         return H;

      else --  H > 12

         return H - 12;

      end if;

   end Hour_12;

   -----------

   -- Image --

   -----------

   function Image

     (Str    : String;

      Length : Natural := 0) return String

   is

      use Ada.Characters.Handling;

      Local : constant String :=

                To_Upper (Str (Str'First)) &

                  To_Lower (Str (Str'First + 1 .. Str'Last));

   begin

      if Length = 0 then

         return Local;

      else

         return Local (1 .. Length);

      end if;

   end Image;

   -----------

   -- Image --

   -----------

   function Image

     (N       : Natural;

      Padding : Padding_Mode := Zero;

      Length  : Natural := 0) return String

   is

   begin

      return Image (Sec_Number (N), Padding, Length);

   end Image;

   function Image

     (N       : Sec_Number;

      Padding : Padding_Mode := Zero;

      Length  : Natural := 0) return String

   is

      function Pad_Char return String;

      --------------

      -- Pad_Char --

      --------------

      function Pad_Char return String is

      begin

         case Padding is

            when None  => return "";

            when Zero  => return "00";

            when Space => return "  ";

         end case;

      end Pad_Char;

      --  Local Declarations

      NI  : constant String := Sec_Number'Image (N);

      NIP : constant String := Pad_Char & NI (2 .. NI'Last);

   --  Start of processing for Image

   begin

      if Length = 0 or else Padding = None then

         return NI (2 .. NI'Last);

      else

         return NIP (NIP'Last - Length + 1 .. NIP'Last);

      end if;

   end Image;

   -----------

   -- Image --

   -----------

   function Image

     (Date    : Ada.Calendar.Time;

      Picture : Picture_String) return String

   is

      Padding : Padding_Mode := Zero;

      --  Padding is set for one directive

      Result : Unbounded_String;

      Year       : Year_Number;

      Month      : Month_Number;

      Day        : Day_Number;

      Hour       : Hour_Number;

      Minute     : Minute_Number;

      Second     : Second_Number;

      Sub_Second : Second_Duration;

      P : Positive;

   begin

      --  Get current time in split format

      Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);

      --  Null picture string is error

      if Picture = "" then

         raise Picture_Error with "null picture string";

      end if;

      --  Loop through characters of picture string, building result

      Result := Null_Unbounded_String;

      P := Picture'First;

      while P <= Picture'Last loop

         --  A directive has the following format "%[-_]."

         if Picture (P) = '%' then

            Padding := Zero;

            if P = Picture'Last then

               raise Picture_Error with "picture string ends with '%";

            end if;

            --  Check for GNU extension to change the padding

            if Picture (P + 1) = '-' then

               Padding := None;

               P := P + 1;

            elsif Picture (P + 1) = '_' then

               Padding := Space;

               P := P + 1;

            end if;

            if P = Picture'Last then

               raise Picture_Error with "picture string ends with '- or '_";

            end if;

            case Picture (P + 1) is

               --  Literal %

               when '%' =>

                  Result := Result & '%';

               --  A newline

               when 'n' =>

                  Result := Result & ASCII.LF;

               --  A horizontal tab

               when 't' =>

                  Result := Result & ASCII.HT;

               --  Hour (00..23)

               when 'H' =>

                  Result := Result & Image (Hour, Padding, 2);

               --  Hour (01..12)

               when 'I' =>

                  Result := Result & Image (Hour_12 (Hour), Padding, 2);

               --  Hour ( 0..23)

               when 'k' =>

                  Result := Result & Image (Hour, Space, 2);

               --  Hour ( 1..12)

               when 'l' =>

                  Result := Result & Image (Hour_12 (Hour), Space, 2);

               --  Minute (00..59)

               when 'M' =>

                  Result := Result & Image (Minute, Padding, 2);

               --  AM/PM

               when 'p' =>

                  Result := Result & Am_Pm (Hour);

               --  Time, 12-hour (hh:mm:ss [AP]M)

               when 'r' =>

                  Result := Result &

                    Image (Hour_12 (Hour), Padding, Length => 2) & ':' &

                    Image (Minute, Padding, Length => 2) & ':' &

                    Image (Second, Padding, Length => 2) & ' ' &

                    Am_Pm (Hour);

               --   Seconds since 1970-01-01  00:00:00 UTC

               --   (a nonstandard extension)

               when 's' =>

                  declare

                     --  Compute the number of seconds using Ada.Calendar.Time

                     --  values rather than Julian days to account for Daylight

                     --  Savings Time.

                     Neg : Boolean  := False;

                     Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);

                  begin

                     --  Avoid rounding errors and perform special processing

                     --  for dates earlier than the Unix Epoc.

                     if Sec > 0.0 then

                        Sec := Sec - 0.5;

                     elsif Sec < 0.0 then

                        Neg := True;

                        Sec := abs (Sec + 0.5);

                     end if;

                     --  Prepend a minus sign to the result since Sec_Number

                     --  cannot handle negative numbers.

                     if Neg then

                        Result :=

                          Result & "-" & Image (Sec_Number (Sec), None);

                     else

                        Result := Result & Image (Sec_Number (Sec), None);

                     end if;

                  end;

               --  Second (00..59)

               when 'S' =>

                  Result := Result & Image (Second, Padding, Length => 2);

               --  Milliseconds (3 digits)

               --  Microseconds (6 digits)

               --  Nanoseconds  (9 digits)

               when 'i' | 'e' | 'o' =>

                  declare

                     Sub_Sec : constant Long_Integer :=

                                 Long_Integer (Sub_Second * 1_000_000_000);

                     Img1  : constant String := Sub_Sec'Img;

                     Img2  : constant String :=

                               "00000000" & Img1 (Img1'First + 1 .. Img1'Last);

                     Nanos : constant String :=

                               Img2 (Img2'Last - 8 .. Img2'Last);

                  begin

                     case Picture (P + 1) is

                        when 'i' =>

                           Result := Result &

                             Nanos (Nanos'First .. Nanos'First + 2);

                        when 'e' =>

                           Result := Result &

                             Nanos (Nanos'First .. Nanos'First + 5);

                        when 'o' =>

                           Result := Result & Nanos;

                        when others =>

                           null;

                     end case;

                  end;

               --  Time, 24-hour (hh:mm:ss)

               when 'T' =>

                  Result := Result &

                    Image (Hour, Padding, Length => 2)   & ':' &

                    Image (Minute, Padding, Length => 2) & ':' &

                    Image (Second, Padding, Length => 2);

               --  Locale's abbreviated weekday name (Sun..Sat)

               when 'a' =>

                  Result := Result &

                    Image (Day_Name'Image (Day_Of_Week (Date)), 3);

               --  Locale's full weekday name, variable length

               --  (Sunday..Saturday)

               when 'A' =>

                  Result := Result &

                    Image (Day_Name'Image (Day_Of_Week (Date)));

               --  Locale's abbreviated month name (Jan..Dec)

               when 'b' | 'h' =>

                  Result := Result &

                    Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);

               --  Locale's full month name, variable length

               --  (January..December).

               when 'B' =>

                  Result := Result &

                    Image (Month_Name'Image (Month_Name'Val (Month - 1)));

               --  Locale's date and time (Sat Nov 04 12:02:33 EST 1989)

               when 'c' =>

                  case Padding is

                     when Zero =>

                        Result := Result & Image (Date, "%a %b %d %T %Y");

                     when Space =>

                        Result := Result & Image (Date, "%a %b %_d %_T %Y");

                     when None =>

                        Result := Result & Image (Date, "%a %b %-d %-T %Y");

                  end case;

               --   Day of month (01..31)

               when 'd' =>

                  Result := Result & Image (Day, Padding, 2);

               --  Date (mm/dd/yy)

               when 'D' | 'x' =>

                  Result := Result &

                              Image (Month, Padding, 2) & '/' &

                              Image (Day, Padding, 2) & '/' &

                              Image (Year, Padding, 2);

               --  Day of year (001..366)

               when 'j' =>

                  Result := Result & Image (Day_In_Year (Date), Padding, 3);

               --  Month (01..12)

               when 'm' =>

                  Result := Result & Image (Month, Padding, 2);

               --  Week number of year with Sunday as first day of week

               --  (00..53)

               when 'U' =>

                  declare

                     Offset : constant Natural :=

                                (Julian_Day (Year, 1, 1) + 1) mod 7;

                     Week : constant Natural :=

                              1 + ((Day_In_Year (Date) - 1) + Offset) / 7;

                  begin

                     Result := Result & Image (Week, Padding, 2);

                  end;

               --  Day of week (0..6) with 0 corresponding to Sunday

               when 'w' =>

                  declare

                     DOW : constant Natural range 0 .. 6 :=

                             (if Day_Of_Week (Date) = Sunday

                              then 0

                              else Day_Name'Pos (Day_Of_Week (Date)));

                  begin

                     Result := Result & Image (DOW, Length => 1);

                  end;

               --  Week number of year with Monday as first day of week

               --  (00..53)

               when 'W' =>

                  Result := Result & Image (Week_In_Year (Date), Padding, 2);

               --  Last two digits of year (00..99)

               when 'y' =>

                  declare

                     Y : constant Natural := Year - (Year / 100) * 100;

                  begin

                     Result := Result & Image (Y, Padding, 2);

                  end;

               --   Year (1970...)

               when 'Y' =>

                  Result := Result & Image (Year, None, 4);

               when others =>

                  raise Picture_Error with

                    "unknown format character in picture string";

            end case;

            --  Skip past % and format character

            P := P + 2;

         --  Character other than % is copied into the result

         else

            Result := Result & Picture (P);

            P := P + 1;

         end if;

      end loop;

      return To_String (Result);

   end Image;

   --------------------------

   -- Month_Name_To_Number --

   --------------------------

   function Month_Name_To_Number

     (Str : String) return Ada.Calendar.Month_Number

   is

      subtype String3 is String (1 .. 3);

      Abbrev_Upper_Month_Names :

        constant array (Ada.Calendar.Month_Number) of String3 :=

         ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",

          "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");

      --  Short version of the month names, used when parsing date strings

      S                                                     : String := Str;

   begin

      GNAT.Case_Util.To_Upper (S);

      for J in Abbrev_Upper_Month_Names'Range loop

         if Abbrev_Upper_Month_Names (J) = S then

            return J;

         end if;

      end loop;

      return Abbrev_Upper_Month_Names'First;

   end Month_Name_To_Number;

   -----------

   -- Value --

   -----------

   function Value (Date : String) return Ada.Calendar.Time is

      D          : String (1 .. 21);

      D_Length   : constant Natural := Date'Length;

      Year   : Year_Number;

      Month  : Month_Number;

      Day    : Day_Number;

      Hour   : Hour_Number;

      Minute : Minute_Number;

      Second : Second_Number;

      procedure Extract_Date

        (Year       : out Year_Number;

         Month      : out Month_Number;

         Day        : out Day_Number;

         Time_Start : out Natural);

      --  Try and extract a date value from string D. Time_Start is set to the

      --  first character that could be the start of time data.

      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;

         Time_Start : out Natural)

      is

      begin

         if D (3) = '-' or else D (3) = '/' then

            if D_Length = 8 or else D_Length = 17 then

               --  Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"

               if D (6) /= D (3) then

                  raise Constraint_Error;

               end if;

               Year  := Year_Number'Value ("20" & D (1 .. 2));

               Month := Month_Number'Value       (D (4 .. 5));

               Day   := Day_Number'Value         (D (7 .. 8));

               Time_Start := 10;

            elsif D_Length = 10 or else D_Length = 19 then

               --  Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"

               if D (6) /= D (3) then

                  raise Constraint_Error;

               end if;

               Year  := Year_Number'Value  (D (7 .. 10));

               Month := Month_Number'Value (D (1 .. 2));

               Day   := Day_Number'Value   (D (4 .. 5));

               Time_Start := 12;

            elsif D_Length = 11 or else D_Length = 20 then

               --  Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"

               if D (7) /= D (3) then

                  raise Constraint_Error;

               end if;

               Year  := Year_Number'Value  (D (8 .. 11));

               Month := Month_Name_To_Number (D (4 .. 6));

               Day   := Day_Number'Value   (D (1 .. 2));

               Time_Start := 13;

            else

               raise Constraint_Error;

            end if;

         elsif D (3) = ' ' then

            if D_Length = 11 or else D_Length = 20 then

               --  Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"

               if D (7) /= ' ' then

                  raise Constraint_Error;

               end if;

               Year  := Year_Number'Value  (D (8 .. 11));

               Month := Month_Name_To_Number (D (4 .. 6));

               Day   := Day_Number'Value   (D (1 .. 2));

               Time_Start := 13;

            else

               raise Constraint_Error;

            end if;

         else

            if D_Length = 8 or else D_Length = 17 then

               --  Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"

               Year  := Year_Number'Value (D (1 .. 4));

               Month := Month_Number'Value (D (5 .. 6));

               Day   := Day_Number'Value (D (7 .. 8));

               Time_Start := 10;

            elsif D_Length = 10 or else D_Length = 19 then

               --  Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"

               if (D (5) /= '-' and then D (5) /= '/')

                 or else D (8) /= D (5)

               then

                  raise Constraint_Error;

               end if;

               Year  := Year_Number'Value (D (1 .. 4));

               Month := Month_Number'Value (D (6 .. 7));

               Day   := Day_Number'Value (D (9 .. 10));

               Time_Start := 12;

            elsif D_Length = 11 or else D_Length = 20 then

               --  Possible formats are "yyyy*mmm*dd"

               if (D (5) /= '-' and then D (5) /= '/')

                 or else D (9) /= D (5)

               then

                  raise Constraint_Error;

               end if;

               Year  := Year_Number'Value (D (1 .. 4));

               Month := Month_Name_To_Number (D (6 .. 8));

               Day   := Day_Number'Value (D (10 .. 11));

               Time_Start := 13;

            elsif D_Length = 12 or else D_Length = 21 then

               --  Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"

               if D (4) /= ' '

                 or else D (7) /= ','

                 or else D (8) /= ' '

               then

                  raise Constraint_Error;

               end if;

               Year  := Year_Number'Value (D (9 .. 12));

               Month := Month_Name_To_Number (D (1 .. 3));

               Day   := Day_Number'Value (D (5 .. 6));

               Time_Start := 14;

            else

               raise Constraint_Error;

            end if;

         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 no time was specified in the string (do not allow trailing

         --  character either)

         if Index = D_Length + 2 then

            Hour   := 0;

            Minute := 0;

            Second := 0;

         else

            --  Not enough characters left ?

            if Index /= D_Length - 7 then

               raise Constraint_Error;

            end if;

            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 if;

      end Extract_Time;

      --  Local Declarations

      Time_Start : Natural := 1;

   --  Start of processing for Value

   begin

      --  Length checks