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