gcc/ada/a-ztedit.adb

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