1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . W I D E _ W I D E _ T E X T _ I O . E D I T I N G -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2012, 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.Strings.Fixed; 33with Ada.Strings.Wide_Wide_Fixed; 34 35package body Ada.Wide_Wide_Text_IO.Editing is 36 37 package Strings renames Ada.Strings; 38 package Strings_Fixed renames Ada.Strings.Fixed; 39 package Strings_Wide_Wide_Fixed renames Ada.Strings.Wide_Wide_Fixed; 40 package Wide_Wide_Text_IO renames Ada.Wide_Wide_Text_IO; 41 42 ----------------------- 43 -- Local_Subprograms -- 44 ----------------------- 45 46 function To_Wide (C : Character) return Wide_Wide_Character; 47 pragma Inline (To_Wide); 48 -- Convert Character to corresponding Wide_Wide_Character 49 50 --------------------- 51 -- Blank_When_Zero -- 52 --------------------- 53 54 function Blank_When_Zero (Pic : Picture) return Boolean is 55 begin 56 return Pic.Contents.Original_BWZ; 57 end Blank_When_Zero; 58 59 -------------------- 60 -- Decimal_Output -- 61 -------------------- 62 63 package body Decimal_Output is 64 65 ----------- 66 -- Image -- 67 ----------- 68 69 function Image 70 (Item : Num; 71 Pic : Picture; 72 Currency : Wide_Wide_String := Default_Currency; 73 Fill : Wide_Wide_Character := Default_Fill; 74 Separator : Wide_Wide_Character := Default_Separator; 75 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark) 76 return Wide_Wide_String 77 is 78 begin 79 return Format_Number 80 (Pic.Contents, Num'Image (Item), 81 Currency, Fill, Separator, Radix_Mark); 82 end Image; 83 84 ------------ 85 -- Length -- 86 ------------ 87 88 function Length 89 (Pic : Picture; 90 Currency : Wide_Wide_String := Default_Currency) return Natural 91 is 92 Picstr : constant String := Pic_String (Pic); 93 V_Adjust : Integer := 0; 94 Cur_Adjust : Integer := 0; 95 96 begin 97 -- Check if Picstr has 'V' or '$' 98 99 -- If 'V', then length is 1 less than otherwise 100 101 -- If '$', then length is Currency'Length-1 more than otherwise 102 103 -- This should use the string handling package ??? 104 105 for J in Picstr'Range loop 106 if Picstr (J) = 'V' then 107 V_Adjust := -1; 108 109 elsif Picstr (J) = '$' then 110 Cur_Adjust := Currency'Length - 1; 111 end if; 112 end loop; 113 114 return Picstr'Length - V_Adjust + Cur_Adjust; 115 end Length; 116 117 --------- 118 -- Put -- 119 --------- 120 121 procedure Put 122 (File : Wide_Wide_Text_IO.File_Type; 123 Item : Num; 124 Pic : Picture; 125 Currency : Wide_Wide_String := Default_Currency; 126 Fill : Wide_Wide_Character := Default_Fill; 127 Separator : Wide_Wide_Character := Default_Separator; 128 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark) 129 is 130 begin 131 Wide_Wide_Text_IO.Put (File, Image (Item, Pic, 132 Currency, Fill, Separator, Radix_Mark)); 133 end Put; 134 135 procedure Put 136 (Item : Num; 137 Pic : Picture; 138 Currency : Wide_Wide_String := Default_Currency; 139 Fill : Wide_Wide_Character := Default_Fill; 140 Separator : Wide_Wide_Character := Default_Separator; 141 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark) 142 is 143 begin 144 Wide_Wide_Text_IO.Put (Image (Item, Pic, 145 Currency, Fill, Separator, Radix_Mark)); 146 end Put; 147 148 procedure Put 149 (To : out Wide_Wide_String; 150 Item : Num; 151 Pic : Picture; 152 Currency : Wide_Wide_String := Default_Currency; 153 Fill : Wide_Wide_Character := Default_Fill; 154 Separator : Wide_Wide_Character := Default_Separator; 155 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark) 156 is 157 Result : constant Wide_Wide_String := 158 Image (Item, Pic, Currency, Fill, Separator, Radix_Mark); 159 160 begin 161 if Result'Length > To'Length then 162 raise Wide_Wide_Text_IO.Layout_Error; 163 else 164 Strings_Wide_Wide_Fixed.Move (Source => Result, Target => To, 165 Justify => Strings.Right); 166 end if; 167 end Put; 168 169 ----------- 170 -- Valid -- 171 ----------- 172 173 function Valid 174 (Item : Num; 175 Pic : Picture; 176 Currency : Wide_Wide_String := Default_Currency) return Boolean 177 is 178 begin 179 declare 180 Temp : constant Wide_Wide_String := Image (Item, Pic, Currency); 181 pragma Warnings (Off, Temp); 182 begin 183 return True; 184 end; 185 186 exception 187 when Layout_Error => return False; 188 189 end Valid; 190 end Decimal_Output; 191 192 ------------ 193 -- Expand -- 194 ------------ 195 196 function Expand (Picture : String) return String is 197 Result : String (1 .. MAX_PICSIZE); 198 Picture_Index : Integer := Picture'First; 199 Result_Index : Integer := Result'First; 200 Count : Natural; 201 Last : Integer; 202 203 begin 204 if Picture'Length < 1 then 205 raise Picture_Error; 206 end if; 207 208 if Picture (Picture'First) = '(' then 209 raise Picture_Error; 210 end if; 211 212 loop 213 case Picture (Picture_Index) is 214 215 when '(' => 216 217 -- We now need to scan out the count after a left paren. In 218 -- the non-wide version we used Integer_IO.Get, but that is 219 -- not convenient here, since we don't want to drag in normal 220 -- Text_IO just for this purpose. So we do the scan ourselves, 221 -- with the normal validity checks. 222 223 Last := Picture_Index + 1; 224 Count := 0; 225 226 if Picture (Last) not in '0' .. '9' then 227 raise Picture_Error; 228 end if; 229 230 Count := Character'Pos (Picture (Last)) - Character'Pos ('0'); 231 Last := Last + 1; 232 233 loop 234 if Last > Picture'Last then 235 raise Picture_Error; 236 end if; 237 238 if Picture (Last) = '_' then 239 if Picture (Last - 1) = '_' then 240 raise Picture_Error; 241 end if; 242 243 elsif Picture (Last) = ')' then 244 exit; 245 246 elsif Picture (Last) not in '0' .. '9' then 247 raise Picture_Error; 248 249 else 250 Count := Count * 10 251 + Character'Pos (Picture (Last)) - 252 Character'Pos ('0'); 253 end if; 254 255 Last := Last + 1; 256 end loop; 257 258 -- In what follows note that one copy of the repeated 259 -- character has already been made, so a count of one is 260 -- no-op, and a count of zero erases a character. 261 262 for J in 2 .. Count loop 263 Result (Result_Index + J - 2) := Picture (Picture_Index - 1); 264 end loop; 265 266 Result_Index := Result_Index + Count - 1; 267 268 -- Last was a ')' throw it away too 269 270 Picture_Index := Last + 1; 271 272 when ')' => 273 raise Picture_Error; 274 275 when others => 276 Result (Result_Index) := Picture (Picture_Index); 277 Picture_Index := Picture_Index + 1; 278 Result_Index := Result_Index + 1; 279 280 end case; 281 282 exit when Picture_Index > Picture'Last; 283 end loop; 284 285 return Result (1 .. Result_Index - 1); 286 287 exception 288 when others => 289 raise Picture_Error; 290 end Expand; 291 292 ------------------- 293 -- Format_Number -- 294 ------------------- 295 296 function Format_Number 297 (Pic : Format_Record; 298 Number : String; 299 Currency_Symbol : Wide_Wide_String; 300 Fill_Character : Wide_Wide_Character; 301 Separator_Character : Wide_Wide_Character; 302 Radix_Point : Wide_Wide_Character) return Wide_Wide_String 303 is 304 Attrs : Number_Attributes := Parse_Number_String (Number); 305 Position : Integer; 306 Rounded : String := Number; 307 308 Sign_Position : Integer := Pic.Sign_Position; -- may float. 309 310 Answer : Wide_Wide_String (1 .. Pic.Picture.Length); 311 Last : Integer; 312 Currency_Pos : Integer := Pic.Start_Currency; 313 314 Dollar : Boolean := False; 315 -- Overridden immediately if necessary 316 317 Zero : Boolean := True; 318 -- Set to False when a non-zero digit is output 319 320 begin 321 322 -- If the picture has fewer decimal places than the number, the image 323 -- must be rounded according to the usual rules. 324 325 if Attrs.Has_Fraction then 326 declare 327 R : constant Integer := 328 (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1) 329 - Pic.Max_Trailing_Digits; 330 R_Pos : Integer; 331 332 begin 333 if R > 0 then 334 R_Pos := Rounded'Length - R; 335 336 if Rounded (R_Pos + 1) > '4' then 337 338 if Rounded (R_Pos) = '.' then 339 R_Pos := R_Pos - 1; 340 end if; 341 342 if Rounded (R_Pos) /= '9' then 343 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos)); 344 else 345 Rounded (R_Pos) := '0'; 346 R_Pos := R_Pos - 1; 347 348 while R_Pos > 1 loop 349 if Rounded (R_Pos) = '.' then 350 R_Pos := R_Pos - 1; 351 end if; 352 353 if Rounded (R_Pos) /= '9' then 354 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos)); 355 exit; 356 else 357 Rounded (R_Pos) := '0'; 358 R_Pos := R_Pos - 1; 359 end if; 360 end loop; 361 362 -- The rounding may add a digit in front. Either the 363 -- leading blank or the sign (already captured) can be 364 -- overwritten. 365 366 if R_Pos = 1 then 367 Rounded (R_Pos) := '1'; 368 Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1; 369 end if; 370 end if; 371 end if; 372 end if; 373 end; 374 end if; 375 376 for J in Answer'Range loop 377 Answer (J) := To_Wide (Pic.Picture.Expanded (J)); 378 end loop; 379 380 if Pic.Start_Currency /= Invalid_Position then 381 Dollar := Answer (Pic.Start_Currency) = '$'; 382 end if; 383 384 -- Fix up "direct inserts" outside the playing field. Set up as one 385 -- loop to do the beginning, one (reverse) loop to do the end. 386 387 Last := 1; 388 loop 389 exit when Last = Pic.Start_Float; 390 exit when Last = Pic.Radix_Position; 391 exit when Answer (Last) = '9'; 392 393 case Answer (Last) is 394 395 when '_' => 396 Answer (Last) := Separator_Character; 397 398 when 'b' => 399 Answer (Last) := ' '; 400 401 when others => 402 null; 403 404 end case; 405 406 exit when Last = Answer'Last; 407 408 Last := Last + 1; 409 end loop; 410 411 -- Now for the end... 412 413 for J in reverse Last .. Answer'Last loop 414 exit when J = Pic.Radix_Position; 415 416 -- Do this test First, Separator_Character can equal Pic.Floater 417 418 if Answer (J) = Pic.Floater then 419 exit; 420 end if; 421 422 case Answer (J) is 423 424 when '_' => 425 Answer (J) := Separator_Character; 426 427 when 'b' => 428 Answer (J) := ' '; 429 430 when '9' => 431 exit; 432 433 when others => 434 null; 435 436 end case; 437 end loop; 438 439 -- Non-floating sign 440 441 if Pic.Start_Currency /= -1 442 and then Answer (Pic.Start_Currency) = '#' 443 and then Pic.Floater /= '#' 444 then 445 if Currency_Symbol'Length > 446 Pic.End_Currency - Pic.Start_Currency + 1 447 then 448 raise Picture_Error; 449 450 elsif Currency_Symbol'Length = 451 Pic.End_Currency - Pic.Start_Currency + 1 452 then 453 Answer (Pic.Start_Currency .. Pic.End_Currency) := 454 Currency_Symbol; 455 456 elsif Pic.Radix_Position = Invalid_Position 457 or else Pic.Start_Currency < Pic.Radix_Position 458 then 459 Answer (Pic.Start_Currency .. Pic.End_Currency) := 460 (others => ' '); 461 Answer (Pic.End_Currency - Currency_Symbol'Length + 1 .. 462 Pic.End_Currency) := Currency_Symbol; 463 464 else 465 Answer (Pic.Start_Currency .. Pic.End_Currency) := 466 (others => ' '); 467 Answer (Pic.Start_Currency .. 468 Pic.Start_Currency + Currency_Symbol'Length - 1) := 469 Currency_Symbol; 470 end if; 471 end if; 472 473 -- Fill in leading digits 474 475 if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 > 476 Pic.Max_Leading_Digits 477 then 478 raise Layout_Error; 479 end if; 480 481 Position := 482 (if Pic.Radix_Position = Invalid_Position then Answer'Last 483 else Pic.Radix_Position - 1); 484 485 for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop 486 while Answer (Position) /= '9' 487 and then 488 Answer (Position) /= Pic.Floater 489 loop 490 if Answer (Position) = '_' then 491 Answer (Position) := Separator_Character; 492 elsif Answer (Position) = 'b' then 493 Answer (Position) := ' '; 494 end if; 495 496 Position := Position - 1; 497 end loop; 498 499 Answer (Position) := To_Wide (Rounded (J)); 500 501 if Rounded (J) /= '0' then 502 Zero := False; 503 end if; 504 505 Position := Position - 1; 506 end loop; 507 508 -- Do lead float 509 510 if Pic.Start_Float = Invalid_Position then 511 512 -- No leading floats, but need to change '9' to '0', '_' to 513 -- Separator_Character and 'b' to ' '. 514 515 for J in Last .. Position loop 516 517 -- Last set when fixing the "uninteresting" leaders above. 518 -- Don't duplicate the work. 519 520 if Answer (J) = '9' then 521 Answer (J) := '0'; 522 523 elsif Answer (J) = '_' then 524 Answer (J) := Separator_Character; 525 526 elsif Answer (J) = 'b' then 527 Answer (J) := ' '; 528 529 end if; 530 531 end loop; 532 533 elsif Pic.Floater = '<' 534 or else 535 Pic.Floater = '+' 536 or else 537 Pic.Floater = '-' 538 then 539 for J in Pic.End_Float .. Position loop -- May be null range 540 if Answer (J) = '9' then 541 Answer (J) := '0'; 542 543 elsif Answer (J) = '_' then 544 Answer (J) := Separator_Character; 545 546 elsif Answer (J) = 'b' then 547 Answer (J) := ' '; 548 549 end if; 550 end loop; 551 552 if Position > Pic.End_Float then 553 Position := Pic.End_Float; 554 end if; 555 556 for J in Pic.Start_Float .. Position - 1 loop 557 Answer (J) := ' '; 558 end loop; 559 560 Answer (Position) := Pic.Floater; 561 Sign_Position := Position; 562 563 elsif Pic.Floater = '$' then 564 565 for J in Pic.End_Float .. Position loop -- May be null range 566 if Answer (J) = '9' then 567 Answer (J) := '0'; 568 569 elsif Answer (J) = '_' then 570 Answer (J) := ' '; -- no separator before leftmost digit 571 572 elsif Answer (J) = 'b' then 573 Answer (J) := ' '; 574 end if; 575 end loop; 576 577 if Position > Pic.End_Float then 578 Position := Pic.End_Float; 579 end if; 580 581 for J in Pic.Start_Float .. Position - 1 loop 582 Answer (J) := ' '; 583 end loop; 584 585 Answer (Position) := Pic.Floater; 586 Currency_Pos := Position; 587 588 elsif Pic.Floater = '*' then 589 590 for J in Pic.End_Float .. Position loop -- May be null range 591 if Answer (J) = '9' then 592 Answer (J) := '0'; 593 594 elsif Answer (J) = '_' then 595 Answer (J) := Separator_Character; 596 597 elsif Answer (J) = 'b' then 598 Answer (J) := '*'; 599 end if; 600 end loop; 601 602 if Position > Pic.End_Float then 603 Position := Pic.End_Float; 604 end if; 605 606 for J in Pic.Start_Float .. Position loop 607 Answer (J) := '*'; 608 end loop; 609 610 else 611 if Pic.Floater = '#' then 612 Currency_Pos := Currency_Symbol'Length; 613 end if; 614 615 for J in reverse Pic.Start_Float .. Position loop 616 case Answer (J) is 617 618 when '*' => 619 Answer (J) := Fill_Character; 620 621 when 'Z' | 'b' | '/' | '0' => 622 Answer (J) := ' '; 623 624 when '9' => 625 Answer (J) := '0'; 626 627 when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' => 628 null; 629 630 when '#' => 631 if Currency_Pos = 0 then 632 Answer (J) := ' '; 633 else 634 Answer (J) := Currency_Symbol (Currency_Pos); 635 Currency_Pos := Currency_Pos - 1; 636 end if; 637 638 when '_' => 639 640 case Pic.Floater is 641 642 when '*' => 643 Answer (J) := Fill_Character; 644 645 when 'Z' | 'b' => 646 Answer (J) := ' '; 647 648 when '#' => 649 if Currency_Pos = 0 then 650 Answer (J) := ' '; 651 652 else 653 Answer (J) := Currency_Symbol (Currency_Pos); 654 Currency_Pos := Currency_Pos - 1; 655 end if; 656 657 when others => 658 null; 659 660 end case; 661 662 when others => 663 null; 664 665 end case; 666 end loop; 667 668 if Pic.Floater = '#' and then Currency_Pos /= 0 then 669 raise Layout_Error; 670 end if; 671 end if; 672 673 -- Do sign 674 675 if Sign_Position = Invalid_Position then 676 if Attrs.Negative then 677 raise Layout_Error; 678 end if; 679 680 else 681 if Attrs.Negative then 682 case Answer (Sign_Position) is 683 when 'C' | 'D' | '-' => 684 null; 685 686 when '+' => 687 Answer (Sign_Position) := '-'; 688 689 when '<' => 690 Answer (Sign_Position) := '('; 691 Answer (Pic.Second_Sign) := ')'; 692 693 when others => 694 raise Picture_Error; 695 696 end case; 697 698 else -- positive 699 700 case Answer (Sign_Position) is 701 702 when '-' => 703 Answer (Sign_Position) := ' '; 704 705 when '<' | 'C' | 'D' => 706 Answer (Sign_Position) := ' '; 707 Answer (Pic.Second_Sign) := ' '; 708 709 when '+' => 710 null; 711 712 when others => 713 raise Picture_Error; 714 715 end case; 716 end if; 717 end if; 718 719 -- Fill in trailing digits 720 721 if Pic.Max_Trailing_Digits > 0 then 722 723 if Attrs.Has_Fraction then 724 Position := Attrs.Start_Of_Fraction; 725 Last := Pic.Radix_Position + 1; 726 727 for J in Last .. Answer'Last loop 728 729 if Answer (J) = '9' or else Answer (J) = Pic.Floater then 730 Answer (J) := To_Wide (Rounded (Position)); 731 732 if Rounded (Position) /= '0' then 733 Zero := False; 734 end if; 735 736 Position := Position + 1; 737 Last := J + 1; 738 739 -- Used up fraction but remember place in Answer 740 741 exit when Position > Attrs.End_Of_Fraction; 742 743 elsif Answer (J) = 'b' then 744 Answer (J) := ' '; 745 746 elsif Answer (J) = '_' then 747 Answer (J) := Separator_Character; 748 749 end if; 750 751 Last := J + 1; 752 end loop; 753 754 Position := Last; 755 756 else 757 Position := Pic.Radix_Position + 1; 758 end if; 759 760 -- Now fill remaining 9's with zeros and _ with separators 761 762 Last := Answer'Last; 763 764 for J in Position .. Last loop 765 if Answer (J) = '9' then 766 Answer (J) := '0'; 767 768 elsif Answer (J) = Pic.Floater then 769 Answer (J) := '0'; 770 771 elsif Answer (J) = '_' then 772 Answer (J) := Separator_Character; 773 774 elsif Answer (J) = 'b' then 775 Answer (J) := ' '; 776 777 end if; 778 end loop; 779 780 Position := Last + 1; 781 782 else 783 if Pic.Floater = '#' and then Currency_Pos /= 0 then 784 raise Layout_Error; 785 end if; 786 787 -- No trailing digits, but now J may need to stick in a currency 788 -- symbol or sign. 789 790 Position := 791 (if Pic.Start_Currency = Invalid_Position then Answer'Last + 1 792 else Pic.Start_Currency); 793 end if; 794 795 for J in Position .. Answer'Last loop 796 if Pic.Start_Currency /= Invalid_Position and then 797 Answer (Pic.Start_Currency) = '#' then 798 Currency_Pos := 1; 799 end if; 800 801 -- Note: There are some weird cases J can imagine with 'b' or '#' 802 -- in currency strings where the following code will cause 803 -- glitches. The trick is to tell when the character in the 804 -- answer should be checked, and when to look at the original 805 -- string. Some other time. RIE 11/26/96 ??? 806 807 case Answer (J) is 808 when '*' => 809 Answer (J) := Fill_Character; 810 811 when 'b' => 812 Answer (J) := ' '; 813 814 when '#' => 815 if Currency_Pos > Currency_Symbol'Length then 816 Answer (J) := ' '; 817 818 else 819 Answer (J) := Currency_Symbol (Currency_Pos); 820 Currency_Pos := Currency_Pos + 1; 821 end if; 822 823 when '_' => 824 825 case Pic.Floater is 826 827 when '*' => 828 Answer (J) := Fill_Character; 829 830 when 'Z' | 'z' => 831 Answer (J) := ' '; 832 833 when '#' => 834 if Currency_Pos > Currency_Symbol'Length then 835 Answer (J) := ' '; 836 else 837 Answer (J) := Currency_Symbol (Currency_Pos); 838 Currency_Pos := Currency_Pos + 1; 839 end if; 840 841 when others => 842 null; 843 844 end case; 845 846 when others => 847 exit; 848 849 end case; 850 end loop; 851 852 -- Now get rid of Blank_when_Zero and complete Star fill 853 854 if Zero and then Pic.Blank_When_Zero then 855 856 -- Value is zero, and blank it 857 858 Last := Answer'Last; 859 860 if Dollar then 861 Last := Last - 1 + Currency_Symbol'Length; 862 end if; 863 864 if Pic.Radix_Position /= Invalid_Position and then 865 Answer (Pic.Radix_Position) = 'V' then 866 Last := Last - 1; 867 end if; 868 869 return Wide_Wide_String'(1 .. Last => ' '); 870 871 elsif Zero and then Pic.Star_Fill then 872 Last := Answer'Last; 873 874 if Dollar then 875 Last := Last - 1 + Currency_Symbol'Length; 876 end if; 877 878 if Pic.Radix_Position /= Invalid_Position then 879 880 if Answer (Pic.Radix_Position) = 'V' then 881 Last := Last - 1; 882 883 elsif Dollar then 884 if Pic.Radix_Position > Pic.Start_Currency then 885 return 886 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') & 887 Radix_Point & 888 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*'); 889 890 else 891 return 892 Wide_Wide_String' 893 (1 .. 894 Pic.Radix_Position + Currency_Symbol'Length - 2 895 => '*') & 896 Radix_Point & 897 Wide_Wide_String' 898 (Pic.Radix_Position + Currency_Symbol'Length .. Last 899 => '*'); 900 end if; 901 902 else 903 return 904 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') & 905 Radix_Point & 906 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*'); 907 end if; 908 end if; 909 910 return Wide_Wide_String'(1 .. Last => '*'); 911 end if; 912 913 -- This was once a simple return statement, now there are nine 914 -- different return cases. Not to mention the five above to deal 915 -- with zeros. Why not split things out? 916 917 -- Processing the radix and sign expansion separately 918 -- would require lots of copying--the string and some of its 919 -- indicies--without really simplifying the logic. The cases are: 920 921 -- 1) Expand $, replace '.' with Radix_Point 922 -- 2) No currency expansion, replace '.' with Radix_Point 923 -- 3) Expand $, radix blanked 924 -- 4) No currency expansion, radix blanked 925 -- 5) Elide V 926 -- 6) Expand $, Elide V 927 -- 7) Elide V, Expand $ (Two cases depending on order.) 928 -- 8) No radix, expand $ 929 -- 9) No radix, no currency expansion 930 931 if Pic.Radix_Position /= Invalid_Position then 932 933 if Answer (Pic.Radix_Position) = '.' then 934 Answer (Pic.Radix_Position) := Radix_Point; 935 936 if Dollar then 937 938 -- 1) Expand $, replace '.' with Radix_Point 939 940 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 941 Answer (Currency_Pos + 1 .. Answer'Last); 942 943 else 944 -- 2) No currency expansion, replace '.' with Radix_Point 945 946 return Answer; 947 end if; 948 949 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix. 950 if Dollar then 951 952 -- 3) Expand $, radix blanked 953 954 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 955 Answer (Currency_Pos + 1 .. Answer'Last); 956 957 else 958 -- 4) No expansion, radix blanked 959 960 return Answer; 961 end if; 962 963 -- V cases 964 965 else 966 if not Dollar then 967 968 -- 5) Elide V 969 970 return Answer (1 .. Pic.Radix_Position - 1) & 971 Answer (Pic.Radix_Position + 1 .. Answer'Last); 972 973 elsif Currency_Pos < Pic.Radix_Position then 974 975 -- 6) Expand $, Elide V 976 977 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 978 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) & 979 Answer (Pic.Radix_Position + 1 .. Answer'Last); 980 981 else 982 -- 7) Elide V, Expand $ 983 984 return Answer (1 .. Pic.Radix_Position - 1) & 985 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) & 986 Currency_Symbol & 987 Answer (Currency_Pos + 1 .. Answer'Last); 988 end if; 989 end if; 990 991 elsif Dollar then 992 993 -- 8) No radix, expand $ 994 995 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 996 Answer (Currency_Pos + 1 .. Answer'Last); 997 998 else 999 -- 9) No radix, no currency expansion 1000 1001 return Answer; 1002 end if; 1003 end Format_Number; 1004 1005 ------------------------- 1006 -- Parse_Number_String -- 1007 ------------------------- 1008 1009 function Parse_Number_String (Str : String) return Number_Attributes is 1010 Answer : Number_Attributes; 1011 1012 begin 1013 for J in Str'Range loop 1014 case Str (J) is 1015 1016 when ' ' => 1017 null; -- ignore 1018 1019 when '1' .. '9' => 1020 1021 -- Decide if this is the start of a number. 1022 -- If so, figure out which one... 1023 1024 if Answer.Has_Fraction then 1025 Answer.End_Of_Fraction := J; 1026 else 1027 if Answer.Start_Of_Int = Invalid_Position then 1028 -- start integer 1029 Answer.Start_Of_Int := J; 1030 end if; 1031 Answer.End_Of_Int := J; 1032 end if; 1033 1034 when '0' => 1035 1036 -- Only count a zero before the decimal point if it follows a 1037 -- non-zero digit. After the decimal point, zeros will be 1038 -- counted if followed by a non-zero digit. 1039 1040 if not Answer.Has_Fraction then 1041 if Answer.Start_Of_Int /= Invalid_Position then 1042 Answer.End_Of_Int := J; 1043 end if; 1044 end if; 1045 1046 when '-' => 1047 1048 -- Set negative 1049 1050 Answer.Negative := True; 1051 1052 when '.' => 1053 1054 -- Close integer, start fraction 1055 1056 if Answer.Has_Fraction then 1057 raise Picture_Error; 1058 end if; 1059 1060 -- Two decimal points is a no-no 1061 1062 Answer.Has_Fraction := True; 1063 Answer.End_Of_Fraction := J; 1064 1065 -- Could leave this at Invalid_Position, but this seems the 1066 -- right way to indicate a null range... 1067 1068 Answer.Start_Of_Fraction := J + 1; 1069 Answer.End_Of_Int := J - 1; 1070 1071 when others => 1072 raise Picture_Error; -- can this happen? probably not! 1073 end case; 1074 end loop; 1075 1076 if Answer.Start_Of_Int = Invalid_Position then 1077 Answer.Start_Of_Int := Answer.End_Of_Int + 1; 1078 end if; 1079 1080 -- No significant (intger) digits needs a null range 1081 1082 return Answer; 1083 end Parse_Number_String; 1084 1085 ---------------- 1086 -- Pic_String -- 1087 ---------------- 1088 1089 -- The following ensures that we return B and not b being careful not 1090 -- to break things which expect lower case b for blank. See CXF3A02. 1091 1092 function Pic_String (Pic : Picture) return String is 1093 Temp : String (1 .. Pic.Contents.Picture.Length) := 1094 Pic.Contents.Picture.Expanded; 1095 begin 1096 for J in Temp'Range loop 1097 if Temp (J) = 'b' then 1098 Temp (J) := 'B'; 1099 end if; 1100 end loop; 1101 1102 return Temp; 1103 end Pic_String; 1104 1105 ------------------ 1106 -- Precalculate -- 1107 ------------------ 1108 1109 procedure Precalculate (Pic : in out Format_Record) is 1110 1111 Computed_BWZ : Boolean := True; 1112 1113 type Legality is (Okay, Reject); 1114 State : Legality := Reject; 1115 -- Start in reject, which will reject null strings 1116 1117 Index : Pic_Index := Pic.Picture.Expanded'First; 1118 1119 function At_End return Boolean; 1120 pragma Inline (At_End); 1121 1122 procedure Set_State (L : Legality); 1123 pragma Inline (Set_State); 1124 1125 function Look return Character; 1126 pragma Inline (Look); 1127 1128 function Is_Insert return Boolean; 1129 pragma Inline (Is_Insert); 1130 1131 procedure Skip; 1132 pragma Inline (Skip); 1133 1134 procedure Trailing_Currency; 1135 procedure Trailing_Bracket; 1136 procedure Number_Fraction; 1137 procedure Number_Completion; 1138 procedure Number_Fraction_Or_Bracket; 1139 procedure Number_Fraction_Or_Z_Fill; 1140 procedure Zero_Suppression; 1141 procedure Floating_Bracket; 1142 procedure Number_Fraction_Or_Star_Fill; 1143 procedure Star_Suppression; 1144 procedure Number_Fraction_Or_Dollar; 1145 procedure Leading_Dollar; 1146 procedure Number_Fraction_Or_Pound; 1147 procedure Leading_Pound; 1148 procedure Picture; 1149 procedure Floating_Plus; 1150 procedure Floating_Minus; 1151 procedure Picture_Plus; 1152 procedure Picture_Minus; 1153 procedure Picture_Bracket; 1154 procedure Number; 1155 procedure Optional_RHS_Sign; 1156 procedure Picture_String; 1157 1158 ------------ 1159 -- At_End -- 1160 ------------ 1161 1162 function At_End return Boolean is 1163 begin 1164 return Index > Pic.Picture.Length; 1165 end At_End; 1166 1167 ---------------------- 1168 -- Floating_Bracket -- 1169 ---------------------- 1170 1171 -- Note that Floating_Bracket is only called with an acceptable 1172 -- prefix. But we don't set Okay, because we must end with a '>'. 1173 1174 procedure Floating_Bracket is 1175 begin 1176 Pic.Floater := '<'; 1177 Pic.End_Float := Index; 1178 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1179 1180 -- First bracket wasn't counted... 1181 1182 Skip; -- known '<' 1183 1184 loop 1185 if At_End then 1186 return; 1187 end if; 1188 1189 case Look is 1190 1191 when '_' | '0' | '/' => 1192 Pic.End_Float := Index; 1193 Skip; 1194 1195 when 'B' | 'b' => 1196 Pic.End_Float := Index; 1197 Pic.Picture.Expanded (Index) := 'b'; 1198 Skip; 1199 1200 when '<' => 1201 Pic.End_Float := Index; 1202 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1203 Skip; 1204 1205 when '9' => 1206 Number_Completion; 1207 1208 when '$' => 1209 Leading_Dollar; 1210 1211 when '#' => 1212 Leading_Pound; 1213 1214 when 'V' | 'v' | '.' => 1215 Pic.Radix_Position := Index; 1216 Skip; 1217 Number_Fraction_Or_Bracket; 1218 return; 1219 1220 when others => 1221 return; 1222 end case; 1223 end loop; 1224 end Floating_Bracket; 1225 1226 -------------------- 1227 -- Floating_Minus -- 1228 -------------------- 1229 1230 procedure Floating_Minus is 1231 begin 1232 loop 1233 if At_End then 1234 return; 1235 end if; 1236 1237 case Look is 1238 when '_' | '0' | '/' => 1239 Pic.End_Float := Index; 1240 Skip; 1241 1242 when 'B' | 'b' => 1243 Pic.End_Float := Index; 1244 Pic.Picture.Expanded (Index) := 'b'; 1245 Skip; 1246 1247 when '-' => 1248 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1249 Pic.End_Float := Index; 1250 Skip; 1251 1252 when '9' => 1253 Number_Completion; 1254 return; 1255 1256 when '.' | 'V' | 'v' => 1257 Pic.Radix_Position := Index; 1258 Skip; -- Radix 1259 1260 while Is_Insert loop 1261 Skip; 1262 end loop; 1263 1264 if At_End then 1265 return; 1266 end if; 1267 1268 if Look = '-' then 1269 loop 1270 if At_End then 1271 return; 1272 end if; 1273 1274 case Look is 1275 1276 when '-' => 1277 Pic.Max_Trailing_Digits := 1278 Pic.Max_Trailing_Digits + 1; 1279 Pic.End_Float := Index; 1280 Skip; 1281 1282 when '_' | '0' | '/' => 1283 Skip; 1284 1285 when 'B' | 'b' => 1286 Pic.Picture.Expanded (Index) := 'b'; 1287 Skip; 1288 1289 when others => 1290 return; 1291 1292 end case; 1293 end loop; 1294 1295 else 1296 Number_Completion; 1297 end if; 1298 1299 return; 1300 1301 when others => 1302 return; 1303 end case; 1304 end loop; 1305 end Floating_Minus; 1306 1307 ------------------- 1308 -- Floating_Plus -- 1309 ------------------- 1310 1311 procedure Floating_Plus is 1312 begin 1313 loop 1314 if At_End then 1315 return; 1316 end if; 1317 1318 case Look is 1319 when '_' | '0' | '/' => 1320 Pic.End_Float := Index; 1321 Skip; 1322 1323 when 'B' | 'b' => 1324 Pic.End_Float := Index; 1325 Pic.Picture.Expanded (Index) := 'b'; 1326 Skip; 1327 1328 when '+' => 1329 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1330 Pic.End_Float := Index; 1331 Skip; 1332 1333 when '9' => 1334 Number_Completion; 1335 return; 1336 1337 when '.' | 'V' | 'v' => 1338 Pic.Radix_Position := Index; 1339 Skip; -- Radix 1340 1341 while Is_Insert loop 1342 Skip; 1343 end loop; 1344 1345 if At_End then 1346 return; 1347 end if; 1348 1349 if Look = '+' then 1350 loop 1351 if At_End then 1352 return; 1353 end if; 1354 1355 case Look is 1356 1357 when '+' => 1358 Pic.Max_Trailing_Digits := 1359 Pic.Max_Trailing_Digits + 1; 1360 Pic.End_Float := Index; 1361 Skip; 1362 1363 when '_' | '0' | '/' => 1364 Skip; 1365 1366 when 'B' | 'b' => 1367 Pic.Picture.Expanded (Index) := 'b'; 1368 Skip; 1369 1370 when others => 1371 return; 1372 1373 end case; 1374 end loop; 1375 1376 else 1377 Number_Completion; 1378 end if; 1379 1380 return; 1381 1382 when others => 1383 return; 1384 1385 end case; 1386 end loop; 1387 end Floating_Plus; 1388 1389 --------------- 1390 -- Is_Insert -- 1391 --------------- 1392 1393 function Is_Insert return Boolean is 1394 begin 1395 if At_End then 1396 return False; 1397 end if; 1398 1399 case Pic.Picture.Expanded (Index) is 1400 1401 when '_' | '0' | '/' => return True; 1402 1403 when 'B' | 'b' => 1404 Pic.Picture.Expanded (Index) := 'b'; -- canonical 1405 return True; 1406 1407 when others => return False; 1408 end case; 1409 end Is_Insert; 1410 1411 -------------------- 1412 -- Leading_Dollar -- 1413 -------------------- 1414 1415 -- Note that Leading_Dollar can be called in either State. It will set 1416 -- state to Okay only if a 9 or (second) is encountered. 1417 1418 -- Also notice the tricky bit with State and Zero_Suppression. 1419 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been 1420 -- encountered, exactly the cases where State has been set. 1421 1422 procedure Leading_Dollar is 1423 begin 1424 -- Treat as a floating dollar, and unwind otherwise 1425 1426 Pic.Floater := '$'; 1427 Pic.Start_Currency := Index; 1428 Pic.End_Currency := Index; 1429 Pic.Start_Float := Index; 1430 Pic.End_Float := Index; 1431 1432 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 1433 -- currency place. 1434 1435 Skip; -- known '$' 1436 1437 loop 1438 if At_End then 1439 return; 1440 end if; 1441 1442 case Look is 1443 1444 when '_' | '0' | '/' => 1445 Pic.End_Float := Index; 1446 Skip; 1447 1448 -- A trailing insertion character is not part of the 1449 -- floating currency, so need to look ahead. 1450 1451 if Look /= '$' then 1452 Pic.End_Float := Pic.End_Float - 1; 1453 end if; 1454 1455 when 'B' | 'b' => 1456 Pic.End_Float := Index; 1457 Pic.Picture.Expanded (Index) := 'b'; 1458 Skip; 1459 1460 when 'Z' | 'z' => 1461 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 1462 1463 if State = Okay then 1464 raise Picture_Error; 1465 else 1466 -- Will overwrite Floater and Start_Float 1467 1468 Zero_Suppression; 1469 end if; 1470 1471 when '*' => 1472 if State = Okay then 1473 raise Picture_Error; 1474 else 1475 -- Will overwrite Floater and Start_Float 1476 1477 Star_Suppression; 1478 end if; 1479 1480 when '$' => 1481 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1482 Pic.End_Float := Index; 1483 Pic.End_Currency := Index; 1484 Set_State (Okay); Skip; 1485 1486 when '9' => 1487 if State /= Okay then 1488 Pic.Floater := '!'; 1489 Pic.Start_Float := Invalid_Position; 1490 Pic.End_Float := Invalid_Position; 1491 end if; 1492 1493 -- A single dollar does not a floating make 1494 1495 Number_Completion; 1496 return; 1497 1498 when 'V' | 'v' | '.' => 1499 if State /= Okay then 1500 Pic.Floater := '!'; 1501 Pic.Start_Float := Invalid_Position; 1502 Pic.End_Float := Invalid_Position; 1503 end if; 1504 1505 -- Only one dollar before the sign is okay, but doesn't 1506 -- float. 1507 1508 Pic.Radix_Position := Index; 1509 Skip; 1510 Number_Fraction_Or_Dollar; 1511 return; 1512 1513 when others => 1514 return; 1515 1516 end case; 1517 end loop; 1518 end Leading_Dollar; 1519 1520 ------------------- 1521 -- Leading_Pound -- 1522 ------------------- 1523 1524 -- This one is complex! A Leading_Pound can be fixed or floating, 1525 -- but in some cases the decision has to be deferred until we leave 1526 -- this procedure. Also note that Leading_Pound can be called in 1527 -- either State. 1528 1529 -- It will set state to Okay only if a 9 or (second) # is encountered 1530 1531 -- One Last note: In ambiguous cases, the currency is treated as 1532 -- floating unless there is only one '#'. 1533 1534 procedure Leading_Pound is 1535 1536 Inserts : Boolean := False; 1537 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered 1538 1539 Must_Float : Boolean := False; 1540 -- Set to true if a '#' occurs after an insert 1541 1542 begin 1543 -- Treat as a floating currency. If it isn't, this will be 1544 -- overwritten later. 1545 1546 Pic.Floater := '#'; 1547 1548 Pic.Start_Currency := Index; 1549 Pic.End_Currency := Index; 1550 Pic.Start_Float := Index; 1551 Pic.End_Float := Index; 1552 1553 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 1554 -- currency place. 1555 1556 Pic.Max_Currency_Digits := 1; -- we've seen one. 1557 1558 Skip; -- known '#' 1559 1560 loop 1561 if At_End then 1562 return; 1563 end if; 1564 1565 case Look is 1566 1567 when '_' | '0' | '/' => 1568 Pic.End_Float := Index; 1569 Inserts := True; 1570 Skip; 1571 1572 when 'B' | 'b' => 1573 Pic.Picture.Expanded (Index) := 'b'; 1574 Pic.End_Float := Index; 1575 Inserts := True; 1576 Skip; 1577 1578 when 'Z' | 'z' => 1579 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 1580 1581 if Must_Float then 1582 raise Picture_Error; 1583 else 1584 Pic.Max_Leading_Digits := 0; 1585 1586 -- Will overwrite Floater and Start_Float 1587 1588 Zero_Suppression; 1589 end if; 1590 1591 when '*' => 1592 if Must_Float then 1593 raise Picture_Error; 1594 else 1595 Pic.Max_Leading_Digits := 0; 1596 1597 -- Will overwrite Floater and Start_Float 1598 1599 Star_Suppression; 1600 end if; 1601 1602 when '#' => 1603 if Inserts then 1604 Must_Float := True; 1605 end if; 1606 1607 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1608 Pic.End_Float := Index; 1609 Pic.End_Currency := Index; 1610 Set_State (Okay); 1611 Skip; 1612 1613 when '9' => 1614 if State /= Okay then 1615 1616 -- A single '#' doesn't float 1617 1618 Pic.Floater := '!'; 1619 Pic.Start_Float := Invalid_Position; 1620 Pic.End_Float := Invalid_Position; 1621 end if; 1622 1623 Number_Completion; 1624 return; 1625 1626 when 'V' | 'v' | '.' => 1627 if State /= Okay then 1628 Pic.Floater := '!'; 1629 Pic.Start_Float := Invalid_Position; 1630 Pic.End_Float := Invalid_Position; 1631 end if; 1632 1633 -- Only one pound before the sign is okay, but doesn't 1634 -- float. 1635 1636 Pic.Radix_Position := Index; 1637 Skip; 1638 Number_Fraction_Or_Pound; 1639 return; 1640 1641 when others => 1642 return; 1643 end case; 1644 end loop; 1645 end Leading_Pound; 1646 1647 ---------- 1648 -- Look -- 1649 ---------- 1650 1651 function Look return Character is 1652 begin 1653 if At_End then 1654 raise Picture_Error; 1655 end if; 1656 1657 return Pic.Picture.Expanded (Index); 1658 end Look; 1659 1660 ------------ 1661 -- Number -- 1662 ------------ 1663 1664 procedure Number is 1665 begin 1666 loop 1667 1668 case Look is 1669 when '_' | '0' | '/' => 1670 Skip; 1671 1672 when 'B' | 'b' => 1673 Pic.Picture.Expanded (Index) := 'b'; 1674 Skip; 1675 1676 when '9' => 1677 Computed_BWZ := False; 1678 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1679 Set_State (Okay); 1680 Skip; 1681 1682 when '.' | 'V' | 'v' => 1683 Pic.Radix_Position := Index; 1684 Skip; 1685 Number_Fraction; 1686 return; 1687 1688 when others => 1689 return; 1690 1691 end case; 1692 1693 if At_End then 1694 return; 1695 end if; 1696 1697 -- Will return in Okay state if a '9' was seen 1698 1699 end loop; 1700 end Number; 1701 1702 ----------------------- 1703 -- Number_Completion -- 1704 ----------------------- 1705 1706 procedure Number_Completion is 1707 begin 1708 while not At_End loop 1709 case Look is 1710 1711 when '_' | '0' | '/' => 1712 Skip; 1713 1714 when 'B' | 'b' => 1715 Pic.Picture.Expanded (Index) := 'b'; 1716 Skip; 1717 1718 when '9' => 1719 Computed_BWZ := False; 1720 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1721 Set_State (Okay); 1722 Skip; 1723 1724 when 'V' | 'v' | '.' => 1725 Pic.Radix_Position := Index; 1726 Skip; 1727 Number_Fraction; 1728 return; 1729 1730 when others => 1731 return; 1732 end case; 1733 end loop; 1734 end Number_Completion; 1735 1736 --------------------- 1737 -- Number_Fraction -- 1738 --------------------- 1739 1740 procedure Number_Fraction is 1741 begin 1742 -- Note that number fraction can be called in either State. 1743 -- It will set state to Valid only if a 9 is encountered. 1744 1745 loop 1746 if At_End then 1747 return; 1748 end if; 1749 1750 case Look is 1751 when '_' | '0' | '/' => 1752 Skip; 1753 1754 when 'B' | 'b' => 1755 Pic.Picture.Expanded (Index) := 'b'; 1756 Skip; 1757 1758 when '9' => 1759 Computed_BWZ := False; 1760 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1761 Set_State (Okay); Skip; 1762 1763 when others => 1764 return; 1765 end case; 1766 end loop; 1767 end Number_Fraction; 1768 1769 -------------------------------- 1770 -- Number_Fraction_Or_Bracket -- 1771 -------------------------------- 1772 1773 procedure Number_Fraction_Or_Bracket is 1774 begin 1775 loop 1776 if At_End then 1777 return; 1778 end if; 1779 1780 case Look is 1781 1782 when '_' | '0' | '/' => Skip; 1783 1784 when 'B' | 'b' => 1785 Pic.Picture.Expanded (Index) := 'b'; 1786 Skip; 1787 1788 when '<' => 1789 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1790 Pic.End_Float := Index; 1791 Skip; 1792 1793 loop 1794 if At_End then 1795 return; 1796 end if; 1797 1798 case Look is 1799 when '_' | '0' | '/' => 1800 Skip; 1801 1802 when 'B' | 'b' => 1803 Pic.Picture.Expanded (Index) := 'b'; 1804 Skip; 1805 1806 when '<' => 1807 Pic.Max_Trailing_Digits := 1808 Pic.Max_Trailing_Digits + 1; 1809 Pic.End_Float := Index; 1810 Skip; 1811 1812 when others => 1813 return; 1814 end case; 1815 end loop; 1816 1817 when others => 1818 Number_Fraction; 1819 return; 1820 end case; 1821 end loop; 1822 end Number_Fraction_Or_Bracket; 1823 1824 ------------------------------- 1825 -- Number_Fraction_Or_Dollar -- 1826 ------------------------------- 1827 1828 procedure Number_Fraction_Or_Dollar is 1829 begin 1830 loop 1831 if At_End then 1832 return; 1833 end if; 1834 1835 case Look is 1836 when '_' | '0' | '/' => 1837 Skip; 1838 1839 when 'B' | 'b' => 1840 Pic.Picture.Expanded (Index) := 'b'; 1841 Skip; 1842 1843 when '$' => 1844 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1845 Pic.End_Float := Index; 1846 Skip; 1847 1848 loop 1849 if At_End then 1850 return; 1851 end if; 1852 1853 case Look is 1854 when '_' | '0' | '/' => 1855 Skip; 1856 1857 when 'B' | 'b' => 1858 Pic.Picture.Expanded (Index) := 'b'; 1859 Skip; 1860 1861 when '$' => 1862 Pic.Max_Trailing_Digits := 1863 Pic.Max_Trailing_Digits + 1; 1864 Pic.End_Float := Index; 1865 Skip; 1866 1867 when others => 1868 return; 1869 end case; 1870 end loop; 1871 1872 when others => 1873 Number_Fraction; 1874 return; 1875 end case; 1876 end loop; 1877 end Number_Fraction_Or_Dollar; 1878 1879 ------------------------------ 1880 -- Number_Fraction_Or_Pound -- 1881 ------------------------------ 1882 1883 procedure Number_Fraction_Or_Pound is 1884 begin 1885 loop 1886 if At_End then 1887 return; 1888 end if; 1889 1890 case Look is 1891 1892 when '_' | '0' | '/' => 1893 Skip; 1894 1895 when 'B' | 'b' => 1896 Pic.Picture.Expanded (Index) := 'b'; 1897 Skip; 1898 1899 when '#' => 1900 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1901 Pic.End_Float := Index; 1902 Skip; 1903 1904 loop 1905 if At_End then 1906 return; 1907 end if; 1908 1909 case Look is 1910 1911 when '_' | '0' | '/' => 1912 Skip; 1913 1914 when 'B' | 'b' => 1915 Pic.Picture.Expanded (Index) := 'b'; 1916 Skip; 1917 1918 when '#' => 1919 Pic.Max_Trailing_Digits := 1920 Pic.Max_Trailing_Digits + 1; 1921 Pic.End_Float := Index; 1922 Skip; 1923 1924 when others => 1925 return; 1926 1927 end case; 1928 end loop; 1929 1930 when others => 1931 Number_Fraction; 1932 return; 1933 1934 end case; 1935 end loop; 1936 end Number_Fraction_Or_Pound; 1937 1938 ---------------------------------- 1939 -- Number_Fraction_Or_Star_Fill -- 1940 ---------------------------------- 1941 1942 procedure Number_Fraction_Or_Star_Fill is 1943 begin 1944 loop 1945 if At_End then 1946 return; 1947 end if; 1948 1949 case Look is 1950 1951 when '_' | '0' | '/' => 1952 Skip; 1953 1954 when 'B' | 'b' => 1955 Pic.Picture.Expanded (Index) := 'b'; 1956 Skip; 1957 1958 when '*' => 1959 Pic.Star_Fill := True; 1960 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1961 Pic.End_Float := Index; 1962 Skip; 1963 1964 loop 1965 if At_End then 1966 return; 1967 end if; 1968 1969 case Look is 1970 1971 when '_' | '0' | '/' => 1972 Skip; 1973 1974 when 'B' | 'b' => 1975 Pic.Picture.Expanded (Index) := 'b'; 1976 Skip; 1977 1978 when '*' => 1979 Pic.Star_Fill := True; 1980 Pic.Max_Trailing_Digits := 1981 Pic.Max_Trailing_Digits + 1; 1982 Pic.End_Float := Index; 1983 Skip; 1984 1985 when others => 1986 return; 1987 end case; 1988 end loop; 1989 1990 when others => 1991 Number_Fraction; 1992 return; 1993 1994 end case; 1995 end loop; 1996 end Number_Fraction_Or_Star_Fill; 1997 1998 ------------------------------- 1999 -- Number_Fraction_Or_Z_Fill -- 2000 ------------------------------- 2001 2002 procedure Number_Fraction_Or_Z_Fill is 2003 begin 2004 loop 2005 if At_End then 2006 return; 2007 end if; 2008 2009 case Look is 2010 2011 when '_' | '0' | '/' => 2012 Skip; 2013 2014 when 'B' | 'b' => 2015 Pic.Picture.Expanded (Index) := 'b'; 2016 Skip; 2017 2018 when 'Z' | 'z' => 2019 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 2020 Pic.End_Float := Index; 2021 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2022 2023 Skip; 2024 2025 loop 2026 if At_End then 2027 return; 2028 end if; 2029 2030 case Look is 2031 2032 when '_' | '0' | '/' => 2033 Skip; 2034 2035 when 'B' | 'b' => 2036 Pic.Picture.Expanded (Index) := 'b'; 2037 Skip; 2038 2039 when 'Z' | 'z' => 2040 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2041 2042 Pic.Max_Trailing_Digits := 2043 Pic.Max_Trailing_Digits + 1; 2044 Pic.End_Float := Index; 2045 Skip; 2046 2047 when others => 2048 return; 2049 end case; 2050 end loop; 2051 2052 when others => 2053 Number_Fraction; 2054 return; 2055 end case; 2056 end loop; 2057 end Number_Fraction_Or_Z_Fill; 2058 2059 ----------------------- 2060 -- Optional_RHS_Sign -- 2061 ----------------------- 2062 2063 procedure Optional_RHS_Sign is 2064 begin 2065 if At_End then 2066 return; 2067 end if; 2068 2069 case Look is 2070 2071 when '+' | '-' => 2072 Pic.Sign_Position := Index; 2073 Skip; 2074 return; 2075 2076 when 'C' | 'c' => 2077 Pic.Sign_Position := Index; 2078 Pic.Picture.Expanded (Index) := 'C'; 2079 Skip; 2080 2081 if Look = 'R' or else Look = 'r' then 2082 Pic.Second_Sign := Index; 2083 Pic.Picture.Expanded (Index) := 'R'; 2084 Skip; 2085 2086 else 2087 raise Picture_Error; 2088 end if; 2089 2090 return; 2091 2092 when 'D' | 'd' => 2093 Pic.Sign_Position := Index; 2094 Pic.Picture.Expanded (Index) := 'D'; 2095 Skip; 2096 2097 if Look = 'B' or else Look = 'b' then 2098 Pic.Second_Sign := Index; 2099 Pic.Picture.Expanded (Index) := 'B'; 2100 Skip; 2101 2102 else 2103 raise Picture_Error; 2104 end if; 2105 2106 return; 2107 2108 when '>' => 2109 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then 2110 Pic.Second_Sign := Index; 2111 Skip; 2112 2113 else 2114 raise Picture_Error; 2115 end if; 2116 2117 when others => 2118 return; 2119 2120 end case; 2121 end Optional_RHS_Sign; 2122 2123 ------------- 2124 -- Picture -- 2125 ------------- 2126 2127 -- Note that Picture can be called in either State 2128 2129 -- It will set state to Valid only if a 9 is encountered or floating 2130 -- currency is called. 2131 2132 procedure Picture is 2133 begin 2134 loop 2135 if At_End then 2136 return; 2137 end if; 2138 2139 case Look is 2140 2141 when '_' | '0' | '/' => 2142 Skip; 2143 2144 when 'B' | 'b' => 2145 Pic.Picture.Expanded (Index) := 'b'; 2146 Skip; 2147 2148 when '$' => 2149 Leading_Dollar; 2150 return; 2151 2152 when '#' => 2153 Leading_Pound; 2154 return; 2155 2156 when '9' => 2157 Computed_BWZ := False; 2158 Set_State (Okay); 2159 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2160 Skip; 2161 2162 when 'V' | 'v' | '.' => 2163 Pic.Radix_Position := Index; 2164 Skip; 2165 Number_Fraction; 2166 Trailing_Currency; 2167 return; 2168 2169 when others => 2170 return; 2171 2172 end case; 2173 end loop; 2174 end Picture; 2175 2176 --------------------- 2177 -- Picture_Bracket -- 2178 --------------------- 2179 2180 procedure Picture_Bracket is 2181 begin 2182 Pic.Sign_Position := Index; 2183 Pic.Sign_Position := Index; 2184 2185 -- Treat as a floating sign, and unwind otherwise 2186 2187 Pic.Floater := '<'; 2188 Pic.Start_Float := Index; 2189 Pic.End_Float := Index; 2190 2191 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 2192 -- sign place. 2193 2194 Skip; -- Known Bracket 2195 2196 loop 2197 case Look is 2198 2199 when '_' | '0' | '/' => 2200 Pic.End_Float := Index; 2201 Skip; 2202 2203 when 'B' | 'b' => 2204 Pic.End_Float := Index; 2205 Pic.Picture.Expanded (Index) := 'b'; 2206 Skip; 2207 2208 when '<' => 2209 Set_State (Okay); -- "<<>" is enough. 2210 Floating_Bracket; 2211 Trailing_Currency; 2212 Trailing_Bracket; 2213 return; 2214 2215 when '$' | '#' | '9' | '*' => 2216 if State /= Okay then 2217 Pic.Floater := '!'; 2218 Pic.Start_Float := Invalid_Position; 2219 Pic.End_Float := Invalid_Position; 2220 end if; 2221 2222 Picture; 2223 Trailing_Bracket; 2224 Set_State (Okay); 2225 return; 2226 2227 when '.' | 'V' | 'v' => 2228 if State /= Okay then 2229 Pic.Floater := '!'; 2230 Pic.Start_Float := Invalid_Position; 2231 Pic.End_Float := Invalid_Position; 2232 end if; 2233 2234 -- Don't assume that state is okay, haven't seen a digit 2235 2236 Picture; 2237 Trailing_Bracket; 2238 return; 2239 2240 when others => 2241 raise Picture_Error; 2242 2243 end case; 2244 end loop; 2245 end Picture_Bracket; 2246 2247 ------------------- 2248 -- Picture_Minus -- 2249 ------------------- 2250 2251 procedure Picture_Minus is 2252 begin 2253 Pic.Sign_Position := Index; 2254 2255 -- Treat as a floating sign, and unwind otherwise 2256 2257 Pic.Floater := '-'; 2258 Pic.Start_Float := Index; 2259 Pic.End_Float := Index; 2260 2261 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 2262 -- sign place. 2263 2264 Skip; -- Known Minus 2265 2266 loop 2267 case Look is 2268 2269 when '_' | '0' | '/' => 2270 Pic.End_Float := Index; 2271 Skip; 2272 2273 when 'B' | 'b' => 2274 Pic.End_Float := Index; 2275 Pic.Picture.Expanded (Index) := 'b'; 2276 Skip; 2277 2278 when '-' => 2279 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2280 Pic.End_Float := Index; 2281 Skip; 2282 Set_State (Okay); -- "-- " is enough. 2283 Floating_Minus; 2284 Trailing_Currency; 2285 return; 2286 2287 when '$' | '#' | '9' | '*' => 2288 if State /= Okay then 2289 Pic.Floater := '!'; 2290 Pic.Start_Float := Invalid_Position; 2291 Pic.End_Float := Invalid_Position; 2292 end if; 2293 2294 Picture; 2295 Set_State (Okay); 2296 return; 2297 2298 when 'Z' | 'z' => 2299 2300 -- Can't have Z and a floating sign 2301 2302 if State = Okay then 2303 Set_State (Reject); 2304 end if; 2305 2306 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2307 Zero_Suppression; 2308 Trailing_Currency; 2309 Optional_RHS_Sign; 2310 return; 2311 2312 when '.' | 'V' | 'v' => 2313 if State /= Okay then 2314 Pic.Floater := '!'; 2315 Pic.Start_Float := Invalid_Position; 2316 Pic.End_Float := Invalid_Position; 2317 end if; 2318 2319 -- Don't assume that state is okay, haven't seen a digit 2320 2321 Picture; 2322 return; 2323 2324 when others => 2325 return; 2326 2327 end case; 2328 end loop; 2329 end Picture_Minus; 2330 2331 ------------------ 2332 -- Picture_Plus -- 2333 ------------------ 2334 2335 procedure Picture_Plus is 2336 begin 2337 Pic.Sign_Position := Index; 2338 2339 -- Treat as a floating sign, and unwind otherwise 2340 2341 Pic.Floater := '+'; 2342 Pic.Start_Float := Index; 2343 Pic.End_Float := Index; 2344 2345 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 2346 -- sign place. 2347 2348 Skip; -- Known Plus 2349 2350 loop 2351 case Look is 2352 2353 when '_' | '0' | '/' => 2354 Pic.End_Float := Index; 2355 Skip; 2356 2357 when 'B' | 'b' => 2358 Pic.End_Float := Index; 2359 Pic.Picture.Expanded (Index) := 'b'; 2360 Skip; 2361 2362 when '+' => 2363 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2364 Pic.End_Float := Index; 2365 Skip; 2366 Set_State (Okay); -- "++" is enough 2367 Floating_Plus; 2368 Trailing_Currency; 2369 return; 2370 2371 when '$' | '#' | '9' | '*' => 2372 if State /= Okay then 2373 Pic.Floater := '!'; 2374 Pic.Start_Float := Invalid_Position; 2375 Pic.End_Float := Invalid_Position; 2376 end if; 2377 2378 Picture; 2379 Set_State (Okay); 2380 return; 2381 2382 when 'Z' | 'z' => 2383 if State = Okay then 2384 Set_State (Reject); 2385 end if; 2386 2387 -- Can't have Z and a floating sign 2388 2389 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2390 2391 -- '+Z' is acceptable 2392 2393 Set_State (Okay); 2394 2395 Zero_Suppression; 2396 Trailing_Currency; 2397 Optional_RHS_Sign; 2398 return; 2399 2400 when '.' | 'V' | 'v' => 2401 if State /= Okay then 2402 Pic.Floater := '!'; 2403 Pic.Start_Float := Invalid_Position; 2404 Pic.End_Float := Invalid_Position; 2405 end if; 2406 2407 -- Don't assume that state is okay, haven't seen a digit 2408 2409 Picture; 2410 return; 2411 2412 when others => 2413 return; 2414 2415 end case; 2416 end loop; 2417 end Picture_Plus; 2418 2419 -------------------- 2420 -- Picture_String -- 2421 -------------------- 2422 2423 procedure Picture_String is 2424 begin 2425 while Is_Insert loop 2426 Skip; 2427 end loop; 2428 2429 case Look is 2430 2431 when '$' | '#' => 2432 Picture; 2433 Optional_RHS_Sign; 2434 2435 when '+' => 2436 Picture_Plus; 2437 2438 when '-' => 2439 Picture_Minus; 2440 2441 when '<' => 2442 Picture_Bracket; 2443 2444 when 'Z' | 'z' => 2445 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2446 Zero_Suppression; 2447 Trailing_Currency; 2448 Optional_RHS_Sign; 2449 2450 when '*' => 2451 Star_Suppression; 2452 Trailing_Currency; 2453 Optional_RHS_Sign; 2454 2455 when '9' | '.' | 'V' | 'v' => 2456 Number; 2457 Trailing_Currency; 2458 Optional_RHS_Sign; 2459 2460 when others => 2461 raise Picture_Error; 2462 2463 end case; 2464 2465 -- Blank when zero either if the PIC does not contain a '9' or if 2466 -- requested by the user and no '*'. 2467 2468 Pic.Blank_When_Zero := 2469 (Computed_BWZ or else Pic.Blank_When_Zero) 2470 and then not Pic.Star_Fill; 2471 2472 -- Star fill if '*' and no '9' 2473 2474 Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ; 2475 2476 if not At_End then 2477 Set_State (Reject); 2478 end if; 2479 2480 end Picture_String; 2481 2482 --------------- 2483 -- Set_State -- 2484 --------------- 2485 2486 procedure Set_State (L : Legality) is 2487 begin 2488 State := L; 2489 end Set_State; 2490 2491 ---------- 2492 -- Skip -- 2493 ---------- 2494 2495 procedure Skip is 2496 begin 2497 Index := Index + 1; 2498 end Skip; 2499 2500 ---------------------- 2501 -- Star_Suppression -- 2502 ---------------------- 2503 2504 procedure Star_Suppression is 2505 begin 2506 Pic.Floater := '*'; 2507 Pic.Start_Float := Index; 2508 Pic.End_Float := Index; 2509 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2510 Set_State (Okay); 2511 2512 -- Even a single * is a valid picture 2513 2514 Pic.Star_Fill := True; 2515 Skip; -- Known * 2516 2517 loop 2518 if At_End then 2519 return; 2520 end if; 2521 2522 case Look is 2523 2524 when '_' | '0' | '/' => 2525 Pic.End_Float := Index; 2526 Skip; 2527 2528 when 'B' | 'b' => 2529 Pic.End_Float := Index; 2530 Pic.Picture.Expanded (Index) := 'b'; 2531 Skip; 2532 2533 when '*' => 2534 Pic.End_Float := Index; 2535 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2536 Set_State (Okay); Skip; 2537 2538 when '9' => 2539 Set_State (Okay); 2540 Number_Completion; 2541 return; 2542 2543 when '.' | 'V' | 'v' => 2544 Pic.Radix_Position := Index; 2545 Skip; 2546 Number_Fraction_Or_Star_Fill; 2547 return; 2548 2549 when '#' | '$' => 2550 Trailing_Currency; 2551 Set_State (Okay); 2552 return; 2553 2554 when others => raise Picture_Error; 2555 end case; 2556 end loop; 2557 end Star_Suppression; 2558 2559 ---------------------- 2560 -- Trailing_Bracket -- 2561 ---------------------- 2562 2563 procedure Trailing_Bracket is 2564 begin 2565 if Look = '>' then 2566 Pic.Second_Sign := Index; 2567 Skip; 2568 else 2569 raise Picture_Error; 2570 end if; 2571 end Trailing_Bracket; 2572 2573 ----------------------- 2574 -- Trailing_Currency -- 2575 ----------------------- 2576 2577 procedure Trailing_Currency is 2578 begin 2579 if At_End then 2580 return; 2581 end if; 2582 2583 if Look = '$' then 2584 Pic.Start_Currency := Index; 2585 Pic.End_Currency := Index; 2586 Skip; 2587 2588 else 2589 while not At_End and then Look = '#' loop 2590 if Pic.Start_Currency = Invalid_Position then 2591 Pic.Start_Currency := Index; 2592 end if; 2593 2594 Pic.End_Currency := Index; 2595 Skip; 2596 end loop; 2597 end if; 2598 2599 loop 2600 if At_End then 2601 return; 2602 end if; 2603 2604 case Look is 2605 when '_' | '0' | '/' => Skip; 2606 2607 when 'B' | 'b' => 2608 Pic.Picture.Expanded (Index) := 'b'; 2609 Skip; 2610 2611 when others => return; 2612 end case; 2613 end loop; 2614 end Trailing_Currency; 2615 2616 ---------------------- 2617 -- Zero_Suppression -- 2618 ---------------------- 2619 2620 procedure Zero_Suppression is 2621 begin 2622 Pic.Floater := 'Z'; 2623 Pic.Start_Float := Index; 2624 Pic.End_Float := Index; 2625 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2626 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2627 2628 Skip; -- Known Z 2629 2630 loop 2631 -- Even a single Z is a valid picture 2632 2633 if At_End then 2634 Set_State (Okay); 2635 return; 2636 end if; 2637 2638 case Look is 2639 when '_' | '0' | '/' => 2640 Pic.End_Float := Index; 2641 Skip; 2642 2643 when 'B' | 'b' => 2644 Pic.End_Float := Index; 2645 Pic.Picture.Expanded (Index) := 'b'; 2646 Skip; 2647 2648 when 'Z' | 'z' => 2649 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2650 2651 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2652 Pic.End_Float := Index; 2653 Set_State (Okay); 2654 Skip; 2655 2656 when '9' => 2657 Set_State (Okay); 2658 Number_Completion; 2659 return; 2660 2661 when '.' | 'V' | 'v' => 2662 Pic.Radix_Position := Index; 2663 Skip; 2664 Number_Fraction_Or_Z_Fill; 2665 return; 2666 2667 when '#' | '$' => 2668 Trailing_Currency; 2669 Set_State (Okay); 2670 return; 2671 2672 when others => 2673 return; 2674 end case; 2675 end loop; 2676 end Zero_Suppression; 2677 2678 -- Start of processing for Precalculate 2679 2680 begin 2681 Picture_String; 2682 2683 if State = Reject then 2684 raise Picture_Error; 2685 end if; 2686 2687 exception 2688 2689 when Constraint_Error => 2690 2691 -- To deal with special cases like null strings 2692 2693 raise Picture_Error; 2694 2695 end Precalculate; 2696 2697 ---------------- 2698 -- To_Picture -- 2699 ---------------- 2700 2701 function To_Picture 2702 (Pic_String : String; 2703 Blank_When_Zero : Boolean := False) return Picture 2704 is 2705 Result : Picture; 2706 2707 begin 2708 declare 2709 Item : constant String := Expand (Pic_String); 2710 2711 begin 2712 Result.Contents.Picture := (Item'Length, Item); 2713 Result.Contents.Original_BWZ := Blank_When_Zero; 2714 Result.Contents.Blank_When_Zero := Blank_When_Zero; 2715 Precalculate (Result.Contents); 2716 return Result; 2717 end; 2718 2719 exception 2720 when others => 2721 raise Picture_Error; 2722 2723 end To_Picture; 2724 2725 ------------- 2726 -- To_Wide -- 2727 ------------- 2728 2729 function To_Wide (C : Character) return Wide_Wide_Character is 2730 begin 2731 return Wide_Wide_Character'Val (Character'Pos (C)); 2732 end To_Wide; 2733 2734 ----------- 2735 -- Valid -- 2736 ----------- 2737 2738 function Valid 2739 (Pic_String : String; 2740 Blank_When_Zero : Boolean := False) return Boolean 2741 is 2742 begin 2743 declare 2744 Expanded_Pic : constant String := Expand (Pic_String); 2745 -- Raises Picture_Error if Item not well-formed 2746 2747 Format_Rec : Format_Record; 2748 2749 begin 2750 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic); 2751 Format_Rec.Blank_When_Zero := Blank_When_Zero; 2752 Format_Rec.Original_BWZ := Blank_When_Zero; 2753 Precalculate (Format_Rec); 2754 2755 -- False only if Blank_When_0 is True but the pic string has a '*' 2756 2757 return not Blank_When_Zero 2758 or else Strings_Fixed.Index (Expanded_Pic, "*") = 0; 2759 end; 2760 2761 exception 2762 when others => return False; 2763 end Valid; 2764 2765end Ada.Wide_Wide_Text_IO.Editing; 2766