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