gcc/ada/a-ztedit.adb

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