OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [g-catiio.adb] - Blame information for rev 281

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
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-2009, 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 2,  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.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
20
-- Boston, MA 02110-1301, USA.                                              --
21
--                                                                          --
22
-- As a special exception,  if other files  instantiate  generics from this --
23
-- unit, or you link  this unit with other files  to produce an executable, --
24
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
25
-- covered  by the  GNU  General  Public  License.  This exception does not --
26
-- however invalidate  any other reasons why  the executable file  might be --
27
-- covered by the  GNU Public License.                                      --
28
--                                                                          --
29
-- GNAT was originally developed  by the GNAT team at  New York University. --
30
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
31
--                                                                          --
32
------------------------------------------------------------------------------
33
 
34
with Ada.Calendar;            use Ada.Calendar;
35
with Ada.Characters.Handling;
36
with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
37
with Ada.Text_IO;
38
 
39
with GNAT.Case_Util;
40
 
41
package body GNAT.Calendar.Time_IO is
42
 
43
   type Month_Name is
44
     (January,
45
      February,
46
      March,
47
      April,
48
      May,
49
      June,
50
      July,
51
      August,
52
      September,
53
      October,
54
      November,
55
      December);
56
 
57
   function Month_Name_To_Number
58
     (Str : String) return Ada.Calendar.Month_Number;
59
   --  Converts a string that contains an abbreviated month name to a month
60
   --  number. Constraint_Error is raised if Str is not a valid month name.
61
   --  Comparison is case insensitive
62
 
63
   type Padding_Mode is (None, Zero, Space);
64
 
65
   type Sec_Number is mod 2 ** 64;
66
   --  Type used to compute the number of seconds since 01/01/1970. A 32 bit
67
   --  number will cover only a period of 136 years. This means that for date
68
   --  past 2106 the computation is not possible. A 64 bits number should be
69
   --  enough for a very large period of time.
70
 
71
   -----------------------
72
   -- Local Subprograms --
73
   -----------------------
74
 
75
   function Am_Pm (H : Natural) return String;
76
   --  Return AM or PM depending on the hour H
77
 
78
   function Hour_12 (H : Natural) return Positive;
79
   --  Convert a 1-24h format to a 0-12 hour format
80
 
81
   function Image (Str : String; Length : Natural := 0) return String;
82
   --  Return Str capitalized and cut to length number of characters. If
83
   --  length is 0, then no cut operation is performed.
84
 
85
   function Image
86
     (N       : Sec_Number;
87
      Padding : Padding_Mode := Zero;
88
      Length  : Natural := 0) return String;
89
   --  Return image of N. This number is eventually padded with zeros or spaces
90
   --  depending of the length required. If length is 0 then no padding occurs.
91
 
92
   function Image
93
     (N       : Natural;
94
      Padding : Padding_Mode := Zero;
95
      Length  : Natural := 0) return String;
96
   --  As above with N provided in Integer format
97
 
98
   -----------
99
   -- Am_Pm --
100
   -----------
101
 
102
   function Am_Pm (H : Natural) return String is
103
   begin
104
      if H = 0 or else H > 12 then
105
         return "PM";
106
      else
107
         return "AM";
108
      end if;
109
   end Am_Pm;
110
 
111
   -------------
112
   -- Hour_12 --
113
   -------------
114
 
115
   function Hour_12 (H : Natural) return Positive is
116
   begin
117
      if H = 0 then
118
         return 12;
119
      elsif H <= 12 then
120
         return H;
121
      else --  H > 12
122
         return H - 12;
123
      end if;
124
   end Hour_12;
125
 
126
   -----------
127
   -- Image --
128
   -----------
129
 
130
   function Image
131
     (Str    : String;
132
      Length : Natural := 0) return String
133
   is
134
      use Ada.Characters.Handling;
135
      Local : constant String :=
136
                To_Upper (Str (Str'First)) &
137
                  To_Lower (Str (Str'First + 1 .. Str'Last));
138
   begin
139
      if Length = 0 then
140
         return Local;
141
      else
142
         return Local (1 .. Length);
143
      end if;
144
   end Image;
145
 
146
   -----------
147
   -- Image --
148
   -----------
149
 
150
   function Image
151
     (N       : Natural;
152
      Padding : Padding_Mode := Zero;
153
      Length  : Natural := 0) return String
154
   is
155
   begin
156
      return Image (Sec_Number (N), Padding, Length);
157
   end Image;
158
 
159
   function Image
160
     (N       : Sec_Number;
161
      Padding : Padding_Mode := Zero;
162
      Length  : Natural := 0) return String
163
   is
164
      function Pad_Char return String;
165
 
166
      --------------
167
      -- Pad_Char --
168
      --------------
169
 
170
      function Pad_Char return String is
171
      begin
172
         case Padding is
173
            when None  => return "";
174
            when Zero  => return "00";
175
            when Space => return "  ";
176
         end case;
177
      end Pad_Char;
178
 
179
      --  Local Declarations
180
 
181
      NI  : constant String := Sec_Number'Image (N);
182
      NIP : constant String := Pad_Char & NI (2 .. NI'Last);
183
 
184
   --  Start of processing for Image
185
 
186
   begin
187
      if Length = 0 or else Padding = None then
188
         return NI (2 .. NI'Last);
189
      else
190
         return NIP (NIP'Last - Length + 1 .. NIP'Last);
191
      end if;
192
   end Image;
193
 
194
   -----------
195
   -- Image --
196
   -----------
197
 
198
   function Image
199
     (Date    : Ada.Calendar.Time;
200
      Picture : Picture_String) return String
201
   is
202
      Padding : Padding_Mode := Zero;
203
      --  Padding is set for one directive
204
 
205
      Result : Unbounded_String;
206
 
207
      Year       : Year_Number;
208
      Month      : Month_Number;
209
      Day        : Day_Number;
210
      Hour       : Hour_Number;
211
      Minute     : Minute_Number;
212
      Second     : Second_Number;
213
      Sub_Second : Second_Duration;
214
 
215
      P : Positive;
216
 
217
   begin
218
      --  Get current time in split format
219
 
220
      Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
221
 
222
      --  Null picture string is error
223
 
224
      if Picture = "" then
225
         raise Picture_Error with "null picture string";
226
      end if;
227
 
228
      --  Loop through characters of picture string, building result
229
 
230
      Result := Null_Unbounded_String;
231
      P := Picture'First;
232
      while P <= Picture'Last loop
233
 
234
         --  A directive has the following format "%[-_]."
235
 
236
         if Picture (P) = '%' then
237
            Padding := Zero;
238
 
239
            if P = Picture'Last then
240
               raise Picture_Error with "picture string ends with '%";
241
            end if;
242
 
243
            --  Check for GNU extension to change the padding
244
 
245
            if Picture (P + 1) = '-' then
246
               Padding := None;
247
               P := P + 1;
248
 
249
            elsif Picture (P + 1) = '_' then
250
               Padding := Space;
251
               P := P + 1;
252
            end if;
253
 
254
            if P = Picture'Last then
255
               raise Picture_Error with "picture string ends with '- or '_";
256
            end if;
257
 
258
            case Picture (P + 1) is
259
 
260
               --  Literal %
261
 
262
               when '%' =>
263
                  Result := Result & '%';
264
 
265
               --  A newline
266
 
267
               when 'n' =>
268
                  Result := Result & ASCII.LF;
269
 
270
               --  A horizontal tab
271
 
272
               when 't' =>
273
                  Result := Result & ASCII.HT;
274
 
275
               --  Hour (00..23)
276
 
277
               when 'H' =>
278
                  Result := Result & Image (Hour, Padding, 2);
279
 
280
               --  Hour (01..12)
281
 
282
               when 'I' =>
283
                  Result := Result & Image (Hour_12 (Hour), Padding, 2);
284
 
285
               --  Hour ( 0..23)
286
 
287
               when 'k' =>
288
                  Result := Result & Image (Hour, Space, 2);
289
 
290
               --  Hour ( 1..12)
291
 
292
               when 'l' =>
293
                  Result := Result & Image (Hour_12 (Hour), Space, 2);
294
 
295
               --  Minute (00..59)
296
 
297
               when 'M' =>
298
                  Result := Result & Image (Minute, Padding, 2);
299
 
300
               --  AM/PM
301
 
302
               when 'p' =>
303
                  Result := Result & Am_Pm (Hour);
304
 
305
               --  Time, 12-hour (hh:mm:ss [AP]M)
306
 
307
               when 'r' =>
308
                  Result := Result &
309
                    Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
310
                    Image (Minute, Padding, Length => 2) & ':' &
311
                    Image (Second, Padding, Length => 2) & ' ' &
312
                    Am_Pm (Hour);
313
 
314
               --   Seconds since 1970-01-01  00:00:00 UTC
315
               --   (a nonstandard extension)
316
 
317
               when 's' =>
318
                  declare
319
                     --  Compute the number of seconds using Ada.Calendar.Time
320
                     --  values rather than Julian days to account for Daylight
321
                     --  Savings Time.
322
 
323
                     Neg : Boolean  := False;
324
                     Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);
325
 
326
                  begin
327
                     --  Avoid rounding errors and perform special processing
328
                     --  for dates earlier than the Unix Epoc.
329
 
330
                     if Sec > 0.0 then
331
                        Sec := Sec - 0.5;
332
                     elsif Sec < 0.0 then
333
                        Neg := True;
334
                        Sec := abs (Sec + 0.5);
335
                     end if;
336
 
337
                     --  Prepend a minus sign to the result since Sec_Number
338
                     --  cannot handle negative numbers.
339
 
340
                     if Neg then
341
                        Result :=
342
                          Result & "-" & Image (Sec_Number (Sec), None);
343
                     else
344
                        Result := Result & Image (Sec_Number (Sec), None);
345
                     end if;
346
                  end;
347
 
348
               --  Second (00..59)
349
 
350
               when 'S' =>
351
                  Result := Result & Image (Second, Padding, Length => 2);
352
 
353
               --  Milliseconds (3 digits)
354
               --  Microseconds (6 digits)
355
               --  Nanoseconds  (9 digits)
356
 
357
               when 'i' | 'e' | 'o' =>
358
                  declare
359
                     Sub_Sec : constant Long_Integer :=
360
                                 Long_Integer (Sub_Second * 1_000_000_000);
361
 
362
                     Img1  : constant String := Sub_Sec'Img;
363
                     Img2  : constant String :=
364
                               "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
365
                     Nanos : constant String :=
366
                               Img2 (Img2'Last - 8 .. Img2'Last);
367
 
368
                  begin
369
                     case Picture (P + 1) is
370
                        when 'i' =>
371
                           Result := Result &
372
                             Nanos (Nanos'First .. Nanos'First + 2);
373
 
374
                        when 'e' =>
375
                           Result := Result &
376
                             Nanos (Nanos'First .. Nanos'First + 5);
377
 
378
                        when 'o' =>
379
                           Result := Result & Nanos;
380
 
381
                        when others =>
382
                           null;
383
                     end case;
384
                  end;
385
 
386
               --  Time, 24-hour (hh:mm:ss)
387
 
388
               when 'T' =>
389
                  Result := Result &
390
                    Image (Hour, Padding, Length => 2)   & ':' &
391
                    Image (Minute, Padding, Length => 2) & ':' &
392
                    Image (Second, Padding, Length => 2);
393
 
394
               --  Locale's abbreviated weekday name (Sun..Sat)
395
 
396
               when 'a' =>
397
                  Result := Result &
398
                    Image (Day_Name'Image (Day_Of_Week (Date)), 3);
399
 
400
               --  Locale's full weekday name, variable length
401
               --  (Sunday..Saturday)
402
 
403
               when 'A' =>
404
                  Result := Result &
405
                    Image (Day_Name'Image (Day_Of_Week (Date)));
406
 
407
               --  Locale's abbreviated month name (Jan..Dec)
408
 
409
               when 'b' | 'h' =>
410
                  Result := Result &
411
                    Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
412
 
413
               --  Locale's full month name, variable length
414
               --  (January..December).
415
 
416
               when 'B' =>
417
                  Result := Result &
418
                    Image (Month_Name'Image (Month_Name'Val (Month - 1)));
419
 
420
               --  Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
421
 
422
               when 'c' =>
423
                  case Padding is
424
                     when Zero =>
425
                        Result := Result & Image (Date, "%a %b %d %T %Y");
426
                     when Space =>
427
                        Result := Result & Image (Date, "%a %b %_d %_T %Y");
428
                     when None =>
429
                        Result := Result & Image (Date, "%a %b %-d %-T %Y");
430
                  end case;
431
 
432
               --   Day of month (01..31)
433
 
434
               when 'd' =>
435
                  Result := Result & Image (Day, Padding, 2);
436
 
437
               --  Date (mm/dd/yy)
438
 
439
               when 'D' | 'x' =>
440
                  Result := Result &
441
                              Image (Month, Padding, 2) & '/' &
442
                              Image (Day, Padding, 2) & '/' &
443
                              Image (Year, Padding, 2);
444
 
445
               --  Day of year (001..366)
446
 
447
               when 'j' =>
448
                  Result := Result & Image (Day_In_Year (Date), Padding, 3);
449
 
450
               --  Month (01..12)
451
 
452
               when 'm' =>
453
                  Result := Result & Image (Month, Padding, 2);
454
 
455
               --  Week number of year with Sunday as first day of week
456
               --  (00..53)
457
 
458
               when 'U' =>
459
                  declare
460
                     Offset : constant Natural :=
461
                                (Julian_Day (Year, 1, 1) + 1) mod 7;
462
 
463
                     Week : constant Natural :=
464
                              1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
465
 
466
                  begin
467
                     Result := Result & Image (Week, Padding, 2);
468
                  end;
469
 
470
               --  Day of week (0..6) with 0 corresponding to Sunday
471
 
472
               when 'w' =>
473
                  declare
474
                     DOW : constant Natural range 0 .. 6 :=
475
                             (if Day_Of_Week (Date) = Sunday
476
                              then 0
477
                              else Day_Name'Pos (Day_Of_Week (Date)));
478
                  begin
479
                     Result := Result & Image (DOW, Length => 1);
480
                  end;
481
 
482
               --  Week number of year with Monday as first day of week
483
               --  (00..53)
484
 
485
               when 'W' =>
486
                  Result := Result & Image (Week_In_Year (Date), Padding, 2);
487
 
488
               --  Last two digits of year (00..99)
489
 
490
               when 'y' =>
491
                  declare
492
                     Y : constant Natural := Year - (Year / 100) * 100;
493
                  begin
494
                     Result := Result & Image (Y, Padding, 2);
495
                  end;
496
 
497
               --   Year (1970...)
498
 
499
               when 'Y' =>
500
                  Result := Result & Image (Year, None, 4);
501
 
502
               when others =>
503
                  raise Picture_Error with
504
                    "unknown format character in picture string";
505
 
506
            end case;
507
 
508
            --  Skip past % and format character
509
 
510
            P := P + 2;
511
 
512
         --  Character other than % is copied into the result
513
 
514
         else
515
            Result := Result & Picture (P);
516
            P := P + 1;
517
         end if;
518
      end loop;
519
 
520
      return To_String (Result);
521
   end Image;
522
 
523
   --------------------------
524
   -- Month_Name_To_Number --
525
   --------------------------
526
 
527
   function Month_Name_To_Number
528
     (Str : String) return Ada.Calendar.Month_Number
529
   is
530
      subtype String3 is String (1 .. 3);
531
      Abbrev_Upper_Month_Names :
532
        constant array (Ada.Calendar.Month_Number) of String3 :=
533
         ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
534
          "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");
535
      --  Short version of the month names, used when parsing date strings
536
 
537
      S                                                     : String := Str;
538
 
539
   begin
540
      GNAT.Case_Util.To_Upper (S);
541
 
542
      for J in Abbrev_Upper_Month_Names'Range loop
543
         if Abbrev_Upper_Month_Names (J) = S then
544
            return J;
545
         end if;
546
      end loop;
547
 
548
      return Abbrev_Upper_Month_Names'First;
549
   end Month_Name_To_Number;
550
 
551
   -----------
552
   -- Value --
553
   -----------
554
 
555
   function Value (Date : String) return Ada.Calendar.Time is
556
      D          : String (1 .. 21);
557
      D_Length   : constant Natural := Date'Length;
558
 
559
      Year   : Year_Number;
560
      Month  : Month_Number;
561
      Day    : Day_Number;
562
      Hour   : Hour_Number;
563
      Minute : Minute_Number;
564
      Second : Second_Number;
565
 
566
      procedure Extract_Date
567
        (Year       : out Year_Number;
568
         Month      : out Month_Number;
569
         Day        : out Day_Number;
570
         Time_Start : out Natural);
571
      --  Try and extract a date value from string D. Time_Start is set to the
572
      --  first character that could be the start of time data.
573
 
574
      procedure Extract_Time
575
        (Index       : Positive;
576
         Hour        : out Hour_Number;
577
         Minute      : out Minute_Number;
578
         Second      : out Second_Number;
579
         Check_Space : Boolean := False);
580
      --  Try and extract a time value from string D starting from position
581
      --  Index. Set Check_Space to True to check whether the character at
582
      --  Index - 1 is a space. Raise Constraint_Error if the portion of D
583
      --  corresponding to the date is not well formatted.
584
 
585
      ------------------
586
      -- Extract_Date --
587
      ------------------
588
 
589
      procedure Extract_Date
590
        (Year       : out Year_Number;
591
         Month      : out Month_Number;
592
         Day        : out Day_Number;
593
         Time_Start : out Natural)
594
      is
595
      begin
596
         if D (3) = '-' or else D (3) = '/' then
597
            if D_Length = 8 or else D_Length = 17 then
598
 
599
               --  Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
600
 
601
               if D (6) /= D (3) then
602
                  raise Constraint_Error;
603
               end if;
604
 
605
               Year  := Year_Number'Value ("20" & D (1 .. 2));
606
               Month := Month_Number'Value       (D (4 .. 5));
607
               Day   := Day_Number'Value         (D (7 .. 8));
608
               Time_Start := 10;
609
 
610
            elsif D_Length = 10 or else D_Length = 19 then
611
 
612
               --  Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
613
 
614
               if D (6) /= D (3) then
615
                  raise Constraint_Error;
616
               end if;
617
 
618
               Year  := Year_Number'Value  (D (7 .. 10));
619
               Month := Month_Number'Value (D (1 .. 2));
620
               Day   := Day_Number'Value   (D (4 .. 5));
621
               Time_Start := 12;
622
 
623
            elsif D_Length = 11 or else D_Length = 20 then
624
 
625
               --  Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
626
 
627
               if D (7) /= D (3) then
628
                  raise Constraint_Error;
629
               end if;
630
 
631
               Year  := Year_Number'Value  (D (8 .. 11));
632
               Month := Month_Name_To_Number (D (4 .. 6));
633
               Day   := Day_Number'Value   (D (1 .. 2));
634
               Time_Start := 13;
635
 
636
            else
637
               raise Constraint_Error;
638
            end if;
639
 
640
         elsif D (3) = ' ' then
641
            if D_Length = 11 or else D_Length = 20 then
642
 
643
               --  Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
644
 
645
               if D (7) /= ' ' then
646
                  raise Constraint_Error;
647
               end if;
648
 
649
               Year  := Year_Number'Value  (D (8 .. 11));
650
               Month := Month_Name_To_Number (D (4 .. 6));
651
               Day   := Day_Number'Value   (D (1 .. 2));
652
               Time_Start := 13;
653
 
654
            else
655
               raise Constraint_Error;
656
            end if;
657
 
658
         else
659
            if D_Length = 8 or else D_Length = 17 then
660
 
661
               --  Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
662
 
663
               Year  := Year_Number'Value (D (1 .. 4));
664
               Month := Month_Number'Value (D (5 .. 6));
665
               Day   := Day_Number'Value (D (7 .. 8));
666
               Time_Start := 10;
667
 
668
            elsif D_Length = 10 or else D_Length = 19 then
669
 
670
               --  Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
671
 
672
               if (D (5) /= '-' and then D (5) /= '/')
673
                 or else D (8) /= D (5)
674
               then
675
                  raise Constraint_Error;
676
               end if;
677
 
678
               Year  := Year_Number'Value (D (1 .. 4));
679
               Month := Month_Number'Value (D (6 .. 7));
680
               Day   := Day_Number'Value (D (9 .. 10));
681
               Time_Start := 12;
682
 
683
            elsif D_Length = 11 or else D_Length = 20 then
684
 
685
               --  Possible formats are "yyyy*mmm*dd"
686
 
687
               if (D (5) /= '-' and then D (5) /= '/')
688
                 or else D (9) /= D (5)
689
               then
690
                  raise Constraint_Error;
691
               end if;
692
 
693
               Year  := Year_Number'Value (D (1 .. 4));
694
               Month := Month_Name_To_Number (D (6 .. 8));
695
               Day   := Day_Number'Value (D (10 .. 11));
696
               Time_Start := 13;
697
 
698
            elsif D_Length = 12 or else D_Length = 21 then
699
 
700
               --  Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
701
 
702
               if D (4) /= ' '
703
                 or else D (7) /= ','
704
                 or else D (8) /= ' '
705
               then
706
                  raise Constraint_Error;
707
               end if;
708
 
709
               Year  := Year_Number'Value (D (9 .. 12));
710
               Month := Month_Name_To_Number (D (1 .. 3));
711
               Day   := Day_Number'Value (D (5 .. 6));
712
               Time_Start := 14;
713
 
714
            else
715
               raise Constraint_Error;
716
            end if;
717
         end if;
718
      end Extract_Date;
719
 
720
      ------------------
721
      -- Extract_Time --
722
      ------------------
723
 
724
      procedure Extract_Time
725
        (Index       : Positive;
726
         Hour        : out Hour_Number;
727
         Minute      : out Minute_Number;
728
         Second      : out Second_Number;
729
         Check_Space : Boolean := False)
730
      is
731
      begin
732
         --  If no time was specified in the string (do not allow trailing
733
         --  character either)
734
 
735
         if Index = D_Length + 2 then
736
            Hour   := 0;
737
            Minute := 0;
738
            Second := 0;
739
 
740
         else
741
            --  Not enough characters left ?
742
 
743
            if Index /= D_Length - 7 then
744
               raise Constraint_Error;
745
            end if;
746
 
747
            if Check_Space and then D (Index - 1) /= ' ' then
748
               raise Constraint_Error;
749
            end if;
750
 
751
            if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
752
               raise Constraint_Error;
753
            end if;
754
 
755
            Hour   := Hour_Number'Value   (D (Index     .. Index + 1));
756
            Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
757
            Second := Second_Number'Value (D (Index + 6 .. Index + 7));
758
         end if;
759
      end Extract_Time;
760
 
761
      --  Local Declarations
762
 
763
      Time_Start : Natural := 1;
764
 
765
   --  Start of processing for Value
766
 
767
   begin
768
      --  Length checks
769
 
770
      if D_Length /= 8
771
        and then D_Length /= 10
772
        and then D_Length /= 11
773
        and then D_Length /= 12
774
        and then D_Length /= 17
775
        and then D_Length /= 19
776
        and then D_Length /= 20
777
        and then D_Length /= 21
778
      then
779
         raise Constraint_Error;
780
      end if;
781
 
782
      --  After the correct length has been determined, it is safe to create
783
      --  a local string copy in order to avoid String'First N arithmetic.
784
 
785
      D (1 .. D_Length) := Date;
786
 
787
      if D_Length /= 8 or else D (3) /= ':' then
788
         Extract_Date (Year, Month, Day, Time_Start);
789
         Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
790
 
791
      else
792
         declare
793
            Discard : Second_Duration;
794
            pragma Unreferenced (Discard);
795
         begin
796
            Split (Clock, Year, Month, Day, Hour, Minute, Second,
797
                   Sub_Second => Discard);
798
         end;
799
 
800
         Extract_Time (1, Hour, Minute, Second, Check_Space => False);
801
      end if;
802
 
803
      --  Sanity checks
804
 
805
      if not Year'Valid
806
        or else not Month'Valid
807
        or else not Day'Valid
808
        or else not Hour'Valid
809
        or else not Minute'Valid
810
        or else not Second'Valid
811
      then
812
         raise Constraint_Error;
813
      end if;
814
 
815
      return Time_Of (Year, Month, Day, Hour, Minute, Second);
816
   end Value;
817
 
818
   --------------
819
   -- Put_Time --
820
   --------------
821
 
822
   procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
823
   begin
824
      Ada.Text_IO.Put (Image (Date, Picture));
825
   end Put_Time;
826
 
827
end GNAT.Calendar.Time_IO;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.