gcc/ada/a-wtedit.adb

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