Commit 7d304f61 by Emmanuel Briot Committed by Arnaud Charlet

g-calend.ads (No_Time): New constant, to represent an uninitialized time value

2007-12-06  Emmanuel Briot  <briot@adacore.com>

	* g-calend.ads (No_Time): New constant, to represent an uninitialized
	time value

	* g-catiio.ads, g-catiio.adb (Value): Added support for more date
	formats.
	(Month_Name_To_Number): New subprogram

	* g-dirope.adb (Get_Current_Dir): On windows, normalize the drive
	letter to upper-case.

From-SVN: r130839
parent 36fcf362
...@@ -56,6 +56,10 @@ package GNAT.Calendar is ...@@ -56,6 +56,10 @@ package GNAT.Calendar is
subtype Day_In_Year_Number is Positive range 1 .. 366; subtype Day_In_Year_Number is Positive range 1 .. 366;
subtype Week_In_Year_Number is Positive range 1 .. 53; subtype Week_In_Year_Number is Positive range 1 .. 53;
No_Time : constant Ada.Calendar.Time;
-- A constant set to the first date that can be represented by the type
-- Time. It can be used to indicate an uninitialized date.
function Hour (Date : Ada.Calendar.Time) return Hour_Number; function Hour (Date : Ada.Calendar.Time) return Hour_Number;
function Minute (Date : Ada.Calendar.Time) return Minute_Number; function Minute (Date : Ada.Calendar.Time) return Minute_Number;
function Second (Date : Ada.Calendar.Time) return Second_Number; function Second (Date : Ada.Calendar.Time) return Second_Number;
...@@ -131,4 +135,10 @@ private ...@@ -131,4 +135,10 @@ private
-- the Collected Algorithms of the ACM. The author of algorithm 199 is -- the Collected Algorithms of the ACM. The author of algorithm 199 is
-- Robert G. Tantzen. -- Robert G. Tantzen.
No_Time : constant Ada.Calendar.Time :=
Ada.Calendar.Time_Of
(Ada.Calendar.Year_Number'First,
Ada.Calendar.Month_Number'First,
Ada.Calendar.Day_Number'First);
end GNAT.Calendar; end GNAT.Calendar;
...@@ -36,6 +36,8 @@ with Ada.Characters.Handling; ...@@ -36,6 +36,8 @@ with Ada.Characters.Handling;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; with Ada.Text_IO;
with GNAT.Case_Util;
package body GNAT.Calendar.Time_IO is package body GNAT.Calendar.Time_IO is
type Month_Name is type Month_Name is
...@@ -52,6 +54,12 @@ package body GNAT.Calendar.Time_IO is ...@@ -52,6 +54,12 @@ package body GNAT.Calendar.Time_IO is
November, November,
December); 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 Padding_Mode is (None, Zero, Space);
type Sec_Number is mod 2 ** 64; type Sec_Number is mod 2 ** 64;
...@@ -168,6 +176,8 @@ package body GNAT.Calendar.Time_IO is ...@@ -168,6 +176,8 @@ package body GNAT.Calendar.Time_IO is
end case; end case;
end Pad_Char; end Pad_Char;
-- Local Declarations
NI : constant String := Sec_Number'Image (N); NI : constant String := Sec_Number'Image (N);
NIP : constant String := Pad_Char & NI (2 .. NI'Last); NIP : constant String := Pad_Char & NI (2 .. NI'Last);
...@@ -514,12 +524,40 @@ package body GNAT.Calendar.Time_IO is ...@@ -514,12 +524,40 @@ package body GNAT.Calendar.Time_IO is
return To_String (Result); return To_String (Result);
end Image; 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 -- -- Value --
----------- -----------
function Value (Date : String) return Ada.Calendar.Time is function Value (Date : String) return Ada.Calendar.Time is
D : String (1 .. 19); D : String (1 .. 21);
D_Length : constant Natural := Date'Length; D_Length : constant Natural := Date'Length;
Year : Year_Number; Year : Year_Number;
...@@ -531,13 +569,12 @@ package body GNAT.Calendar.Time_IO is ...@@ -531,13 +569,12 @@ package body GNAT.Calendar.Time_IO is
Sub_Second : Second_Duration; Sub_Second : Second_Duration;
procedure Extract_Date procedure Extract_Date
(Year : out Year_Number; (Year : out Year_Number;
Month : out Month_Number; Month : out Month_Number;
Day : out Day_Number; Day : out Day_Number;
Y2K : Boolean := False); Time_Start : out Natural);
-- Try and extract a date value from string D. Set Y2K to True to -- Try and extract a date value from string D. Time_Start is set to the
-- account for the 20YY case. Raise Constraint_Error if the portion -- first character that could be the start of time data.
-- of D corresponding to the date is not well formatted.
procedure Extract_Time procedure Extract_Time
(Index : Positive; (Index : Positive;
...@@ -555,33 +592,133 @@ package body GNAT.Calendar.Time_IO is ...@@ -555,33 +592,133 @@ package body GNAT.Calendar.Time_IO is
------------------ ------------------
procedure Extract_Date procedure Extract_Date
(Year : out Year_Number; (Year : out Year_Number;
Month : out Month_Number; Month : out Month_Number;
Day : out Day_Number; Day : out Day_Number;
Y2K : Boolean := False) Time_Start : out Natural)
is is
Delim_Index : Positive := 5;
begin begin
if Y2K then if D (3) = '-' or else D (3) = '/' then
Delim_Index := 3; if D_Length = 8 or else D_Length = 17 then
end if;
if (D (Delim_Index) /= '-' or else D (Delim_Index + 3) /= '-') -- Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
and then
(D (Delim_Index) /= '/' or else D (Delim_Index + 3) /= '/') if D (6) /= D (3) then
then raise Constraint_Error;
raise Constraint_Error; end if;
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;
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 else
Year := Year_Number'Value (D (1 .. 4)); if D_Length = 8 or else D_Length = 17 then
Month := Month_Number'Value (D (6 .. 7));
Day := Day_Number'Value (D (9 .. 10)); -- 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 if;
end Extract_Date; end Extract_Date;
...@@ -594,22 +731,42 @@ package body GNAT.Calendar.Time_IO is ...@@ -594,22 +731,42 @@ package body GNAT.Calendar.Time_IO is
Hour : out Hour_Number; Hour : out Hour_Number;
Minute : out Minute_Number; Minute : out Minute_Number;
Second : out Second_Number; Second : out Second_Number;
Check_Space : Boolean := False) is Check_Space : Boolean := False)
is
begin begin
if Check_Space and then D (Index - 1) /= ' ' then -- If no time was specified in the string (do not allow trailing
raise Constraint_Error; -- character either)
end if;
if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then if Index = D_Length + 2 then
raise Constraint_Error; Hour := 0;
end if; Minute := 0;
Second := 0;
else
-- Not enough characters left ?
if Index /= D_Length - 7 then
raise Constraint_Error;
end if;
Hour := Hour_Number'Value (D (Index .. Index + 1)); if Check_Space and then D (Index - 1) /= ' ' then
Minute := Minute_Number'Value (D (Index + 3 .. Index + 4)); raise Constraint_Error;
Second := Second_Number'Value (D (Index + 6 .. Index + 7)); 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; end Extract_Time;
-- Local Declarations
Time_Start : Natural := 1;
-- Start of processing for Value -- Start of processing for Value
begin begin
...@@ -620,8 +777,12 @@ package body GNAT.Calendar.Time_IO is ...@@ -620,8 +777,12 @@ package body GNAT.Calendar.Time_IO is
if D_Length /= 8 if D_Length /= 8
and then D_Length /= 10 and then D_Length /= 10
and then D_Length /= 11
and then D_Length /= 12
and then D_Length /= 17 and then D_Length /= 17
and then D_Length /= 19 and then D_Length /= 19
and then D_Length /= 20
and then D_Length /= 21
then then
raise Constraint_Error; raise Constraint_Error;
end if; end if;
...@@ -631,47 +792,13 @@ package body GNAT.Calendar.Time_IO is ...@@ -631,47 +792,13 @@ package body GNAT.Calendar.Time_IO is
D (1 .. D_Length) := Date; D (1 .. D_Length) := Date;
-- Case 1: if D_Length /= 8
or else D (3) /= ':'
-- hh:mm:ss then
-- yy*mm*dd Extract_Date (Year, Month, Day, Time_Start);
Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
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 else
Extract_Date (Year, Month, Day); Extract_Time (1, Hour, Minute, Second, Check_Space => False);
Extract_Time (12, Hour, Minute, Second, True);
end if; end if;
-- Sanity checks -- Sanity checks
......
...@@ -118,15 +118,26 @@ package GNAT.Calendar.Time_IO is ...@@ -118,15 +118,26 @@ package GNAT.Calendar.Time_IO is
function Value (Date : String) return Ada.Calendar.Time; function Value (Date : String) return Ada.Calendar.Time;
-- Parse the string Date and return its equivalent as a Time value. The -- Parse the string Date and return its equivalent as a Time value. The
-- following formats are supported: -- following time format is supported:
-- --
-- yyyy*mm*dd hh:mm:ss - Delimiter '*' is either '-' or '/' -- hh:mm:ss - Date is the current date
-- 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 -- The following formats are also supported. They all accept an optional
-- yy*mm*dd - The time of day is set to 00:00:00 -- time with the format "hh:mm:ss". The time is separated from the date by
-- exactly one space character.
-- When the time is not specified, it is set to 00:00:00. The delimiter '*'
-- must be either '-' and '/' and both occurrences must use the same
-- character.
-- Trailing characters (in particular spaces) are not allowed.
-- --
-- hh:mm:ss - Date is the current date -- yyyy*mm*dd
-- yy*mm*dd - Year is assumed to be 20yy
-- mm*dd*yyyy - (US date format)
-- dd*mmm*yyyy - month spelled out
-- yyyy*mmm*dd - month spelled out
-- yyyymmdd - Iso format, no separator
-- mmm dd, yyyy - month spelled out
-- dd mmm yyyy - month spelled out
-- --
-- Constraint_Error is raised if the input string is malformatted or -- Constraint_Error is raised if the input string is malformatted or
-- the resulting time is not valid. -- the resulting time is not valid.
......
...@@ -56,6 +56,10 @@ package body GNAT.Directory_Operations is ...@@ -56,6 +56,10 @@ package body GNAT.Directory_Operations is
procedure Free is new procedure Free is new
Ada.Unchecked_Deallocation (Dir_Type_Value, Dir_Type); Ada.Unchecked_Deallocation (Dir_Type_Value, Dir_Type);
On_Windows : constant Boolean := GNAT.OS_Lib.Directory_Separator = '\';
-- An indication that we are on Windows. Used in Get_Current_Dir, to
-- deal with drive letters in the beginning of absolute paths.
--------------- ---------------
-- Base_Name -- -- Base_Name --
--------------- ---------------
...@@ -591,6 +595,15 @@ package body GNAT.Directory_Operations is ...@@ -591,6 +595,15 @@ package body GNAT.Directory_Operations is
end if; end if;
Dir (Buffer'First .. Last) := Buffer (Buffer'First .. Last); Dir (Buffer'First .. Last) := Buffer (Buffer'First .. Last);
-- By default, the drive letter on Windows is in upper case
if On_Windows and then Last > Dir'First and then
Dir (Dir'First + 1) = ':'
then
Dir (Dir'First) :=
Ada.Characters.Handling.To_Upper (Dir (Dir'First));
end if;
end Get_Current_Dir; end Get_Current_Dir;
------------- -------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment