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-2013, 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 797 and then Answer (Pic.Start_Currency) = '#' 798 then 799 Currency_Pos := 1; 800 end if; 801 802 -- Note: There are some weird cases J can imagine with 'b' or '#' 803 -- in currency strings where the following code will cause 804 -- glitches. The trick is to tell when the character in the 805 -- answer should be checked, and when to look at the original 806 -- string. Some other time. RIE 11/26/96 ??? 807 808 case Answer (J) is 809 when '*' => 810 Answer (J) := Fill_Character; 811 812 when 'b' => 813 Answer (J) := ' '; 814 815 when '#' => 816 if Currency_Pos > Currency_Symbol'Length then 817 Answer (J) := ' '; 818 819 else 820 Answer (J) := Currency_Symbol (Currency_Pos); 821 Currency_Pos := Currency_Pos + 1; 822 end if; 823 824 when '_' => 825 826 case Pic.Floater is 827 828 when '*' => 829 Answer (J) := Fill_Character; 830 831 when 'Z' | 'z' => 832 Answer (J) := ' '; 833 834 when '#' => 835 if Currency_Pos > Currency_Symbol'Length then 836 Answer (J) := ' '; 837 else 838 Answer (J) := Currency_Symbol (Currency_Pos); 839 Currency_Pos := Currency_Pos + 1; 840 end if; 841 842 when others => 843 null; 844 845 end case; 846 847 when others => 848 exit; 849 850 end case; 851 end loop; 852 853 -- Now get rid of Blank_when_Zero and complete Star fill 854 855 if Zero and then Pic.Blank_When_Zero then 856 857 -- Value is zero, and blank it 858 859 Last := Answer'Last; 860 861 if Dollar then 862 Last := Last - 1 + Currency_Symbol'Length; 863 end if; 864 865 if Pic.Radix_Position /= Invalid_Position 866 and then Answer (Pic.Radix_Position) = 'V' 867 then 868 Last := Last - 1; 869 end if; 870 871 return Wide_Wide_String'(1 .. Last => ' '); 872 873 elsif Zero and then Pic.Star_Fill then 874 Last := Answer'Last; 875 876 if Dollar then 877 Last := Last - 1 + Currency_Symbol'Length; 878 end if; 879 880 if Pic.Radix_Position /= Invalid_Position then 881 882 if Answer (Pic.Radix_Position) = 'V' then 883 Last := Last - 1; 884 885 elsif Dollar then 886 if Pic.Radix_Position > Pic.Start_Currency then 887 return 888 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') & 889 Radix_Point & 890 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*'); 891 892 else 893 return 894 Wide_Wide_String' 895 (1 .. 896 Pic.Radix_Position + Currency_Symbol'Length - 2 897 => '*') & 898 Radix_Point & 899 Wide_Wide_String' 900 (Pic.Radix_Position + Currency_Symbol'Length .. Last 901 => '*'); 902 end if; 903 904 else 905 return 906 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') & 907 Radix_Point & 908 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*'); 909 end if; 910 end if; 911 912 return Wide_Wide_String'(1 .. Last => '*'); 913 end if; 914 915 -- This was once a simple return statement, now there are nine different 916 -- return cases. Not to mention the five above to deal with zeros. Why 917 -- not split things out? 918 919 -- Processing the radix and sign expansion separately would require 920 -- lots of copying--the string and some of its indexes--without 921 -- really simplifying the logic. The cases are: 922 923 -- 1) Expand $, replace '.' with Radix_Point 924 -- 2) No currency expansion, replace '.' with Radix_Point 925 -- 3) Expand $, radix blanked 926 -- 4) No currency expansion, radix blanked 927 -- 5) Elide V 928 -- 6) Expand $, Elide V 929 -- 7) Elide V, Expand $ (Two cases depending on order.) 930 -- 8) No radix, expand $ 931 -- 9) No radix, no currency expansion 932 933 if Pic.Radix_Position /= Invalid_Position then 934 935 if Answer (Pic.Radix_Position) = '.' then 936 Answer (Pic.Radix_Position) := Radix_Point; 937 938 if Dollar then 939 940 -- 1) Expand $, replace '.' with Radix_Point 941 942 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 943 Answer (Currency_Pos + 1 .. Answer'Last); 944 945 else 946 -- 2) No currency expansion, replace '.' with Radix_Point 947 948 return Answer; 949 end if; 950 951 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix. 952 if Dollar then 953 954 -- 3) Expand $, radix blanked 955 956 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 957 Answer (Currency_Pos + 1 .. Answer'Last); 958 959 else 960 -- 4) No expansion, radix blanked 961 962 return Answer; 963 end if; 964 965 -- V cases 966 967 else 968 if not Dollar then 969 970 -- 5) Elide V 971 972 return Answer (1 .. Pic.Radix_Position - 1) & 973 Answer (Pic.Radix_Position + 1 .. Answer'Last); 974 975 elsif Currency_Pos < Pic.Radix_Position then 976 977 -- 6) Expand $, Elide V 978 979 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 980 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) & 981 Answer (Pic.Radix_Position + 1 .. Answer'Last); 982 983 else 984 -- 7) Elide V, Expand $ 985 986 return Answer (1 .. Pic.Radix_Position - 1) & 987 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) & 988 Currency_Symbol & 989 Answer (Currency_Pos + 1 .. Answer'Last); 990 end if; 991 end if; 992 993 elsif Dollar then 994 995 -- 8) No radix, expand $ 996 997 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & 998 Answer (Currency_Pos + 1 .. Answer'Last); 999 1000 else 1001 -- 9) No radix, no currency expansion 1002 1003 return Answer; 1004 end if; 1005 end Format_Number; 1006 1007 ------------------------- 1008 -- Parse_Number_String -- 1009 ------------------------- 1010 1011 function Parse_Number_String (Str : String) return Number_Attributes is 1012 Answer : Number_Attributes; 1013 1014 begin 1015 for J in Str'Range loop 1016 case Str (J) is 1017 1018 when ' ' => 1019 null; -- ignore 1020 1021 when '1' .. '9' => 1022 1023 -- Decide if this is the start of a number. 1024 -- If so, figure out which one... 1025 1026 if Answer.Has_Fraction then 1027 Answer.End_Of_Fraction := J; 1028 else 1029 if Answer.Start_Of_Int = Invalid_Position then 1030 -- start integer 1031 Answer.Start_Of_Int := J; 1032 end if; 1033 Answer.End_Of_Int := J; 1034 end if; 1035 1036 when '0' => 1037 1038 -- Only count a zero before the decimal point if it follows a 1039 -- non-zero digit. After the decimal point, zeros will be 1040 -- counted if followed by a non-zero digit. 1041 1042 if not Answer.Has_Fraction then 1043 if Answer.Start_Of_Int /= Invalid_Position then 1044 Answer.End_Of_Int := J; 1045 end if; 1046 end if; 1047 1048 when '-' => 1049 1050 -- Set negative 1051 1052 Answer.Negative := True; 1053 1054 when '.' => 1055 1056 -- Close integer, start fraction 1057 1058 if Answer.Has_Fraction then 1059 raise Picture_Error; 1060 end if; 1061 1062 -- Two decimal points is a no-no 1063 1064 Answer.Has_Fraction := True; 1065 Answer.End_Of_Fraction := J; 1066 1067 -- Could leave this at Invalid_Position, but this seems the 1068 -- right way to indicate a null range... 1069 1070 Answer.Start_Of_Fraction := J + 1; 1071 Answer.End_Of_Int := J - 1; 1072 1073 when others => 1074 raise Picture_Error; -- can this happen? probably not 1075 end case; 1076 end loop; 1077 1078 if Answer.Start_Of_Int = Invalid_Position then 1079 Answer.Start_Of_Int := Answer.End_Of_Int + 1; 1080 end if; 1081 1082 -- No significant (intger) digits needs a null range 1083 1084 return Answer; 1085 end Parse_Number_String; 1086 1087 ---------------- 1088 -- Pic_String -- 1089 ---------------- 1090 1091 -- The following ensures that we return B and not b being careful not 1092 -- to break things which expect lower case b for blank. See CXF3A02. 1093 1094 function Pic_String (Pic : Picture) return String is 1095 Temp : String (1 .. Pic.Contents.Picture.Length) := 1096 Pic.Contents.Picture.Expanded; 1097 begin 1098 for J in Temp'Range loop 1099 if Temp (J) = 'b' then 1100 Temp (J) := 'B'; 1101 end if; 1102 end loop; 1103 1104 return Temp; 1105 end Pic_String; 1106 1107 ------------------ 1108 -- Precalculate -- 1109 ------------------ 1110 1111 procedure Precalculate (Pic : in out Format_Record) is 1112 1113 Computed_BWZ : Boolean := True; 1114 1115 type Legality is (Okay, Reject); 1116 State : Legality := Reject; 1117 -- Start in reject, which will reject null strings 1118 1119 Index : Pic_Index := Pic.Picture.Expanded'First; 1120 1121 function At_End return Boolean; 1122 pragma Inline (At_End); 1123 1124 procedure Set_State (L : Legality); 1125 pragma Inline (Set_State); 1126 1127 function Look return Character; 1128 pragma Inline (Look); 1129 1130 function Is_Insert return Boolean; 1131 pragma Inline (Is_Insert); 1132 1133 procedure Skip; 1134 pragma Inline (Skip); 1135 1136 procedure Trailing_Currency; 1137 procedure Trailing_Bracket; 1138 procedure Number_Fraction; 1139 procedure Number_Completion; 1140 procedure Number_Fraction_Or_Bracket; 1141 procedure Number_Fraction_Or_Z_Fill; 1142 procedure Zero_Suppression; 1143 procedure Floating_Bracket; 1144 procedure Number_Fraction_Or_Star_Fill; 1145 procedure Star_Suppression; 1146 procedure Number_Fraction_Or_Dollar; 1147 procedure Leading_Dollar; 1148 procedure Number_Fraction_Or_Pound; 1149 procedure Leading_Pound; 1150 procedure Picture; 1151 procedure Floating_Plus; 1152 procedure Floating_Minus; 1153 procedure Picture_Plus; 1154 procedure Picture_Minus; 1155 procedure Picture_Bracket; 1156 procedure Number; 1157 procedure Optional_RHS_Sign; 1158 procedure Picture_String; 1159 1160 ------------ 1161 -- At_End -- 1162 ------------ 1163 1164 function At_End return Boolean is 1165 begin 1166 return Index > Pic.Picture.Length; 1167 end At_End; 1168 1169 ---------------------- 1170 -- Floating_Bracket -- 1171 ---------------------- 1172 1173 -- Note that Floating_Bracket is only called with an acceptable 1174 -- prefix. But we don't set Okay, because we must end with a '>'. 1175 1176 procedure Floating_Bracket is 1177 begin 1178 Pic.Floater := '<'; 1179 Pic.End_Float := Index; 1180 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1181 1182 -- First bracket wasn't counted... 1183 1184 Skip; -- known '<' 1185 1186 loop 1187 if At_End then 1188 return; 1189 end if; 1190 1191 case Look is 1192 1193 when '_' | '0' | '/' => 1194 Pic.End_Float := Index; 1195 Skip; 1196 1197 when 'B' | 'b' => 1198 Pic.End_Float := Index; 1199 Pic.Picture.Expanded (Index) := 'b'; 1200 Skip; 1201 1202 when '<' => 1203 Pic.End_Float := Index; 1204 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1205 Skip; 1206 1207 when '9' => 1208 Number_Completion; 1209 1210 when '$' => 1211 Leading_Dollar; 1212 1213 when '#' => 1214 Leading_Pound; 1215 1216 when 'V' | 'v' | '.' => 1217 Pic.Radix_Position := Index; 1218 Skip; 1219 Number_Fraction_Or_Bracket; 1220 return; 1221 1222 when others => 1223 return; 1224 end case; 1225 end loop; 1226 end Floating_Bracket; 1227 1228 -------------------- 1229 -- Floating_Minus -- 1230 -------------------- 1231 1232 procedure Floating_Minus is 1233 begin 1234 loop 1235 if At_End then 1236 return; 1237 end if; 1238 1239 case Look is 1240 when '_' | '0' | '/' => 1241 Pic.End_Float := Index; 1242 Skip; 1243 1244 when 'B' | 'b' => 1245 Pic.End_Float := Index; 1246 Pic.Picture.Expanded (Index) := 'b'; 1247 Skip; 1248 1249 when '-' => 1250 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1251 Pic.End_Float := Index; 1252 Skip; 1253 1254 when '9' => 1255 Number_Completion; 1256 return; 1257 1258 when '.' | 'V' | 'v' => 1259 Pic.Radix_Position := Index; 1260 Skip; -- Radix 1261 1262 while Is_Insert loop 1263 Skip; 1264 end loop; 1265 1266 if At_End then 1267 return; 1268 end if; 1269 1270 if Look = '-' then 1271 loop 1272 if At_End then 1273 return; 1274 end if; 1275 1276 case Look is 1277 1278 when '-' => 1279 Pic.Max_Trailing_Digits := 1280 Pic.Max_Trailing_Digits + 1; 1281 Pic.End_Float := Index; 1282 Skip; 1283 1284 when '_' | '0' | '/' => 1285 Skip; 1286 1287 when 'B' | 'b' => 1288 Pic.Picture.Expanded (Index) := 'b'; 1289 Skip; 1290 1291 when others => 1292 return; 1293 1294 end case; 1295 end loop; 1296 1297 else 1298 Number_Completion; 1299 end if; 1300 1301 return; 1302 1303 when others => 1304 return; 1305 end case; 1306 end loop; 1307 end Floating_Minus; 1308 1309 ------------------- 1310 -- Floating_Plus -- 1311 ------------------- 1312 1313 procedure Floating_Plus is 1314 begin 1315 loop 1316 if At_End then 1317 return; 1318 end if; 1319 1320 case Look is 1321 when '_' | '0' | '/' => 1322 Pic.End_Float := Index; 1323 Skip; 1324 1325 when 'B' | 'b' => 1326 Pic.End_Float := Index; 1327 Pic.Picture.Expanded (Index) := 'b'; 1328 Skip; 1329 1330 when '+' => 1331 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1332 Pic.End_Float := Index; 1333 Skip; 1334 1335 when '9' => 1336 Number_Completion; 1337 return; 1338 1339 when '.' | 'V' | 'v' => 1340 Pic.Radix_Position := Index; 1341 Skip; -- Radix 1342 1343 while Is_Insert loop 1344 Skip; 1345 end loop; 1346 1347 if At_End then 1348 return; 1349 end if; 1350 1351 if Look = '+' then 1352 loop 1353 if At_End then 1354 return; 1355 end if; 1356 1357 case Look is 1358 1359 when '+' => 1360 Pic.Max_Trailing_Digits := 1361 Pic.Max_Trailing_Digits + 1; 1362 Pic.End_Float := Index; 1363 Skip; 1364 1365 when '_' | '0' | '/' => 1366 Skip; 1367 1368 when 'B' | 'b' => 1369 Pic.Picture.Expanded (Index) := 'b'; 1370 Skip; 1371 1372 when others => 1373 return; 1374 1375 end case; 1376 end loop; 1377 1378 else 1379 Number_Completion; 1380 end if; 1381 1382 return; 1383 1384 when others => 1385 return; 1386 1387 end case; 1388 end loop; 1389 end Floating_Plus; 1390 1391 --------------- 1392 -- Is_Insert -- 1393 --------------- 1394 1395 function Is_Insert return Boolean is 1396 begin 1397 if At_End then 1398 return False; 1399 end if; 1400 1401 case Pic.Picture.Expanded (Index) is 1402 1403 when '_' | '0' | '/' => return True; 1404 1405 when 'B' | 'b' => 1406 Pic.Picture.Expanded (Index) := 'b'; -- canonical 1407 return True; 1408 1409 when others => return False; 1410 end case; 1411 end Is_Insert; 1412 1413 -------------------- 1414 -- Leading_Dollar -- 1415 -------------------- 1416 1417 -- Note that Leading_Dollar can be called in either State. It will set 1418 -- state to Okay only if a 9 or (second) is encountered. 1419 1420 -- Also notice the tricky bit with State and Zero_Suppression. 1421 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been 1422 -- encountered, exactly the cases where State has been set. 1423 1424 procedure Leading_Dollar is 1425 begin 1426 -- Treat as a floating dollar, and unwind otherwise 1427 1428 Pic.Floater := '$'; 1429 Pic.Start_Currency := Index; 1430 Pic.End_Currency := Index; 1431 Pic.Start_Float := Index; 1432 Pic.End_Float := Index; 1433 1434 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 1435 -- currency place. 1436 1437 Skip; -- known '$' 1438 1439 loop 1440 if At_End then 1441 return; 1442 end if; 1443 1444 case Look is 1445 1446 when '_' | '0' | '/' => 1447 Pic.End_Float := Index; 1448 Skip; 1449 1450 -- A trailing insertion character is not part of the 1451 -- floating currency, so need to look ahead. 1452 1453 if Look /= '$' then 1454 Pic.End_Float := Pic.End_Float - 1; 1455 end if; 1456 1457 when 'B' | 'b' => 1458 Pic.End_Float := Index; 1459 Pic.Picture.Expanded (Index) := 'b'; 1460 Skip; 1461 1462 when 'Z' | 'z' => 1463 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 1464 1465 if State = Okay then 1466 raise Picture_Error; 1467 else 1468 -- Will overwrite Floater and Start_Float 1469 1470 Zero_Suppression; 1471 end if; 1472 1473 when '*' => 1474 if State = Okay then 1475 raise Picture_Error; 1476 else 1477 -- Will overwrite Floater and Start_Float 1478 1479 Star_Suppression; 1480 end if; 1481 1482 when '$' => 1483 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1484 Pic.End_Float := Index; 1485 Pic.End_Currency := Index; 1486 Set_State (Okay); Skip; 1487 1488 when '9' => 1489 if State /= Okay then 1490 Pic.Floater := '!'; 1491 Pic.Start_Float := Invalid_Position; 1492 Pic.End_Float := Invalid_Position; 1493 end if; 1494 1495 -- A single dollar does not a floating make 1496 1497 Number_Completion; 1498 return; 1499 1500 when 'V' | 'v' | '.' => 1501 if State /= Okay then 1502 Pic.Floater := '!'; 1503 Pic.Start_Float := Invalid_Position; 1504 Pic.End_Float := Invalid_Position; 1505 end if; 1506 1507 -- Only one dollar before the sign is okay, but doesn't 1508 -- float. 1509 1510 Pic.Radix_Position := Index; 1511 Skip; 1512 Number_Fraction_Or_Dollar; 1513 return; 1514 1515 when others => 1516 return; 1517 1518 end case; 1519 end loop; 1520 end Leading_Dollar; 1521 1522 ------------------- 1523 -- Leading_Pound -- 1524 ------------------- 1525 1526 -- This one is complex. A Leading_Pound can be fixed or floating, but 1527 -- in some cases the decision has to be deferred until we leave this 1528 -- procedure. Also note that Leading_Pound can be called in either 1529 -- State. 1530 1531 -- It will set state to Okay only if a 9 or (second) # is encountered 1532 1533 -- One Last note: In ambiguous cases, the currency is treated as 1534 -- floating unless there is only one '#'. 1535 1536 procedure Leading_Pound is 1537 1538 Inserts : Boolean := False; 1539 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered 1540 1541 Must_Float : Boolean := False; 1542 -- Set to true if a '#' occurs after an insert 1543 1544 begin 1545 -- Treat as a floating currency. If it isn't, this will be 1546 -- overwritten later. 1547 1548 Pic.Floater := '#'; 1549 1550 Pic.Start_Currency := Index; 1551 Pic.End_Currency := Index; 1552 Pic.Start_Float := Index; 1553 Pic.End_Float := Index; 1554 1555 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 1556 -- currency place. 1557 1558 Pic.Max_Currency_Digits := 1; -- we've seen one. 1559 1560 Skip; -- known '#' 1561 1562 loop 1563 if At_End then 1564 return; 1565 end if; 1566 1567 case Look is 1568 1569 when '_' | '0' | '/' => 1570 Pic.End_Float := Index; 1571 Inserts := True; 1572 Skip; 1573 1574 when 'B' | 'b' => 1575 Pic.Picture.Expanded (Index) := 'b'; 1576 Pic.End_Float := Index; 1577 Inserts := True; 1578 Skip; 1579 1580 when 'Z' | 'z' => 1581 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 1582 1583 if Must_Float then 1584 raise Picture_Error; 1585 else 1586 Pic.Max_Leading_Digits := 0; 1587 1588 -- Will overwrite Floater and Start_Float 1589 1590 Zero_Suppression; 1591 end if; 1592 1593 when '*' => 1594 if Must_Float then 1595 raise Picture_Error; 1596 else 1597 Pic.Max_Leading_Digits := 0; 1598 1599 -- Will overwrite Floater and Start_Float 1600 1601 Star_Suppression; 1602 end if; 1603 1604 when '#' => 1605 if Inserts then 1606 Must_Float := True; 1607 end if; 1608 1609 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1610 Pic.End_Float := Index; 1611 Pic.End_Currency := Index; 1612 Set_State (Okay); 1613 Skip; 1614 1615 when '9' => 1616 if State /= Okay then 1617 1618 -- A single '#' doesn't float 1619 1620 Pic.Floater := '!'; 1621 Pic.Start_Float := Invalid_Position; 1622 Pic.End_Float := Invalid_Position; 1623 end if; 1624 1625 Number_Completion; 1626 return; 1627 1628 when 'V' | 'v' | '.' => 1629 if State /= Okay then 1630 Pic.Floater := '!'; 1631 Pic.Start_Float := Invalid_Position; 1632 Pic.End_Float := Invalid_Position; 1633 end if; 1634 1635 -- Only one pound before the sign is okay, but doesn't 1636 -- float. 1637 1638 Pic.Radix_Position := Index; 1639 Skip; 1640 Number_Fraction_Or_Pound; 1641 return; 1642 1643 when others => 1644 return; 1645 end case; 1646 end loop; 1647 end Leading_Pound; 1648 1649 ---------- 1650 -- Look -- 1651 ---------- 1652 1653 function Look return Character is 1654 begin 1655 if At_End then 1656 raise Picture_Error; 1657 end if; 1658 1659 return Pic.Picture.Expanded (Index); 1660 end Look; 1661 1662 ------------ 1663 -- Number -- 1664 ------------ 1665 1666 procedure Number is 1667 begin 1668 loop 1669 1670 case Look is 1671 when '_' | '0' | '/' => 1672 Skip; 1673 1674 when 'B' | 'b' => 1675 Pic.Picture.Expanded (Index) := 'b'; 1676 Skip; 1677 1678 when '9' => 1679 Computed_BWZ := False; 1680 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1681 Set_State (Okay); 1682 Skip; 1683 1684 when '.' | 'V' | 'v' => 1685 Pic.Radix_Position := Index; 1686 Skip; 1687 Number_Fraction; 1688 return; 1689 1690 when others => 1691 return; 1692 1693 end case; 1694 1695 if At_End then 1696 return; 1697 end if; 1698 1699 -- Will return in Okay state if a '9' was seen 1700 1701 end loop; 1702 end Number; 1703 1704 ----------------------- 1705 -- Number_Completion -- 1706 ----------------------- 1707 1708 procedure Number_Completion is 1709 begin 1710 while not At_End loop 1711 case Look is 1712 1713 when '_' | '0' | '/' => 1714 Skip; 1715 1716 when 'B' | 'b' => 1717 Pic.Picture.Expanded (Index) := 'b'; 1718 Skip; 1719 1720 when '9' => 1721 Computed_BWZ := False; 1722 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 1723 Set_State (Okay); 1724 Skip; 1725 1726 when 'V' | 'v' | '.' => 1727 Pic.Radix_Position := Index; 1728 Skip; 1729 Number_Fraction; 1730 return; 1731 1732 when others => 1733 return; 1734 end case; 1735 end loop; 1736 end Number_Completion; 1737 1738 --------------------- 1739 -- Number_Fraction -- 1740 --------------------- 1741 1742 procedure Number_Fraction is 1743 begin 1744 -- Note that number fraction can be called in either State. 1745 -- It will set state to Valid only if a 9 is encountered. 1746 1747 loop 1748 if At_End then 1749 return; 1750 end if; 1751 1752 case Look is 1753 when '_' | '0' | '/' => 1754 Skip; 1755 1756 when 'B' | 'b' => 1757 Pic.Picture.Expanded (Index) := 'b'; 1758 Skip; 1759 1760 when '9' => 1761 Computed_BWZ := False; 1762 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1763 Set_State (Okay); Skip; 1764 1765 when others => 1766 return; 1767 end case; 1768 end loop; 1769 end Number_Fraction; 1770 1771 -------------------------------- 1772 -- Number_Fraction_Or_Bracket -- 1773 -------------------------------- 1774 1775 procedure Number_Fraction_Or_Bracket is 1776 begin 1777 loop 1778 if At_End then 1779 return; 1780 end if; 1781 1782 case Look is 1783 1784 when '_' | '0' | '/' => Skip; 1785 1786 when 'B' | 'b' => 1787 Pic.Picture.Expanded (Index) := 'b'; 1788 Skip; 1789 1790 when '<' => 1791 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1792 Pic.End_Float := Index; 1793 Skip; 1794 1795 loop 1796 if At_End then 1797 return; 1798 end if; 1799 1800 case Look is 1801 when '_' | '0' | '/' => 1802 Skip; 1803 1804 when 'B' | 'b' => 1805 Pic.Picture.Expanded (Index) := 'b'; 1806 Skip; 1807 1808 when '<' => 1809 Pic.Max_Trailing_Digits := 1810 Pic.Max_Trailing_Digits + 1; 1811 Pic.End_Float := Index; 1812 Skip; 1813 1814 when others => 1815 return; 1816 end case; 1817 end loop; 1818 1819 when others => 1820 Number_Fraction; 1821 return; 1822 end case; 1823 end loop; 1824 end Number_Fraction_Or_Bracket; 1825 1826 ------------------------------- 1827 -- Number_Fraction_Or_Dollar -- 1828 ------------------------------- 1829 1830 procedure Number_Fraction_Or_Dollar is 1831 begin 1832 loop 1833 if At_End then 1834 return; 1835 end if; 1836 1837 case Look is 1838 when '_' | '0' | '/' => 1839 Skip; 1840 1841 when 'B' | 'b' => 1842 Pic.Picture.Expanded (Index) := 'b'; 1843 Skip; 1844 1845 when '$' => 1846 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1847 Pic.End_Float := Index; 1848 Skip; 1849 1850 loop 1851 if At_End then 1852 return; 1853 end if; 1854 1855 case Look is 1856 when '_' | '0' | '/' => 1857 Skip; 1858 1859 when 'B' | 'b' => 1860 Pic.Picture.Expanded (Index) := 'b'; 1861 Skip; 1862 1863 when '$' => 1864 Pic.Max_Trailing_Digits := 1865 Pic.Max_Trailing_Digits + 1; 1866 Pic.End_Float := Index; 1867 Skip; 1868 1869 when others => 1870 return; 1871 end case; 1872 end loop; 1873 1874 when others => 1875 Number_Fraction; 1876 return; 1877 end case; 1878 end loop; 1879 end Number_Fraction_Or_Dollar; 1880 1881 ------------------------------ 1882 -- Number_Fraction_Or_Pound -- 1883 ------------------------------ 1884 1885 procedure Number_Fraction_Or_Pound is 1886 begin 1887 loop 1888 if At_End then 1889 return; 1890 end if; 1891 1892 case Look is 1893 1894 when '_' | '0' | '/' => 1895 Skip; 1896 1897 when 'B' | 'b' => 1898 Pic.Picture.Expanded (Index) := 'b'; 1899 Skip; 1900 1901 when '#' => 1902 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1903 Pic.End_Float := Index; 1904 Skip; 1905 1906 loop 1907 if At_End then 1908 return; 1909 end if; 1910 1911 case Look is 1912 1913 when '_' | '0' | '/' => 1914 Skip; 1915 1916 when 'B' | 'b' => 1917 Pic.Picture.Expanded (Index) := 'b'; 1918 Skip; 1919 1920 when '#' => 1921 Pic.Max_Trailing_Digits := 1922 Pic.Max_Trailing_Digits + 1; 1923 Pic.End_Float := Index; 1924 Skip; 1925 1926 when others => 1927 return; 1928 1929 end case; 1930 end loop; 1931 1932 when others => 1933 Number_Fraction; 1934 return; 1935 1936 end case; 1937 end loop; 1938 end Number_Fraction_Or_Pound; 1939 1940 ---------------------------------- 1941 -- Number_Fraction_Or_Star_Fill -- 1942 ---------------------------------- 1943 1944 procedure Number_Fraction_Or_Star_Fill is 1945 begin 1946 loop 1947 if At_End then 1948 return; 1949 end if; 1950 1951 case Look is 1952 1953 when '_' | '0' | '/' => 1954 Skip; 1955 1956 when 'B' | 'b' => 1957 Pic.Picture.Expanded (Index) := 'b'; 1958 Skip; 1959 1960 when '*' => 1961 Pic.Star_Fill := True; 1962 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 1963 Pic.End_Float := Index; 1964 Skip; 1965 1966 loop 1967 if At_End then 1968 return; 1969 end if; 1970 1971 case Look is 1972 1973 when '_' | '0' | '/' => 1974 Skip; 1975 1976 when 'B' | 'b' => 1977 Pic.Picture.Expanded (Index) := 'b'; 1978 Skip; 1979 1980 when '*' => 1981 Pic.Star_Fill := True; 1982 Pic.Max_Trailing_Digits := 1983 Pic.Max_Trailing_Digits + 1; 1984 Pic.End_Float := Index; 1985 Skip; 1986 1987 when others => 1988 return; 1989 end case; 1990 end loop; 1991 1992 when others => 1993 Number_Fraction; 1994 return; 1995 1996 end case; 1997 end loop; 1998 end Number_Fraction_Or_Star_Fill; 1999 2000 ------------------------------- 2001 -- Number_Fraction_Or_Z_Fill -- 2002 ------------------------------- 2003 2004 procedure Number_Fraction_Or_Z_Fill is 2005 begin 2006 loop 2007 if At_End then 2008 return; 2009 end if; 2010 2011 case Look is 2012 2013 when '_' | '0' | '/' => 2014 Skip; 2015 2016 when 'B' | 'b' => 2017 Pic.Picture.Expanded (Index) := 'b'; 2018 Skip; 2019 2020 when 'Z' | 'z' => 2021 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1; 2022 Pic.End_Float := Index; 2023 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2024 2025 Skip; 2026 2027 loop 2028 if At_End then 2029 return; 2030 end if; 2031 2032 case Look is 2033 2034 when '_' | '0' | '/' => 2035 Skip; 2036 2037 when 'B' | 'b' => 2038 Pic.Picture.Expanded (Index) := 'b'; 2039 Skip; 2040 2041 when 'Z' | 'z' => 2042 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2043 2044 Pic.Max_Trailing_Digits := 2045 Pic.Max_Trailing_Digits + 1; 2046 Pic.End_Float := Index; 2047 Skip; 2048 2049 when others => 2050 return; 2051 end case; 2052 end loop; 2053 2054 when others => 2055 Number_Fraction; 2056 return; 2057 end case; 2058 end loop; 2059 end Number_Fraction_Or_Z_Fill; 2060 2061 ----------------------- 2062 -- Optional_RHS_Sign -- 2063 ----------------------- 2064 2065 procedure Optional_RHS_Sign is 2066 begin 2067 if At_End then 2068 return; 2069 end if; 2070 2071 case Look is 2072 2073 when '+' | '-' => 2074 Pic.Sign_Position := Index; 2075 Skip; 2076 return; 2077 2078 when 'C' | 'c' => 2079 Pic.Sign_Position := Index; 2080 Pic.Picture.Expanded (Index) := 'C'; 2081 Skip; 2082 2083 if Look = 'R' or else Look = 'r' then 2084 Pic.Second_Sign := Index; 2085 Pic.Picture.Expanded (Index) := 'R'; 2086 Skip; 2087 2088 else 2089 raise Picture_Error; 2090 end if; 2091 2092 return; 2093 2094 when 'D' | 'd' => 2095 Pic.Sign_Position := Index; 2096 Pic.Picture.Expanded (Index) := 'D'; 2097 Skip; 2098 2099 if Look = 'B' or else Look = 'b' then 2100 Pic.Second_Sign := Index; 2101 Pic.Picture.Expanded (Index) := 'B'; 2102 Skip; 2103 2104 else 2105 raise Picture_Error; 2106 end if; 2107 2108 return; 2109 2110 when '>' => 2111 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then 2112 Pic.Second_Sign := Index; 2113 Skip; 2114 2115 else 2116 raise Picture_Error; 2117 end if; 2118 2119 when others => 2120 return; 2121 2122 end case; 2123 end Optional_RHS_Sign; 2124 2125 ------------- 2126 -- Picture -- 2127 ------------- 2128 2129 -- Note that Picture can be called in either State 2130 2131 -- It will set state to Valid only if a 9 is encountered or floating 2132 -- currency is called. 2133 2134 procedure Picture is 2135 begin 2136 loop 2137 if At_End then 2138 return; 2139 end if; 2140 2141 case Look is 2142 2143 when '_' | '0' | '/' => 2144 Skip; 2145 2146 when 'B' | 'b' => 2147 Pic.Picture.Expanded (Index) := 'b'; 2148 Skip; 2149 2150 when '$' => 2151 Leading_Dollar; 2152 return; 2153 2154 when '#' => 2155 Leading_Pound; 2156 return; 2157 2158 when '9' => 2159 Computed_BWZ := False; 2160 Set_State (Okay); 2161 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2162 Skip; 2163 2164 when 'V' | 'v' | '.' => 2165 Pic.Radix_Position := Index; 2166 Skip; 2167 Number_Fraction; 2168 Trailing_Currency; 2169 return; 2170 2171 when others => 2172 return; 2173 2174 end case; 2175 end loop; 2176 end Picture; 2177 2178 --------------------- 2179 -- Picture_Bracket -- 2180 --------------------- 2181 2182 procedure Picture_Bracket is 2183 begin 2184 Pic.Sign_Position := Index; 2185 Pic.Sign_Position := Index; 2186 2187 -- Treat as a floating sign, and unwind otherwise 2188 2189 Pic.Floater := '<'; 2190 Pic.Start_Float := Index; 2191 Pic.End_Float := Index; 2192 2193 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 2194 -- sign place. 2195 2196 Skip; -- Known Bracket 2197 2198 loop 2199 case Look is 2200 2201 when '_' | '0' | '/' => 2202 Pic.End_Float := Index; 2203 Skip; 2204 2205 when 'B' | 'b' => 2206 Pic.End_Float := Index; 2207 Pic.Picture.Expanded (Index) := 'b'; 2208 Skip; 2209 2210 when '<' => 2211 Set_State (Okay); -- "<<>" is enough. 2212 Floating_Bracket; 2213 Trailing_Currency; 2214 Trailing_Bracket; 2215 return; 2216 2217 when '$' | '#' | '9' | '*' => 2218 if State /= Okay then 2219 Pic.Floater := '!'; 2220 Pic.Start_Float := Invalid_Position; 2221 Pic.End_Float := Invalid_Position; 2222 end if; 2223 2224 Picture; 2225 Trailing_Bracket; 2226 Set_State (Okay); 2227 return; 2228 2229 when '.' | 'V' | 'v' => 2230 if State /= Okay then 2231 Pic.Floater := '!'; 2232 Pic.Start_Float := Invalid_Position; 2233 Pic.End_Float := Invalid_Position; 2234 end if; 2235 2236 -- Don't assume that state is okay, haven't seen a digit 2237 2238 Picture; 2239 Trailing_Bracket; 2240 return; 2241 2242 when others => 2243 raise Picture_Error; 2244 2245 end case; 2246 end loop; 2247 end Picture_Bracket; 2248 2249 ------------------- 2250 -- Picture_Minus -- 2251 ------------------- 2252 2253 procedure Picture_Minus is 2254 begin 2255 Pic.Sign_Position := Index; 2256 2257 -- Treat as a floating sign, and unwind otherwise 2258 2259 Pic.Floater := '-'; 2260 Pic.Start_Float := Index; 2261 Pic.End_Float := Index; 2262 2263 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 2264 -- sign place. 2265 2266 Skip; -- Known Minus 2267 2268 loop 2269 case Look is 2270 2271 when '_' | '0' | '/' => 2272 Pic.End_Float := Index; 2273 Skip; 2274 2275 when 'B' | 'b' => 2276 Pic.End_Float := Index; 2277 Pic.Picture.Expanded (Index) := 'b'; 2278 Skip; 2279 2280 when '-' => 2281 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2282 Pic.End_Float := Index; 2283 Skip; 2284 Set_State (Okay); -- "-- " is enough. 2285 Floating_Minus; 2286 Trailing_Currency; 2287 return; 2288 2289 when '$' | '#' | '9' | '*' => 2290 if State /= Okay then 2291 Pic.Floater := '!'; 2292 Pic.Start_Float := Invalid_Position; 2293 Pic.End_Float := Invalid_Position; 2294 end if; 2295 2296 Picture; 2297 Set_State (Okay); 2298 return; 2299 2300 when 'Z' | 'z' => 2301 2302 -- Can't have Z and a floating sign 2303 2304 if State = Okay then 2305 Set_State (Reject); 2306 end if; 2307 2308 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2309 Zero_Suppression; 2310 Trailing_Currency; 2311 Optional_RHS_Sign; 2312 return; 2313 2314 when '.' | 'V' | 'v' => 2315 if State /= Okay then 2316 Pic.Floater := '!'; 2317 Pic.Start_Float := Invalid_Position; 2318 Pic.End_Float := Invalid_Position; 2319 end if; 2320 2321 -- Don't assume that state is okay, haven't seen a digit 2322 2323 Picture; 2324 return; 2325 2326 when others => 2327 return; 2328 2329 end case; 2330 end loop; 2331 end Picture_Minus; 2332 2333 ------------------ 2334 -- Picture_Plus -- 2335 ------------------ 2336 2337 procedure Picture_Plus is 2338 begin 2339 Pic.Sign_Position := Index; 2340 2341 -- Treat as a floating sign, and unwind otherwise 2342 2343 Pic.Floater := '+'; 2344 Pic.Start_Float := Index; 2345 Pic.End_Float := Index; 2346 2347 -- Don't increment Pic.Max_Leading_Digits, we need one "real" 2348 -- sign place. 2349 2350 Skip; -- Known Plus 2351 2352 loop 2353 case Look is 2354 2355 when '_' | '0' | '/' => 2356 Pic.End_Float := Index; 2357 Skip; 2358 2359 when 'B' | 'b' => 2360 Pic.End_Float := Index; 2361 Pic.Picture.Expanded (Index) := 'b'; 2362 Skip; 2363 2364 when '+' => 2365 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2366 Pic.End_Float := Index; 2367 Skip; 2368 Set_State (Okay); -- "++" is enough 2369 Floating_Plus; 2370 Trailing_Currency; 2371 return; 2372 2373 when '$' | '#' | '9' | '*' => 2374 if State /= Okay then 2375 Pic.Floater := '!'; 2376 Pic.Start_Float := Invalid_Position; 2377 Pic.End_Float := Invalid_Position; 2378 end if; 2379 2380 Picture; 2381 Set_State (Okay); 2382 return; 2383 2384 when 'Z' | 'z' => 2385 if State = Okay then 2386 Set_State (Reject); 2387 end if; 2388 2389 -- Can't have Z and a floating sign 2390 2391 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2392 2393 -- '+Z' is acceptable 2394 2395 Set_State (Okay); 2396 2397 Zero_Suppression; 2398 Trailing_Currency; 2399 Optional_RHS_Sign; 2400 return; 2401 2402 when '.' | 'V' | 'v' => 2403 if State /= Okay then 2404 Pic.Floater := '!'; 2405 Pic.Start_Float := Invalid_Position; 2406 Pic.End_Float := Invalid_Position; 2407 end if; 2408 2409 -- Don't assume that state is okay, haven't seen a digit 2410 2411 Picture; 2412 return; 2413 2414 when others => 2415 return; 2416 2417 end case; 2418 end loop; 2419 end Picture_Plus; 2420 2421 -------------------- 2422 -- Picture_String -- 2423 -------------------- 2424 2425 procedure Picture_String is 2426 begin 2427 while Is_Insert loop 2428 Skip; 2429 end loop; 2430 2431 case Look is 2432 2433 when '$' | '#' => 2434 Picture; 2435 Optional_RHS_Sign; 2436 2437 when '+' => 2438 Picture_Plus; 2439 2440 when '-' => 2441 Picture_Minus; 2442 2443 when '<' => 2444 Picture_Bracket; 2445 2446 when 'Z' | 'z' => 2447 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2448 Zero_Suppression; 2449 Trailing_Currency; 2450 Optional_RHS_Sign; 2451 2452 when '*' => 2453 Star_Suppression; 2454 Trailing_Currency; 2455 Optional_RHS_Sign; 2456 2457 when '9' | '.' | 'V' | 'v' => 2458 Number; 2459 Trailing_Currency; 2460 Optional_RHS_Sign; 2461 2462 when others => 2463 raise Picture_Error; 2464 2465 end case; 2466 2467 -- Blank when zero either if the PIC does not contain a '9' or if 2468 -- requested by the user and no '*'. 2469 2470 Pic.Blank_When_Zero := 2471 (Computed_BWZ or else Pic.Blank_When_Zero) 2472 and then not Pic.Star_Fill; 2473 2474 -- Star fill if '*' and no '9' 2475 2476 Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ; 2477 2478 if not At_End then 2479 Set_State (Reject); 2480 end if; 2481 2482 end Picture_String; 2483 2484 --------------- 2485 -- Set_State -- 2486 --------------- 2487 2488 procedure Set_State (L : Legality) is 2489 begin 2490 State := L; 2491 end Set_State; 2492 2493 ---------- 2494 -- Skip -- 2495 ---------- 2496 2497 procedure Skip is 2498 begin 2499 Index := Index + 1; 2500 end Skip; 2501 2502 ---------------------- 2503 -- Star_Suppression -- 2504 ---------------------- 2505 2506 procedure Star_Suppression is 2507 begin 2508 Pic.Floater := '*'; 2509 Pic.Start_Float := Index; 2510 Pic.End_Float := Index; 2511 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2512 Set_State (Okay); 2513 2514 -- Even a single * is a valid picture 2515 2516 Pic.Star_Fill := True; 2517 Skip; -- Known * 2518 2519 loop 2520 if At_End then 2521 return; 2522 end if; 2523 2524 case Look is 2525 2526 when '_' | '0' | '/' => 2527 Pic.End_Float := Index; 2528 Skip; 2529 2530 when 'B' | 'b' => 2531 Pic.End_Float := Index; 2532 Pic.Picture.Expanded (Index) := 'b'; 2533 Skip; 2534 2535 when '*' => 2536 Pic.End_Float := Index; 2537 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2538 Set_State (Okay); Skip; 2539 2540 when '9' => 2541 Set_State (Okay); 2542 Number_Completion; 2543 return; 2544 2545 when '.' | 'V' | 'v' => 2546 Pic.Radix_Position := Index; 2547 Skip; 2548 Number_Fraction_Or_Star_Fill; 2549 return; 2550 2551 when '#' | '$' => 2552 Trailing_Currency; 2553 Set_State (Okay); 2554 return; 2555 2556 when others => raise Picture_Error; 2557 end case; 2558 end loop; 2559 end Star_Suppression; 2560 2561 ---------------------- 2562 -- Trailing_Bracket -- 2563 ---------------------- 2564 2565 procedure Trailing_Bracket is 2566 begin 2567 if Look = '>' then 2568 Pic.Second_Sign := Index; 2569 Skip; 2570 else 2571 raise Picture_Error; 2572 end if; 2573 end Trailing_Bracket; 2574 2575 ----------------------- 2576 -- Trailing_Currency -- 2577 ----------------------- 2578 2579 procedure Trailing_Currency is 2580 begin 2581 if At_End then 2582 return; 2583 end if; 2584 2585 if Look = '$' then 2586 Pic.Start_Currency := Index; 2587 Pic.End_Currency := Index; 2588 Skip; 2589 2590 else 2591 while not At_End and then Look = '#' loop 2592 if Pic.Start_Currency = Invalid_Position then 2593 Pic.Start_Currency := Index; 2594 end if; 2595 2596 Pic.End_Currency := Index; 2597 Skip; 2598 end loop; 2599 end if; 2600 2601 loop 2602 if At_End then 2603 return; 2604 end if; 2605 2606 case Look is 2607 when '_' | '0' | '/' => Skip; 2608 2609 when 'B' | 'b' => 2610 Pic.Picture.Expanded (Index) := 'b'; 2611 Skip; 2612 2613 when others => return; 2614 end case; 2615 end loop; 2616 end Trailing_Currency; 2617 2618 ---------------------- 2619 -- Zero_Suppression -- 2620 ---------------------- 2621 2622 procedure Zero_Suppression is 2623 begin 2624 Pic.Floater := 'Z'; 2625 Pic.Start_Float := Index; 2626 Pic.End_Float := Index; 2627 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2628 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2629 2630 Skip; -- Known Z 2631 2632 loop 2633 -- Even a single Z is a valid picture 2634 2635 if At_End then 2636 Set_State (Okay); 2637 return; 2638 end if; 2639 2640 case Look is 2641 when '_' | '0' | '/' => 2642 Pic.End_Float := Index; 2643 Skip; 2644 2645 when 'B' | 'b' => 2646 Pic.End_Float := Index; 2647 Pic.Picture.Expanded (Index) := 'b'; 2648 Skip; 2649 2650 when 'Z' | 'z' => 2651 Pic.Picture.Expanded (Index) := 'Z'; -- consistency 2652 2653 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; 2654 Pic.End_Float := Index; 2655 Set_State (Okay); 2656 Skip; 2657 2658 when '9' => 2659 Set_State (Okay); 2660 Number_Completion; 2661 return; 2662 2663 when '.' | 'V' | 'v' => 2664 Pic.Radix_Position := Index; 2665 Skip; 2666 Number_Fraction_Or_Z_Fill; 2667 return; 2668 2669 when '#' | '$' => 2670 Trailing_Currency; 2671 Set_State (Okay); 2672 return; 2673 2674 when others => 2675 return; 2676 end case; 2677 end loop; 2678 end Zero_Suppression; 2679 2680 -- Start of processing for Precalculate 2681 2682 begin 2683 Picture_String; 2684 2685 if State = Reject then 2686 raise Picture_Error; 2687 end if; 2688 2689 exception 2690 2691 when Constraint_Error => 2692 2693 -- To deal with special cases like null strings 2694 2695 raise Picture_Error; 2696 2697 end Precalculate; 2698 2699 ---------------- 2700 -- To_Picture -- 2701 ---------------- 2702 2703 function To_Picture 2704 (Pic_String : String; 2705 Blank_When_Zero : Boolean := False) return Picture 2706 is 2707 Result : Picture; 2708 2709 begin 2710 declare 2711 Item : constant String := Expand (Pic_String); 2712 2713 begin 2714 Result.Contents.Picture := (Item'Length, Item); 2715 Result.Contents.Original_BWZ := Blank_When_Zero; 2716 Result.Contents.Blank_When_Zero := Blank_When_Zero; 2717 Precalculate (Result.Contents); 2718 return Result; 2719 end; 2720 2721 exception 2722 when others => 2723 raise Picture_Error; 2724 2725 end To_Picture; 2726 2727 ------------- 2728 -- To_Wide -- 2729 ------------- 2730 2731 function To_Wide (C : Character) return Wide_Wide_Character is 2732 begin 2733 return Wide_Wide_Character'Val (Character'Pos (C)); 2734 end To_Wide; 2735 2736 ----------- 2737 -- Valid -- 2738 ----------- 2739 2740 function Valid 2741 (Pic_String : String; 2742 Blank_When_Zero : Boolean := False) return Boolean 2743 is 2744 begin 2745 declare 2746 Expanded_Pic : constant String := Expand (Pic_String); 2747 -- Raises Picture_Error if Item not well-formed 2748 2749 Format_Rec : Format_Record; 2750 2751 begin 2752 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic); 2753 Format_Rec.Blank_When_Zero := Blank_When_Zero; 2754 Format_Rec.Original_BWZ := Blank_When_Zero; 2755 Precalculate (Format_Rec); 2756 2757 -- False only if Blank_When_0 is True but the pic string has a '*' 2758 2759 return not Blank_When_Zero 2760 or else Strings_Fixed.Index (Expanded_Pic, "*") = 0; 2761 end; 2762 2763 exception 2764 when others => return False; 2765 end Valid; 2766 2767end Ada.Wide_Wide_Text_IO.Editing; 2768