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-2019, 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
32with Ada.Characters.Handling;
33with Ada.Float_Text_IO;
34with Ada.Integer_Text_IO;
35with Ada.Long_Float_Text_IO;
36with Ada.Long_Integer_Text_IO;
37with Ada.Strings.Fixed;
38with Ada.Unchecked_Deallocation;
39
40with System.Address_Image;
41
42package 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, 1,
134             Null_Unbounded_String, 0, 0, (0, 0), Format));
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
984end GNAT.Formatted_String;
985