gcc/ada/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-2016, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Strings.Fixed;
  33 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          use Ada.Text_IO; --  needed for >
1023
1024       begin
1025          if Debug and then Value > 0 then
1026             if Ada.Text_IO.Col > 70 - S'Length then
1027                Ada.Text_IO.New_Line;
1028             end if;
1029
1030             Ada.Text_IO.Put (' ' & S & Integer'Image (Value) & ',');
1031          end if;
1032       end Debug_Integer;
1033
1034       -----------------
1035       -- Debug_Start --
1036       -----------------
1037
1038       procedure Debug_Start (Name : String) is
1039       begin
1040          if Debug then
1041             Ada.Text_IO.Put_Line ("  In " & Name & '.');
1042          end if;
1043       end Debug_Start;
1044
1045       ----------------------
1046       -- Floating_Bracket --
1047       ----------------------
1048
1049       --  Note that Floating_Bracket is only called with an acceptable
1050       --  prefix. But we don't set Okay, because we must end with a '>'.
1051
1052       procedure Floating_Bracket is
1053       begin
1054          Debug_Start ("Floating_Bracket");
1055
1056          --  Two different floats not allowed
1057
1058          if Pic.Floater /= '!' and then Pic.Floater /= '<' then
1059             raise Picture_Error;
1060
1061          else
1062             Pic.Floater := '<';
1063          end if;
1064
1065          Pic.End_Float := Index;
1066          Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1067
1068          --  First bracket wasn't counted...
1069
1070          Skip; --  known '<'
1071
1072          loop
1073             if At_End then
1074                return;
1075             end if;
1076
1077             case Look is
1078                when '_' | '0' | '/' =>
1079                   Pic.End_Float := Index;
1080                   Skip;
1081
1082                when 'B' | 'b'  =>
1083                   Pic.End_Float := Index;
1084                   Pic.Picture.Expanded (Index) := 'b';
1085                   Skip;
1086
1087                when '<' =>
1088                   Pic.End_Float := Index;
1089                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1090                   Skip;
1091
1092                when '9' =>
1093                   Number_Completion;
1094
1095                when '$' =>
1096                   Leading_Dollar;
1097
1098                when '#' =>
1099                   Leading_Pound;
1100
1101                when 'V' | 'v' | '.' =>
1102                   Pic.Radix_Position := Index;
1103                   Skip;
1104                   Number_Fraction_Or_Bracket;
1105                   return;
1106
1107                when others =>
1108                return;
1109             end case;
1110          end loop;
1111       end Floating_Bracket;
1112
1113       --------------------
1114       -- Floating_Minus --
1115       --------------------
1116
1117       procedure Floating_Minus is
1118       begin
1119          Debug_Start ("Floating_Minus");
1120
1121          loop
1122             if At_End then
1123                return;
1124             end if;
1125
1126             case Look is
1127                when '_' | '0' | '/' =>
1128                   Pic.End_Float := Index;
1129                   Skip;
1130
1131                when 'B' | 'b'  =>
1132                   Pic.End_Float := Index;
1133                   Pic.Picture.Expanded (Index) := 'b';
1134                   Skip;
1135
1136                when '-' =>
1137                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1138                   Pic.End_Float := Index;
1139                   Skip;
1140
1141                when '9' =>
1142                   Number_Completion;
1143                   return;
1144
1145                when '.' | 'V' | 'v' =>
1146                   Pic.Radix_Position := Index;
1147                   Skip; --  Radix
1148
1149                   while Is_Insert loop
1150                      Skip;
1151                   end loop;
1152
1153                   if At_End then
1154                      return;
1155                   end if;
1156
1157                   if Look = '-' then
1158                      loop
1159                         if At_End then
1160                            return;
1161                         end if;
1162
1163                         case Look is
1164                            when '-' =>
1165                               Pic.Max_Trailing_Digits :=
1166                                 Pic.Max_Trailing_Digits + 1;
1167                               Pic.End_Float := Index;
1168                               Skip;
1169
1170                            when '_' | '0' | '/' =>
1171                               Skip;
1172
1173                            when 'B' | 'b'  =>
1174                               Pic.Picture.Expanded (Index) := 'b';
1175                               Skip;
1176
1177                            when others =>
1178                               return;
1179                         end case;
1180                      end loop;
1181
1182                   else
1183                      Number_Completion;
1184                   end if;
1185
1186                   return;
1187
1188                when others =>
1189                   return;
1190             end case;
1191          end loop;
1192       end Floating_Minus;
1193
1194       -------------------
1195       -- Floating_Plus --
1196       -------------------
1197
1198       procedure Floating_Plus is
1199       begin
1200          Debug_Start ("Floating_Plus");
1201
1202          loop
1203             if At_End then
1204                return;
1205             end if;
1206
1207             case Look is
1208                when '_' | '0' | '/' =>
1209                   Pic.End_Float := Index;
1210                   Skip;
1211
1212                when 'B' | 'b'  =>
1213                   Pic.End_Float := Index;
1214                   Pic.Picture.Expanded (Index) := 'b';
1215                   Skip;
1216
1217                when '+' =>
1218                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1219                   Pic.End_Float := Index;
1220                   Skip;
1221
1222                when '9' =>
1223                   Number_Completion;
1224                   return;
1225
1226                when '.' | 'V' | 'v' =>
1227                   Pic.Radix_Position := Index;
1228                   Skip; --  Radix
1229
1230                   while Is_Insert loop
1231                      Skip;
1232                   end loop;
1233
1234                   if At_End then
1235                      return;
1236                   end if;
1237
1238                   if Look = '+' then
1239                      loop
1240                         if At_End then
1241                            return;
1242                         end if;
1243
1244                         case Look is
1245                            when '+' =>
1246                               Pic.Max_Trailing_Digits :=
1247                                 Pic.Max_Trailing_Digits + 1;
1248                               Pic.End_Float := Index;
1249                               Skip;
1250
1251                            when '_' | '0' | '/' =>
1252                               Skip;
1253
1254                            when 'B' | 'b'  =>
1255                               Pic.Picture.Expanded (Index) := 'b';
1256                               Skip;
1257
1258                            when others =>
1259                               return;
1260                         end case;
1261                      end loop;
1262
1263                   else
1264                      Number_Completion;
1265                   end if;
1266
1267                   return;
1268
1269                when others =>
1270                   return;
1271             end case;
1272          end loop;
1273       end Floating_Plus;
1274
1275       ---------------
1276       -- Is_Insert --
1277       ---------------
1278
1279       function Is_Insert return Boolean is
1280       begin
1281          if At_End then
1282             return False;
1283          end if;
1284
1285          case Pic.Picture.Expanded (Index) is
1286             when '_' | '0' | '/' =>
1287                return True;
1288
1289             when 'B' | 'b' =>
1290                Pic.Picture.Expanded (Index) := 'b'; --  canonical
1291                return True;
1292
1293             when others =>
1294                return False;
1295          end case;
1296       end Is_Insert;
1297
1298       --------------------
1299       -- Leading_Dollar --
1300       --------------------
1301
1302       --  Note that Leading_Dollar can be called in either State. It will set
1303       --  state to Okay only if a 9 or (second) $ is encountered.
1304
1305       --  Also notice the tricky bit with State and Zero_Suppression.
1306       --  Zero_Suppression is Picture_Error if a '$' or a '9' has been
1307       --  encountered, exactly the cases where State has been set.
1308
1309       procedure Leading_Dollar is
1310       begin
1311          Debug_Start ("Leading_Dollar");
1312
1313          --  Treat as a floating dollar, and unwind otherwise
1314
1315          if Pic.Floater /= '!' and then Pic.Floater /= '$' then
1316
1317             --  Two floats not allowed
1318
1319             raise Picture_Error;
1320
1321          else
1322             Pic.Floater := '$';
1323          end if;
1324
1325          Pic.Start_Currency := Index;
1326          Pic.End_Currency := Index;
1327          Pic.Start_Float := Index;
1328          Pic.End_Float := Index;
1329
1330          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
1331          --  currency place.
1332
1333          Skip; --  known '$'
1334
1335          loop
1336             if At_End then
1337                return;
1338             end if;
1339
1340             case Look is
1341                when '_' | '0' | '/' =>
1342                   Pic.End_Float := Index;
1343                   Skip;
1344
1345                   --  A trailing insertion character is not part of the
1346                   --  floating currency, so need to look ahead.
1347
1348                   if Look /= '$' then
1349                      Pic.End_Float := Pic.End_Float - 1;
1350                   end if;
1351
1352                when 'B' | 'b'  =>
1353                   Pic.End_Float := Index;
1354                   Pic.Picture.Expanded (Index) := 'b';
1355                   Skip;
1356
1357                when 'Z' | 'z' =>
1358                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1359
1360                   if State = Okay then
1361                      raise Picture_Error;
1362                   else
1363                      --  Overwrite Floater and Start_Float
1364
1365                      Pic.Floater := 'Z';
1366                      Pic.Start_Float := Index;
1367                      Zero_Suppression;
1368                   end if;
1369
1370                when '*' =>
1371                   if State = Okay then
1372                      raise Picture_Error;
1373                   else
1374                      --  Overwrite Floater and Start_Float
1375
1376                      Pic.Floater := '*';
1377                      Pic.Start_Float := Index;
1378                      Star_Suppression;
1379                   end if;
1380
1381                when '$' =>
1382                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1383                   Pic.End_Float := Index;
1384                   Pic.End_Currency := Index;
1385                   Set_State (Okay); Skip;
1386
1387                when '9' =>
1388                   if State /= Okay then
1389                      Pic.Floater := '!';
1390                      Pic.Start_Float := Invalid_Position;
1391                      Pic.End_Float := Invalid_Position;
1392                   end if;
1393
1394                   --  A single dollar does not a floating make
1395
1396                   Number_Completion;
1397                   return;
1398
1399                when 'V' | 'v' | '.' =>
1400                   if State /= Okay then
1401                      Pic.Floater := '!';
1402                      Pic.Start_Float := Invalid_Position;
1403                      Pic.End_Float := Invalid_Position;
1404                   end if;
1405
1406                   --  Only one dollar before the sign is okay, but doesn't
1407                   --  float.
1408
1409                   Pic.Radix_Position := Index;
1410                   Skip;
1411                   Number_Fraction_Or_Dollar;
1412                   return;
1413
1414                when others =>
1415                   return;
1416             end case;
1417          end loop;
1418       end Leading_Dollar;
1419
1420       -------------------
1421       -- Leading_Pound --
1422       -------------------
1423
1424       --  This one is complex.  A Leading_Pound can be fixed or floating,
1425       --  but in some cases the decision has to be deferred until we leave
1426       --  this procedure. Also note that Leading_Pound can be called in
1427       --  either State.
1428
1429       --  It will set state to Okay only if a 9 or (second) # is encountered
1430
1431       --  One Last note:  In ambiguous cases, the currency is treated as
1432       --  floating unless there is only one '#'.
1433
1434       procedure Leading_Pound is
1435
1436          Inserts : Boolean := False;
1437          --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1438
1439          Must_Float : Boolean := False;
1440          --  Set to true if a '#' occurs after an insert
1441
1442       begin
1443          Debug_Start ("Leading_Pound");
1444
1445          --  Treat as a floating currency. If it isn't, this will be
1446          --  overwritten later.
1447
1448          if Pic.Floater /= '!' and then Pic.Floater /= '#' then
1449
1450             --  Two floats not allowed
1451
1452             raise Picture_Error;
1453
1454          else
1455             Pic.Floater := '#';
1456          end if;
1457
1458          Pic.Start_Currency := Index;
1459          Pic.End_Currency := Index;
1460          Pic.Start_Float := Index;
1461          Pic.End_Float := Index;
1462
1463          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
1464          --  currency place.
1465
1466          Pic.Max_Currency_Digits := 1; --  we've seen one.
1467
1468          Skip; --  known '#'
1469
1470          loop
1471             if At_End then
1472                return;
1473             end if;
1474
1475             case Look is
1476                when '_' | '0' | '/' =>
1477                   Pic.End_Float := Index;
1478                   Inserts := True;
1479                   Skip;
1480
1481                when 'B' | 'b'  =>
1482                   Pic.Picture.Expanded (Index) := 'b';
1483                   Pic.End_Float := Index;
1484                   Inserts := True;
1485                   Skip;
1486
1487                when 'Z' | 'z' =>
1488                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1489
1490                   if Must_Float then
1491                      raise Picture_Error;
1492                   else
1493                      Pic.Max_Leading_Digits := 0;
1494
1495                      --  Overwrite Floater and Start_Float
1496
1497                      Pic.Floater := 'Z';
1498                      Pic.Start_Float := Index;
1499                      Zero_Suppression;
1500                   end if;
1501
1502                when '*' =>
1503                   if Must_Float then
1504                      raise Picture_Error;
1505                   else
1506                      Pic.Max_Leading_Digits := 0;
1507
1508                      --  Overwrite Floater and Start_Float
1509                      Pic.Floater := '*';
1510                      Pic.Start_Float := Index;
1511                      Star_Suppression;
1512                   end if;
1513
1514                when '#' =>
1515                   if Inserts then
1516                      Must_Float := True;
1517                   end if;
1518
1519                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1520                   Pic.End_Float := Index;
1521                   Pic.End_Currency := Index;
1522                   Set_State (Okay);
1523                   Skip;
1524
1525                when '9' =>
1526                   if State /= Okay then
1527
1528                      --  A single '#' doesn't float
1529
1530                      Pic.Floater := '!';
1531                      Pic.Start_Float := Invalid_Position;
1532                      Pic.End_Float := Invalid_Position;
1533                   end if;
1534
1535                   Number_Completion;
1536                   return;
1537
1538                when 'V' | 'v' | '.' =>
1539                   if State /= Okay then
1540                      Pic.Floater := '!';
1541                      Pic.Start_Float := Invalid_Position;
1542                      Pic.End_Float := Invalid_Position;
1543                   end if;
1544
1545                   --  Only one pound before the sign is okay, but doesn't
1546                   --  float.
1547
1548                   Pic.Radix_Position := Index;
1549                   Skip;
1550                   Number_Fraction_Or_Pound;
1551                   return;
1552
1553                when others =>
1554                   return;
1555             end case;
1556          end loop;
1557       end Leading_Pound;
1558
1559       ----------
1560       -- Look --
1561       ----------
1562
1563       function Look return Character is
1564       begin
1565          if At_End then
1566             raise Picture_Error;
1567          end if;
1568
1569          return Pic.Picture.Expanded (Index);
1570       end Look;
1571
1572       ------------
1573       -- Number --
1574       ------------
1575
1576       procedure Number is
1577       begin
1578          Debug_Start ("Number");
1579
1580          loop
1581             case Look is
1582                when '_' | '0' | '/' =>
1583                   Skip;
1584
1585                when 'B' | 'b'  =>
1586                   Pic.Picture.Expanded (Index) := 'b';
1587                   Skip;
1588
1589                when '9' =>
1590                   Computed_BWZ := False;
1591                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1592                   Set_State (Okay);
1593                   Skip;
1594
1595                when '.' | 'V' | 'v' =>
1596                   Pic.Radix_Position := Index;
1597                   Skip;
1598                   Number_Fraction;
1599                   return;
1600
1601                when others =>
1602                   return;
1603             end case;
1604
1605             if At_End then
1606                return;
1607             end if;
1608
1609             --  Will return in Okay state if a '9' was seen
1610
1611          end loop;
1612       end Number;
1613
1614       -----------------------
1615       -- Number_Completion --
1616       -----------------------
1617
1618       procedure Number_Completion is
1619       begin
1620          Debug_Start ("Number_Completion");
1621
1622          while not At_End loop
1623             case Look is
1624                when '_' | '0' | '/' =>
1625                   Skip;
1626
1627                when 'B' | 'b'  =>
1628                   Pic.Picture.Expanded (Index) := 'b';
1629                   Skip;
1630
1631                when '9' =>
1632                   Computed_BWZ := False;
1633                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1634                   Set_State (Okay);
1635                   Skip;
1636
1637                when 'V' | 'v' | '.' =>
1638                   Pic.Radix_Position := Index;
1639                   Skip;
1640                   Number_Fraction;
1641                   return;
1642
1643                when others =>
1644                   return;
1645             end case;
1646          end loop;
1647       end Number_Completion;
1648
1649       ---------------------
1650       -- Number_Fraction --
1651       ---------------------
1652
1653       procedure Number_Fraction is
1654       begin
1655          --  Note that number fraction can be called in either State.
1656          --  It will set state to Valid only if a 9 is encountered.
1657
1658          Debug_Start ("Number_Fraction");
1659
1660          loop
1661             if At_End then
1662                return;
1663             end if;
1664
1665             case Look is
1666                when '_' | '0' | '/' =>
1667                   Skip;
1668
1669                when 'B' | 'b'  =>
1670                   Pic.Picture.Expanded (Index) := 'b';
1671                   Skip;
1672
1673                when '9' =>
1674                   Computed_BWZ := False;
1675                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1676                   Set_State (Okay); Skip;
1677
1678                when others =>
1679                   return;
1680             end case;
1681          end loop;
1682       end Number_Fraction;
1683
1684       --------------------------------
1685       -- Number_Fraction_Or_Bracket --
1686       --------------------------------
1687
1688       procedure Number_Fraction_Or_Bracket is
1689       begin
1690          Debug_Start ("Number_Fraction_Or_Bracket");
1691
1692          loop
1693             if At_End then
1694                return;
1695             end if;
1696
1697             case Look is
1698                when '_' | '0' | '/' =>
1699                   Skip;
1700
1701                when 'B' | 'b'  =>
1702                   Pic.Picture.Expanded (Index) := 'b';
1703                   Skip;
1704
1705                when '<' =>
1706                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1707                   Pic.End_Float := Index;
1708                   Skip;
1709
1710                   loop
1711                      if At_End then
1712                         return;
1713                      end if;
1714
1715                      case Look is
1716                         when '_' | '0' | '/' =>
1717                            Skip;
1718
1719                         when 'B' | 'b'  =>
1720                            Pic.Picture.Expanded (Index) := 'b';
1721                            Skip;
1722
1723                         when '<' =>
1724                            Pic.Max_Trailing_Digits :=
1725                              Pic.Max_Trailing_Digits + 1;
1726                            Pic.End_Float := Index;
1727                            Skip;
1728
1729                         when others =>
1730                            return;
1731                      end case;
1732                   end loop;
1733
1734                when others =>
1735                   Number_Fraction;
1736                   return;
1737             end case;
1738          end loop;
1739       end Number_Fraction_Or_Bracket;
1740
1741       -------------------------------
1742       -- Number_Fraction_Or_Dollar --
1743       -------------------------------
1744
1745       procedure Number_Fraction_Or_Dollar is
1746       begin
1747          Debug_Start ("Number_Fraction_Or_Dollar");
1748
1749          loop
1750             if At_End then
1751                return;
1752             end if;
1753
1754             case Look is
1755                when '_' | '0' | '/' =>
1756                   Skip;
1757
1758                when 'B' | 'b'  =>
1759                   Pic.Picture.Expanded (Index) := 'b';
1760                   Skip;
1761
1762                when '$' =>
1763                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1764                   Pic.End_Float := Index;
1765                   Skip;
1766
1767                   loop
1768                      if At_End then
1769                         return;
1770                      end if;
1771
1772                      case Look is
1773                         when '_' | '0' | '/' =>
1774                            Skip;
1775
1776                         when 'B' | 'b'  =>
1777                            Pic.Picture.Expanded (Index) := 'b';
1778                            Skip;
1779
1780                         when '$' =>
1781                            Pic.Max_Trailing_Digits :=
1782                              Pic.Max_Trailing_Digits + 1;
1783                            Pic.End_Float := Index;
1784                            Skip;
1785
1786                         when others =>
1787                            return;
1788                      end case;
1789                   end loop;
1790
1791                when others =>
1792                   Number_Fraction;
1793                   return;
1794             end case;
1795          end loop;
1796       end Number_Fraction_Or_Dollar;
1797
1798       ------------------------------
1799       -- Number_Fraction_Or_Pound --
1800       ------------------------------
1801
1802       procedure Number_Fraction_Or_Pound is
1803       begin
1804          loop
1805             if At_End then
1806                return;
1807             end if;
1808
1809             case Look is
1810                when '_' | '0' | '/' =>
1811                   Skip;
1812
1813                when 'B' | 'b'  =>
1814                   Pic.Picture.Expanded (Index) := 'b';
1815                   Skip;
1816
1817                when '#' =>
1818                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1819                   Pic.End_Float := Index;
1820                   Skip;
1821
1822                   loop
1823                      if At_End then
1824                         return;
1825                      end if;
1826
1827                      case Look is
1828                         when '_' | '0' | '/' =>
1829                            Skip;
1830
1831                         when 'B' | 'b'  =>
1832                            Pic.Picture.Expanded (Index) := 'b';
1833                            Skip;
1834
1835                         when '#' =>
1836                            Pic.Max_Trailing_Digits :=
1837                              Pic.Max_Trailing_Digits + 1;
1838                            Pic.End_Float := Index;
1839                            Skip;
1840
1841                         when others =>
1842                            return;
1843                      end case;
1844                   end loop;
1845
1846                when others =>
1847                   Number_Fraction;
1848                   return;
1849             end case;
1850          end loop;
1851       end Number_Fraction_Or_Pound;
1852
1853       ----------------------------------
1854       -- Number_Fraction_Or_Star_Fill --
1855       ----------------------------------
1856
1857       procedure Number_Fraction_Or_Star_Fill is
1858       begin
1859          Debug_Start ("Number_Fraction_Or_Star_Fill");
1860
1861          loop
1862             if At_End then
1863                return;
1864             end if;
1865
1866             case Look is
1867                when '_' | '0' | '/' =>
1868                   Skip;
1869
1870                when 'B' | 'b'  =>
1871                   Pic.Picture.Expanded (Index) := 'b';
1872                   Skip;
1873
1874                when '*' =>
1875                   Pic.Star_Fill := True;
1876                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1877                   Pic.End_Float := Index;
1878                   Skip;
1879
1880                   loop
1881                      if At_End then
1882                         return;
1883                      end if;
1884
1885                      case Look is
1886                         when '_' | '0' | '/' =>
1887                            Skip;
1888
1889                         when 'B' | 'b'  =>
1890                            Pic.Picture.Expanded (Index) := 'b';
1891                            Skip;
1892
1893                         when '*' =>
1894                            Pic.Star_Fill := True;
1895                            Pic.Max_Trailing_Digits :=
1896                              Pic.Max_Trailing_Digits + 1;
1897                            Pic.End_Float := Index;
1898                            Skip;
1899
1900                         when others =>
1901                            return;
1902                      end case;
1903                   end loop;
1904
1905                when others =>
1906                   Number_Fraction;
1907                   return;
1908             end case;
1909          end loop;
1910       end Number_Fraction_Or_Star_Fill;
1911
1912       -------------------------------
1913       -- Number_Fraction_Or_Z_Fill --
1914       -------------------------------
1915
1916       procedure Number_Fraction_Or_Z_Fill is
1917       begin
1918          Debug_Start ("Number_Fraction_Or_Z_Fill");
1919
1920          loop
1921             if At_End then
1922                return;
1923             end if;
1924
1925             case Look is
1926                when '_' | '0' | '/' =>
1927                   Skip;
1928
1929                when 'B' | 'b'  =>
1930                   Pic.Picture.Expanded (Index) := 'b';
1931                   Skip;
1932
1933                when 'Z' | 'z' =>
1934                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1935                   Pic.End_Float := Index;
1936                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1937
1938                   Skip;
1939
1940                   loop
1941                      if At_End then
1942                         return;
1943                      end if;
1944
1945                      case Look is
1946                         when '_' | '0' | '/' =>
1947                            Skip;
1948
1949                         when 'B' | 'b'  =>
1950                            Pic.Picture.Expanded (Index) := 'b';
1951                            Skip;
1952
1953                         when 'Z' | 'z' =>
1954                            Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1955
1956                            Pic.Max_Trailing_Digits :=
1957                              Pic.Max_Trailing_Digits + 1;
1958                            Pic.End_Float := Index;
1959                            Skip;
1960
1961                         when others =>
1962                            return;
1963                      end case;
1964                   end loop;
1965
1966                when others =>
1967                   Number_Fraction;
1968                   return;
1969             end case;
1970          end loop;
1971       end Number_Fraction_Or_Z_Fill;
1972
1973       -----------------------
1974       -- Optional_RHS_Sign --
1975       -----------------------
1976
1977       procedure Optional_RHS_Sign is
1978       begin
1979          Debug_Start ("Optional_RHS_Sign");
1980
1981          if At_End then
1982             return;
1983          end if;
1984
1985          case Look is
1986             when '+' | '-' =>
1987                Pic.Sign_Position := Index;
1988                Skip;
1989                return;
1990
1991             when 'C' | 'c' =>
1992                Pic.Sign_Position := Index;
1993                Pic.Picture.Expanded (Index) := 'C';
1994                Skip;
1995
1996                if Look = 'R' or else Look = 'r' then
1997                   Pic.Second_Sign := Index;
1998                   Pic.Picture.Expanded (Index) := 'R';
1999                   Skip;
2000
2001                else
2002                   raise Picture_Error;
2003                end if;
2004
2005                return;
2006
2007             when 'D' | 'd' =>
2008                Pic.Sign_Position := Index;
2009                Pic.Picture.Expanded (Index) := 'D';
2010                Skip;
2011
2012                if Look = 'B' or else Look = 'b' then
2013                   Pic.Second_Sign := Index;
2014                   Pic.Picture.Expanded (Index) := 'B';
2015                   Skip;
2016
2017                else
2018                   raise Picture_Error;
2019                end if;
2020
2021                return;
2022
2023             when '>' =>
2024                if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2025                   Pic.Second_Sign := Index;
2026                   Skip;
2027
2028                else
2029                   raise Picture_Error;
2030                end if;
2031
2032             when others =>
2033                return;
2034          end case;
2035       end Optional_RHS_Sign;
2036
2037       -------------
2038       -- Picture --
2039       -------------
2040
2041       --  Note that Picture can be called in either State
2042
2043       --  It will set state to Valid only if a 9 is encountered or floating
2044       --  currency is called.
2045
2046       procedure Picture is
2047       begin
2048          Debug_Start ("Picture");
2049
2050          loop
2051             if At_End then
2052                return;
2053             end if;
2054
2055             case Look is
2056                when '_' | '0' | '/' =>
2057                   Skip;
2058
2059                when 'B' | 'b'  =>
2060                   Pic.Picture.Expanded (Index) := 'b';
2061                   Skip;
2062
2063                when '$' =>
2064                   Leading_Dollar;
2065                   return;
2066
2067                when '#' =>
2068                   Leading_Pound;
2069                   return;
2070
2071                when '9' =>
2072                   Computed_BWZ := False;
2073                   Set_State (Okay);
2074                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2075                   Skip;
2076
2077                when 'V' | 'v' | '.' =>
2078                   Pic.Radix_Position := Index;
2079                   Skip;
2080                   Number_Fraction;
2081                   Trailing_Currency;
2082                   return;
2083
2084                when others =>
2085                   return;
2086             end case;
2087          end loop;
2088       end Picture;
2089
2090       ---------------------
2091       -- Picture_Bracket --
2092       ---------------------
2093
2094       procedure Picture_Bracket is
2095       begin
2096          Pic.Sign_Position := Index;
2097          Debug_Start ("Picture_Bracket");
2098          Pic.Sign_Position := Index;
2099
2100          --  Treat as a floating sign, and unwind otherwise
2101
2102          Pic.Floater := '<';
2103          Pic.Start_Float := Index;
2104          Pic.End_Float := Index;
2105
2106          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2107          --  sign place.
2108
2109          Skip; --  Known Bracket
2110
2111          loop
2112             case Look is
2113                when '_' | '0' | '/' =>
2114                   Pic.End_Float := Index;
2115                   Skip;
2116
2117                when 'B' | 'b'  =>
2118                   Pic.End_Float := Index;
2119                   Pic.Picture.Expanded (Index) := 'b';
2120                   Skip;
2121
2122                when '<' =>
2123                   Set_State (Okay);  --  "<<>" is enough.
2124                   Floating_Bracket;
2125                   Trailing_Currency;
2126                   Trailing_Bracket;
2127                   return;
2128
2129                when '$' | '#' | '9' | '*' =>
2130                   if State /= Okay then
2131                      Pic.Floater := '!';
2132                      Pic.Start_Float := Invalid_Position;
2133                      Pic.End_Float := Invalid_Position;
2134                   end if;
2135
2136                   Picture;
2137                   Trailing_Bracket;
2138                   Set_State (Okay);
2139                   return;
2140
2141                when '.' | 'V' | 'v' =>
2142                   if State /= Okay then
2143                      Pic.Floater := '!';
2144                      Pic.Start_Float := Invalid_Position;
2145                      Pic.End_Float := Invalid_Position;
2146                   end if;
2147
2148                   --  Don't assume that state is okay, haven't seen a digit
2149
2150                   Picture;
2151                   Trailing_Bracket;
2152                   return;
2153
2154                when others =>
2155                   raise Picture_Error;
2156             end case;
2157          end loop;
2158       end Picture_Bracket;
2159
2160       -------------------
2161       -- Picture_Minus --
2162       -------------------
2163
2164       procedure Picture_Minus is
2165       begin
2166          Debug_Start ("Picture_Minus");
2167
2168          Pic.Sign_Position := Index;
2169
2170          --  Treat as a floating sign, and unwind otherwise
2171
2172          Pic.Floater := '-';
2173          Pic.Start_Float := Index;
2174          Pic.End_Float := Index;
2175
2176          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2177          --  sign place.
2178
2179          Skip; --  Known Minus
2180
2181          loop
2182             case Look is
2183                when '_' | '0' | '/' =>
2184                   Pic.End_Float := Index;
2185                   Skip;
2186
2187                when 'B' | 'b'  =>
2188                   Pic.End_Float := Index;
2189                   Pic.Picture.Expanded (Index) := 'b';
2190                   Skip;
2191
2192                when '-' =>
2193                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2194                   Pic.End_Float := Index;
2195                   Skip;
2196                   Set_State (Okay);  --  "-- " is enough.
2197                   Floating_Minus;
2198                   Trailing_Currency;
2199                   return;
2200
2201                when '$' | '#' | '9' | '*' =>
2202                   if State /= Okay then
2203                      Pic.Floater := '!';
2204                      Pic.Start_Float := Invalid_Position;
2205                      Pic.End_Float := Invalid_Position;
2206                   end if;
2207
2208                   Picture;
2209                   Set_State (Okay);
2210                   return;
2211
2212                when 'Z' | 'z' =>
2213
2214                   --  Can't have Z and a floating sign
2215
2216                   if State = Okay then
2217                      Set_State (Reject);
2218                   end if;
2219
2220                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2221                   Zero_Suppression;
2222                   Trailing_Currency;
2223                   Optional_RHS_Sign;
2224                   return;
2225
2226                when '.' | 'V' | 'v' =>
2227                   if State /= Okay then
2228                      Pic.Floater := '!';
2229                      Pic.Start_Float := Invalid_Position;
2230                      Pic.End_Float := Invalid_Position;
2231                   end if;
2232
2233                   --  Don't assume that state is okay, haven't seen a digit
2234
2235                   Picture;
2236                   return;
2237
2238                when others =>
2239                   return;
2240             end case;
2241          end loop;
2242       end Picture_Minus;
2243
2244       ------------------
2245       -- Picture_Plus --
2246       ------------------
2247
2248       procedure Picture_Plus is
2249       begin
2250          Debug_Start ("Picture_Plus");
2251          Pic.Sign_Position := Index;
2252
2253          --  Treat as a floating sign, and unwind otherwise
2254
2255          Pic.Floater := '+';
2256          Pic.Start_Float := Index;
2257          Pic.End_Float := Index;
2258
2259          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2260          --  sign place.
2261
2262          Skip; --  Known Plus
2263
2264          loop
2265             case Look is
2266                when '_' | '0' | '/' =>
2267                   Pic.End_Float := Index;
2268                   Skip;
2269
2270                when 'B' | 'b'  =>
2271                   Pic.End_Float := Index;
2272                   Pic.Picture.Expanded (Index) := 'b';
2273                   Skip;
2274
2275                when '+' =>
2276                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2277                   Pic.End_Float := Index;
2278                   Skip;
2279                   Set_State (Okay);  --  "++" is enough
2280                   Floating_Plus;
2281                   Trailing_Currency;
2282                   return;
2283
2284                when '$' | '#' | '9' | '*' =>
2285                   if State /= Okay then
2286                      Pic.Floater := '!';
2287                      Pic.Start_Float := Invalid_Position;
2288                      Pic.End_Float := Invalid_Position;
2289                   end if;
2290
2291                   Picture;
2292                   Set_State (Okay);
2293                   return;
2294
2295                when 'Z' | 'z' =>
2296                   if State = Okay then
2297                      Set_State (Reject);
2298                   end if;
2299
2300                   --  Can't have Z and a floating sign
2301
2302                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2303
2304                   --  '+Z' is acceptable
2305
2306                   Set_State (Okay);
2307
2308                   --  Overwrite Floater and Start_Float
2309
2310                   Pic.Floater := 'Z';
2311                   Pic.Start_Float := Index;
2312
2313                   Zero_Suppression;
2314                   Trailing_Currency;
2315                   Optional_RHS_Sign;
2316                   return;
2317
2318                when '.' | 'V' | 'v' =>
2319                   if State /= Okay then
2320                      Pic.Floater := '!';
2321                      Pic.Start_Float := Invalid_Position;
2322                      Pic.End_Float := Invalid_Position;
2323                   end if;
2324
2325                   --  Don't assume that state is okay, haven't seen a digit
2326
2327                   Picture;
2328                   return;
2329
2330                when others =>
2331                   return;
2332             end case;
2333          end loop;
2334       end Picture_Plus;
2335
2336       --------------------
2337       -- Picture_String --
2338       --------------------
2339
2340       procedure Picture_String is
2341       begin
2342          Debug_Start ("Picture_String");
2343
2344          while Is_Insert loop
2345             Skip;
2346          end loop;
2347
2348          case Look is
2349             when '$' | '#' =>
2350                Picture;
2351                Optional_RHS_Sign;
2352
2353             when '+' =>
2354                Picture_Plus;
2355
2356             when '-' =>
2357                Picture_Minus;
2358
2359             when '<' =>
2360                Picture_Bracket;
2361
2362             when 'Z' | 'z' =>
2363                Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2364                Zero_Suppression;
2365                Trailing_Currency;
2366                Optional_RHS_Sign;
2367
2368             when '*' =>
2369                Star_Suppression;
2370                Trailing_Currency;
2371                Optional_RHS_Sign;
2372
2373             when '9' | '.' | 'V' | 'v' =>
2374                Number;
2375                Trailing_Currency;
2376                Optional_RHS_Sign;
2377
2378             when others =>
2379                raise Picture_Error;
2380          end case;
2381
2382          --  Blank when zero either if the PIC does not contain a '9' or if
2383          --  requested by the user and no '*'.
2384
2385          Pic.Blank_When_Zero :=
2386            (Computed_BWZ or else Pic.Blank_When_Zero)
2387              and then not Pic.Star_Fill;
2388
2389          --  Star fill if '*' and no '9'
2390
2391          Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ;
2392
2393          if not At_End then
2394             Set_State (Reject);
2395          end if;
2396       end Picture_String;
2397
2398       ---------------
2399       -- Set_State --
2400       ---------------
2401
2402       procedure Set_State (L : Legality) is
2403       begin
2404          if Debug then
2405             Ada.Text_IO.Put_Line
2406               ("  Set state from " & Legality'Image (State)
2407                & " to " & Legality'Image (L));
2408          end if;
2409
2410          State := L;
2411       end Set_State;
2412
2413       ----------
2414       -- Skip --
2415       ----------
2416
2417       procedure Skip is
2418       begin
2419          if Debug then
2420             Ada.Text_IO.Put_Line ("  Skip " & Pic.Picture.Expanded (Index));
2421          end if;
2422
2423          Index := Index + 1;
2424       end Skip;
2425
2426       ----------------------
2427       -- Star_Suppression --
2428       ----------------------
2429
2430       procedure Star_Suppression is
2431       begin
2432          Debug_Start ("Star_Suppression");
2433
2434          if Pic.Floater /= '!' and then Pic.Floater /= '*' then
2435
2436             --  Two floats not allowed
2437
2438             raise Picture_Error;
2439
2440          else
2441             Pic.Floater := '*';
2442          end if;
2443
2444          Pic.Start_Float := Index;
2445          Pic.End_Float := Index;
2446          Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2447          Set_State (Okay);
2448
2449          --  Even a single * is a valid picture
2450
2451          Pic.Star_Fill := True;
2452          Skip; --  Known *
2453
2454          loop
2455             if At_End then
2456                return;
2457             end if;
2458
2459             case Look is
2460                when '_' | '0' | '/' =>
2461                   Pic.End_Float := Index;
2462                   Skip;
2463
2464                when 'B' | 'b'  =>
2465                   Pic.End_Float := Index;
2466                   Pic.Picture.Expanded (Index) := 'b';
2467                   Skip;
2468
2469                when '*' =>
2470                   Pic.End_Float := Index;
2471                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2472                   Set_State (Okay); Skip;
2473
2474                when '9' =>
2475                   Set_State (Okay);
2476                   Number_Completion;
2477                   return;
2478
2479                when '.' | 'V' | 'v' =>
2480                   Pic.Radix_Position := Index;
2481                   Skip;
2482                   Number_Fraction_Or_Star_Fill;
2483                   return;
2484
2485                when '#' | '$' =>
2486                   if Pic.Max_Currency_Digits > 0 then
2487                      raise Picture_Error;
2488                   end if;
2489
2490                   --  Cannot have leading and trailing currency
2491
2492                   Trailing_Currency;
2493                   Set_State (Okay);
2494                   return;
2495
2496                when others =>
2497                   raise Picture_Error;
2498             end case;
2499          end loop;
2500       end Star_Suppression;
2501
2502       ----------------------
2503       -- Trailing_Bracket --
2504       ----------------------
2505
2506       procedure Trailing_Bracket is
2507       begin
2508          Debug_Start ("Trailing_Bracket");
2509
2510          if Look = '>' then
2511             Pic.Second_Sign := Index;
2512             Skip;
2513          else
2514             raise Picture_Error;
2515          end if;
2516       end Trailing_Bracket;
2517
2518       -----------------------
2519       -- Trailing_Currency --
2520       -----------------------
2521
2522       procedure Trailing_Currency is
2523       begin
2524          Debug_Start ("Trailing_Currency");
2525
2526          if At_End then
2527             return;
2528          end if;
2529
2530          if Look = '$' then
2531             Pic.Start_Currency := Index;
2532             Pic.End_Currency := Index;
2533             Skip;
2534
2535          else
2536             while not At_End and then Look = '#' loop
2537                if Pic.Start_Currency = Invalid_Position then
2538                   Pic.Start_Currency := Index;
2539                end if;
2540
2541                Pic.End_Currency := Index;
2542                Skip;
2543             end loop;
2544          end if;
2545
2546          loop
2547             if At_End then
2548                return;
2549             end if;
2550
2551             case Look is
2552                when '_' | '0' | '/' =>
2553                   Skip;
2554
2555                when 'B' | 'b'  =>
2556                   Pic.Picture.Expanded (Index) := 'b';
2557                   Skip;
2558
2559                when others =>
2560                   return;
2561             end case;
2562          end loop;
2563       end Trailing_Currency;
2564
2565       ----------------------
2566       -- Zero_Suppression --
2567       ----------------------
2568
2569       procedure Zero_Suppression is
2570       begin
2571          Debug_Start ("Zero_Suppression");
2572
2573          Pic.Floater := 'Z';
2574          Pic.Start_Float := Index;
2575          Pic.End_Float := Index;
2576          Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2577          Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2578
2579          Skip; --  Known Z
2580
2581          loop
2582             --  Even a single Z is a valid picture
2583
2584             if At_End then
2585                Set_State (Okay);
2586                return;
2587             end if;
2588
2589             case Look is
2590                when '_' | '0' | '/' =>
2591                   Pic.End_Float := Index;
2592                   Skip;
2593
2594                when 'B' | 'b'  =>
2595                   Pic.End_Float := Index;
2596                   Pic.Picture.Expanded (Index) := 'b';
2597                   Skip;
2598
2599                when 'Z' | 'z' =>
2600                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2601
2602                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2603                   Pic.End_Float := Index;
2604                   Set_State (Okay);
2605                   Skip;
2606
2607                when '9' =>
2608                   Set_State (Okay);
2609                   Number_Completion;
2610                   return;
2611
2612                when '.' | 'V' | 'v' =>
2613                   Pic.Radix_Position := Index;
2614                   Skip;
2615                   Number_Fraction_Or_Z_Fill;
2616                   return;
2617
2618                when '#' | '$' =>
2619                   Trailing_Currency;
2620                   Set_State (Okay);
2621                   return;
2622
2623                when others =>
2624                   return;
2625             end case;
2626          end loop;
2627       end Zero_Suppression;
2628
2629    --  Start of processing for Precalculate
2630
2631    begin
2632       pragma Debug (Set_Debug);
2633
2634       Picture_String;
2635
2636       if Debug then
2637          Ada.Text_IO.New_Line;
2638          Ada.Text_IO.Put (" Picture : """ &
2639                      Pic.Picture.Expanded (1 .. Pic.Picture.Length) & """,");
2640          Ada.Text_IO.Put (" Floater : '" & Pic.Floater & "',");
2641       end if;
2642
2643       if State = Reject then
2644          raise Picture_Error;
2645       end if;
2646
2647       Debug_Integer (Pic.Radix_Position, "Radix Positon : ");
2648       Debug_Integer (Pic.Sign_Position, "Sign Positon : ");
2649       Debug_Integer (Pic.Second_Sign, "Second Sign : ");
2650       Debug_Integer (Pic.Start_Float, "Start Float : ");
2651       Debug_Integer (Pic.End_Float, "End Float : ");
2652       Debug_Integer (Pic.Start_Currency, "Start Currency : ");
2653       Debug_Integer (Pic.End_Currency, "End Currency : ");
2654       Debug_Integer (Pic.Max_Leading_Digits, "Max Leading Digits : ");
2655       Debug_Integer (Pic.Max_Trailing_Digits, "Max Trailing Digits : ");
2656
2657       if Debug then
2658          Ada.Text_IO.New_Line;
2659       end if;
2660
2661    exception
2662
2663       when Constraint_Error =>
2664
2665       --  To deal with special cases like null strings
2666
2667       raise Picture_Error;
2668    end Precalculate;
2669
2670    ----------------
2671    -- To_Picture --
2672    ----------------
2673
2674    function To_Picture
2675      (Pic_String      : String;
2676       Blank_When_Zero : Boolean := False) return Picture
2677    is
2678       Result : Picture;
2679
2680    begin
2681       declare
2682          Item : constant String := Expand (Pic_String);
2683
2684       begin
2685          Result.Contents.Picture         := (Item'Length, Item);
2686          Result.Contents.Original_BWZ := Blank_When_Zero;
2687          Result.Contents.Blank_When_Zero := Blank_When_Zero;
2688          Precalculate (Result.Contents);
2689          return Result;
2690       end;
2691
2692    exception
2693       when others =>
2694          raise Picture_Error;
2695    end To_Picture;
2696
2697    -----------
2698    -- Valid --
2699    -----------
2700
2701    function Valid
2702      (Pic_String      : String;
2703       Blank_When_Zero : Boolean := False) return Boolean
2704    is
2705    begin
2706       declare
2707          Expanded_Pic : constant String := Expand (Pic_String);
2708          --  Raises Picture_Error if Item not well-formed
2709
2710          Format_Rec : Format_Record;
2711
2712       begin
2713          Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2714          Format_Rec.Blank_When_Zero := Blank_When_Zero;
2715          Format_Rec.Original_BWZ := Blank_When_Zero;
2716          Precalculate (Format_Rec);
2717
2718          --  False only if Blank_When_Zero is True but the pic string has a '*'
2719
2720          return not Blank_When_Zero
2721            or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2722       end;
2723
2724    exception
2725       when others => return False;
2726    end Valid;
2727
2728    --------------------
2729    -- Decimal_Output --
2730    --------------------
2731
2732    package body Decimal_Output is
2733
2734       -----------
2735       -- Image --
2736       -----------
2737
2738       function Image
2739         (Item       : Num;
2740          Pic        : Picture;
2741          Currency   : String    := Default_Currency;
2742          Fill       : Character := Default_Fill;
2743          Separator  : Character := Default_Separator;
2744          Radix_Mark : Character := Default_Radix_Mark) return String
2745       is
2746       begin
2747          return Format_Number
2748             (Pic.Contents, Num'Image (Item),
2749              Currency, Fill, Separator, Radix_Mark);
2750       end Image;
2751
2752       ------------
2753       -- Length --
2754       ------------
2755
2756       function Length
2757         (Pic      : Picture;
2758          Currency : String := Default_Currency) return Natural
2759       is
2760          Picstr     : constant String := Pic_String (Pic);
2761          V_Adjust   : Integer := 0;
2762          Cur_Adjust : Integer := 0;
2763
2764       begin
2765          --  Check if Picstr has 'V' or '$'
2766
2767          --  If 'V', then length is 1 less than otherwise
2768
2769          --  If '$', then length is Currency'Length-1 more than otherwise
2770
2771          --  This should use the string handling package ???
2772
2773          for J in Picstr'Range loop
2774             if Picstr (J) = 'V' then
2775                V_Adjust := -1;
2776
2777             elsif Picstr (J) = '$' then
2778                Cur_Adjust := Currency'Length - 1;
2779             end if;
2780          end loop;
2781
2782          return Picstr'Length - V_Adjust + Cur_Adjust;
2783       end Length;
2784
2785       ---------
2786       -- Put --
2787       ---------
2788
2789       procedure Put
2790         (File       : Text_IO.File_Type;
2791          Item       : Num;
2792          Pic        : Picture;
2793          Currency   : String    := Default_Currency;
2794          Fill       : Character := Default_Fill;
2795          Separator  : Character := Default_Separator;
2796          Radix_Mark : Character := Default_Radix_Mark)
2797       is
2798       begin
2799          Text_IO.Put (File, Image (Item, Pic,
2800                                    Currency, Fill, Separator, Radix_Mark));
2801       end Put;
2802
2803       procedure Put
2804         (Item       : Num;
2805          Pic        : Picture;
2806          Currency   : String    := Default_Currency;
2807          Fill       : Character := Default_Fill;
2808          Separator  : Character := Default_Separator;
2809          Radix_Mark : Character := Default_Radix_Mark)
2810       is
2811       begin
2812          Text_IO.Put (Image (Item, Pic,
2813                              Currency, Fill, Separator, Radix_Mark));
2814       end Put;
2815
2816       procedure Put
2817         (To         : out String;
2818          Item       : Num;
2819          Pic        : Picture;
2820          Currency   : String    := Default_Currency;
2821          Fill       : Character := Default_Fill;
2822          Separator  : Character := Default_Separator;
2823          Radix_Mark : Character := Default_Radix_Mark)
2824       is
2825          Result : constant String :=
2826            Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
2827
2828       begin
2829          if Result'Length > To'Length then
2830             raise Ada.Text_IO.Layout_Error;
2831          else
2832             Strings_Fixed.Move (Source => Result, Target => To,
2833                                 Justify => Strings.Right);
2834          end if;
2835       end Put;
2836
2837       -----------
2838       -- Valid --
2839       -----------
2840
2841       function Valid
2842         (Item     : Num;
2843          Pic      : Picture;
2844          Currency : String := Default_Currency) return Boolean
2845       is
2846       begin
2847          declare
2848             Temp : constant String := Image (Item, Pic, Currency);
2849             pragma Warnings (Off, Temp);
2850          begin
2851             return True;
2852          end;
2853
2854       exception
2855          when Ada.Text_IO.Layout_Error => return False;
2856
2857       end Valid;
2858    end Decimal_Output;
2859
2860 end Ada.Text_IO.Editing;