gcc/ada/libgnat/a-teioed.adb

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