gcc/ada/g-forstr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                G N A T . F O R M A T T E D _ S T R I N G                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --             Copyright (C) 2014, Free Software Foundation, Inc.           --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Characters.Handling;
  33 with Ada.Float_Text_IO;
  34 with Ada.Integer_Text_IO;
  35 with Ada.Long_Float_Text_IO;
  36 with Ada.Long_Integer_Text_IO;
  37 with Ada.Strings.Fixed;
  38 with Ada.Unchecked_Deallocation;
  39
  40 with System.Address_Image;
  41
  42 package body GNAT.Formatted_String is
  43
  44    type F_Kind is (Decimal_Int,                 -- %d %i
  45                    Unsigned_Decimal_Int,        -- %u
  46                    Unsigned_Octal,              -- %o
  47                    Unsigned_Hexadecimal_Int,    -- %x
  48                    Unsigned_Hexadecimal_Int_Up, -- %X
  49                    Decimal_Float,               -- %f %F
  50                    Decimal_Scientific_Float,    -- %e
  51                    Decimal_Scientific_Float_Up, -- %E
  52                    Shortest_Decimal_Float,      -- %g
  53                    Shortest_Decimal_Float_Up,   -- %G
  54                    Char,                        -- %c
  55                    Str,                         -- %s
  56                    Pointer                      -- %p
  57                   );
  58
  59    type Sign_Kind is (Neg, Zero, Pos);
  60
  61    subtype Is_Number is F_Kind range Decimal_Int .. Decimal_Float;
  62
  63    type F_Sign is (If_Neg, Forced, Space) with Default_Value => If_Neg;
  64
  65    type F_Base is (None, C_Style, Ada_Style) with Default_Value => None;
  66
  67    Unset : constant Integer := -1;
  68
  69    type F_Data is record
  70       Kind         : F_Kind;
  71       Width        : Natural := 0;
  72       Precision    : Integer := Unset;
  73       Left_Justify : Boolean := False;
  74       Sign         : F_Sign;
  75       Base         : F_Base;
  76       Zero_Pad     : Boolean := False;
  77       Value_Needed : Natural range 0 .. 2 := 0;
  78    end record;
  79
  80    procedure Next_Format
  81      (Format : Formatted_String;
  82       F_Spec : out F_Data;
  83       Start  : out Positive);
  84    --  Parse the next format specifier, a format specifier has the following
  85    --  syntax: %[flags][width][.precision][length]specifier
  86
  87    function Get_Formatted
  88      (F_Spec : F_Data;
  89       Value  : String;
  90       Len    : Positive) return String;
  91    --  Returns Value formatted given the information in F_Spec
  92
  93    procedure Raise_Wrong_Format (Format : Formatted_String) with No_Return;
  94    --  Raise the Format_Error exception which information about the context
  95
  96    generic
  97       type Flt is private;
  98
  99       with procedure Put
 100         (To   : out String;
 101          Item : Flt;
 102          Aft  : Text_IO.Field;
 103          Exp  : Text_IO.Field);
 104    function P_Flt_Format
 105      (Format : Formatted_String;
 106       Var    : Flt) return Formatted_String;
 107    --  Generic routine which handles all floating point numbers
 108
 109    generic
 110       type Int is private;
 111
 112       with function To_Integer (Item : Int) return Integer;
 113
 114       with function Sign (Item : Int) return Sign_Kind;
 115
 116       with procedure Put
 117         (To   : out String;
 118          Item : Int;
 119          Base : Text_IO.Number_Base);
 120    function P_Int_Format
 121      (Format : Formatted_String;
 122       Var    : Int) return Formatted_String;
 123    --  Generic routine which handles all the integer numbers
 124
 125    ---------
 126    -- "+" --
 127    ---------
 128
 129    function "+" (Format : String) return Formatted_String is
 130    begin
 131       return Formatted_String'
 132         (Finalization.Controlled with
 133            D => new Data'(Format'Length, 1, Format, 1,
 134              Null_Unbounded_String, 0, 0, (0, 0)));
 135    end "+";
 136
 137    ---------
 138    -- "-" --
 139    ---------
 140
 141    function "-" (Format : Formatted_String) return String is
 142       F : String renames Format.D.Format;
 143       J : Natural renames Format.D.Index;
 144       R : Unbounded_String := Format.D.Result;
 145
 146    begin
 147       --  Make sure we get the remaining character up to the next unhandled
 148       --  format specifier.
 149
 150       while (J <= F'Length and then F (J) /= '%')
 151         or else (J < F'Length - 1 and then F (J + 1) = '%')
 152       loop
 153          Append (R, F (J));
 154
 155          --  If we have two consecutive %, skip the second one
 156
 157          if F (J) = '%' and then J < F'Length - 1 and then F (J + 1) = '%' then
 158             J := J + 1;
 159          end if;
 160
 161          J := J + 1;
 162       end loop;
 163
 164       return To_String (R);
 165    end "-";
 166
 167    ---------
 168    -- "&" --
 169    ---------
 170
 171    function "&"
 172      (Format : Formatted_String;
 173       Var    : Character) return Formatted_String
 174    is
 175       F     : F_Data;
 176       Start : Positive;
 177
 178    begin
 179       Next_Format (Format, F, Start);
 180
 181       if F.Value_Needed > 0 then
 182          Raise_Wrong_Format (Format);
 183       end if;
 184
 185       case F.Kind is
 186          when Char =>
 187             Append (Format.D.Result, Get_Formatted (F, String'(1 => Var), 1));
 188          when others =>
 189             Raise_Wrong_Format (Format);
 190       end case;
 191
 192       return Format;
 193    end "&";
 194
 195    function "&"
 196      (Format : Formatted_String;
 197       Var    : String) return Formatted_String
 198    is
 199       F     : F_Data;
 200       Start : Positive;
 201
 202    begin
 203       Next_Format (Format, F, Start);
 204
 205       if F.Value_Needed > 0 then
 206          Raise_Wrong_Format (Format);
 207       end if;
 208
 209       case F.Kind is
 210          when Str =>
 211             declare
 212                S : constant String := Get_Formatted (F, Var, Var'Length);
 213             begin
 214                if F.Precision = Unset then
 215                   Append (Format.D.Result, S);
 216                else
 217                   Append
 218                     (Format.D.Result,
 219                      S (S'First .. S'First + F.Precision - 1));
 220                end if;
 221             end;
 222
 223          when others =>
 224             Raise_Wrong_Format (Format);
 225       end case;
 226
 227       return Format;
 228    end "&";
 229
 230    function "&"
 231      (Format : Formatted_String;
 232       Var    : Boolean) return Formatted_String is
 233    begin
 234       return Format & Boolean'Image (Var);
 235    end "&";
 236
 237    function "&"
 238      (Format : Formatted_String;
 239       Var    : Float) return Formatted_String
 240    is
 241       function Float_Format is new Flt_Format (Float, Float_Text_IO.Put);
 242    begin
 243       return Float_Format (Format, Var);
 244    end "&";
 245
 246    function "&"
 247      (Format : Formatted_String;
 248       Var    : Long_Float) return Formatted_String
 249    is
 250       function Float_Format is
 251         new Flt_Format (Long_Float, Long_Float_Text_IO.Put);
 252    begin
 253       return Float_Format (Format, Var);
 254    end "&";
 255
 256    function "&"
 257      (Format : Formatted_String;
 258       Var    : Duration) return Formatted_String
 259    is
 260       package Duration_Text_IO is new Text_IO.Fixed_IO (Duration);
 261       function Duration_Format is
 262         new P_Flt_Format (Duration, Duration_Text_IO.Put);
 263    begin
 264       return Duration_Format (Format, Var);
 265    end "&";
 266
 267    function "&"
 268      (Format : Formatted_String;
 269       Var    : Integer) return Formatted_String
 270    is
 271       function Integer_Format is
 272         new Int_Format (Integer, Integer_Text_IO.Put);
 273    begin
 274       return Integer_Format (Format, Var);
 275    end "&";
 276
 277    function "&"
 278      (Format : Formatted_String;
 279       Var    : Long_Integer) return Formatted_String
 280    is
 281       function Integer_Format is
 282         new Int_Format (Long_Integer, Long_Integer_Text_IO.Put);
 283    begin
 284       return Integer_Format (Format, Var);
 285    end "&";
 286
 287    function "&"
 288      (Format : Formatted_String;
 289       Var    : System.Address) return Formatted_String
 290    is
 291       A_Img : constant String := System.Address_Image (Var);
 292       F     : F_Data;
 293       Start : Positive;
 294
 295    begin
 296       Next_Format (Format, F, Start);
 297
 298       if F.Value_Needed > 0 then
 299          Raise_Wrong_Format (Format);
 300       end if;
 301
 302       case F.Kind is
 303          when Pointer =>
 304             Append (Format.D.Result, Get_Formatted (F, A_Img, A_Img'Length));
 305          when others =>
 306             Raise_Wrong_Format (Format);
 307       end case;
 308
 309       return Format;
 310    end "&";
 311
 312    ------------
 313    -- Adjust --
 314    ------------
 315
 316    overriding procedure Adjust (F : in out Formatted_String) is
 317    begin
 318       F.D.Ref_Count := F.D.Ref_Count + 1;
 319    end Adjust;
 320
 321    --------------------
 322    -- Decimal_Format --
 323    --------------------
 324
 325    function Decimal_Format
 326      (Format : Formatted_String;
 327       Var    : Flt) return Formatted_String
 328    is
 329       function Flt_Format is new P_Flt_Format (Flt, Put);
 330    begin
 331       return Flt_Format (Format, Var);
 332    end Decimal_Format;
 333
 334    -----------------
 335    -- Enum_Format --
 336    -----------------
 337
 338    function Enum_Format
 339      (Format : Formatted_String;
 340       Var    : Enum) return Formatted_String is
 341    begin
 342       return Format & Enum'Image (Var);
 343    end Enum_Format;
 344
 345    --------------
 346    -- Finalize --
 347    --------------
 348
 349    overriding procedure Finalize (F : in out Formatted_String) is
 350       procedure Unchecked_Free is
 351         new Unchecked_Deallocation (Data, Data_Access);
 352
 353       D : Data_Access := F.D;
 354
 355    begin
 356       F.D := null;
 357
 358       D.Ref_Count := D.Ref_Count - 1;
 359
 360       if D.Ref_Count = 0 then
 361          Unchecked_Free (D);
 362       end if;
 363    end Finalize;
 364
 365    ------------------
 366    -- Fixed_Format --
 367    ------------------
 368
 369    function Fixed_Format
 370      (Format : Formatted_String;
 371       Var    : Flt) return Formatted_String
 372    is
 373       function Flt_Format is new P_Flt_Format (Flt, Put);
 374    begin
 375       return Flt_Format (Format, Var);
 376    end Fixed_Format;
 377
 378    ----------------
 379    -- Flt_Format --
 380    ----------------
 381
 382    function Flt_Format
 383      (Format : Formatted_String;
 384       Var    : Flt) return Formatted_String
 385    is
 386       function Flt_Format is new P_Flt_Format (Flt, Put);
 387    begin
 388       return Flt_Format (Format, Var);
 389    end Flt_Format;
 390
 391    -------------------
 392    -- Get_Formatted --
 393    -------------------
 394
 395    function Get_Formatted
 396      (F_Spec : F_Data;
 397       Value  : String;
 398       Len    : Positive) return String
 399    is
 400       use Ada.Strings.Fixed;
 401
 402       Res : Unbounded_String;
 403       S   : Positive := Value'First;
 404
 405    begin
 406       --  Handle the flags
 407
 408       if F_Spec.Kind in Is_Number then
 409          if F_Spec.Sign = Forced and then Value (Value'First) /= '-' then
 410             Append (Res, "+");
 411          elsif F_Spec.Sign = Space and then Value (Value'First) /= '-' then
 412             Append (Res, " ");
 413          end if;
 414
 415          if Value (Value'First) = '-' then
 416             Append (Res, "-");
 417             S := S + 1;
 418          end if;
 419       end if;
 420
 421       --  Zero padding if required and possible
 422
 423       if F_Spec.Left_Justify = False
 424         and then F_Spec.Zero_Pad
 425         and then F_Spec.Width > Len + Value'First - S
 426       then
 427          Append (Res, String'((F_Spec.Width - Len + Value'First - S) * '0'));
 428       end if;
 429
 430       --  Add the value now
 431
 432       Append (Res, Value (S .. Value'Last));
 433
 434       declare
 435          R : String (1 .. Natural'Max (Natural'Max (F_Spec.Width, Len),
 436                                        Length (Res))) := (others => ' ');
 437       begin
 438          if F_Spec.Left_Justify then
 439             R (1 .. Length (Res)) := To_String (Res);
 440          else
 441             R (R'Last - Length (Res) + 1 .. R'Last) := To_String (Res);
 442          end if;
 443
 444          return R;
 445       end;
 446    end Get_Formatted;
 447
 448    ----------------
 449    -- Int_Format --
 450    ----------------
 451
 452    function Int_Format
 453      (Format : Formatted_String;
 454       Var    : Int) return Formatted_String
 455    is
 456       function Sign (Var : Int) return Sign_Kind is
 457         (if Var < 0 then Neg elsif Var = 0 then Zero else Pos);
 458
 459       function To_Integer (Var : Int) return Integer is
 460         (Integer (Var));
 461
 462       function Int_Format is new P_Int_Format (Int, To_Integer, Sign, Put);
 463
 464    begin
 465       return Int_Format (Format, Var);
 466    end Int_Format;
 467
 468    ----------------
 469    -- Mod_Format --
 470    ----------------
 471
 472    function Mod_Format
 473      (Format : Formatted_String;
 474       Var    : Int) return Formatted_String
 475    is
 476       function Sign (Var : Int) return Sign_Kind is
 477         (if Var < 0 then Neg elsif Var = 0 then Zero else Pos);
 478
 479       function To_Integer (Var : Int) return Integer is
 480         (Integer (Var));
 481
 482       function Int_Format is new P_Int_Format (Int, To_Integer, Sign, Put);
 483
 484    begin
 485       return Int_Format (Format, Var);
 486    end Mod_Format;
 487
 488    -----------------
 489    -- Next_Format --
 490    -----------------
 491
 492    procedure Next_Format
 493      (Format : Formatted_String;
 494       F_Spec : out F_Data;
 495       Start  : out Positive)
 496    is
 497       F              : String  renames Format.D.Format;
 498       J              : Natural renames Format.D.Index;
 499       S              : Natural;
 500       Width_From_Var : Boolean := False;
 501
 502    begin
 503       Format.D.Current := Format.D.Current + 1;
 504       F_Spec.Value_Needed := 0;
 505
 506       --  Got to next %
 507
 508       while (J <= F'Last and then F (J) /= '%')
 509         or else (J < F'Last - 1 and then F (J + 1) = '%')
 510       loop
 511          Append (Format.D.Result, F (J));
 512
 513          --  If we have two consecutive %, skip the second one
 514
 515          if F (J) = '%' and then J < F'Last - 1 and then F (J + 1) = '%' then
 516             J := J + 1;
 517          end if;
 518
 519          J := J + 1;
 520       end loop;
 521
 522       if F (J) /= '%' or else J = F'Last then
 523          raise Format_Error with "no format specifier found for parameter"
 524            & Positive'Image (Format.D.Current);
 525       end if;
 526
 527       Start := J;
 528
 529       J := J + 1;
 530
 531       --  Check for any flags
 532
 533       Flags_Check : while J < F'Last loop
 534          if F (J) = '-' then
 535             F_Spec.Left_Justify := True;
 536          elsif F (J) = '+' then
 537             F_Spec.Sign         := Forced;
 538          elsif F (J) = ' ' then
 539             F_Spec.Sign         := Space;
 540          elsif F (J) = '#' then
 541             F_Spec.Base         := C_Style;
 542          elsif F (J) = '~' then
 543             F_Spec.Base         := Ada_Style;
 544          elsif F (J) = '0' then
 545             F_Spec.Zero_Pad     := True;
 546          else
 547             exit Flags_Check;
 548          end if;
 549
 550          J := J + 1;
 551       end loop Flags_Check;
 552
 553       --  Check width if any
 554
 555       if F (J) in '0' .. '9' then
 556
 557          --  We have a width parameter
 558
 559          S := J;
 560
 561          while J < F'Last and then F (J + 1) in '0' .. '9' loop
 562             J := J + 1;
 563          end loop;
 564
 565          F_Spec.Width := Natural'Value (F (S .. J));
 566
 567          J := J + 1;
 568
 569       elsif F (J) = '*' then
 570
 571          --  The width will be taken from the integer parameter
 572
 573          F_Spec.Value_Needed := 1;
 574          Width_From_Var := True;
 575
 576          J := J + 1;
 577       end if;
 578
 579       if F (J) = '.' then
 580
 581          --  We have a precision parameter
 582
 583          J := J + 1;
 584
 585          if F (J) in '0' .. '9' then
 586             S := J;
 587
 588             while J < F'Length and then F (J + 1) in '0' .. '9' loop
 589                J := J + 1;
 590             end loop;
 591
 592             if F (J) = '.' then
 593
 594                --  No precision, 0 is assumed
 595
 596                F_Spec.Precision := 0;
 597
 598             else
 599                F_Spec.Precision := Natural'Value (F (S .. J));
 600             end if;
 601
 602             J := J + 1;
 603
 604          elsif F (J) = '*' then
 605
 606             --  The prevision will be taken from the integer parameter
 607
 608             F_Spec.Value_Needed := F_Spec.Value_Needed + 1;
 609             J := J + 1;
 610          end if;
 611       end if;
 612
 613       --  Skip the length specifier, this is not needed for this implementation
 614       --  but yet for compatibility reason it is handled.
 615
 616       Length_Check :
 617       while J <= F'Last
 618         and then F (J) in 'h' | 'l' | 'j' | 'z' | 't' | 'L'
 619       loop
 620          J := J + 1;
 621       end loop Length_Check;
 622
 623       if J > F'Last then
 624          Raise_Wrong_Format (Format);
 625       end if;
 626
 627       --  Read next character which should be the expected type
 628
 629       case F (J) is
 630          when 'c'       => F_Spec.Kind := Char;
 631          when 's'       => F_Spec.Kind := Str;
 632          when 'd' | 'i' => F_Spec.Kind := Decimal_Int;
 633          when 'u'       => F_Spec.Kind := Unsigned_Decimal_Int;
 634          when 'f' | 'F' => F_Spec.Kind := Decimal_Float;
 635          when 'e'       => F_Spec.Kind := Decimal_Scientific_Float;
 636          when 'E'       => F_Spec.Kind := Decimal_Scientific_Float_Up;
 637          when 'g'       => F_Spec.Kind := Shortest_Decimal_Float;
 638          when 'G'       => F_Spec.Kind := Shortest_Decimal_Float_Up;
 639          when 'o'       => F_Spec.Kind := Unsigned_Octal;
 640          when 'x'       => F_Spec.Kind := Unsigned_Hexadecimal_Int;
 641          when 'X'       => F_Spec.Kind := Unsigned_Hexadecimal_Int_Up;
 642
 643          when others =>
 644             raise Format_Error with "unknown format specified for parameter"
 645               & Positive'Image (Format.D.Current);
 646       end case;
 647
 648       J := J + 1;
 649
 650       if F_Spec.Value_Needed > 0
 651         and then F_Spec.Value_Needed = Format.D.Stored_Value
 652       then
 653          if F_Spec.Value_Needed = 1 then
 654             if Width_From_Var then
 655                F_Spec.Width := Format.D.Stack (1);
 656             else
 657                F_Spec.Precision := Format.D.Stack (1);
 658             end if;
 659
 660          else
 661             F_Spec.Width := Format.D.Stack (1);
 662             F_Spec.Precision := Format.D.Stack (2);
 663          end if;
 664       end if;
 665    end Next_Format;
 666
 667    ------------------
 668    -- P_Flt_Format --
 669    ------------------
 670
 671    function P_Flt_Format
 672      (Format : Formatted_String;
 673       Var    : Flt) return Formatted_String
 674    is
 675       F      : F_Data;
 676       Buffer : String (1 .. 50);
 677       S, E   : Positive := 1;
 678       Start  : Positive;
 679       Aft    : Text_IO.Field;
 680
 681    begin
 682       Next_Format (Format, F, Start);
 683
 684       if F.Value_Needed > 0 then
 685          Raise_Wrong_Format (Format);
 686       end if;
 687
 688       if F.Precision = Unset then
 689          Aft := 6;
 690       else
 691          Aft := F.Precision;
 692       end if;
 693
 694       case F.Kind is
 695          when Decimal_Float =>
 696
 697             Put (Buffer, Var, Aft, Exp => 0);
 698             S := Strings.Fixed.Index_Non_Blank (Buffer);
 699             E := Buffer'Last;
 700
 701          when Decimal_Scientific_Float | Decimal_Scientific_Float_Up =>
 702
 703             Put (Buffer, Var, Aft, Exp => 3);
 704             S := Strings.Fixed.Index_Non_Blank (Buffer);
 705             E := Buffer'Last;
 706
 707             if F.Kind = Decimal_Scientific_Float then
 708                Buffer (S .. E) :=
 709                  Characters.Handling.To_Lower (Buffer (S .. E));
 710             end if;
 711
 712          when Shortest_Decimal_Float | Shortest_Decimal_Float_Up =>
 713
 714             --  Without exponent
 715
 716             Put (Buffer, Var, Aft, Exp => 0);
 717             S := Strings.Fixed.Index_Non_Blank (Buffer);
 718             E := Buffer'Last;
 719
 720             --  Check with exponent
 721
 722             declare
 723                Buffer2 : String (1 .. 50);
 724                S2, E2  : Positive;
 725
 726             begin
 727                Put (Buffer2, Var, Aft, Exp => 3);
 728                S2 := Strings.Fixed.Index_Non_Blank (Buffer2);
 729                E2 := Buffer2'Last;
 730
 731                --  If with exponent it is shorter, use it
 732
 733                if (E2 - S2) < (E - S) then
 734                   Buffer := Buffer2;
 735                   S := S2;
 736                   E := E2;
 737                end if;
 738             end;
 739
 740             if F.Kind = Shortest_Decimal_Float then
 741                Buffer (S .. E) :=
 742                  Characters.Handling.To_Lower (Buffer (S .. E));
 743             end if;
 744
 745          when others =>
 746             Raise_Wrong_Format (Format);
 747       end case;
 748
 749       Append (Format.D.Result,
 750         Get_Formatted (F, Buffer (S .. E), Buffer (S .. E)'Length));
 751
 752       return Format;
 753    end P_Flt_Format;
 754
 755    ------------------
 756    -- P_Int_Format --
 757    ------------------
 758
 759    function P_Int_Format
 760      (Format : Formatted_String;
 761       Var    : Int) return Formatted_String
 762    is
 763       function Handle_Precision return Boolean;
 764       --  Return True if nothing else to do
 765
 766       F      : F_Data;
 767       Buffer : String (1 .. 50);
 768       S, E   : Positive := 1;
 769       Len    : Natural := 0;
 770       Start  : Positive;
 771
 772       ----------------------
 773       -- Handle_Precision --
 774       ----------------------
 775
 776       function Handle_Precision return Boolean is
 777       begin
 778          if F.Precision = 0 and then Sign (Var) = Zero then
 779             return True;
 780
 781          elsif F.Precision = Natural'Last then
 782             null;
 783
 784          elsif F.Precision > E - S + 1 then
 785             Len := F.Precision - (E - S + 1);
 786             Buffer (S - Len .. S - 1) := (others => '0');
 787             S := S - Len;
 788          end if;
 789
 790          return False;
 791       end Handle_Precision;
 792
 793    --  Start of processing for P_Int_Format
 794
 795    begin
 796       Next_Format (Format, F, Start);
 797
 798       if Format.D.Stored_Value < F.Value_Needed then
 799          Format.D.Stored_Value := Format.D.Stored_Value + 1;
 800          Format.D.Stack (Format.D.Stored_Value) := To_Integer (Var);
 801          Format.D.Index := Start;
 802          return Format;
 803       end if;
 804
 805       case F.Kind is
 806          when Unsigned_Octal =>
 807             if Sign (Var) = Neg then
 808                Raise_Wrong_Format (Format);
 809             end if;
 810
 811             Put (Buffer, Var, Base => 8);
 812             S := Strings.Fixed.Index (Buffer, "8#") + 2;
 813             E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
 814
 815             if Handle_Precision then
 816                return Format;
 817             end if;
 818
 819             case F.Base is
 820                when None      => null;
 821                when C_Style   => Len := 1;
 822                when Ada_Style => Len := 3;
 823             end case;
 824
 825          when Unsigned_Hexadecimal_Int =>
 826             if Sign (Var) = Neg then
 827                Raise_Wrong_Format (Format);
 828             end if;
 829
 830             Put (Buffer, Var, Base => 16);
 831             S := Strings.Fixed.Index (Buffer, "16#") + 3;
 832             E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
 833             Buffer (S .. E) := Characters.Handling.To_Lower (Buffer (S .. E));
 834
 835             if Handle_Precision then
 836                return Format;
 837             end if;
 838
 839             case F.Base is
 840                when None      => null;
 841                when C_Style   => Len := 2;
 842                when Ada_Style => Len := 4;
 843             end case;
 844
 845          when Unsigned_Hexadecimal_Int_Up =>
 846             if Sign (Var) = Neg then
 847                Raise_Wrong_Format (Format);
 848             end if;
 849
 850             Put (Buffer, Var, Base => 16);
 851             S := Strings.Fixed.Index (Buffer, "16#") + 3;
 852             E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
 853
 854             if Handle_Precision then
 855                return Format;
 856             end if;
 857
 858             case F.Base is
 859                when None      => null;
 860                when C_Style   => Len := 2;
 861                when Ada_Style => Len := 4;
 862             end case;
 863
 864          when Unsigned_Decimal_Int =>
 865             if Sign (Var) = Neg then
 866                Raise_Wrong_Format (Format);
 867             end if;
 868
 869             Put (Buffer, Var, Base => 10);
 870             S := Strings.Fixed.Index_Non_Blank (Buffer);
 871             E := Buffer'Last;
 872
 873             if Handle_Precision then
 874                return Format;
 875             end if;
 876
 877          when Decimal_Int =>
 878             Put (Buffer, Var, Base => 10);
 879             S := Strings.Fixed.Index_Non_Blank (Buffer);
 880             E := Buffer'Last;
 881
 882             if Handle_Precision then
 883                return Format;
 884             end if;
 885
 886          when Char =>
 887             S := Buffer'First;
 888             E := Buffer'First;
 889             Buffer (S) := Character'Val (To_Integer (Var));
 890
 891             if Handle_Precision then
 892                return Format;
 893             end if;
 894
 895          when others =>
 896             Raise_Wrong_Format (Format);
 897       end case;
 898
 899       --  Then add base if needed
 900
 901       declare
 902          N : String := Get_Formatted (F, Buffer (S .. E), E - S + 1 + Len);
 903          P : constant Positive :=
 904                (if F.Left_Justify
 905                 then N'First
 906                 else Natural'Max (Strings.Fixed.Index_Non_Blank (N) - 1,
 907                                   N'First));
 908       begin
 909          case F.Base is
 910             when None   =>
 911                null;
 912
 913             when C_Style   =>
 914                case F.Kind is
 915                   when Unsigned_Octal =>
 916                      N (P) := 'O';
 917
 918                   when Unsigned_Hexadecimal_Int =>
 919                      if F.Left_Justify then
 920                         N (P .. P + 1) := "Ox";
 921                      else
 922                         N (P - 1 .. P) := "0x";
 923                      end if;
 924
 925                   when Unsigned_Hexadecimal_Int_Up =>
 926                      if F.Left_Justify then
 927                         N (P .. P + 1) := "OX";
 928                      else
 929                         N (P - 1 .. P) := "0X";
 930                      end if;
 931
 932                   when others =>
 933                      null;
 934                end case;
 935
 936             when Ada_Style   =>
 937                case F.Kind is
 938                   when Unsigned_Octal =>
 939                      if F.Left_Justify then
 940                         N (N'First + 2 .. N'Last) := N (N'First .. N'Last - 2);
 941                      else
 942                         N (P .. N'Last - 1) := N (P + 1 .. N'Last);
 943                      end if;
 944
 945                      N (N'First .. N'First + 1) := "8#";
 946                      N (N'Last) := '#';
 947
 948                   when Unsigned_Hexadecimal_Int    |
 949                        Unsigned_Hexadecimal_Int_Up =>
 950                      if F.Left_Justify then
 951                         N (N'First + 3 .. N'Last) := N (N'First .. N'Last - 3);
 952                      else
 953                         N (P .. N'Last - 1) := N (P + 1 .. N'Last);
 954                      end if;
 955
 956                      N (N'First .. N'First + 2) := "16#";
 957                      N (N'Last) := '#';
 958
 959                   when others =>
 960                      null;
 961                end case;
 962          end case;
 963
 964          Append (Format.D.Result, N);
 965       end;
 966
 967       return Format;
 968    end P_Int_Format;
 969
 970    ------------------------
 971    -- Raise_Wrong_Format --
 972    ------------------------
 973
 974    procedure Raise_Wrong_Format (Format : Formatted_String) is
 975    begin
 976       raise Format_Error with
 977         "wrong format specified for parameter"
 978         & Positive'Image (Format.D.Current);
 979    end Raise_Wrong_Format;
 980
 981 end GNAT.Formatted_String;