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/] [a-calfor.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
--              A D A . C A L E N D A R . F O R M A T T I N G               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2006-2009, Free Software Foundation, Inc.         --
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
------------------------------------------------------------------------------
31
 
32
with Ada.Calendar;            use Ada.Calendar;
33
with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
34
 
35
package body Ada.Calendar.Formatting is
36
 
37
   --------------------------
38
   -- Implementation Notes --
39
   --------------------------
40
 
41
   --  All operations in this package are target and time representation
42
   --  independent, thus only one source file is needed for multiple targets.
43
 
44
   procedure Check_Char (S : String; C : Character; Index : Integer);
45
   --  Subsidiary to the two versions of Value. Determine whether the
46
   --  input string S has character C at position Index. Raise
47
   --  Constraint_Error if there is a mismatch.
48
 
49
   procedure Check_Digit (S : String; Index : Integer);
50
   --  Subsidiary to the two versions of Value. Determine whether the
51
   --  character of string S at position Index is a digit. This catches
52
   --  invalid input such as 1983-*1-j3 u5:n7:k9 which should be
53
   --  1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
54
 
55
   ----------------
56
   -- Check_Char --
57
   ----------------
58
 
59
   procedure Check_Char (S : String; C : Character; Index : Integer) is
60
   begin
61
      if S (Index) /= C then
62
         raise Constraint_Error;
63
      end if;
64
   end Check_Char;
65
 
66
   -----------------
67
   -- Check_Digit --
68
   -----------------
69
 
70
   procedure Check_Digit (S : String; Index : Integer) is
71
   begin
72
      if S (Index) not in '0' .. '9' then
73
         raise Constraint_Error;
74
      end if;
75
   end Check_Digit;
76
 
77
   ---------
78
   -- Day --
79
   ---------
80
 
81
   function Day
82
     (Date      : Time;
83
      Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
84
   is
85
      Y  : Year_Number;
86
      Mo : Month_Number;
87
      D  : Day_Number;
88
      H  : Hour_Number;
89
      Mi : Minute_Number;
90
      Se : Second_Number;
91
      Ss : Second_Duration;
92
      Le : Boolean;
93
 
94
      pragma Unreferenced (Y, Mo, H, Mi);
95
 
96
   begin
97
      Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
98
      return D;
99
   end Day;
100
 
101
   -----------------
102
   -- Day_Of_Week --
103
   -----------------
104
 
105
   function Day_Of_Week (Date : Time) return Day_Name is
106
   begin
107
      return Day_Name'Val (Formatting_Operations.Day_Of_Week (Date));
108
   end Day_Of_Week;
109
 
110
   ----------
111
   -- Hour --
112
   ----------
113
 
114
   function Hour
115
     (Date      : Time;
116
      Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
117
   is
118
      Y  : Year_Number;
119
      Mo : Month_Number;
120
      D  : Day_Number;
121
      H  : Hour_Number;
122
      Mi : Minute_Number;
123
      Se : Second_Number;
124
      Ss : Second_Duration;
125
      Le : Boolean;
126
 
127
      pragma Unreferenced (Y, Mo, D, Mi);
128
 
129
   begin
130
      Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
131
      return H;
132
   end Hour;
133
 
134
   -----------
135
   -- Image --
136
   -----------
137
 
138
   function Image
139
     (Elapsed_Time          : Duration;
140
      Include_Time_Fraction : Boolean := False) return String
141
   is
142
      Hour       : Hour_Number;
143
      Minute     : Minute_Number;
144
      Second     : Second_Number;
145
      Sub_Second : Duration;
146
      SS_Nat     : Natural;
147
 
148
      Low  : Integer;
149
      High : Integer;
150
 
151
      Result : String := "-00:00:00.00";
152
 
153
   begin
154
      Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second);
155
 
156
      --  Determine the two slice bounds for the result string depending on
157
      --  whether the input is negative and whether fractions are requested.
158
 
159
      Low  := (if Elapsed_Time < 0.0 then 1 else 2);
160
      High := (if Include_Time_Fraction then 12 else 9);
161
 
162
      --  Prevent rounding when converting to natural
163
 
164
      Sub_Second := Sub_Second * 100.0;
165
 
166
      if Sub_Second > 0.0 then
167
         Sub_Second := Sub_Second - 0.5;
168
      end if;
169
 
170
      SS_Nat := Natural (Sub_Second);
171
 
172
      declare
173
         Hour_Str   : constant String := Hour_Number'Image (Hour);
174
         Minute_Str : constant String := Minute_Number'Image (Minute);
175
         Second_Str : constant String := Second_Number'Image (Second);
176
         SS_Str     : constant String := Natural'Image (SS_Nat);
177
 
178
      begin
179
         --  Hour processing, positions 2 and 3
180
 
181
         if Hour < 10 then
182
            Result (3) := Hour_Str (2);
183
         else
184
            Result (2) := Hour_Str (2);
185
            Result (3) := Hour_Str (3);
186
         end if;
187
 
188
         --  Minute processing, positions 5 and 6
189
 
190
         if Minute < 10 then
191
            Result (6) := Minute_Str (2);
192
         else
193
            Result (5) := Minute_Str (2);
194
            Result (6) := Minute_Str (3);
195
         end if;
196
 
197
         --  Second processing, positions 8 and 9
198
 
199
         if Second < 10 then
200
            Result (9) := Second_Str (2);
201
         else
202
            Result (8) := Second_Str (2);
203
            Result (9) := Second_Str (3);
204
         end if;
205
 
206
         --  Optional sub second processing, positions 11 and 12
207
 
208
         if Include_Time_Fraction then
209
            if SS_Nat < 10 then
210
               Result (12) := SS_Str (2);
211
            else
212
               Result (11) := SS_Str (2);
213
               Result (12) := SS_Str (3);
214
            end if;
215
         end if;
216
 
217
         return Result (Low .. High);
218
      end;
219
   end Image;
220
 
221
   -----------
222
   -- Image --
223
   -----------
224
 
225
   function Image
226
     (Date                  : Time;
227
      Include_Time_Fraction : Boolean := False;
228
      Time_Zone             : Time_Zones.Time_Offset := 0) return String
229
   is
230
      Year        : Year_Number;
231
      Month       : Month_Number;
232
      Day         : Day_Number;
233
      Hour        : Hour_Number;
234
      Minute      : Minute_Number;
235
      Second      : Second_Number;
236
      Sub_Second  : Duration;
237
      SS_Nat      : Natural;
238
      Leap_Second : Boolean;
239
 
240
      Result : String := "0000-00-00 00:00:00.00";
241
 
242
   begin
243
      Split (Date, Year, Month, Day,
244
             Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
245
 
246
      --  Prevent rounding when converting to natural
247
 
248
      Sub_Second := Sub_Second * 100.0;
249
 
250
      if Sub_Second > 0.0 then
251
         Sub_Second := Sub_Second - 0.5;
252
      end if;
253
 
254
      SS_Nat := Natural (Sub_Second);
255
 
256
      declare
257
         Year_Str   : constant String := Year_Number'Image (Year);
258
         Month_Str  : constant String := Month_Number'Image (Month);
259
         Day_Str    : constant String := Day_Number'Image (Day);
260
         Hour_Str   : constant String := Hour_Number'Image (Hour);
261
         Minute_Str : constant String := Minute_Number'Image (Minute);
262
         Second_Str : constant String := Second_Number'Image (Second);
263
         SS_Str     : constant String := Natural'Image (SS_Nat);
264
 
265
      begin
266
         --  Year processing, positions 1, 2, 3 and 4
267
 
268
         Result (1) := Year_Str (2);
269
         Result (2) := Year_Str (3);
270
         Result (3) := Year_Str (4);
271
         Result (4) := Year_Str (5);
272
 
273
         --  Month processing, positions 6 and 7
274
 
275
         if Month < 10 then
276
            Result (7) := Month_Str (2);
277
         else
278
            Result (6) := Month_Str (2);
279
            Result (7) := Month_Str (3);
280
         end if;
281
 
282
         --  Day processing, positions 9 and 10
283
 
284
         if Day < 10 then
285
            Result (10) := Day_Str (2);
286
         else
287
            Result (9)  := Day_Str (2);
288
            Result (10) := Day_Str (3);
289
         end if;
290
 
291
         --  Hour processing, positions 12 and 13
292
 
293
         if Hour < 10 then
294
            Result (13) := Hour_Str (2);
295
         else
296
            Result (12) := Hour_Str (2);
297
            Result (13) := Hour_Str (3);
298
         end if;
299
 
300
         --  Minute processing, positions 15 and 16
301
 
302
         if Minute < 10 then
303
            Result (16) := Minute_Str (2);
304
         else
305
            Result (15) := Minute_Str (2);
306
            Result (16) := Minute_Str (3);
307
         end if;
308
 
309
         --  Second processing, positions 18 and 19
310
 
311
         if Second < 10 then
312
            Result (19) := Second_Str (2);
313
         else
314
            Result (18) := Second_Str (2);
315
            Result (19) := Second_Str (3);
316
         end if;
317
 
318
         --  Optional sub second processing, positions 21 and 22
319
 
320
         if Include_Time_Fraction then
321
            if SS_Nat < 10 then
322
               Result (22) := SS_Str (2);
323
            else
324
               Result (21) := SS_Str (2);
325
               Result (22) := SS_Str (3);
326
            end if;
327
 
328
            return Result;
329
         else
330
            return Result (1 .. 19);
331
         end if;
332
      end;
333
   end Image;
334
 
335
   ------------
336
   -- Minute --
337
   ------------
338
 
339
   function Minute
340
     (Date      : Time;
341
      Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
342
   is
343
      Y  : Year_Number;
344
      Mo : Month_Number;
345
      D  : Day_Number;
346
      H  : Hour_Number;
347
      Mi : Minute_Number;
348
      Se : Second_Number;
349
      Ss : Second_Duration;
350
      Le : Boolean;
351
 
352
      pragma Unreferenced (Y, Mo, D, H);
353
 
354
   begin
355
      Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
356
      return Mi;
357
   end Minute;
358
 
359
   -----------
360
   -- Month --
361
   -----------
362
 
363
   function Month
364
     (Date      : Time;
365
      Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
366
   is
367
      Y  : Year_Number;
368
      Mo : Month_Number;
369
      D  : Day_Number;
370
      H  : Hour_Number;
371
      Mi : Minute_Number;
372
      Se : Second_Number;
373
      Ss : Second_Duration;
374
      Le : Boolean;
375
 
376
      pragma Unreferenced (Y, D, H, Mi);
377
 
378
   begin
379
      Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
380
      return Mo;
381
   end Month;
382
 
383
   ------------
384
   -- Second --
385
   ------------
386
 
387
   function Second (Date : Time) return Second_Number is
388
      Y  : Year_Number;
389
      Mo : Month_Number;
390
      D  : Day_Number;
391
      H  : Hour_Number;
392
      Mi : Minute_Number;
393
      Se : Second_Number;
394
      Ss : Second_Duration;
395
      Le : Boolean;
396
 
397
      pragma Unreferenced (Y, Mo, D, H, Mi);
398
 
399
   begin
400
      Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
401
      return Se;
402
   end Second;
403
 
404
   ----------------
405
   -- Seconds_Of --
406
   ----------------
407
 
408
   function Seconds_Of
409
     (Hour       : Hour_Number;
410
      Minute     : Minute_Number;
411
      Second     : Second_Number := 0;
412
      Sub_Second : Second_Duration := 0.0) return Day_Duration is
413
 
414
   begin
415
      --  Validity checks
416
 
417
      if not Hour'Valid
418
        or else not Minute'Valid
419
        or else not Second'Valid
420
        or else not Sub_Second'Valid
421
      then
422
         raise Constraint_Error;
423
      end if;
424
 
425
      return Day_Duration (Hour   * 3_600) +
426
             Day_Duration (Minute *    60) +
427
             Day_Duration (Second)         +
428
             Sub_Second;
429
   end Seconds_Of;
430
 
431
   -----------
432
   -- Split --
433
   -----------
434
 
435
   procedure Split
436
     (Seconds    : Day_Duration;
437
      Hour       : out Hour_Number;
438
      Minute     : out Minute_Number;
439
      Second     : out Second_Number;
440
      Sub_Second : out Second_Duration)
441
   is
442
      Secs : Natural;
443
 
444
   begin
445
      --  Validity checks
446
 
447
      if not Seconds'Valid then
448
         raise Constraint_Error;
449
      end if;
450
 
451
      Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5));
452
 
453
      Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
454
      Hour       := Hour_Number (Secs / 3_600);
455
      Secs       := Secs mod 3_600;
456
      Minute     := Minute_Number (Secs / 60);
457
      Second     := Second_Number (Secs mod 60);
458
 
459
      --  Validity checks
460
 
461
      if not Hour'Valid
462
        or else not Minute'Valid
463
        or else not Second'Valid
464
        or else not Sub_Second'Valid
465
      then
466
         raise Time_Error;
467
      end if;
468
   end Split;
469
 
470
   -----------
471
   -- Split --
472
   -----------
473
 
474
   procedure Split
475
     (Date        : Time;
476
      Year        : out Year_Number;
477
      Month       : out Month_Number;
478
      Day         : out Day_Number;
479
      Seconds     : out Day_Duration;
480
      Leap_Second : out Boolean;
481
      Time_Zone   : Time_Zones.Time_Offset := 0)
482
   is
483
      H  : Integer;
484
      M  : Integer;
485
      Se : Integer;
486
      Su : Duration;
487
      Tz : constant Long_Integer := Long_Integer (Time_Zone);
488
 
489
   begin
490
      Formatting_Operations.Split
491
        (Date      => Date,
492
         Year      => Year,
493
         Month     => Month,
494
         Day       => Day,
495
         Day_Secs  => Seconds,
496
         Hour      => H,
497
         Minute    => M,
498
         Second    => Se,
499
         Sub_Sec   => Su,
500
         Leap_Sec  => Leap_Second,
501
         Time_Zone => Tz,
502
         Is_Ada_05 => True);
503
 
504
      --  Validity checks
505
 
506
      if not Year'Valid
507
        or else not Month'Valid
508
        or else not Day'Valid
509
        or else not Seconds'Valid
510
      then
511
         raise Time_Error;
512
      end if;
513
   end Split;
514
 
515
   -----------
516
   -- Split --
517
   -----------
518
 
519
   procedure Split
520
     (Date       : Time;
521
      Year       : out Year_Number;
522
      Month      : out Month_Number;
523
      Day        : out Day_Number;
524
      Hour       : out Hour_Number;
525
      Minute     : out Minute_Number;
526
      Second     : out Second_Number;
527
      Sub_Second : out Second_Duration;
528
      Time_Zone  : Time_Zones.Time_Offset := 0)
529
   is
530
      Dd : Day_Duration;
531
      Le : Boolean;
532
      Tz : constant Long_Integer := Long_Integer (Time_Zone);
533
 
534
   begin
535
      Formatting_Operations.Split
536
        (Date      => Date,
537
         Year      => Year,
538
         Month     => Month,
539
         Day       => Day,
540
         Day_Secs  => Dd,
541
         Hour      => Hour,
542
         Minute    => Minute,
543
         Second    => Second,
544
         Sub_Sec   => Sub_Second,
545
         Leap_Sec  => Le,
546
         Time_Zone => Tz,
547
         Is_Ada_05 => True);
548
 
549
      --  Validity checks
550
 
551
      if not Year'Valid
552
        or else not Month'Valid
553
        or else not Day'Valid
554
        or else not Hour'Valid
555
        or else not Minute'Valid
556
        or else not Second'Valid
557
        or else not Sub_Second'Valid
558
      then
559
         raise Time_Error;
560
      end if;
561
   end Split;
562
 
563
   -----------
564
   -- Split --
565
   -----------
566
 
567
   procedure Split
568
     (Date        : Time;
569
      Year        : out Year_Number;
570
      Month       : out Month_Number;
571
      Day         : out Day_Number;
572
      Hour        : out Hour_Number;
573
      Minute      : out Minute_Number;
574
      Second      : out Second_Number;
575
      Sub_Second  : out Second_Duration;
576
      Leap_Second : out Boolean;
577
      Time_Zone   : Time_Zones.Time_Offset := 0)
578
   is
579
      Dd : Day_Duration;
580
      Tz : constant Long_Integer := Long_Integer (Time_Zone);
581
 
582
   begin
583
      Formatting_Operations.Split
584
       (Date      => Date,
585
        Year      => Year,
586
        Month     => Month,
587
        Day       => Day,
588
        Day_Secs  => Dd,
589
        Hour      => Hour,
590
        Minute    => Minute,
591
        Second    => Second,
592
        Sub_Sec   => Sub_Second,
593
        Leap_Sec  => Leap_Second,
594
        Time_Zone => Tz,
595
        Is_Ada_05 => True);
596
 
597
      --  Validity checks
598
 
599
      if not Year'Valid
600
        or else not Month'Valid
601
        or else not Day'Valid
602
        or else not Hour'Valid
603
        or else not Minute'Valid
604
        or else not Second'Valid
605
        or else not Sub_Second'Valid
606
      then
607
         raise Time_Error;
608
      end if;
609
   end Split;
610
 
611
   ----------------
612
   -- Sub_Second --
613
   ----------------
614
 
615
   function Sub_Second (Date : Time) return Second_Duration is
616
      Y  : Year_Number;
617
      Mo : Month_Number;
618
      D  : Day_Number;
619
      H  : Hour_Number;
620
      Mi : Minute_Number;
621
      Se : Second_Number;
622
      Ss : Second_Duration;
623
      Le : Boolean;
624
 
625
      pragma Unreferenced (Y, Mo, D, H, Mi);
626
 
627
   begin
628
      Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
629
      return Ss;
630
   end Sub_Second;
631
 
632
   -------------
633
   -- Time_Of --
634
   -------------
635
 
636
   function Time_Of
637
     (Year        : Year_Number;
638
      Month       : Month_Number;
639
      Day         : Day_Number;
640
      Seconds     : Day_Duration := 0.0;
641
      Leap_Second : Boolean := False;
642
      Time_Zone   : Time_Zones.Time_Offset := 0) return Time
643
   is
644
      Adj_Year  : Year_Number  := Year;
645
      Adj_Month : Month_Number := Month;
646
      Adj_Day   : Day_Number   := Day;
647
 
648
      H  : constant Integer := 1;
649
      M  : constant Integer := 1;
650
      Se : constant Integer := 1;
651
      Ss : constant Duration := 0.1;
652
      Tz : constant Long_Integer := Long_Integer (Time_Zone);
653
 
654
   begin
655
      --  Validity checks
656
 
657
      if not Year'Valid
658
        or else not Month'Valid
659
        or else not Day'Valid
660
        or else not Seconds'Valid
661
        or else not Time_Zone'Valid
662
      then
663
         raise Constraint_Error;
664
      end if;
665
 
666
      --  A Seconds value of 86_400 denotes a new day. This case requires an
667
      --  adjustment to the input values.
668
 
669
      if Seconds = 86_400.0 then
670
         if Day < Days_In_Month (Month)
671
           or else (Is_Leap (Year)
672
                      and then Month = 2)
673
         then
674
            Adj_Day := Day + 1;
675
         else
676
            Adj_Day := 1;
677
 
678
            if Month < 12 then
679
               Adj_Month := Month + 1;
680
            else
681
               Adj_Month := 1;
682
               Adj_Year  := Year + 1;
683
            end if;
684
         end if;
685
      end if;
686
 
687
      return
688
        Formatting_Operations.Time_Of
689
          (Year         => Adj_Year,
690
           Month        => Adj_Month,
691
           Day          => Adj_Day,
692
           Day_Secs     => Seconds,
693
           Hour         => H,
694
           Minute       => M,
695
           Second       => Se,
696
           Sub_Sec      => Ss,
697
           Leap_Sec     => Leap_Second,
698
           Use_Day_Secs => True,
699
           Is_Ada_05    => True,
700
           Time_Zone    => Tz);
701
   end Time_Of;
702
 
703
   -------------
704
   -- Time_Of --
705
   -------------
706
 
707
   function Time_Of
708
     (Year        : Year_Number;
709
      Month       : Month_Number;
710
      Day         : Day_Number;
711
      Hour        : Hour_Number;
712
      Minute      : Minute_Number;
713
      Second      : Second_Number;
714
      Sub_Second  : Second_Duration := 0.0;
715
      Leap_Second : Boolean := False;
716
      Time_Zone   : Time_Zones.Time_Offset := 0) return Time
717
   is
718
      Dd : constant Day_Duration := Day_Duration'First;
719
      Tz : constant Long_Integer := Long_Integer (Time_Zone);
720
 
721
   begin
722
      --  Validity checks
723
 
724
      if not Year'Valid
725
        or else not Month'Valid
726
        or else not Day'Valid
727
        or else not Hour'Valid
728
        or else not Minute'Valid
729
        or else not Second'Valid
730
        or else not Sub_Second'Valid
731
        or else not Time_Zone'Valid
732
      then
733
         raise Constraint_Error;
734
      end if;
735
 
736
      return
737
        Formatting_Operations.Time_Of
738
          (Year         => Year,
739
           Month        => Month,
740
           Day          => Day,
741
           Day_Secs     => Dd,
742
           Hour         => Hour,
743
           Minute       => Minute,
744
           Second       => Second,
745
           Sub_Sec      => Sub_Second,
746
           Leap_Sec     => Leap_Second,
747
           Use_Day_Secs => False,
748
           Is_Ada_05    => True,
749
           Time_Zone    => Tz);
750
   end Time_Of;
751
 
752
   -----------
753
   -- Value --
754
   -----------
755
 
756
   function Value
757
     (Date      : String;
758
      Time_Zone : Time_Zones.Time_Offset := 0) return Time
759
   is
760
      D          : String (1 .. 22);
761
      Year       : Year_Number;
762
      Month      : Month_Number;
763
      Day        : Day_Number;
764
      Hour       : Hour_Number;
765
      Minute     : Minute_Number;
766
      Second     : Second_Number;
767
      Sub_Second : Second_Duration := 0.0;
768
 
769
   begin
770
      --  Validity checks
771
 
772
      if not Time_Zone'Valid then
773
         raise Constraint_Error;
774
      end if;
775
 
776
      --  Length checks
777
 
778
      if Date'Length /= 19
779
        and then Date'Length /= 22
780
      then
781
         raise Constraint_Error;
782
      end if;
783
 
784
      --  After the correct length has been determined, it is safe to
785
      --  copy the Date in order to avoid Date'First + N indexing.
786
 
787
      D (1 .. Date'Length) := Date;
788
 
789
      --  Format checks
790
 
791
      Check_Char (D, '-', 5);
792
      Check_Char (D, '-', 8);
793
      Check_Char (D, ' ', 11);
794
      Check_Char (D, ':', 14);
795
      Check_Char (D, ':', 17);
796
 
797
      if Date'Length = 22 then
798
         Check_Char (D, '.', 20);
799
      end if;
800
 
801
      --  Leading zero checks
802
 
803
      Check_Digit (D, 6);
804
      Check_Digit (D, 9);
805
      Check_Digit (D, 12);
806
      Check_Digit (D, 15);
807
      Check_Digit (D, 18);
808
 
809
      if Date'Length = 22 then
810
         Check_Digit (D, 21);
811
      end if;
812
 
813
      --  Value extraction
814
 
815
      Year   := Year_Number   (Year_Number'Value   (D (1 .. 4)));
816
      Month  := Month_Number  (Month_Number'Value  (D (6 .. 7)));
817
      Day    := Day_Number    (Day_Number'Value    (D (9 .. 10)));
818
      Hour   := Hour_Number   (Hour_Number'Value   (D (12 .. 13)));
819
      Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
820
      Second := Second_Number (Second_Number'Value (D (18 .. 19)));
821
 
822
      --  Optional part
823
 
824
      if Date'Length = 22 then
825
         Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
826
      end if;
827
 
828
      --  Sanity checks
829
 
830
      if not Year'Valid
831
        or else not Month'Valid
832
        or else not Day'Valid
833
        or else not Hour'Valid
834
        or else not Minute'Valid
835
        or else not Second'Valid
836
        or else not Sub_Second'Valid
837
      then
838
         raise Constraint_Error;
839
      end if;
840
 
841
      return Time_Of (Year, Month, Day,
842
                      Hour, Minute, Second, Sub_Second, False, Time_Zone);
843
 
844
   exception
845
      when others => raise Constraint_Error;
846
   end Value;
847
 
848
   -----------
849
   -- Value --
850
   -----------
851
 
852
   function Value (Elapsed_Time : String) return Duration is
853
      D          : String (1 .. 11);
854
      Hour       : Hour_Number;
855
      Minute     : Minute_Number;
856
      Second     : Second_Number;
857
      Sub_Second : Second_Duration := 0.0;
858
 
859
   begin
860
      --  Length checks
861
 
862
      if Elapsed_Time'Length /= 8
863
        and then Elapsed_Time'Length /= 11
864
      then
865
         raise Constraint_Error;
866
      end if;
867
 
868
      --  After the correct length has been determined, it is safe to
869
      --  copy the Elapsed_Time in order to avoid Date'First + N indexing.
870
 
871
      D (1 .. Elapsed_Time'Length) := Elapsed_Time;
872
 
873
      --  Format checks
874
 
875
      Check_Char (D, ':', 3);
876
      Check_Char (D, ':', 6);
877
 
878
      if Elapsed_Time'Length = 11 then
879
         Check_Char (D, '.', 9);
880
      end if;
881
 
882
      --  Leading zero checks
883
 
884
      Check_Digit (D, 1);
885
      Check_Digit (D, 4);
886
      Check_Digit (D, 7);
887
 
888
      if Elapsed_Time'Length = 11 then
889
         Check_Digit (D, 10);
890
      end if;
891
 
892
      --  Value extraction
893
 
894
      Hour   := Hour_Number   (Hour_Number'Value   (D (1 .. 2)));
895
      Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
896
      Second := Second_Number (Second_Number'Value (D (7 .. 8)));
897
 
898
      --  Optional part
899
 
900
      if Elapsed_Time'Length = 11 then
901
         Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
902
      end if;
903
 
904
      --  Sanity checks
905
 
906
      if not Hour'Valid
907
        or else not Minute'Valid
908
        or else not Second'Valid
909
        or else not Sub_Second'Valid
910
      then
911
         raise Constraint_Error;
912
      end if;
913
 
914
      return Seconds_Of (Hour, Minute, Second, Sub_Second);
915
 
916
   exception
917
      when others => raise Constraint_Error;
918
   end Value;
919
 
920
   ----------
921
   -- Year --
922
   ----------
923
 
924
   function Year
925
     (Date      : Time;
926
      Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
927
   is
928
      Y  : Year_Number;
929
      Mo : Month_Number;
930
      D  : Day_Number;
931
      H  : Hour_Number;
932
      Mi : Minute_Number;
933
      Se : Second_Number;
934
      Ss : Second_Duration;
935
      Le : Boolean;
936
 
937
      pragma Unreferenced (Mo, D, H, Mi);
938
 
939
   begin
940
      Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
941
      return Y;
942
   end Year;
943
 
944
end Ada.Calendar.Formatting;

powered by: WebSVN 2.1.0

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