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