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-2016, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.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
 702             | Decimal_Scientific_Float_Up
 703          =>
 704             Put (Buffer, Var, Aft, Exp => 3);
 705             S := Strings.Fixed.Index_Non_Blank (Buffer);
 706             E := Buffer'Last;
 707
 708             if F.Kind = Decimal_Scientific_Float then
 709                Buffer (S .. E) :=
 710                  Characters.Handling.To_Lower (Buffer (S .. E));
 711             end if;
 712
 713          when Shortest_Decimal_Float
 714             | Shortest_Decimal_Float_Up
 715          =>
 716             --  Without exponent
 717
 718             Put (Buffer, Var, Aft, Exp => 0);
 719             S := Strings.Fixed.Index_Non_Blank (Buffer);
 720             E := Buffer'Last;
 721
 722             --  Check with exponent
 723
 724             declare
 725                Buffer2 : String (1 .. 50);
 726                S2, E2  : Positive;
 727
 728             begin
 729                Put (Buffer2, Var, Aft, Exp => 3);
 730                S2 := Strings.Fixed.Index_Non_Blank (Buffer2);
 731                E2 := Buffer2'Last;
 732
 733                --  If with exponent it is shorter, use it
 734
 735                if (E2 - S2) < (E - S) then
 736                   Buffer := Buffer2;
 737                   S := S2;
 738                   E := E2;
 739                end if;
 740             end;
 741
 742             if F.Kind = Shortest_Decimal_Float then
 743                Buffer (S .. E) :=
 744                  Characters.Handling.To_Lower (Buffer (S .. E));
 745             end if;
 746
 747          when others =>
 748             Raise_Wrong_Format (Format);
 749       end case;
 750
 751       Append (Format.D.Result,
 752         Get_Formatted (F, Buffer (S .. E), Buffer (S .. E)'Length));
 753
 754       return Format;
 755    end P_Flt_Format;
 756
 757    ------------------
 758    -- P_Int_Format --
 759    ------------------
 760
 761    function P_Int_Format
 762      (Format : Formatted_String;
 763       Var    : Int) return Formatted_String
 764    is
 765       function Handle_Precision return Boolean;
 766       --  Return True if nothing else to do
 767
 768       F      : F_Data;
 769       Buffer : String (1 .. 50);
 770       S, E   : Positive := 1;
 771       Len    : Natural := 0;
 772       Start  : Positive;
 773
 774       ----------------------
 775       -- Handle_Precision --
 776       ----------------------
 777
 778       function Handle_Precision return Boolean is
 779       begin
 780          if F.Precision = 0 and then Sign (Var) = Zero then
 781             return True;
 782
 783          elsif F.Precision = Natural'Last then
 784             null;
 785
 786          elsif F.Precision > E - S + 1 then
 787             Len := F.Precision - (E - S + 1);
 788             Buffer (S - Len .. S - 1) := (others => '0');
 789             S := S - Len;
 790          end if;
 791
 792          return False;
 793       end Handle_Precision;
 794
 795    --  Start of processing for P_Int_Format
 796
 797    begin
 798       Next_Format (Format, F, Start);
 799
 800       if Format.D.Stored_Value < F.Value_Needed then
 801          Format.D.Stored_Value := Format.D.Stored_Value + 1;
 802          Format.D.Stack (Format.D.Stored_Value) := To_Integer (Var);
 803          Format.D.Index := Start;
 804          return Format;
 805       end if;
 806
 807       case F.Kind is
 808          when Unsigned_Octal =>
 809             if Sign (Var) = Neg then
 810                Raise_Wrong_Format (Format);
 811             end if;
 812
 813             Put (Buffer, Var, Base => 8);
 814             S := Strings.Fixed.Index (Buffer, "8#") + 2;
 815             E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
 816
 817             if Handle_Precision then
 818                return Format;
 819             end if;
 820
 821             case F.Base is
 822                when None      => null;
 823                when C_Style   => Len := 1;
 824                when Ada_Style => Len := 3;
 825             end case;
 826
 827          when Unsigned_Hexadecimal_Int =>
 828             if Sign (Var) = Neg then
 829                Raise_Wrong_Format (Format);
 830             end if;
 831
 832             Put (Buffer, Var, Base => 16);
 833             S := Strings.Fixed.Index (Buffer, "16#") + 3;
 834             E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
 835             Buffer (S .. E) := Characters.Handling.To_Lower (Buffer (S .. E));
 836
 837             if Handle_Precision then
 838                return Format;
 839             end if;
 840
 841             case F.Base is
 842                when None      => null;
 843                when C_Style   => Len := 2;
 844                when Ada_Style => Len := 4;
 845             end case;
 846
 847          when Unsigned_Hexadecimal_Int_Up =>
 848             if Sign (Var) = Neg then
 849                Raise_Wrong_Format (Format);
 850             end if;
 851
 852             Put (Buffer, Var, Base => 16);
 853             S := Strings.Fixed.Index (Buffer, "16#") + 3;
 854             E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
 855
 856             if Handle_Precision then
 857                return Format;
 858             end if;
 859
 860             case F.Base is
 861                when None      => null;
 862                when C_Style   => Len := 2;
 863                when Ada_Style => Len := 4;
 864             end case;
 865
 866          when Unsigned_Decimal_Int =>
 867             if Sign (Var) = Neg then
 868                Raise_Wrong_Format (Format);
 869             end if;
 870
 871             Put (Buffer, Var, Base => 10);
 872             S := Strings.Fixed.Index_Non_Blank (Buffer);
 873             E := Buffer'Last;
 874
 875             if Handle_Precision then
 876                return Format;
 877             end if;
 878
 879          when Decimal_Int =>
 880             Put (Buffer, Var, Base => 10);
 881             S := Strings.Fixed.Index_Non_Blank (Buffer);
 882             E := Buffer'Last;
 883
 884             if Handle_Precision then
 885                return Format;
 886             end if;
 887
 888          when Char =>
 889             S := Buffer'First;
 890             E := Buffer'First;
 891             Buffer (S) := Character'Val (To_Integer (Var));
 892
 893             if Handle_Precision then
 894                return Format;
 895             end if;
 896
 897          when others =>
 898             Raise_Wrong_Format (Format);
 899       end case;
 900
 901       --  Then add base if needed
 902
 903       declare
 904          N : String := Get_Formatted (F, Buffer (S .. E), E - S + 1 + Len);
 905          P : constant Positive :=
 906                (if F.Left_Justify
 907                 then N'First
 908                 else Natural'Max (Strings.Fixed.Index_Non_Blank (N) - 1,
 909                                   N'First));
 910       begin
 911          case F.Base is
 912             when None =>
 913                null;
 914
 915             when C_Style =>
 916                case F.Kind is
 917                   when Unsigned_Octal =>
 918                      N (P) := 'O';
 919
 920                   when Unsigned_Hexadecimal_Int =>
 921                      if F.Left_Justify then
 922                         N (P .. P + 1) := "Ox";
 923                      else
 924                         N (P - 1 .. P) := "0x";
 925                      end if;
 926
 927                   when Unsigned_Hexadecimal_Int_Up =>
 928                      if F.Left_Justify then
 929                         N (P .. P + 1) := "OX";
 930                      else
 931                         N (P - 1 .. P) := "0X";
 932                      end if;
 933
 934                   when others =>
 935                      null;
 936                end case;
 937
 938             when Ada_Style =>
 939                case F.Kind is
 940                   when Unsigned_Octal =>
 941                      if F.Left_Justify then
 942                         N (N'First + 2 .. N'Last) := N (N'First .. N'Last - 2);
 943                      else
 944                         N (P .. N'Last - 1) := N (P + 1 .. N'Last);
 945                      end if;
 946
 947                      N (N'First .. N'First + 1) := "8#";
 948                      N (N'Last) := '#';
 949
 950                   when Unsigned_Hexadecimal_Int
 951                      | Unsigned_Hexadecimal_Int_Up
 952                   =>
 953                      if F.Left_Justify then
 954                         N (N'First + 3 .. N'Last) := N (N'First .. N'Last - 3);
 955                      else
 956                         N (P .. N'Last - 1) := N (P + 1 .. N'Last);
 957                      end if;
 958
 959                      N (N'First .. N'First + 2) := "16#";
 960                      N (N'Last) := '#';
 961
 962                   when others =>
 963                      null;
 964                end case;
 965          end case;
 966
 967          Append (Format.D.Result, N);
 968       end;
 969
 970       return Format;
 971    end P_Int_Format;
 972
 973    ------------------------
 974    -- Raise_Wrong_Format --
 975    ------------------------
 976
 977    procedure Raise_Wrong_Format (Format : Formatted_String) is
 978    begin
 979       raise Format_Error with
 980         "wrong format specified for parameter"
 981         & Positive'Image (Format.D.Current);
 982    end Raise_Wrong_Format;
 983
 984 end GNAT.Formatted_String;