1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . C A L E N D A R . T I M E _ I O --
9 -- Copyright (C) 1999-2024, AdaCore --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Characters
.Handling
;
33 with Ada
.Strings
.Unbounded
; use Ada
.Strings
.Unbounded
;
38 package body GNAT
.Calendar
.Time_IO
is
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 -----------------------
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
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.
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.
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
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
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
122 function Am_Pm
(H
: Natural) return String is
124 if H
= 0 or else H
> 12 then
135 function Hour_12
(H
: Natural) return Positive is
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));
162 return Local
(1 .. Length
);
172 Padding
: Padding_Mode
:= Zero
;
173 Length
: Natural := 0) return String
176 return Image
(Sec_Number
(N
), Padding
, Length
);
185 Padding
: Padding_Mode
:= Zero
;
186 Length
: Natural := 0) return String
188 function Pad_Char
return String;
194 function Pad_Char
return String is
197 when None
=> return "";
198 when Zero
=> return "00";
199 when Space
=> return " ";
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
211 if Length
= 0 or else Padding
= None
then
212 return NI
(2 .. NI
'Last);
214 return NIP
(NIP
'Last - Length
+ 1 .. NIP
'Last);
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
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;
237 (Date
+ Duration (Second_Offset
), Picture
, Time_Zone
);
245 (Date
: Ada
.Calendar
.Time
;
246 Picture
: Picture_String
) return String
249 Local_TZ
: constant Time_Offset
:= Local_Time_Offset
(Date
);
251 return Image_Helper
(Date
, Picture
, Local_TZ
);
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
;
269 Month
: Month_Number
;
272 Minute
: Minute_Number
;
273 Second
: Second_Number
;
274 Sub_Second
: Second_Duration
;
279 -- Get current time in split format
281 Split
(Date
, Year
, Month
, Day
, Hour
, Minute
, Second
, Sub_Second
);
283 -- Null picture string is error
286 raise Picture_Error
with "null picture string";
289 -- Loop through characters of picture string, building result
291 Result
:= Null_Unbounded_String
;
293 while P
<= Picture
'Last loop
295 -- A directive has the following format "%[-_]."
297 if Picture
(P
) = '%' then
300 if P
= Picture
'Last then
301 raise Picture_Error
with "picture string ends with '%";
304 -- Check for GNU extension to change the padding
306 if Picture
(P
+ 1) = '-' then
310 elsif Picture
(P
+ 1) = '_' then
315 if P
= Picture
'Last then
316 raise Picture_Error
with "picture string ends with '- or '_";
319 case Picture
(P
+ 1) is
324 Result
:= Result
& '%';
329 Result
:= Result
& ASCII
.LF
;
334 Result
:= Result
& ASCII
.HT
;
339 Result
:= Result
& Image
(Hour
, Padding
, 2);
344 Result
:= Result
& Image
(Hour_12
(Hour
), Padding
, 2);
349 Result
:= Result
& Image
(Hour
, Space
, 2);
354 Result
:= Result
& Image
(Hour_12
(Hour
), Space
, 2);
359 Result
:= Result
& Image
(Minute
, Padding
, 2);
364 Result
:= Result
& Am_Pm
(Hour
);
366 -- Time, 12-hour (hh:mm:ss [AP]M)
370 Image
(Hour_12
(Hour
), Padding
, Length
=> 2) & ':' &
371 Image
(Minute
, Padding
, Length
=> 2) & ':' &
372 Image
(Second
, Padding
, Length
=> 2) & ' ' &
375 -- Seconds since 1970-01-01 00:00:00 UTC
376 -- (a nonstandard extension)
380 -- Compute the number of seconds using Ada.Calendar.Time
381 -- values rather than Julian days to account for Daylight
384 Neg
: Boolean := False;
385 Sec
: Duration := Date
- Time_Of
(1970, 1, 1, 0.0);
388 -- Avoid rounding errors and perform special processing
389 -- for dates earlier than the Unix Epoc.
395 Sec
:= abs (Sec
+ 0.5);
398 -- Prepend a minus sign to the result since Sec_Number
399 -- cannot handle negative numbers.
403 Result
& "-" & Image
(Sec_Number
(Sec
), None
);
405 Result
:= Result
& Image
(Sec_Number
(Sec
), None
);
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' =>
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);
430 case Picture
(P
+ 1) is
433 Nanos
(Nanos
'First .. Nanos
'First + 2);
437 Nanos
(Nanos
'First .. Nanos
'First + 5);
440 Result
:= Result
& Nanos
;
447 -- Time, 24-hour (hh:mm:ss)
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
460 use type Time_Zones
.Time_Offset
;
461 TZ_Form
: constant Picture_String
:= "%:::z";
462 TZ
: constant Natural := Natural (abs Time_Zone
);
464 if P
+ TZ_Form
'Length - 1 <= Picture
'Last
465 and then Picture
(P
.. P
+ TZ_Form
'Length - 1) = "%:::z"
467 if Time_Zone
>= 0 then
468 Result
:= Result
& "+";
470 Result
:= Result
& "-";
474 Image
(Integer (TZ
/ 60), Padding
, Length
=> 2);
476 if TZ
mod 60 /= 0 then
477 Result
:= Result
& ":";
479 Image
(TZ
mod 60, Padding
, Length
=> 2);
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).
488 raise Picture_Error
with "unsupported picture format";
492 -- Locale's abbreviated weekday name (Sun..Sat)
496 Image
(Day_Name
'Image (Day_Of_Week
(Date
)), 3);
498 -- Locale's full weekday name, variable length
499 -- (Sunday..Saturday)
503 Image
(Day_Name
'Image (Day_Of_Week
(Date
)));
505 -- Locale's abbreviated month name (Jan..Dec)
509 Image
(Month_Name
'Image (Month_Name
'Val (Month
- 1)), 3);
511 -- Locale's full month name, variable length
512 -- (January..December).
516 Image
(Month_Name
'Image (Month_Name
'Val (Month
- 1)));
518 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
523 Result
:= Result
& Image
(Date
, "%a %b %d %T %Y");
525 Result
:= Result
& Image
(Date
, "%a %b %_d %_T %Y");
527 Result
:= Result
& Image
(Date
, "%a %b %-d %-T %Y");
530 -- Day of month (01..31)
533 Result
:= Result
& Image
(Day
, Padding
, 2);
539 Image
(Month
, Padding
, 2) & '/' &
540 Image
(Day
, Padding
, 2) & '/' &
541 Image
(Year
, Padding
, 2);
543 -- Day of year (001..366)
546 Result
:= Result
& Image
(Day_In_Year
(Date
), Padding
, 3);
551 Result
:= Result
& Image
(Month
, Padding
, 2);
553 -- Week number of year with Sunday as first day of week
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;
565 Result
:= Result
& Image
(Week
, Padding
, 2);
568 -- Day of week (0..6) with 0 corresponding to Sunday
572 DOW
: constant Natural range 0 .. 6 :=
573 (if Day_Of_Week
(Date
) = Sunday
575 else Day_Name
'Pos (Day_Of_Week
(Date
)));
577 Result
:= Result
& Image
(DOW
, Length
=> 1);
580 -- Week number of year with Monday as first day of week
584 Result
:= Result
& Image
(Week_In_Year
(Date
), Padding
, 2);
586 -- Last two digits of year (00..99)
590 Y
: constant Natural := Year
- (Year
/ 100) * 100;
592 Result
:= Result
& Image
(Y
, Padding
, 2);
598 Result
:= Result
& Image
(Year
, None
, 4);
601 raise Picture_Error
with
602 "unknown format character in picture string";
605 -- Skip past % and format character
609 -- Character other than % is copied into the result
612 Result
:= Result
& Picture
(P
);
617 return To_String
(Result
);
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
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
645 return Abbrev_Upper_Month_Names
'First;
646 end Month_Name_To_Number
;
652 procedure Parse_ISO_8601
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
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.
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
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
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
748 procedure Advance_Digits
(Num_Digits
: Positive) is
750 for J
in 1 .. Num_Digits
loop
751 if Symbol
not in '0' .. '9' then
755 Advance
; -- past digit
763 function Scan_Day
return Day_Number
is
764 From
: constant Positive := Index
;
766 Advance_Digits
(Num_Digits
=> 2);
767 return Day_Number
'Value (Date
(From
.. Index
- 1));
774 function Scan_Hour
return Hour_Number
is
775 From
: constant Positive := Index
;
777 Advance_Digits
(Num_Digits
=> 2);
778 return Hour_Number
'Value (Date
(From
.. Index
- 1));
785 function Scan_Minute
return Minute_Number
is
786 From
: constant Positive := Index
;
788 Advance_Digits
(Num_Digits
=> 2);
789 return Minute_Number
'Value (Date
(From
.. Index
- 1));
796 function Scan_Month
return Month_Number
is
797 From
: constant Positive := Index
;
799 Advance_Digits
(Num_Digits
=> 2);
800 return Month_Number
'Value (Date
(From
.. Index
- 1));
807 function Scan_Second
return Second_Number
is
808 From
: constant Positive := Index
;
810 Advance_Digits
(Num_Digits
=> 2);
811 return Second_Number
'Value (Date
(From
.. Index
- 1));
818 function Scan_Separator
(Expected_Symbol
: Character) return Boolean is
820 if Symbol
= Expected_Symbol
then
832 procedure Scan_Separator
(Required
: Boolean; Separator
: Character) is
835 if Symbol
/= Separator
then
839 Advance
; -- Past the separator
847 function Scan_Subsecond
return Second_Duration
is
848 From
: constant Positive := Index
;
850 Advance_Digits
(Num_Digits
=> 1);
852 while Index
<= Date
'Last and then Symbol
in '0' .. '9' loop
856 return Second_Duration
'Value ("0." & Date
(From
.. Index
- 1));
863 function Scan_Year
return Year_Number
is
864 From
: constant Positive := Index
;
866 Advance_Digits
(Num_Digits
=> 4);
867 return Year_Number
'Value (Date
(From
.. Index
- 1));
874 function Symbol
return Character is
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
893 Date_Separator
: constant Character := '-';
894 Hour_Separator
: constant Character := ':';
897 Month
: Month_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
918 Sep_Required
:= Scan_Separator
(Date_Separator
);
921 Scan_Separator
(Sep_Required
, Date_Separator
);
925 if Index
< Date
'Last and then Symbol
= 'T' then
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
;
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)
961 Time_Zone_Offset
:= 0;
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
974 Time_Zone_Sign
: constant Sign_Type
:= Symbol
;
975 Time_Zone_Hour
: Hour_Number
;
976 Time_Zone_Minute
: Minute_Number
;
979 Time_Zone_Hour
:= Scan_Hour
;
983 if Index
< Date
'Last and then Symbol
= Hour_Separator
then
985 Time_Zone_Minute
:= Scan_Minute
;
987 Time_Zone_Minute
:= 0;
990 -- Compute Time_Zone_Offset
993 Time_Offset
(Time_Zone_Hour
* 60 + Time_Zone_Minute
);
995 case Time_Zone_Sign
is
997 when '-' => Time_Zone_Offset
:= -Time_Zone_Offset
;
1006 -- Check for trailing characters
1008 if Index
/= Date
'Last + 1 then
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
);
1021 Time
:= GNAT
.Calendar
.Time_Of
1022 (Year
, Month
, Day
, Hour
, Minute
, Second
, Subsec
);
1025 -- Notify that the input string was successfully parsed
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.
1035 Time_Of
(Year_Number
'First, Month_Number
'First, Day_Number
'First);
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;
1050 Month
: Month_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
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.
1079 procedure Extract_Date
1080 (Year
: out Year_Number
;
1081 Month
: out Month_Number
;
1082 Day
: out Day_Number
;
1083 Time_Start
: out Natural)
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
;
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));
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
;
1108 Year
:= Year_Number
'Value (D
(7 .. 10));
1109 Month
:= Month_Number
'Value (D
(1 .. 2));
1110 Day
:= Day_Number
'Value (D
(4 .. 5));
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
;
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));
1127 raise Constraint_Error
;
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
;
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));
1145 raise Constraint_Error
;
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));
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)
1165 raise Constraint_Error
;
1168 Year
:= Year_Number
'Value (D
(1 .. 4));
1169 Month
:= Month_Number
'Value (D
(6 .. 7));
1170 Day
:= Day_Number
'Value (D
(9 .. 10));
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)
1180 raise Constraint_Error
;
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));
1188 elsif D_Length
= 12 or else D_Length
= 21 then
1190 -- Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
1193 or else D
(7) /= ','
1194 or else D
(8) /= ' '
1196 raise Constraint_Error
;
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));
1205 raise Constraint_Error
;
1214 procedure Extract_Time
1216 Hour
: out Hour_Number
;
1217 Minute
: out Minute_Number
;
1218 Second
: out Second_Number
;
1219 Check_Space
: Boolean := False)
1222 -- If no time was specified in the string (do not allow trailing
1223 -- character either)
1225 if Index
= D_Length
+ 2 then
1231 -- Not enough characters left ?
1233 if Index
/= D_Length
- 7 then
1234 raise Constraint_Error
;
1237 if Check_Space
and then D
(Index
- 1) /= ' ' then
1238 raise Constraint_Error
;
1241 if D
(Index
+ 2) /= ':' or else D
(Index
+ 5) /= ':' then
1242 raise Constraint_Error
;
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));
1251 -- Local Declarations
1254 Time_Start
: Natural := 1;
1255 Time
: Ada
.Calendar
.Time
;
1257 -- Start of processing for Value
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
);
1271 if D_Length
not in 8 |
10 |
11 |
12 |
17 |
19 |
20 |
21 then
1272 raise Constraint_Error
;
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);
1286 Discard
: Second_Duration
;
1288 Split
(Clock
, Year
, Month
, Day
, Hour
, Minute
, Second
,
1289 Sub_Second
=> Discard
);
1292 Extract_Time
(1, Hour
, Minute
, Second
, Check_Space
=> False);
1295 return Time_Of
(Year
, Month
, Day
, Hour
, Minute
, Second
);
1302 procedure Put_Time
(Date
: Ada
.Calendar
.Time
; Picture
: Picture_String
) is
1304 Ada
.Text_IO
.Put
(Image
(Date
, Picture
));
1307 end GNAT
.Calendar
.Time_IO
;