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