* tree-vect-loop-manip.c (vect_do_peeling): Do not use
[official-gcc.git] / gcc / ada / libgnat / g-catiio.adb
blob6677a9b1b847e256e74e7bf7dd40d934b3cd6c16
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- G N A T . C A L E N D A R . T I M E _ I O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2017, AdaCore --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
32 with Ada.Calendar; use Ada.Calendar;
33 with Ada.Characters.Handling;
34 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
35 with Ada.Text_IO;
37 with GNAT.Case_Util;
39 package body GNAT.Calendar.Time_IO is
41 type Month_Name is
42 (January,
43 February,
44 March,
45 April,
46 May,
47 June,
48 July,
49 August,
50 September,
51 October,
52 November,
53 December);
55 function Month_Name_To_Number
56 (Str : String) return Ada.Calendar.Month_Number;
57 -- Converts a string that contains an abbreviated month name to a month
58 -- number. Constraint_Error is raised if Str is not a valid month name.
59 -- Comparison is case insensitive
61 type Padding_Mode is (None, Zero, Space);
63 type Sec_Number is mod 2 ** 64;
64 -- Type used to compute the number of seconds since 01/01/1970. A 32 bit
65 -- number will cover only a period of 136 years. This means that for date
66 -- past 2106 the computation is not possible. A 64 bits number should be
67 -- enough for a very large period of time.
69 -----------------------
70 -- Local Subprograms --
71 -----------------------
73 function Am_Pm (H : Natural) return String;
74 -- Return AM or PM depending on the hour H
76 function Hour_12 (H : Natural) return Positive;
77 -- Convert a 1-24h format to a 0-12 hour format
79 function Image (Str : String; Length : Natural := 0) return String;
80 -- Return Str capitalized and cut to length number of characters. If
81 -- length is 0, then no cut operation is performed.
83 function Image
84 (N : Sec_Number;
85 Padding : Padding_Mode := Zero;
86 Length : Natural := 0) return String;
87 -- Return image of N. This number is eventually padded with zeros or spaces
88 -- depending of the length required. If length is 0 then no padding occurs.
90 function Image
91 (N : Natural;
92 Padding : Padding_Mode := Zero;
93 Length : Natural := 0) return String;
94 -- As above with N provided in Integer format
96 procedure Parse_ISO_8861_UTC
97 (Date : String;
98 Time : out Ada.Calendar.Time;
99 Success : out Boolean);
100 -- Subsidiary of function Value. It parses the string Date, interpreted as
101 -- an ISO 8861 time representation, and returns corresponding Time value.
102 -- Success is set to False when the string is not a supported ISO 8861
103 -- date. The following regular expression defines the supported format:
105 -- (yyyymmdd | yyyy'-'mm'-'dd)'T'(hhmmss | hh':'mm':'ss)
106 -- [ ('Z' | ('.' | ',') s{s} | ('+'|'-')hh':'mm) ]
108 -- Trailing characters (in particular spaces) are not allowed.
110 -- Examples:
112 -- 2017-04-14T14:47:06 20170414T14:47:06 20170414T144706
113 -- 2017-04-14T14:47:06,12 20170414T14:47:06.12
114 -- 2017-04-14T19:47:06+05 20170414T09:00:06-05:47
116 -----------
117 -- Am_Pm --
118 -----------
120 function Am_Pm (H : Natural) return String is
121 begin
122 if H = 0 or else H > 12 then
123 return "PM";
124 else
125 return "AM";
126 end if;
127 end Am_Pm;
129 -------------
130 -- Hour_12 --
131 -------------
133 function Hour_12 (H : Natural) return Positive is
134 begin
135 if H = 0 then
136 return 12;
137 elsif H <= 12 then
138 return H;
139 else -- H > 12
140 return H - 12;
141 end if;
142 end Hour_12;
144 -----------
145 -- Image --
146 -----------
148 function Image
149 (Str : String;
150 Length : Natural := 0) return String
152 use Ada.Characters.Handling;
153 Local : constant String :=
154 To_Upper (Str (Str'First)) &
155 To_Lower (Str (Str'First + 1 .. Str'Last));
156 begin
157 if Length = 0 then
158 return Local;
159 else
160 return Local (1 .. Length);
161 end if;
162 end Image;
164 -----------
165 -- Image --
166 -----------
168 function Image
169 (N : Natural;
170 Padding : Padding_Mode := Zero;
171 Length : Natural := 0) return String
173 begin
174 return Image (Sec_Number (N), Padding, Length);
175 end Image;
177 function Image
178 (N : Sec_Number;
179 Padding : Padding_Mode := Zero;
180 Length : Natural := 0) return String
182 function Pad_Char return String;
184 --------------
185 -- Pad_Char --
186 --------------
188 function Pad_Char return String is
189 begin
190 case Padding is
191 when None => return "";
192 when Zero => return "00";
193 when Space => return " ";
194 end case;
195 end Pad_Char;
197 -- Local Declarations
199 NI : constant String := Sec_Number'Image (N);
200 NIP : constant String := Pad_Char & NI (2 .. NI'Last);
202 -- Start of processing for Image
204 begin
205 if Length = 0 or else Padding = None then
206 return NI (2 .. NI'Last);
207 else
208 return NIP (NIP'Last - Length + 1 .. NIP'Last);
209 end if;
210 end Image;
212 -----------
213 -- Image --
214 -----------
216 function Image
217 (Date : Ada.Calendar.Time;
218 Picture : Picture_String) return String
220 Padding : Padding_Mode := Zero;
221 -- Padding is set for one directive
223 Result : Unbounded_String;
225 Year : Year_Number;
226 Month : Month_Number;
227 Day : Day_Number;
228 Hour : Hour_Number;
229 Minute : Minute_Number;
230 Second : Second_Number;
231 Sub_Second : Second_Duration;
233 P : Positive;
235 begin
236 -- Get current time in split format
238 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
240 -- Null picture string is error
242 if Picture = "" then
243 raise Picture_Error with "null picture string";
244 end if;
246 -- Loop through characters of picture string, building result
248 Result := Null_Unbounded_String;
249 P := Picture'First;
250 while P <= Picture'Last loop
252 -- A directive has the following format "%[-_]."
254 if Picture (P) = '%' then
255 Padding := Zero;
257 if P = Picture'Last then
258 raise Picture_Error with "picture string ends with '%";
259 end if;
261 -- Check for GNU extension to change the padding
263 if Picture (P + 1) = '-' then
264 Padding := None;
265 P := P + 1;
267 elsif Picture (P + 1) = '_' then
268 Padding := Space;
269 P := P + 1;
270 end if;
272 if P = Picture'Last then
273 raise Picture_Error with "picture string ends with '- or '_";
274 end if;
276 case Picture (P + 1) is
278 -- Literal %
280 when '%' =>
281 Result := Result & '%';
283 -- A newline
285 when 'n' =>
286 Result := Result & ASCII.LF;
288 -- A horizontal tab
290 when 't' =>
291 Result := Result & ASCII.HT;
293 -- Hour (00..23)
295 when 'H' =>
296 Result := Result & Image (Hour, Padding, 2);
298 -- Hour (01..12)
300 when 'I' =>
301 Result := Result & Image (Hour_12 (Hour), Padding, 2);
303 -- Hour ( 0..23)
305 when 'k' =>
306 Result := Result & Image (Hour, Space, 2);
308 -- Hour ( 1..12)
310 when 'l' =>
311 Result := Result & Image (Hour_12 (Hour), Space, 2);
313 -- Minute (00..59)
315 when 'M' =>
316 Result := Result & Image (Minute, Padding, 2);
318 -- AM/PM
320 when 'p' =>
321 Result := Result & Am_Pm (Hour);
323 -- Time, 12-hour (hh:mm:ss [AP]M)
325 when 'r' =>
326 Result := Result &
327 Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
328 Image (Minute, Padding, Length => 2) & ':' &
329 Image (Second, Padding, Length => 2) & ' ' &
330 Am_Pm (Hour);
332 -- Seconds since 1970-01-01 00:00:00 UTC
333 -- (a nonstandard extension)
335 when 's' =>
336 declare
337 -- Compute the number of seconds using Ada.Calendar.Time
338 -- values rather than Julian days to account for Daylight
339 -- Savings Time.
341 Neg : Boolean := False;
342 Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);
344 begin
345 -- Avoid rounding errors and perform special processing
346 -- for dates earlier than the Unix Epoc.
348 if Sec > 0.0 then
349 Sec := Sec - 0.5;
350 elsif Sec < 0.0 then
351 Neg := True;
352 Sec := abs (Sec + 0.5);
353 end if;
355 -- Prepend a minus sign to the result since Sec_Number
356 -- cannot handle negative numbers.
358 if Neg then
359 Result :=
360 Result & "-" & Image (Sec_Number (Sec), None);
361 else
362 Result := Result & Image (Sec_Number (Sec), None);
363 end if;
364 end;
366 -- Second (00..59)
368 when 'S' =>
369 Result := Result & Image (Second, Padding, Length => 2);
371 -- Milliseconds (3 digits)
372 -- Microseconds (6 digits)
373 -- Nanoseconds (9 digits)
375 when 'i' | 'e' | 'o' =>
376 declare
377 Sub_Sec : constant Long_Integer :=
378 Long_Integer (Sub_Second * 1_000_000_000);
380 Img1 : constant String := Sub_Sec'Img;
381 Img2 : constant String :=
382 "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
383 Nanos : constant String :=
384 Img2 (Img2'Last - 8 .. Img2'Last);
386 begin
387 case Picture (P + 1) is
388 when 'i' =>
389 Result := Result &
390 Nanos (Nanos'First .. Nanos'First + 2);
392 when 'e' =>
393 Result := Result &
394 Nanos (Nanos'First .. Nanos'First + 5);
396 when 'o' =>
397 Result := Result & Nanos;
399 when others =>
400 null;
401 end case;
402 end;
404 -- Time, 24-hour (hh:mm:ss)
406 when 'T' =>
407 Result := Result &
408 Image (Hour, Padding, Length => 2) & ':' &
409 Image (Minute, Padding, Length => 2) & ':' &
410 Image (Second, Padding, Length => 2);
412 -- Locale's abbreviated weekday name (Sun..Sat)
414 when 'a' =>
415 Result := Result &
416 Image (Day_Name'Image (Day_Of_Week (Date)), 3);
418 -- Locale's full weekday name, variable length
419 -- (Sunday..Saturday)
421 when 'A' =>
422 Result := Result &
423 Image (Day_Name'Image (Day_Of_Week (Date)));
425 -- Locale's abbreviated month name (Jan..Dec)
427 when 'b' | 'h' =>
428 Result := Result &
429 Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
431 -- Locale's full month name, variable length
432 -- (January..December).
434 when 'B' =>
435 Result := Result &
436 Image (Month_Name'Image (Month_Name'Val (Month - 1)));
438 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
440 when 'c' =>
441 case Padding is
442 when Zero =>
443 Result := Result & Image (Date, "%a %b %d %T %Y");
444 when Space =>
445 Result := Result & Image (Date, "%a %b %_d %_T %Y");
446 when None =>
447 Result := Result & Image (Date, "%a %b %-d %-T %Y");
448 end case;
450 -- Day of month (01..31)
452 when 'd' =>
453 Result := Result & Image (Day, Padding, 2);
455 -- Date (mm/dd/yy)
457 when 'D' | 'x' =>
458 Result := Result &
459 Image (Month, Padding, 2) & '/' &
460 Image (Day, Padding, 2) & '/' &
461 Image (Year, Padding, 2);
463 -- Day of year (001..366)
465 when 'j' =>
466 Result := Result & Image (Day_In_Year (Date), Padding, 3);
468 -- Month (01..12)
470 when 'm' =>
471 Result := Result & Image (Month, Padding, 2);
473 -- Week number of year with Sunday as first day of week
474 -- (00..53)
476 when 'U' =>
477 declare
478 Offset : constant Natural :=
479 (Julian_Day (Year, 1, 1) + 1) mod 7;
481 Week : constant Natural :=
482 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
484 begin
485 Result := Result & Image (Week, Padding, 2);
486 end;
488 -- Day of week (0..6) with 0 corresponding to Sunday
490 when 'w' =>
491 declare
492 DOW : constant Natural range 0 .. 6 :=
493 (if Day_Of_Week (Date) = Sunday
494 then 0
495 else Day_Name'Pos (Day_Of_Week (Date)));
496 begin
497 Result := Result & Image (DOW, Length => 1);
498 end;
500 -- Week number of year with Monday as first day of week
501 -- (00..53)
503 when 'W' =>
504 Result := Result & Image (Week_In_Year (Date), Padding, 2);
506 -- Last two digits of year (00..99)
508 when 'y' =>
509 declare
510 Y : constant Natural := Year - (Year / 100) * 100;
511 begin
512 Result := Result & Image (Y, Padding, 2);
513 end;
515 -- Year (1970...)
517 when 'Y' =>
518 Result := Result & Image (Year, None, 4);
520 when others =>
521 raise Picture_Error with
522 "unknown format character in picture string";
523 end case;
525 -- Skip past % and format character
527 P := P + 2;
529 -- Character other than % is copied into the result
531 else
532 Result := Result & Picture (P);
533 P := P + 1;
534 end if;
535 end loop;
537 return To_String (Result);
538 end Image;
540 --------------------------
541 -- Month_Name_To_Number --
542 --------------------------
544 function Month_Name_To_Number
545 (Str : String) return Ada.Calendar.Month_Number
547 subtype String3 is String (1 .. 3);
548 Abbrev_Upper_Month_Names :
549 constant array (Ada.Calendar.Month_Number) of String3 :=
550 ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
551 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");
552 -- Short version of the month names, used when parsing date strings
554 S : String := Str;
556 begin
557 GNAT.Case_Util.To_Upper (S);
559 for J in Abbrev_Upper_Month_Names'Range loop
560 if Abbrev_Upper_Month_Names (J) = S then
561 return J;
562 end if;
563 end loop;
565 return Abbrev_Upper_Month_Names'First;
566 end Month_Name_To_Number;
568 ------------------------
569 -- Parse_ISO_8861_UTC --
570 ------------------------
572 procedure Parse_ISO_8861_UTC
573 (Date : String;
574 Time : out Ada.Calendar.Time;
575 Success : out Boolean)
577 Index : Positive := Date'First;
578 -- The current character scan index. After a call to Advance, Index
579 -- points to the next character.
581 End_Of_Source_Reached : exception;
582 -- An exception used to signal that the scan pointer has reached the
583 -- end of the source string.
585 Wrong_Syntax : exception;
586 -- An exception used to signal that the scan pointer has reached an
587 -- unexpected character in the source string.
589 procedure Advance;
590 pragma Inline (Advance);
591 -- Past the current character of Date
593 procedure Advance_Digits (Num_Digits : Positive);
594 pragma Inline (Advance_Digits);
595 -- Past the given number of digit characters
597 function Scan_Day return Day_Number;
598 pragma Inline (Scan_Day);
599 -- Scan the two digits of a day number and return its value
601 function Scan_Hour return Hour_Number;
602 pragma Inline (Scan_Hour);
603 -- Scan the two digits of an hour number and return its value
605 function Scan_Minute return Minute_Number;
606 pragma Inline (Scan_Minute);
607 -- Scan the two digits of a minute number and return its value
609 function Scan_Month return Month_Number;
610 pragma Inline (Scan_Month);
611 -- Scan the two digits of a month number and return its value
613 function Scan_Second return Second_Number;
614 pragma Inline (Scan_Second);
615 -- Scan the two digits of a second number and return its value
617 function Scan_Separator (Expected_Symbol : Character) return Boolean;
618 pragma Inline (Scan_Separator);
619 -- If the current symbol matches the Expected_Symbol then advance the
620 -- scanner index and return True; otherwise do nothing and return False
622 procedure Scan_Separator (Required : Boolean; Separator : Character);
623 pragma Inline (Scan_Separator);
624 -- If Required then check that the current character matches Separator
625 -- and advance the scanner index; if not Required then do nothing.
627 function Scan_Subsecond return Second_Duration;
628 pragma Inline (Scan_Subsecond);
629 -- Scan all the digits of a subsecond number and return its value
631 function Scan_Year return Year_Number;
632 pragma Inline (Scan_Year);
633 -- Scan the four digits of a year number and return its value
635 function Symbol return Character;
636 pragma Inline (Symbol);
637 -- Return the current character being scanned
639 -------------
640 -- Advance --
641 -------------
643 procedure Advance is
644 begin
645 -- Signal the end of the source string. This stops a complex scan by
646 -- bottoming up any recursive calls till control reaches routine Scan
647 -- which handles the exception. Certain scanning scenarios may handle
648 -- this exception on their own.
650 if Index > Date'Last then
651 raise End_Of_Source_Reached;
653 -- Advance the scan pointer as long as there are characters to scan,
654 -- in other words, the scan pointer has not passed the end of the
655 -- source string.
657 else
658 Index := Index + 1;
659 end if;
660 end Advance;
662 --------------------
663 -- Advance_Digits --
664 --------------------
666 procedure Advance_Digits (Num_Digits : Positive) is
667 begin
668 for J in 1 .. Num_Digits loop
669 if Symbol not in '0' .. '9' then
670 raise Wrong_Syntax;
671 end if;
673 Advance; -- past digit
674 end loop;
675 end Advance_Digits;
677 --------------
678 -- Scan_Day --
679 --------------
681 function Scan_Day return Day_Number is
682 From : constant Positive := Index;
683 begin
684 Advance_Digits (Num_Digits => 2);
685 return Day_Number'Value (Date (From .. Index - 1));
686 end Scan_Day;
688 ---------------
689 -- Scan_Hour --
690 ---------------
692 function Scan_Hour return Hour_Number is
693 From : constant Positive := Index;
694 begin
695 Advance_Digits (Num_Digits => 2);
696 return Hour_Number'Value (Date (From .. Index - 1));
697 end Scan_Hour;
699 -----------------
700 -- Scan_Minute --
701 -----------------
703 function Scan_Minute return Minute_Number is
704 From : constant Positive := Index;
705 begin
706 Advance_Digits (Num_Digits => 2);
707 return Minute_Number'Value (Date (From .. Index - 1));
708 end Scan_Minute;
710 ----------------
711 -- Scan_Month --
712 ----------------
714 function Scan_Month return Month_Number is
715 From : constant Positive := Index;
716 begin
717 Advance_Digits (Num_Digits => 2);
718 return Month_Number'Value (Date (From .. Index - 1));
719 end Scan_Month;
721 -----------------
722 -- Scan_Second --
723 -----------------
725 function Scan_Second return Second_Number is
726 From : constant Positive := Index;
727 begin
728 Advance_Digits (Num_Digits => 2);
729 return Second_Number'Value (Date (From .. Index - 1));
730 end Scan_Second;
732 --------------------
733 -- Scan_Separator --
734 --------------------
736 function Scan_Separator (Expected_Symbol : Character) return Boolean is
737 begin
738 if Symbol = Expected_Symbol then
739 Advance;
740 return True;
741 else
742 return False;
743 end if;
744 end Scan_Separator;
746 --------------------
747 -- Scan_Separator --
748 --------------------
750 procedure Scan_Separator (Required : Boolean; Separator : Character) is
751 begin
752 if Required then
753 if Symbol /= Separator then
754 raise Wrong_Syntax;
755 end if;
757 Advance; -- Past the separator
758 end if;
759 end Scan_Separator;
761 --------------------
762 -- Scan_Subsecond --
763 --------------------
765 function Scan_Subsecond return Second_Duration is
766 From : constant Positive := Index;
767 begin
768 Advance_Digits (Num_Digits => 1);
770 while Symbol in '0' .. '9'
771 and then Index < Date'Length
772 loop
773 Advance;
774 end loop;
776 if Symbol not in '0' .. '9' then
777 raise Wrong_Syntax;
778 end if;
780 Advance;
781 return Second_Duration'Value ("0." & Date (From .. Index - 1));
782 end Scan_Subsecond;
784 ---------------
785 -- Scan_Year --
786 ---------------
788 function Scan_Year return Year_Number is
789 From : constant Positive := Index;
790 begin
791 Advance_Digits (Num_Digits => 4);
792 return Year_Number'Value (Date (From .. Index - 1));
793 end Scan_Year;
795 ------------
796 -- Symbol --
797 ------------
799 function Symbol return Character is
800 begin
801 -- Signal the end of the source string. This stops a complex scan by
802 -- bottoming up any recursive calls till control reaches routine Scan
803 -- which handles the exception. Certain scanning scenarios may handle
804 -- this exception on their own.
806 if Index > Date'Last then
807 raise End_Of_Source_Reached;
809 else
810 return Date (Index);
811 end if;
812 end Symbol;
814 -- Local variables
816 Date_Separator : constant Character := '-';
817 Hour_Separator : constant Character := ':';
819 Day : Day_Number;
820 Month : Month_Number;
821 Year : Year_Number;
822 Hour : Hour_Number := 0;
823 Minute : Minute_Number := 0;
824 Second : Second_Number := 0;
825 Subsec : Second_Duration := 0.0;
827 Local_Hour : Hour_Number := 0;
828 Local_Minute : Minute_Number := 0;
829 Local_Sign : Character := ' ';
830 Local_Disp : Duration;
832 Sep_Required : Boolean := False;
833 -- True if a separator is seen (and therefore required after it!)
835 begin
836 -- Parse date
838 Year := Scan_Year;
839 Sep_Required := Scan_Separator (Date_Separator);
841 Month := Scan_Month;
842 Scan_Separator (Sep_Required, Date_Separator);
844 Day := Scan_Day;
846 if Index < Date'Last and then Symbol = 'T' then
847 Advance;
849 -- Parse time
851 Hour := Scan_Hour;
852 Sep_Required := Scan_Separator (Hour_Separator);
854 Minute := Scan_Minute;
855 Scan_Separator (Sep_Required, Hour_Separator);
857 Second := Scan_Second;
859 -- [('Z' | ('.' | ',') s{s} | ('+'|'-')hh:mm)]
861 if Index <= Date'Last then
863 -- Suffix 'Z' just confirms that this is an UTC time. No further
864 -- action needed.
866 if Symbol = 'Z' then
867 Advance;
869 -- A decimal fraction shall have at least one digit, and has as
870 -- many digits as supported by the underlying implementation.
871 -- The valid decimal separators are those specified in ISO 31-0,
872 -- i.e. the comma [,] or full stop [.]. Of these, the comma is
873 -- the preferred separator of ISO-8861.
875 elsif Symbol = ',' or else Symbol = '.' then
876 Advance; -- past decimal separator
877 Subsec := Scan_Subsecond;
879 -- Difference between local time and UTC: It shall be expressed
880 -- as positive (i.e. with the leading plus sign [+]) if the local
881 -- time is ahead of or equal to UTC of day and as negative (i.e.
882 -- with the leading minus sign [-]) if it is behind UTC of day.
883 -- The minutes time element of the difference may only be omitted
884 -- if the difference between the time scales is exactly an
885 -- integral number of hours.
887 elsif Symbol = '+' or else Symbol = '-' then
888 Local_Sign := Symbol;
889 Advance;
890 Local_Hour := Scan_Hour;
892 -- Past ':'
894 if Index < Date'Last and then Symbol = Hour_Separator then
895 Advance;
896 Local_Minute := Scan_Minute;
897 end if;
899 -- Compute local displacement
901 Local_Disp := Local_Hour * 3600.0 + Local_Minute * 60.0;
902 else
903 raise Wrong_Syntax;
904 end if;
905 end if;
906 end if;
908 -- Sanity checks. The check on Index ensures that there are no trailing
909 -- characters.
911 if Index /= Date'Length + 1
912 or else not Year'Valid
913 or else not Month'Valid
914 or else not Day'Valid
915 or else not Hour'Valid
916 or else not Minute'Valid
917 or else not Second'Valid
918 or else not Subsec'Valid
919 or else not Local_Hour'Valid
920 or else not Local_Minute'Valid
921 then
922 raise Wrong_Syntax;
923 end if;
925 -- Compute time without local displacement
927 if Local_Sign = ' ' then
928 Time := Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec);
930 -- Compute time with positive local displacement
932 elsif Local_Sign = '+' then
933 Time :=
934 Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec) -
935 Local_Disp;
937 -- Compute time with negative local displacement
939 elsif Local_Sign = '-' then
940 Time :=
941 Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec) +
942 Local_Disp;
943 end if;
945 -- Notify that the input string was successfully parsed
947 Success := True;
949 exception
950 when End_Of_Source_Reached
951 | Wrong_Syntax
953 Success := False;
954 end Parse_ISO_8861_UTC;
956 -----------
957 -- Value --
958 -----------
960 function Value (Date : String) return Ada.Calendar.Time is
961 D : String (1 .. 21);
962 D_Length : constant Natural := Date'Length;
964 Year : Year_Number;
965 Month : Month_Number;
966 Day : Day_Number;
967 Hour : Hour_Number;
968 Minute : Minute_Number;
969 Second : Second_Number;
971 procedure Extract_Date
972 (Year : out Year_Number;
973 Month : out Month_Number;
974 Day : out Day_Number;
975 Time_Start : out Natural);
976 -- Try and extract a date value from string D. Time_Start is set to the
977 -- first character that could be the start of time data.
979 procedure Extract_Time
980 (Index : Positive;
981 Hour : out Hour_Number;
982 Minute : out Minute_Number;
983 Second : out Second_Number;
984 Check_Space : Boolean := False);
985 -- Try and extract a time value from string D starting from position
986 -- Index. Set Check_Space to True to check whether the character at
987 -- Index - 1 is a space. Raise Constraint_Error if the portion of D
988 -- corresponding to the date is not well formatted.
990 ------------------
991 -- Extract_Date --
992 ------------------
994 procedure Extract_Date
995 (Year : out Year_Number;
996 Month : out Month_Number;
997 Day : out Day_Number;
998 Time_Start : out Natural)
1000 begin
1001 if D (3) = '-' or else D (3) = '/' then
1002 if D_Length = 8 or else D_Length = 17 then
1004 -- Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
1006 if D (6) /= D (3) then
1007 raise Constraint_Error;
1008 end if;
1010 Year := Year_Number'Value ("20" & D (1 .. 2));
1011 Month := Month_Number'Value (D (4 .. 5));
1012 Day := Day_Number'Value (D (7 .. 8));
1013 Time_Start := 10;
1015 elsif D_Length = 10 or else D_Length = 19 then
1017 -- Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
1019 if D (6) /= D (3) then
1020 raise Constraint_Error;
1021 end if;
1023 Year := Year_Number'Value (D (7 .. 10));
1024 Month := Month_Number'Value (D (1 .. 2));
1025 Day := Day_Number'Value (D (4 .. 5));
1026 Time_Start := 12;
1028 elsif D_Length = 11 or else D_Length = 20 then
1030 -- Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
1032 if D (7) /= D (3) then
1033 raise Constraint_Error;
1034 end if;
1036 Year := Year_Number'Value (D (8 .. 11));
1037 Month := Month_Name_To_Number (D (4 .. 6));
1038 Day := Day_Number'Value (D (1 .. 2));
1039 Time_Start := 13;
1041 else
1042 raise Constraint_Error;
1043 end if;
1045 elsif D (3) = ' ' then
1046 if D_Length = 11 or else D_Length = 20 then
1048 -- Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
1050 if D (7) /= ' ' then
1051 raise Constraint_Error;
1052 end if;
1054 Year := Year_Number'Value (D (8 .. 11));
1055 Month := Month_Name_To_Number (D (4 .. 6));
1056 Day := Day_Number'Value (D (1 .. 2));
1057 Time_Start := 13;
1059 else
1060 raise Constraint_Error;
1061 end if;
1063 else
1064 if D_Length = 8 or else D_Length = 17 then
1066 -- Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
1068 Year := Year_Number'Value (D (1 .. 4));
1069 Month := Month_Number'Value (D (5 .. 6));
1070 Day := Day_Number'Value (D (7 .. 8));
1071 Time_Start := 10;
1073 elsif D_Length = 10 or else D_Length = 19 then
1075 -- Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
1077 if (D (5) /= '-' and then D (5) /= '/')
1078 or else D (8) /= D (5)
1079 then
1080 raise Constraint_Error;
1081 end if;
1083 Year := Year_Number'Value (D (1 .. 4));
1084 Month := Month_Number'Value (D (6 .. 7));
1085 Day := Day_Number'Value (D (9 .. 10));
1086 Time_Start := 12;
1088 elsif D_Length = 11 or else D_Length = 20 then
1090 -- Possible formats are "yyyy*mmm*dd"
1092 if (D (5) /= '-' and then D (5) /= '/')
1093 or else D (9) /= D (5)
1094 then
1095 raise Constraint_Error;
1096 end if;
1098 Year := Year_Number'Value (D (1 .. 4));
1099 Month := Month_Name_To_Number (D (6 .. 8));
1100 Day := Day_Number'Value (D (10 .. 11));
1101 Time_Start := 13;
1103 elsif D_Length = 12 or else D_Length = 21 then
1105 -- Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
1107 if D (4) /= ' '
1108 or else D (7) /= ','
1109 or else D (8) /= ' '
1110 then
1111 raise Constraint_Error;
1112 end if;
1114 Year := Year_Number'Value (D (9 .. 12));
1115 Month := Month_Name_To_Number (D (1 .. 3));
1116 Day := Day_Number'Value (D (5 .. 6));
1117 Time_Start := 14;
1119 else
1120 raise Constraint_Error;
1121 end if;
1122 end if;
1123 end Extract_Date;
1125 ------------------
1126 -- Extract_Time --
1127 ------------------
1129 procedure Extract_Time
1130 (Index : Positive;
1131 Hour : out Hour_Number;
1132 Minute : out Minute_Number;
1133 Second : out Second_Number;
1134 Check_Space : Boolean := False)
1136 begin
1137 -- If no time was specified in the string (do not allow trailing
1138 -- character either)
1140 if Index = D_Length + 2 then
1141 Hour := 0;
1142 Minute := 0;
1143 Second := 0;
1145 else
1146 -- Not enough characters left ?
1148 if Index /= D_Length - 7 then
1149 raise Constraint_Error;
1150 end if;
1152 if Check_Space and then D (Index - 1) /= ' ' then
1153 raise Constraint_Error;
1154 end if;
1156 if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
1157 raise Constraint_Error;
1158 end if;
1160 Hour := Hour_Number'Value (D (Index .. Index + 1));
1161 Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
1162 Second := Second_Number'Value (D (Index + 6 .. Index + 7));
1163 end if;
1164 end Extract_Time;
1166 -- Local Declarations
1168 Success : Boolean;
1169 Time_Start : Natural := 1;
1170 Time : Ada.Calendar.Time;
1172 -- Start of processing for Value
1174 begin
1175 -- Let's try parsing Date as a supported ISO-8861 format. If we do not
1176 -- succeed, then retry using all the other GNAT supported formats.
1178 Parse_ISO_8861_UTC (Date, Time, Success);
1180 if Success then
1181 return Time;
1182 end if;
1184 -- Length checks
1186 if D_Length /= 8
1187 and then D_Length /= 10
1188 and then D_Length /= 11
1189 and then D_Length /= 12
1190 and then D_Length /= 17
1191 and then D_Length /= 19
1192 and then D_Length /= 20
1193 and then D_Length /= 21
1194 then
1195 raise Constraint_Error;
1196 end if;
1198 -- After the correct length has been determined, it is safe to create
1199 -- a local string copy in order to avoid String'First N arithmetic.
1201 D (1 .. D_Length) := Date;
1203 if D_Length /= 8 or else D (3) /= ':' then
1204 Extract_Date (Year, Month, Day, Time_Start);
1205 Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
1207 else
1208 declare
1209 Discard : Second_Duration;
1210 begin
1211 Split (Clock, Year, Month, Day, Hour, Minute, Second,
1212 Sub_Second => Discard);
1213 end;
1215 Extract_Time (1, Hour, Minute, Second, Check_Space => False);
1216 end if;
1218 -- Sanity checks
1220 if not Year'Valid
1221 or else not Month'Valid
1222 or else not Day'Valid
1223 or else not Hour'Valid
1224 or else not Minute'Valid
1225 or else not Second'Valid
1226 then
1227 raise Constraint_Error;
1228 end if;
1230 return Time_Of (Year, Month, Day, Hour, Minute, Second);
1231 end Value;
1233 --------------
1234 -- Put_Time --
1235 --------------
1237 procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
1238 begin
1239 Ada.Text_IO.Put (Image (Date, Picture));
1240 end Put_Time;
1242 end GNAT.Calendar.Time_IO;