gcc/ada/a-teioed.adb

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