gcc/ada/a-wtedit.adb

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