------------------------------------------------------------------------------ -- -- -- 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-2019, 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 -- -- . -- -- -- -- 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 procedure Parse_ISO_8861_UTC (Date : String; Time : out Ada.Calendar.Time; Success : out Boolean); -- Subsidiary of function Value. It parses the string Date, interpreted as -- an ISO 8861 time representation, and returns corresponding Time value. -- Success is set to False when the string is not a supported ISO 8861 -- date. The following regular expression defines the supported format: -- -- (yyyymmdd | yyyy'-'mm'-'dd)'T'(hhmmss | hh':'mm':'ss) -- [ ('Z' | ('.' | ',') s{s} | ('+'|'-')hh':'mm) ] -- -- Trailing characters (in particular spaces) are not allowed. -- -- Examples: -- -- 2017-04-14T14:47:06 20170414T14:47:06 20170414T144706 -- 2017-04-14T14:47:06,12 20170414T14:47:06.12 -- 2017-04-14T19:47:06+05 20170414T09:00:06-05:47 ----------- -- 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; ------------------------ -- Parse_ISO_8861_UTC -- ------------------------ procedure Parse_ISO_8861_UTC (Date : String; Time : out Ada.Calendar.Time; Success : out Boolean) is Index : Positive := Date'First; -- The current character scan index. After a call to Advance, Index -- points to the next character. End_Of_Source_Reached : exception; -- An exception used to signal that the scan pointer has reached the -- end of the source string. Wrong_Syntax : exception; -- An exception used to signal that the scan pointer has reached an -- unexpected character in the source string. procedure Advance; pragma Inline (Advance); -- Past the current character of Date procedure Advance_Digits (Num_Digits : Positive); pragma Inline (Advance_Digits); -- Past the given number of digit characters function Scan_Day return Day_Number; pragma Inline (Scan_Day); -- Scan the two digits of a day number and return its value function Scan_Hour return Hour_Number; pragma Inline (Scan_Hour); -- Scan the two digits of an hour number and return its value function Scan_Minute return Minute_Number; pragma Inline (Scan_Minute); -- Scan the two digits of a minute number and return its value function Scan_Month return Month_Number; pragma Inline (Scan_Month); -- Scan the two digits of a month number and return its value function Scan_Second return Second_Number; pragma Inline (Scan_Second); -- Scan the two digits of a second number and return its value function Scan_Separator (Expected_Symbol : Character) return Boolean; pragma Inline (Scan_Separator); -- If the current symbol matches the Expected_Symbol then advance the -- scanner index and return True; otherwise do nothing and return False procedure Scan_Separator (Required : Boolean; Separator : Character); pragma Inline (Scan_Separator); -- If Required then check that the current character matches Separator -- and advance the scanner index; if not Required then do nothing. function Scan_Subsecond return Second_Duration; pragma Inline (Scan_Subsecond); -- Scan all the digits of a subsecond number and return its value function Scan_Year return Year_Number; pragma Inline (Scan_Year); -- Scan the four digits of a year number and return its value function Symbol return Character; pragma Inline (Symbol); -- Return the current character being scanned ------------- -- Advance -- ------------- procedure Advance is begin -- Signal the end of the source string. This stops a complex scan by -- bottoming up any recursive calls till control reaches routine Scan -- which handles the exception. Certain scanning scenarios may handle -- this exception on their own. if Index > Date'Last then raise End_Of_Source_Reached; -- Advance the scan pointer as long as there are characters to scan, -- in other words, the scan pointer has not passed the end of the -- source string. else Index := Index + 1; end if; end Advance; -------------------- -- Advance_Digits -- -------------------- procedure Advance_Digits (Num_Digits : Positive) is begin for J in 1 .. Num_Digits loop if Symbol not in '0' .. '9' then raise Wrong_Syntax; end if; Advance; -- past digit end loop; end Advance_Digits; -------------- -- Scan_Day -- -------------- function Scan_Day return Day_Number is From : constant Positive := Index; begin Advance_Digits (Num_Digits => 2); return Day_Number'Value (Date (From .. Index - 1)); end Scan_Day; --------------- -- Scan_Hour -- --------------- function Scan_Hour return Hour_Number is From : constant Positive := Index; begin Advance_Digits (Num_Digits => 2); return Hour_Number'Value (Date (From .. Index - 1)); end Scan_Hour; ----------------- -- Scan_Minute -- ----------------- function Scan_Minute return Minute_Number is From : constant Positive := Index; begin Advance_Digits (Num_Digits => 2); return Minute_Number'Value (Date (From .. Index - 1)); end Scan_Minute; ---------------- -- Scan_Month -- ---------------- function Scan_Month return Month_Number is From : constant Positive := Index; begin Advance_Digits (Num_Digits => 2); return Month_Number'Value (Date (From .. Index - 1)); end Scan_Month; ----------------- -- Scan_Second -- ----------------- function Scan_Second return Second_Number is From : constant Positive := Index; begin Advance_Digits (Num_Digits => 2); return Second_Number'Value (Date (From .. Index - 1)); end Scan_Second; -------------------- -- Scan_Separator -- -------------------- function Scan_Separator (Expected_Symbol : Character) return Boolean is begin if Symbol = Expected_Symbol then Advance; return True; else return False; end if; end Scan_Separator; -------------------- -- Scan_Separator -- -------------------- procedure Scan_Separator (Required : Boolean; Separator : Character) is begin if Required then if Symbol /= Separator then raise Wrong_Syntax; end if; Advance; -- Past the separator end if; end Scan_Separator; -------------------- -- Scan_Subsecond -- -------------------- function Scan_Subsecond return Second_Duration is From : constant Positive := Index; begin Advance_Digits (Num_Digits => 1); while Symbol in '0' .. '9' and then Index < Date'Length loop Advance; end loop; if Symbol not in '0' .. '9' then raise Wrong_Syntax; end if; Advance; return Second_Duration'Value ("0." & Date (From .. Index - 1)); end Scan_Subsecond; --------------- -- Scan_Year -- --------------- function Scan_Year return Year_Number is From : constant Positive := Index; begin Advance_Digits (Num_Digits => 4); return Year_Number'Value (Date (From .. Index - 1)); end Scan_Year; ------------ -- Symbol -- ------------ function Symbol return Character is begin -- Signal the end of the source string. This stops a complex scan by -- bottoming up any recursive calls till control reaches routine Scan -- which handles the exception. Certain scanning scenarios may handle -- this exception on their own. if Index > Date'Last then raise End_Of_Source_Reached; else return Date (Index); end if; end Symbol; -- Local variables Date_Separator : constant Character := '-'; Hour_Separator : constant Character := ':'; Day : Day_Number; Month : Month_Number; Year : Year_Number; Hour : Hour_Number := 0; Minute : Minute_Number := 0; Second : Second_Number := 0; Subsec : Second_Duration := 0.0; Local_Hour : Hour_Number := 0; Local_Minute : Minute_Number := 0; Local_Sign : Character := ' '; Local_Disp : Duration; Sep_Required : Boolean := False; -- True if a separator is seen (and therefore required after it!) begin -- Parse date Year := Scan_Year; Sep_Required := Scan_Separator (Date_Separator); Month := Scan_Month; Scan_Separator (Sep_Required, Date_Separator); Day := Scan_Day; if Index < Date'Last and then Symbol = 'T' then Advance; -- Parse time Hour := Scan_Hour; Sep_Required := Scan_Separator (Hour_Separator); Minute := Scan_Minute; Scan_Separator (Sep_Required, Hour_Separator); Second := Scan_Second; -- [('Z' | ('.' | ',') s{s} | ('+'|'-')hh:mm)] if Index <= Date'Last then -- Suffix 'Z' just confirms that this is an UTC time. No further -- action needed. if Symbol = 'Z' then Advance; -- A decimal fraction shall have at least one digit, and has as -- many digits as supported by the underlying implementation. -- The valid decimal separators are those specified in ISO 31-0, -- i.e. the comma [,] or full stop [.]. Of these, the comma is -- the preferred separator of ISO-8861. elsif Symbol = ',' or else Symbol = '.' then Advance; -- past decimal separator Subsec := Scan_Subsecond; -- Difference between local time and UTC: It shall be expressed -- as positive (i.e. with the leading plus sign [+]) if the local -- time is ahead of or equal to UTC of day and as negative (i.e. -- with the leading minus sign [-]) if it is behind UTC of day. -- The minutes time element of the difference may only be omitted -- if the difference between the time scales is exactly an -- integral number of hours. elsif Symbol = '+' or else Symbol = '-' then Local_Sign := Symbol; Advance; Local_Hour := Scan_Hour; -- Past ':' if Index < Date'Last and then Symbol = Hour_Separator then Advance; Local_Minute := Scan_Minute; end if; -- Compute local displacement Local_Disp := Local_Hour * 3600.0 + Local_Minute * 60.0; else raise Wrong_Syntax; end if; end if; end if; -- Sanity checks. The check on Index ensures that there are no trailing -- characters. if Index /= Date'Length + 1 or else 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 or else not Subsec'Valid or else not Local_Hour'Valid or else not Local_Minute'Valid then raise Wrong_Syntax; end if; -- Compute time without local displacement if Local_Sign = ' ' then Time := Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec); -- Compute time with positive local displacement elsif Local_Sign = '+' then Time := Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec) - Local_Disp; -- Compute time with negative local displacement elsif Local_Sign = '-' then Time := Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec) + Local_Disp; end if; -- Notify that the input string was successfully parsed Success := True; exception when End_Of_Source_Reached | Wrong_Syntax => Success := False; end Parse_ISO_8861_UTC; ----------- -- 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 Success : Boolean; Time_Start : Natural := 1; Time : Ada.Calendar.Time; -- Start of processing for Value begin -- Let's try parsing Date as a supported ISO-8861 format. If we do not -- succeed, then retry using all the other GNAT supported formats. Parse_ISO_8861_UTC (Date, Time, Success); if Success then return Time; end if; -- Length checks if D_Length /= 8 and then D_Length /= 10 and then D_Length /= 11 and then D_Length /= 12 and then D_Length /= 17 and then D_Length /= 19 and then D_Length /= 20 and then D_Length /= 21 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; if D_Length /= 8 or else D (3) /= ':' then Extract_Date (Year, Month, Day, Time_Start); Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True); else declare Discard : Second_Duration; begin Split (Clock, Year, Month, Day, Hour, Minute, Second, Sub_Second => Discard); end; Extract_Time (1, Hour, Minute, Second, Check_Space => False); 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); end Value; -------------- -- Put_Time -- -------------- procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is begin Ada.Text_IO.Put (Image (Date, Picture)); end Put_Time; end GNAT.Calendar.Time_IO;