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