From patchwork Wed Sep 6 11:56:41 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 810535 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461590-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="S6zTl01T"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xnMWY0xfDz9s8J for ; Wed, 6 Sep 2017 21:56:56 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=fWnmJSnFg3KWgfgvq8sqzYqcE7nJM+XsI3SgIrEFbWJ6b8bf4S A+OZ3gbxkPJ7h5LSUwPLm4vZFXH+0ZNVijTGTsmd5qR2IwHouDlA7wJYNsIxYPzz rWHAd6Sw18gmwXR0HTBeaEaw8v44hLqEo+zh5BhCODf1kZDTAXpCkjsHw= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=F53K9D1z6d34sK8cycCCe50BohE=; b=S6zTl01TTrB5fBIBPykh iUDtHqcHSIqXgxanwj5qqvD/a0cUINYDoSWDuwGhQDQXDY/OMcBp4t1yyvg58oLr 4j8ZqEfrpUiJWIA28W3Ot/UXm4HZpjCbaLcW0PCNJYYgejeE4XosdFtqdpWDYKdN WLrORKF+sFsRYotVuq2auLY= Received: (qmail 54505 invoked by alias); 6 Sep 2017 11:56:46 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 54232 invoked by uid 89); 6 Sep 2017 11:56:45 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-16.1 required=5.0 tests=BAYES_00, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=confirms, fraction, SEP, JUL X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 06 Sep 2017 11:56:43 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0F0825614F; Wed, 6 Sep 2017 07:56:42 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id KgaHw6QN6pMv; Wed, 6 Sep 2017 07:56:41 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id F11B85614D; Wed, 6 Sep 2017 07:56:41 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id ED6194AC; Wed, 6 Sep 2017 07:56:41 -0400 (EDT) Date: Wed, 6 Sep 2017 07:56:41 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [Ada] Time_IO.Value enhanced to parse ISO-8861 UTC date and time Message-ID: <20170906115641.GA140767@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) The function Value of package GNAT.Calendar.Time_IO has been enhanced to parse strings containing UTC date and time. After this patch the following test works fine. with Ada.Calendar; use Ada.Calendar; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Calendar.Time_IO; use GNAT.Calendar.Time_IO; procedure Do_Test is Picture : Picture_String := "%Y-%m-%dT%H:%M:%S,%i"; T1 : Time; T2 : Time; T3 : Time; T4 : Time; T5 : Time; begin T1 := Value ("2017-04-14T14:47:06"); pragma Assert (Image (T1, Picture) = "2017-04-14T14:47:06,000"); T2 := Value ("2017-04-14T14:47:06Z"); pragma Assert (Image (T2, Picture) = "2017-04-14T14:47:06,000"); T3 := Value ("2017-04-14T14:47:06,999"); pragma Assert (Image (T3, Picture) = "2017-04-14T14:47:06,999"); T4 := Value ("2017-04-14T19:47:06+05"); pragma Assert (Image (T4, Picture) = "2017-04-14T14:47:06,000"); T5 := Value ("2017-04-14T09:00:06-05:47"); pragma Assert (Image (T5, Picture) = "2017-04-14T14:47:06,000"); end; Command: gnatmake -gnata do_test.adb; ./do_test Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-06 Javier Miranda * g-catiio.ads, g-catiio.adb (Value): Extended to parse an UTC time following ISO-8861. Index: g-catiio.adb =================================================================== --- g-catiio.adb (revision 251753) +++ g-catiio.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2016, AdaCore -- +-- Copyright (C) 1999-2017, 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- -- @@ -93,6 +93,26 @@ 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 -- ----------- @@ -531,7 +551,7 @@ "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"); -- Short version of the month names, used when parsing date strings - S : String := Str; + S : String := Str; begin GNAT.Case_Util.To_Upper (S); @@ -545,6 +565,390 @@ 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 -- ----------- @@ -757,11 +1161,22 @@ -- 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 Index: g-catiio.ads =================================================================== --- g-catiio.ads (revision 251753) +++ g-catiio.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2013, AdaCore -- +-- Copyright (C) 1999-2017, 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- -- @@ -141,6 +141,18 @@ -- mmm dd, yyyy - month spelled out -- dd mmm yyyy - month spelled out -- + -- The following ISO-8861 format expressed as a regular expression is also + -- supported: + -- + -- (yyyymmdd | yyyy'-'mm'-'dd)'T'(hhmmss | hh':'mm':'ss) + -- [ ('Z' | ('.' | ',') s{s} | ('+'|'-')hh':'mm) ] + -- + -- Examples: + -- + -- 2017-04-14T14:47:06 20170414T14:47:06 20170414T144706 + -- 2017-04-14T14:47:06,1234 20170414T14:47:06.1234 + -- 2017-04-14T19:47:06+05 20170414T09:00:06-05:47 + -- Constraint_Error is raised if the input string is malformed (does not -- conform to one of the above dates, or has an invalid time string), or -- the resulting time is not valid.