arm: Use LDMIA/STMIA for thumb1 DI/DF loads/stores
[official-gcc.git] / gcc / ada / libgnat / g-catiio.adb
blob3bd11d8268d3e8af3d71422fcb9a7692cc185bdf
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-2024, 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.Characters.Handling;
33 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
34 with Ada.Text_IO;
36 with GNAT.Case_Util;
38 package body GNAT.Calendar.Time_IO is
40 type Month_Name is
41 (January,
42 February,
43 March,
44 April,
45 May,
46 June,
47 July,
48 August,
49 September,
50 October,
51 November,
52 December);
54 function Month_Name_To_Number
55 (Str : String) return Ada.Calendar.Month_Number;
56 -- Converts a string that contains an abbreviated month name to a month
57 -- number. Constraint_Error is raised if Str is not a valid month name.
58 -- Comparison is case insensitive
60 type Padding_Mode is (None, Zero, Space);
62 type Sec_Number is mod 2 ** 64;
63 -- Type used to compute the number of seconds since 01/01/1970. A 32 bit
64 -- number will cover only a period of 136 years. This means that for date
65 -- past 2106 the computation is not possible. A 64 bits number should be
66 -- enough for a very large period of time.
68 -----------------------
69 -- Local Subprograms --
70 -----------------------
72 function Image_Helper
73 (Date : Ada.Calendar.Time;
74 Picture : Picture_String;
75 Time_Zone : Time_Zones.Time_Offset) return String;
76 -- This is called by the two exported Image functions. It uses the local
77 -- time zone for its computations, but uses Time_Zone when interpreting the
78 -- "%:::z" tag.
80 function Am_Pm (H : Natural) return String;
81 -- Return AM or PM depending on the hour H
83 function Hour_12 (H : Natural) return Positive;
84 -- Convert a 1-24h format to a 0-12 hour format
86 function Image (Str : String; Length : Natural := 0) return String;
87 -- Return Str capitalized and cut to length number of characters. If
88 -- length is 0, then no cut operation is performed.
90 function Image
91 (N : Sec_Number;
92 Padding : Padding_Mode := Zero;
93 Length : Natural := 0) return String;
94 -- Return image of N. This number is eventually padded with zeros or spaces
95 -- depending of the length required. If length is 0 then no padding occurs.
97 function Image
98 (N : Natural;
99 Padding : Padding_Mode := Zero;
100 Length : Natural := 0) return String;
101 -- As above with N provided in Integer format
103 procedure Parse_ISO_8601
104 (Date : String;
105 Time : out Ada.Calendar.Time;
106 Success : out Boolean);
107 -- Subsidiary of function Value. It parses the string Date, interpreted as
108 -- an ISO 8601 time representation, and returns corresponding Time value.
109 -- Success is set to False when the string is not a supported ISO 8601
110 -- date.
112 -- Examples:
114 -- 2017-04-14T14:47:06 20170414T14:47:06 20170414T144706
115 -- 2017-04-14T14:47:06,12 20170414T14:47:06.12
116 -- 2017-04-14T19:47:06+05 20170414T09:00:06-05:47
118 -----------
119 -- Am_Pm --
120 -----------
122 function Am_Pm (H : Natural) return String is
123 begin
124 if H = 0 or else H > 12 then
125 return "PM";
126 else
127 return "AM";
128 end if;
129 end Am_Pm;
131 -------------
132 -- Hour_12 --
133 -------------
135 function Hour_12 (H : Natural) return Positive is
136 begin
137 if H = 0 then
138 return 12;
139 elsif H <= 12 then
140 return H;
141 else -- H > 12
142 return H - 12;
143 end if;
144 end Hour_12;
146 -----------
147 -- Image --
148 -----------
150 function Image
151 (Str : String;
152 Length : Natural := 0) return String
154 use Ada.Characters.Handling;
155 Local : constant String :=
156 To_Upper (Str (Str'First)) &
157 To_Lower (Str (Str'First + 1 .. Str'Last));
158 begin
159 if Length = 0 then
160 return Local;
161 else
162 return Local (1 .. Length);
163 end if;
164 end Image;
166 -----------
167 -- Image --
168 -----------
170 function Image
171 (N : Natural;
172 Padding : Padding_Mode := Zero;
173 Length : Natural := 0) return String
175 begin
176 return Image (Sec_Number (N), Padding, Length);
177 end Image;
179 -----------
180 -- Image --
181 -----------
183 function Image
184 (N : Sec_Number;
185 Padding : Padding_Mode := Zero;
186 Length : Natural := 0) return String
188 function Pad_Char return String;
190 --------------
191 -- Pad_Char --
192 --------------
194 function Pad_Char return String is
195 begin
196 case Padding is
197 when None => return "";
198 when Zero => return "00";
199 when Space => return " ";
200 end case;
201 end Pad_Char;
203 -- Local Declarations
205 NI : constant String := Sec_Number'Image (N);
206 NIP : constant String := Pad_Char & NI (2 .. NI'Last);
208 -- Start of processing for Image
210 begin
211 if Length = 0 or else Padding = None then
212 return NI (2 .. NI'Last);
213 else
214 return NIP (NIP'Last - Length + 1 .. NIP'Last);
215 end if;
216 end Image;
218 -----------
219 -- Image --
220 -----------
222 function Image
223 (Date : Ada.Calendar.Time;
224 Picture : Picture_String;
225 Time_Zone : Time_Zones.Time_Offset) return String
227 -- We subtract off the local time zone, and add in the requested
228 -- Time_Zone, and then pass it on to Image_Helper, which uses the
229 -- local time zone.
231 use Time_Zones;
232 Local_TZ : constant Time_Offset := Local_Time_Offset (Date);
233 Minute_Offset : constant Integer := Integer (Time_Zone - Local_TZ);
234 Second_Offset : constant Integer := Minute_Offset * 60;
235 begin
236 return Image_Helper
237 (Date + Duration (Second_Offset), Picture, Time_Zone);
238 end Image;
240 -----------
241 -- Image --
242 -----------
244 function Image
245 (Date : Ada.Calendar.Time;
246 Picture : Picture_String) return String
248 use Time_Zones;
249 Local_TZ : constant Time_Offset := Local_Time_Offset (Date);
250 begin
251 return Image_Helper (Date, Picture, Local_TZ);
252 end Image;
254 ------------------
255 -- Image_Helper --
256 ------------------
258 function Image_Helper
259 (Date : Ada.Calendar.Time;
260 Picture : Picture_String;
261 Time_Zone : Time_Zones.Time_Offset) return String
263 Padding : Padding_Mode := Zero;
264 -- Padding is set for one directive
266 Result : Unbounded_String;
268 Year : Year_Number;
269 Month : Month_Number;
270 Day : Day_Number;
271 Hour : Hour_Number;
272 Minute : Minute_Number;
273 Second : Second_Number;
274 Sub_Second : Second_Duration;
276 P : Positive;
278 begin
279 -- Get current time in split format
281 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
283 -- Null picture string is error
285 if Picture = "" then
286 raise Picture_Error with "null picture string";
287 end if;
289 -- Loop through characters of picture string, building result
291 Result := Null_Unbounded_String;
292 P := Picture'First;
293 while P <= Picture'Last loop
295 -- A directive has the following format "%[-_]."
297 if Picture (P) = '%' then
298 Padding := Zero;
300 if P = Picture'Last then
301 raise Picture_Error with "picture string ends with '%";
302 end if;
304 -- Check for GNU extension to change the padding
306 if Picture (P + 1) = '-' then
307 Padding := None;
308 P := P + 1;
310 elsif Picture (P + 1) = '_' then
311 Padding := Space;
312 P := P + 1;
313 end if;
315 if P = Picture'Last then
316 raise Picture_Error with "picture string ends with '- or '_";
317 end if;
319 case Picture (P + 1) is
321 -- Literal %
323 when '%' =>
324 Result := Result & '%';
326 -- A newline
328 when 'n' =>
329 Result := Result & ASCII.LF;
331 -- A horizontal tab
333 when 't' =>
334 Result := Result & ASCII.HT;
336 -- Hour (00..23)
338 when 'H' =>
339 Result := Result & Image (Hour, Padding, 2);
341 -- Hour (01..12)
343 when 'I' =>
344 Result := Result & Image (Hour_12 (Hour), Padding, 2);
346 -- Hour ( 0..23)
348 when 'k' =>
349 Result := Result & Image (Hour, Space, 2);
351 -- Hour ( 1..12)
353 when 'l' =>
354 Result := Result & Image (Hour_12 (Hour), Space, 2);
356 -- Minute (00..59)
358 when 'M' =>
359 Result := Result & Image (Minute, Padding, 2);
361 -- AM/PM
363 when 'p' =>
364 Result := Result & Am_Pm (Hour);
366 -- Time, 12-hour (hh:mm:ss [AP]M)
368 when 'r' =>
369 Result := Result &
370 Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
371 Image (Minute, Padding, Length => 2) & ':' &
372 Image (Second, Padding, Length => 2) & ' ' &
373 Am_Pm (Hour);
375 -- Seconds since 1970-01-01 00:00:00 UTC
376 -- (a nonstandard extension)
378 when 's' =>
379 declare
380 -- Compute the number of seconds using Ada.Calendar.Time
381 -- values rather than Julian days to account for Daylight
382 -- Savings Time.
384 Neg : Boolean := False;
385 Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);
387 begin
388 -- Avoid rounding errors and perform special processing
389 -- for dates earlier than the Unix Epoc.
391 if Sec > 0.0 then
392 Sec := Sec - 0.5;
393 elsif Sec < 0.0 then
394 Neg := True;
395 Sec := abs (Sec + 0.5);
396 end if;
398 -- Prepend a minus sign to the result since Sec_Number
399 -- cannot handle negative numbers.
401 if Neg then
402 Result :=
403 Result & "-" & Image (Sec_Number (Sec), None);
404 else
405 Result := Result & Image (Sec_Number (Sec), None);
406 end if;
407 end;
409 -- Second (00..59)
411 when 'S' =>
412 Result := Result & Image (Second, Padding, Length => 2);
414 -- Milliseconds (3 digits)
415 -- Microseconds (6 digits)
416 -- Nanoseconds (9 digits)
418 when 'i' | 'e' | 'o' =>
419 declare
420 Sub_Sec : constant Long_Integer :=
421 Long_Integer (Sub_Second * 1_000_000_000);
423 Img1 : constant String := Sub_Sec'Img;
424 Img2 : constant String :=
425 "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
426 Nanos : constant String :=
427 Img2 (Img2'Last - 8 .. Img2'Last);
429 begin
430 case Picture (P + 1) is
431 when 'i' =>
432 Result := Result &
433 Nanos (Nanos'First .. Nanos'First + 2);
435 when 'e' =>
436 Result := Result &
437 Nanos (Nanos'First .. Nanos'First + 5);
439 when 'o' =>
440 Result := Result & Nanos;
442 when others =>
443 null;
444 end case;
445 end;
447 -- Time, 24-hour (hh:mm:ss)
449 when 'T' =>
450 Result := Result &
451 Image (Hour, Padding, Length => 2) & ':' &
452 Image (Minute, Padding, Length => 2) & ':' &
453 Image (Second, Padding, Length => 2);
455 -- Time zone. Append "+hh", "-hh", "+hh:mm", or "-hh:mm", as
456 -- appropriate.
458 when ':' =>
459 declare
460 use type Time_Zones.Time_Offset;
461 TZ_Form : constant Picture_String := "%:::z";
462 TZ : constant Natural := Natural (abs Time_Zone);
463 begin
464 if P + TZ_Form'Length - 1 <= Picture'Last
465 and then Picture (P .. P + TZ_Form'Length - 1) = "%:::z"
466 then
467 if Time_Zone >= 0 then
468 Result := Result & "+";
469 else
470 Result := Result & "-";
471 end if;
473 Result := Result &
474 Image (Integer (TZ / 60), Padding, Length => 2);
476 if TZ mod 60 /= 0 then
477 Result := Result & ":";
478 Result := Result &
479 Image (TZ mod 60, Padding, Length => 2);
480 end if;
482 P := P + TZ_Form'Length - 2; -- will add 2 below
484 -- We do not support any of the other standard GNU
485 -- time-zone formats (%z, %:z, %::z, %Z).
487 else
488 raise Picture_Error with "unsupported picture format";
489 end if;
490 end;
492 -- Locale's abbreviated weekday name (Sun..Sat)
494 when 'a' =>
495 Result := Result &
496 Image (Day_Name'Image (Day_Of_Week (Date)), 3);
498 -- Locale's full weekday name, variable length
499 -- (Sunday..Saturday)
501 when 'A' =>
502 Result := Result &
503 Image (Day_Name'Image (Day_Of_Week (Date)));
505 -- Locale's abbreviated month name (Jan..Dec)
507 when 'b' | 'h' =>
508 Result := Result &
509 Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
511 -- Locale's full month name, variable length
512 -- (January..December).
514 when 'B' =>
515 Result := Result &
516 Image (Month_Name'Image (Month_Name'Val (Month - 1)));
518 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
520 when 'c' =>
521 case Padding is
522 when Zero =>
523 Result := Result & Image (Date, "%a %b %d %T %Y");
524 when Space =>
525 Result := Result & Image (Date, "%a %b %_d %_T %Y");
526 when None =>
527 Result := Result & Image (Date, "%a %b %-d %-T %Y");
528 end case;
530 -- Day of month (01..31)
532 when 'd' =>
533 Result := Result & Image (Day, Padding, 2);
535 -- Date (mm/dd/yy)
537 when 'D' | 'x' =>
538 Result := Result &
539 Image (Month, Padding, 2) & '/' &
540 Image (Day, Padding, 2) & '/' &
541 Image (Year, Padding, 2);
543 -- Day of year (001..366)
545 when 'j' =>
546 Result := Result & Image (Day_In_Year (Date), Padding, 3);
548 -- Month (01..12)
550 when 'm' =>
551 Result := Result & Image (Month, Padding, 2);
553 -- Week number of year with Sunday as first day of week
554 -- (00..53)
556 when 'U' =>
557 declare
558 Offset : constant Natural :=
559 (Julian_Day (Year, 1, 1) + 1) mod 7;
561 Week : constant Natural :=
562 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
564 begin
565 Result := Result & Image (Week, Padding, 2);
566 end;
568 -- Day of week (0..6) with 0 corresponding to Sunday
570 when 'w' =>
571 declare
572 DOW : constant Natural range 0 .. 6 :=
573 (if Day_Of_Week (Date) = Sunday
574 then 0
575 else Day_Name'Pos (Day_Of_Week (Date)));
576 begin
577 Result := Result & Image (DOW, Length => 1);
578 end;
580 -- Week number of year with Monday as first day of week
581 -- (00..53)
583 when 'W' =>
584 Result := Result & Image (Week_In_Year (Date), Padding, 2);
586 -- Last two digits of year (00..99)
588 when 'y' =>
589 declare
590 Y : constant Natural := Year - (Year / 100) * 100;
591 begin
592 Result := Result & Image (Y, Padding, 2);
593 end;
595 -- Year (1970...)
597 when 'Y' =>
598 Result := Result & Image (Year, None, 4);
600 when others =>
601 raise Picture_Error with
602 "unknown format character in picture string";
603 end case;
605 -- Skip past % and format character
607 P := P + 2;
609 -- Character other than % is copied into the result
611 else
612 Result := Result & Picture (P);
613 P := P + 1;
614 end if;
615 end loop;
617 return To_String (Result);
618 end Image_Helper;
620 --------------------------
621 -- Month_Name_To_Number --
622 --------------------------
624 function Month_Name_To_Number
625 (Str : String) return Ada.Calendar.Month_Number
627 subtype String3 is String (1 .. 3);
628 Abbrev_Upper_Month_Names :
629 constant array (Ada.Calendar.Month_Number) of String3 :=
630 ["JAN", "FEB", "MAR", "APR", "MAY", "JUN",
631 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"];
632 -- Short version of the month names, used when parsing date strings
634 S : String := Str;
636 begin
637 GNAT.Case_Util.To_Upper (S);
639 for J in Abbrev_Upper_Month_Names'Range loop
640 if Abbrev_Upper_Month_Names (J) = S then
641 return J;
642 end if;
643 end loop;
645 return Abbrev_Upper_Month_Names'First;
646 end Month_Name_To_Number;
648 --------------------
649 -- Parse_ISO_8601 --
650 --------------------
652 procedure Parse_ISO_8601
653 (Date : String;
654 Time : out Ada.Calendar.Time;
655 Success : out Boolean)
657 pragma Unsuppress (All_Checks);
658 -- This is necessary because the run-time library is usually compiled
659 -- with checks suppressed, and we are relying on constraint checks in
660 -- this code to catch syntax errors in the Date string (e.g. out of
661 -- bounds slices).
663 Index : Positive := Date'First;
664 -- The current character scan index. After a call to Advance, Index
665 -- points to the next character.
667 Wrong_Syntax : exception;
668 -- An exception used to signal that the scan pointer has reached an
669 -- unexpected character in the source string, or if premature
670 -- end-of-source was reached.
672 procedure Advance;
673 pragma Inline (Advance);
674 -- Past the current character of Date
676 procedure Advance_Digits (Num_Digits : Positive);
677 pragma Inline (Advance_Digits);
678 -- Past the given number of digit characters
680 function Scan_Day return Day_Number;
681 pragma Inline (Scan_Day);
682 -- Scan the two digits of a day number and return its value
684 function Scan_Hour return Hour_Number;
685 pragma Inline (Scan_Hour);
686 -- Scan the two digits of an hour number and return its value
688 function Scan_Minute return Minute_Number;
689 pragma Inline (Scan_Minute);
690 -- Scan the two digits of a minute number and return its value
692 function Scan_Month return Month_Number;
693 pragma Inline (Scan_Month);
694 -- Scan the two digits of a month number and return its value
696 function Scan_Second return Second_Number;
697 pragma Inline (Scan_Second);
698 -- Scan the two digits of a second number and return its value
700 function Scan_Separator (Expected_Symbol : Character) return Boolean;
701 pragma Inline (Scan_Separator);
702 -- If the current symbol matches the Expected_Symbol then advance the
703 -- scanner index and return True; otherwise do nothing and return False
705 procedure Scan_Separator (Required : Boolean; Separator : Character);
706 pragma Inline (Scan_Separator);
707 -- If Required then check that the current character matches Separator
708 -- and advance the scanner index; if not Required then do nothing.
710 function Scan_Subsecond return Second_Duration;
711 pragma Inline (Scan_Subsecond);
712 -- Scan all the digits of a subsecond number and return its value
714 function Scan_Year return Year_Number;
715 pragma Inline (Scan_Year);
716 -- Scan the four digits of a year number and return its value
718 function Symbol return Character;
719 pragma Inline (Symbol);
720 -- Return the current character being scanned
722 -------------
723 -- Advance --
724 -------------
726 procedure Advance is
727 begin
728 -- Signal the end of the source string. This stops a complex scan
729 -- by bottoming up any recursive calls till control reaches routine
730 -- Scan, which handles the exception.
732 if Index > Date'Last then
733 raise Wrong_Syntax;
735 -- Advance the scan pointer as long as there are characters to scan,
736 -- in other words, the scan pointer has not passed the end of the
737 -- source string.
739 else
740 Index := Index + 1;
741 end if;
742 end Advance;
744 --------------------
745 -- Advance_Digits --
746 --------------------
748 procedure Advance_Digits (Num_Digits : Positive) is
749 begin
750 for J in 1 .. Num_Digits loop
751 if Symbol not in '0' .. '9' then
752 raise Wrong_Syntax;
753 end if;
755 Advance; -- past digit
756 end loop;
757 end Advance_Digits;
759 --------------
760 -- Scan_Day --
761 --------------
763 function Scan_Day return Day_Number is
764 From : constant Positive := Index;
765 begin
766 Advance_Digits (Num_Digits => 2);
767 return Day_Number'Value (Date (From .. Index - 1));
768 end Scan_Day;
770 ---------------
771 -- Scan_Hour --
772 ---------------
774 function Scan_Hour return Hour_Number is
775 From : constant Positive := Index;
776 begin
777 Advance_Digits (Num_Digits => 2);
778 return Hour_Number'Value (Date (From .. Index - 1));
779 end Scan_Hour;
781 -----------------
782 -- Scan_Minute --
783 -----------------
785 function Scan_Minute return Minute_Number is
786 From : constant Positive := Index;
787 begin
788 Advance_Digits (Num_Digits => 2);
789 return Minute_Number'Value (Date (From .. Index - 1));
790 end Scan_Minute;
792 ----------------
793 -- Scan_Month --
794 ----------------
796 function Scan_Month return Month_Number is
797 From : constant Positive := Index;
798 begin
799 Advance_Digits (Num_Digits => 2);
800 return Month_Number'Value (Date (From .. Index - 1));
801 end Scan_Month;
803 -----------------
804 -- Scan_Second --
805 -----------------
807 function Scan_Second return Second_Number is
808 From : constant Positive := Index;
809 begin
810 Advance_Digits (Num_Digits => 2);
811 return Second_Number'Value (Date (From .. Index - 1));
812 end Scan_Second;
814 --------------------
815 -- Scan_Separator --
816 --------------------
818 function Scan_Separator (Expected_Symbol : Character) return Boolean is
819 begin
820 if Symbol = Expected_Symbol then
821 Advance;
822 return True;
823 else
824 return False;
825 end if;
826 end Scan_Separator;
828 --------------------
829 -- Scan_Separator --
830 --------------------
832 procedure Scan_Separator (Required : Boolean; Separator : Character) is
833 begin
834 if Required then
835 if Symbol /= Separator then
836 raise Wrong_Syntax;
837 end if;
839 Advance; -- Past the separator
840 end if;
841 end Scan_Separator;
843 --------------------
844 -- Scan_Subsecond --
845 --------------------
847 function Scan_Subsecond return Second_Duration is
848 From : constant Positive := Index;
849 begin
850 Advance_Digits (Num_Digits => 1);
852 while Index <= Date'Last and then Symbol in '0' .. '9' loop
853 Advance;
854 end loop;
856 return Second_Duration'Value ("0." & Date (From .. Index - 1));
857 end Scan_Subsecond;
859 ---------------
860 -- Scan_Year --
861 ---------------
863 function Scan_Year return Year_Number is
864 From : constant Positive := Index;
865 begin
866 Advance_Digits (Num_Digits => 4);
867 return Year_Number'Value (Date (From .. Index - 1));
868 end Scan_Year;
870 ------------
871 -- Symbol --
872 ------------
874 function Symbol return Character is
875 begin
876 -- Signal the end of the source string. This stops a complex scan by
877 -- bottoming up any recursive calls till control reaches routine Scan
878 -- which handles the exception. Certain scanning scenarios may handle
879 -- this exception on their own.
881 if Index > Date'Last then
882 raise Wrong_Syntax;
884 else
885 return Date (Index);
886 end if;
887 end Symbol;
889 -- Local variables
891 use Time_Zones;
893 Date_Separator : constant Character := '-';
894 Hour_Separator : constant Character := ':';
896 Day : Day_Number;
897 Month : Month_Number;
898 Year : Year_Number;
899 Hour : Hour_Number := 0;
900 Minute : Minute_Number := 0;
901 Second : Second_Number := 0;
902 Subsec : Second_Duration := 0.0;
904 Time_Zone_Seen : Boolean := False;
905 Time_Zone_Offset : Time_Offset; -- Valid only if Time_Zone_Seen
907 Sep_Required : Boolean := False;
908 -- True if a separator is seen (and therefore required after it!)
910 subtype Sign_Type is Character with Predicate => Sign_Type in '+' | '-';
912 -- Start of processing for Parse_ISO_8601
914 begin
915 -- Parse date
917 Year := Scan_Year;
918 Sep_Required := Scan_Separator (Date_Separator);
920 Month := Scan_Month;
921 Scan_Separator (Sep_Required, Date_Separator);
923 Day := Scan_Day;
925 if Index < Date'Last and then Symbol = 'T' then
926 Advance;
928 -- Parse time
930 Hour := Scan_Hour;
931 Sep_Required := Scan_Separator (Hour_Separator);
933 Minute := Scan_Minute;
934 Scan_Separator (Sep_Required, Hour_Separator);
936 Second := Scan_Second;
938 -- [ ('.' | ',') s{s} ]
940 if Index <= Date'Last then
941 -- A decimal fraction shall have at least one digit, and has as
942 -- many digits as supported by the underlying implementation.
943 -- The valid decimal separators are those specified in ISO 31-0,
944 -- i.e. the comma [,] or full stop [.]. Of these, the comma is
945 -- the preferred separator of ISO-8601.
947 if Symbol = ',' or else Symbol = '.' then
948 Advance; -- past decimal separator
949 Subsec := Scan_Subsecond;
950 end if;
951 end if;
953 -- [ ('Z' | ('+'|'-')hh':'mm) ]
955 if Index <= Date'Last then
956 Time_Zone_Seen := Symbol in 'Z' | Sign_Type;
958 -- Suffix 'Z' signifies that this is UTC time (time zone 0)
960 if Symbol = 'Z' then
961 Time_Zone_Offset := 0;
962 Advance;
964 -- Difference between local time and UTC: It shall be expressed
965 -- as positive (i.e. with the leading plus sign [+]) if the local
966 -- time is ahead of or equal to UTC of day and as negative (i.e.
967 -- with the leading minus sign [-]) if it is behind UTC of day.
968 -- The minutes time element of the difference may only be omitted
969 -- if the difference between the time scales is exactly an
970 -- integral number of hours.
972 elsif Symbol in Sign_Type then
973 declare
974 Time_Zone_Sign : constant Sign_Type := Symbol;
975 Time_Zone_Hour : Hour_Number;
976 Time_Zone_Minute : Minute_Number;
977 begin
978 Advance;
979 Time_Zone_Hour := Scan_Hour;
981 -- Past ':'
983 if Index < Date'Last and then Symbol = Hour_Separator then
984 Advance;
985 Time_Zone_Minute := Scan_Minute;
986 else
987 Time_Zone_Minute := 0;
988 end if;
990 -- Compute Time_Zone_Offset
992 Time_Zone_Offset :=
993 Time_Offset (Time_Zone_Hour * 60 + Time_Zone_Minute);
995 case Time_Zone_Sign is
996 when '+' => null;
997 when '-' => Time_Zone_Offset := -Time_Zone_Offset;
998 end case;
999 end;
1000 else
1001 raise Wrong_Syntax;
1002 end if;
1003 end if;
1004 end if;
1006 -- Check for trailing characters
1008 if Index /= Date'Last + 1 then
1009 raise Wrong_Syntax;
1010 end if;
1012 -- If a time zone was specified, use Ada.Calendar.Formatting.Time_Of,
1013 -- and specify the time zone. Otherwise, call GNAT.Calendar.Time_Of,
1014 -- which uses local time.
1016 if Time_Zone_Seen then
1017 Time := Ada.Calendar.Formatting.Time_Of
1018 (Year, Month, Day, Hour, Minute, Second, Subsec,
1019 Time_Zone => Time_Zone_Offset);
1020 else
1021 Time := GNAT.Calendar.Time_Of
1022 (Year, Month, Day, Hour, Minute, Second, Subsec);
1023 end if;
1025 -- Notify that the input string was successfully parsed
1027 Success := True;
1029 exception
1030 when Wrong_Syntax | Constraint_Error =>
1031 -- If constraint check fails, we want to behave the same as
1032 -- Wrong_Syntax; we want the caller (Value) to try other
1033 -- allowed syntaxes.
1034 Time :=
1035 Time_Of (Year_Number'First, Month_Number'First, Day_Number'First);
1036 Success := False;
1037 end Parse_ISO_8601;
1039 -----------
1040 -- Value --
1041 -----------
1043 function Value (Date : String) return Ada.Calendar.Time is
1044 pragma Unsuppress (All_Checks); -- see comment in Parse_ISO_8601
1046 D : String (1 .. 21);
1047 D_Length : constant Natural := Date'Length;
1049 Year : Year_Number;
1050 Month : Month_Number;
1051 Day : Day_Number;
1052 Hour : Hour_Number;
1053 Minute : Minute_Number;
1054 Second : Second_Number;
1056 procedure Extract_Date
1057 (Year : out Year_Number;
1058 Month : out Month_Number;
1059 Day : out Day_Number;
1060 Time_Start : out Natural);
1061 -- Try and extract a date value from string D. Time_Start is set to the
1062 -- first character that could be the start of time data.
1064 procedure Extract_Time
1065 (Index : Positive;
1066 Hour : out Hour_Number;
1067 Minute : out Minute_Number;
1068 Second : out Second_Number;
1069 Check_Space : Boolean := False);
1070 -- Try and extract a time value from string D starting from position
1071 -- Index. Set Check_Space to True to check whether the character at
1072 -- Index - 1 is a space. Raise Constraint_Error if the portion of D
1073 -- corresponding to the date is not well formatted.
1075 ------------------
1076 -- Extract_Date --
1077 ------------------
1079 procedure Extract_Date
1080 (Year : out Year_Number;
1081 Month : out Month_Number;
1082 Day : out Day_Number;
1083 Time_Start : out Natural)
1085 begin
1086 if D (3) = '-' or else D (3) = '/' then
1087 if D_Length = 8 or else D_Length = 17 then
1089 -- Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
1091 if D (6) /= D (3) then
1092 raise Constraint_Error;
1093 end if;
1095 Year := Year_Number'Value ("20" & D (1 .. 2));
1096 Month := Month_Number'Value (D (4 .. 5));
1097 Day := Day_Number'Value (D (7 .. 8));
1098 Time_Start := 10;
1100 elsif D_Length = 10 or else D_Length = 19 then
1102 -- Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
1104 if D (6) /= D (3) then
1105 raise Constraint_Error;
1106 end if;
1108 Year := Year_Number'Value (D (7 .. 10));
1109 Month := Month_Number'Value (D (1 .. 2));
1110 Day := Day_Number'Value (D (4 .. 5));
1111 Time_Start := 12;
1113 elsif D_Length = 11 or else D_Length = 20 then
1115 -- Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
1117 if D (7) /= D (3) then
1118 raise Constraint_Error;
1119 end if;
1121 Year := Year_Number'Value (D (8 .. 11));
1122 Month := Month_Name_To_Number (D (4 .. 6));
1123 Day := Day_Number'Value (D (1 .. 2));
1124 Time_Start := 13;
1126 else
1127 raise Constraint_Error;
1128 end if;
1130 elsif D (3) = ' ' then
1131 if D_Length = 11 or else D_Length = 20 then
1133 -- Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
1135 if D (7) /= ' ' then
1136 raise Constraint_Error;
1137 end if;
1139 Year := Year_Number'Value (D (8 .. 11));
1140 Month := Month_Name_To_Number (D (4 .. 6));
1141 Day := Day_Number'Value (D (1 .. 2));
1142 Time_Start := 13;
1144 else
1145 raise Constraint_Error;
1146 end if;
1148 else
1149 if D_Length = 8 or else D_Length = 17 then
1151 -- Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
1153 Year := Year_Number'Value (D (1 .. 4));
1154 Month := Month_Number'Value (D (5 .. 6));
1155 Day := Day_Number'Value (D (7 .. 8));
1156 Time_Start := 10;
1158 elsif D_Length = 10 or else D_Length = 19 then
1160 -- Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
1162 if (D (5) /= '-' and then D (5) /= '/')
1163 or else D (8) /= D (5)
1164 then
1165 raise Constraint_Error;
1166 end if;
1168 Year := Year_Number'Value (D (1 .. 4));
1169 Month := Month_Number'Value (D (6 .. 7));
1170 Day := Day_Number'Value (D (9 .. 10));
1171 Time_Start := 12;
1173 elsif D_Length = 11 or else D_Length = 20 then
1175 -- Possible formats are "yyyy*mmm*dd"
1177 if (D (5) /= '-' and then D (5) /= '/')
1178 or else D (9) /= D (5)
1179 then
1180 raise Constraint_Error;
1181 end if;
1183 Year := Year_Number'Value (D (1 .. 4));
1184 Month := Month_Name_To_Number (D (6 .. 8));
1185 Day := Day_Number'Value (D (10 .. 11));
1186 Time_Start := 13;
1188 elsif D_Length = 12 or else D_Length = 21 then
1190 -- Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
1192 if D (4) /= ' '
1193 or else D (7) /= ','
1194 or else D (8) /= ' '
1195 then
1196 raise Constraint_Error;
1197 end if;
1199 Year := Year_Number'Value (D (9 .. 12));
1200 Month := Month_Name_To_Number (D (1 .. 3));
1201 Day := Day_Number'Value (D (5 .. 6));
1202 Time_Start := 14;
1204 else
1205 raise Constraint_Error;
1206 end if;
1207 end if;
1208 end Extract_Date;
1210 ------------------
1211 -- Extract_Time --
1212 ------------------
1214 procedure Extract_Time
1215 (Index : Positive;
1216 Hour : out Hour_Number;
1217 Minute : out Minute_Number;
1218 Second : out Second_Number;
1219 Check_Space : Boolean := False)
1221 begin
1222 -- If no time was specified in the string (do not allow trailing
1223 -- character either)
1225 if Index = D_Length + 2 then
1226 Hour := 0;
1227 Minute := 0;
1228 Second := 0;
1230 else
1231 -- Not enough characters left ?
1233 if Index /= D_Length - 7 then
1234 raise Constraint_Error;
1235 end if;
1237 if Check_Space and then D (Index - 1) /= ' ' then
1238 raise Constraint_Error;
1239 end if;
1241 if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
1242 raise Constraint_Error;
1243 end if;
1245 Hour := Hour_Number'Value (D (Index .. Index + 1));
1246 Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
1247 Second := Second_Number'Value (D (Index + 6 .. Index + 7));
1248 end if;
1249 end Extract_Time;
1251 -- Local Declarations
1253 Success : Boolean;
1254 Time_Start : Natural := 1;
1255 Time : Ada.Calendar.Time;
1257 -- Start of processing for Value
1259 begin
1260 -- Let's try parsing Date as a supported ISO-8601 format. If we do not
1261 -- succeed, then retry using all the other GNAT supported formats.
1263 Parse_ISO_8601 (Date, Time, Success);
1265 if Success then
1266 return Time;
1267 end if;
1269 -- Length checks
1271 if D_Length not in 8 | 10 | 11 | 12 | 17 | 19 | 20 | 21 then
1272 raise Constraint_Error;
1273 end if;
1275 -- After the correct length has been determined, it is safe to create
1276 -- a local string copy in order to avoid String'First N arithmetic.
1278 D (1 .. D_Length) := Date;
1280 if D_Length /= 8 or else D (3) /= ':' then
1281 Extract_Date (Year, Month, Day, Time_Start);
1282 Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
1284 else
1285 declare
1286 Discard : Second_Duration;
1287 begin
1288 Split (Clock, Year, Month, Day, Hour, Minute, Second,
1289 Sub_Second => Discard);
1290 end;
1292 Extract_Time (1, Hour, Minute, Second, Check_Space => False);
1293 end if;
1295 return Time_Of (Year, Month, Day, Hour, Minute, Second);
1296 end Value;
1298 --------------
1299 -- Put_Time --
1300 --------------
1302 procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
1303 begin
1304 Ada.Text_IO.Put (Image (Date, Picture));
1305 end Put_Time;
1307 end GNAT.Calendar.Time_IO;