Mark ChangeLog
[official-gcc.git] / gcc / ada / g-catiio.adb
blob615dfbd54b55d0308f49845da114bd41462f6fb9
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-2003 Ada Core Technologies, Inc. --
10 -- --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
14 -- --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 2, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
24 -- MA 02111-1307, USA. --
25 -- --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
32 -- --
33 -- GNAT was originally developed by the GNAT team at New York University. --
34 -- Extensive contributions were provided by Ada Core Technologies Inc. --
35 -- --
36 ------------------------------------------------------------------------------
38 with Ada.Calendar; use Ada.Calendar;
39 with Ada.Characters.Handling;
40 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
41 with Ada.Text_IO;
43 package body GNAT.Calendar.Time_IO is
45 type Month_Name is
46 (January,
47 February,
48 March,
49 April,
50 May,
51 June,
52 July,
53 August,
54 September,
55 October,
56 November,
57 December);
59 type Padding_Mode is (None, Zero, Space);
61 -----------------------
62 -- Local Subprograms --
63 -----------------------
65 function Am_Pm (H : Natural) return String;
66 -- return AM or PM depending on the hour H
68 function Hour_12 (H : Natural) return Positive;
69 -- Convert a 1-24h format to a 0-12 hour format.
71 function Image (Str : String; Length : Natural := 0) return String;
72 -- Return Str capitalized and cut to length number of characters. If
73 -- length is set to 0 it does not cut it.
75 function Image
76 (N : Long_Integer;
77 Padding : Padding_Mode := Zero;
78 Length : Natural := 0)
79 return String;
80 -- Return image of N. This number is eventually padded with zeros or
81 -- spaces depending of the length required. If length is 0 then no padding
82 -- occurs.
84 function Image
85 (N : Integer;
86 Padding : Padding_Mode := Zero;
87 Length : Natural := 0)
88 return String;
89 -- As above with N provided in Integer format.
91 -----------
92 -- Am_Pm --
93 -----------
95 function Am_Pm (H : Natural) return String is
96 begin
97 if H = 0 or else H > 12 then
98 return "PM";
99 else
100 return "AM";
101 end if;
102 end Am_Pm;
104 -------------
105 -- Hour_12 --
106 -------------
108 function Hour_12 (H : Natural) return Positive is
109 begin
110 if H = 0 then
111 return 12;
112 elsif H <= 12 then
113 return H;
114 else -- H > 12
115 return H - 12;
116 end if;
117 end Hour_12;
119 -----------
120 -- Image --
121 -----------
123 function Image
124 (Str : String;
125 Length : Natural := 0)
126 return String
128 use Ada.Characters.Handling;
129 Local : constant String :=
130 To_Upper (Str (1)) & To_Lower (Str (2 .. Str'Last));
132 begin
133 if Length = 0 then
134 return Local;
135 else
136 return Local (1 .. Length);
137 end if;
138 end Image;
140 -----------
141 -- Image --
142 -----------
144 function Image
145 (N : Integer;
146 Padding : Padding_Mode := Zero;
147 Length : Natural := 0)
148 return String
150 begin
151 return Image (Long_Integer (N), Padding, Length);
152 end Image;
154 function Image
155 (N : Long_Integer;
156 Padding : Padding_Mode := Zero;
157 Length : Natural := 0)
158 return String
160 function Pad_Char return String;
162 --------------
163 -- Pad_Char --
164 --------------
166 function Pad_Char return String is
167 begin
168 case Padding is
169 when None => return "";
170 when Zero => return "00";
171 when Space => return " ";
172 end case;
173 end Pad_Char;
175 NI : constant String := Long_Integer'Image (N);
176 NIP : constant String := Pad_Char & NI (2 .. NI'Last);
178 -- Start of processing for Image
180 begin
181 if Length = 0 or else Padding = None then
182 return NI (2 .. NI'Last);
184 else
185 return NIP (NIP'Last - Length + 1 .. NIP'Last);
186 end if;
187 end Image;
189 -----------
190 -- Image --
191 -----------
193 function Image
194 (Date : Ada.Calendar.Time;
195 Picture : Picture_String)
196 return String
198 Padding : Padding_Mode := Zero;
199 -- Padding is set for one directive
201 Result : Unbounded_String;
203 Year : Year_Number;
204 Month : Month_Number;
205 Day : Day_Number;
206 Hour : Hour_Number;
207 Minute : Minute_Number;
208 Second : Second_Number;
209 Sub_Second : Second_Duration;
211 P : Positive := Picture'First;
213 begin
214 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
216 loop
217 -- A directive has the following format "%[-_]."
219 if Picture (P) = '%' then
221 Padding := Zero;
223 if P = Picture'Last then
224 raise Picture_Error;
225 end if;
227 -- Check for GNU extension to change the padding
229 if Picture (P + 1) = '-' then
230 Padding := None;
231 P := P + 1;
232 elsif Picture (P + 1) = '_' then
233 Padding := Space;
234 P := P + 1;
235 end if;
237 if P = Picture'Last then
238 raise Picture_Error;
239 end if;
241 case Picture (P + 1) is
243 -- Literal %
245 when '%' =>
246 Result := Result & '%';
248 -- A newline
250 when 'n' =>
251 Result := Result & ASCII.LF;
253 -- A horizontal tab
255 when 't' =>
256 Result := Result & ASCII.HT;
258 -- Hour (00..23)
260 when 'H' =>
261 Result := Result & Image (Hour, Padding, 2);
263 -- Hour (01..12)
265 when 'I' =>
266 Result := Result & Image (Hour_12 (Hour), Padding, 2);
268 -- Hour ( 0..23)
270 when 'k' =>
271 Result := Result & Image (Hour, Space, 2);
273 -- Hour ( 1..12)
275 when 'l' =>
276 Result := Result & Image (Hour_12 (Hour), Space, 2);
278 -- Minute (00..59)
280 when 'M' =>
281 Result := Result & Image (Minute, Padding, 2);
283 -- AM/PM
285 when 'p' =>
286 Result := Result & Am_Pm (Hour);
288 -- Time, 12-hour (hh:mm:ss [AP]M)
290 when 'r' =>
291 Result := Result &
292 Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
293 Image (Minute, Padding, Length => 2) & ':' &
294 Image (Second, Padding, Length => 2) & ' ' &
295 Am_Pm (Hour);
297 -- Seconds since 1970-01-01 00:00:00 UTC
298 -- (a nonstandard extension)
300 when 's' =>
301 declare
302 Sec : constant Long_Integer :=
303 Long_Integer
304 ((Julian_Day (Year, Month, Day) -
305 Julian_Day (1970, 1, 1)) * 86_400 +
306 Hour * 3_600 + Minute * 60 + Second);
308 begin
309 Result := Result & Image (Sec, None);
310 end;
312 -- Second (00..59)
314 when 'S' =>
315 Result := Result & Image (Second, Padding, Length => 2);
317 -- Milliseconds (3 digits)
318 -- Microseconds (6 digits)
319 -- Nanoseconds (9 digits)
321 when 'i' | 'e' | 'o' =>
322 declare
323 Sub_Sec : constant Long_Integer :=
324 Long_Integer (Sub_Second * 1_000_000_000);
326 Img1 : constant String := Sub_Sec'Img;
327 Img2 : constant String :=
328 "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
329 Nanos : constant String :=
330 Img2 (Img2'Last - 8 .. Img2'Last);
332 begin
333 case Picture (P + 1) is
334 when 'i' =>
335 Result := Result &
336 Nanos (Nanos'First .. Nanos'First + 2);
338 when 'e' =>
339 Result := Result &
340 Nanos (Nanos'First .. Nanos'First + 5);
342 when 'o' =>
343 Result := Result & Nanos;
345 when others =>
346 null;
347 end case;
348 end;
350 -- Time, 24-hour (hh:mm:ss)
352 when 'T' =>
353 Result := Result &
354 Image (Hour, Padding, Length => 2) & ':' &
355 Image (Minute, Padding, Length => 2) & ':' &
356 Image (Second, Padding, Length => 2);
358 -- Locale's abbreviated weekday name (Sun..Sat)
360 when 'a' =>
361 Result := Result &
362 Image (Day_Name'Image (Day_Of_Week (Date)), 3);
364 -- Locale's full weekday name, variable length
365 -- (Sunday..Saturday)
367 when 'A' =>
368 Result := Result &
369 Image (Day_Name'Image (Day_Of_Week (Date)));
371 -- Locale's abbreviated month name (Jan..Dec)
373 when 'b' | 'h' =>
374 Result := Result &
375 Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
377 -- Locale's full month name, variable length
378 -- (January..December)
380 when 'B' =>
381 Result := Result &
382 Image (Month_Name'Image (Month_Name'Val (Month - 1)));
384 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
386 when 'c' =>
387 case Padding is
388 when Zero =>
389 Result := Result & Image (Date, "%a %b %d %T %Y");
390 when Space =>
391 Result := Result & Image (Date, "%a %b %_d %_T %Y");
392 when None =>
393 Result := Result & Image (Date, "%a %b %-d %-T %Y");
394 end case;
396 -- Day of month (01..31)
398 when 'd' =>
399 Result := Result & Image (Day, Padding, 2);
401 -- Date (mm/dd/yy)
403 when 'D' | 'x' =>
404 Result := Result &
405 Image (Month, Padding, 2) & '/' &
406 Image (Day, Padding, 2) & '/' &
407 Image (Year, Padding, 2);
409 -- Day of year (001..366)
411 when 'j' =>
412 Result := Result & Image (Day_In_Year (Date), Padding, 3);
414 -- Month (01..12)
416 when 'm' =>
417 Result := Result & Image (Month, Padding, 2);
419 -- Week number of year with Sunday as first day of week
420 -- (00..53)
422 when 'U' =>
423 declare
424 Offset : constant Natural :=
425 (Julian_Day (Year, 1, 1) + 1) mod 7;
427 Week : constant Natural :=
428 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
430 begin
431 Result := Result & Image (Week, Padding, 2);
432 end;
434 -- Day of week (0..6) with 0 corresponding to Sunday
436 when 'w' =>
437 declare
438 DOW : Natural range 0 .. 6;
440 begin
441 if Day_Of_Week (Date) = Sunday then
442 DOW := 0;
443 else
444 DOW := Day_Name'Pos (Day_Of_Week (Date));
445 end if;
447 Result := Result & Image (DOW, Length => 1);
448 end;
450 -- Week number of year with Monday as first day of week
451 -- (00..53)
453 when 'W' =>
454 Result := Result & Image (Week_In_Year (Date), Padding, 2);
456 -- Last two digits of year (00..99)
458 when 'y' =>
459 declare
460 Y : constant Natural := Year - (Year / 100) * 100;
461 begin
462 Result := Result & Image (Y, Padding, 2);
463 end;
465 -- Year (1970...)
467 when 'Y' =>
468 Result := Result & Image (Year, None, 4);
470 when others =>
471 raise Picture_Error;
472 end case;
474 P := P + 2;
476 else
477 Result := Result & Picture (P);
478 P := P + 1;
479 end if;
481 exit when P > Picture'Last;
483 end loop;
485 return To_String (Result);
486 end Image;
488 --------------
489 -- Put_Time --
490 --------------
492 procedure Put_Time
493 (Date : Ada.Calendar.Time;
494 Picture : Picture_String)
496 begin
497 Ada.Text_IO.Put (Image (Date, Picture));
498 end Put_Time;
500 end GNAT.Calendar.Time_IO;