gcc/ada/a-teioed.adb

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