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