| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- G N A T . F O R M A T T E D _ S T R I N G -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2014, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Characters.Handling; |
| with Ada.Float_Text_IO; |
| with Ada.Integer_Text_IO; |
| with Ada.Long_Float_Text_IO; |
| with Ada.Long_Integer_Text_IO; |
| with Ada.Strings.Fixed; |
| with Ada.Unchecked_Deallocation; |
| |
| with System.Address_Image; |
| |
| package body GNAT.Formatted_String is |
| |
| type F_Kind is (Decimal_Int, -- %d %i |
| Unsigned_Decimal_Int, -- %u |
| Unsigned_Octal, -- %o |
| Unsigned_Hexadecimal_Int, -- %x |
| Unsigned_Hexadecimal_Int_Up, -- %X |
| Decimal_Float, -- %f %F |
| Decimal_Scientific_Float, -- %e |
| Decimal_Scientific_Float_Up, -- %E |
| Shortest_Decimal_Float, -- %g |
| Shortest_Decimal_Float_Up, -- %G |
| Char, -- %c |
| Str, -- %s |
| Pointer -- %p |
| ); |
| |
| type Sign_Kind is (Neg, Zero, Pos); |
| |
| subtype Is_Number is F_Kind range Decimal_Int .. Decimal_Float; |
| |
| type F_Sign is (If_Neg, Forced, Space) with Default_Value => If_Neg; |
| |
| type F_Base is (None, C_Style, Ada_Style) with Default_Value => None; |
| |
| Unset : constant Integer := -1; |
| |
| type F_Data is record |
| Kind : F_Kind; |
| Width : Natural := 0; |
| Precision : Integer := Unset; |
| Left_Justify : Boolean := False; |
| Sign : F_Sign; |
| Base : F_Base; |
| Zero_Pad : Boolean := False; |
| Value_Needed : Natural range 0 .. 2 := 0; |
| end record; |
| |
| procedure Next_Format |
| (Format : Formatted_String; |
| F_Spec : out F_Data; |
| Start : out Positive); |
| -- Parse the next format specifier, a format specifier has the following |
| -- syntax: %[flags][width][.precision][length]specifier |
| |
| function Get_Formatted |
| (F_Spec : F_Data; |
| Value : String; |
| Len : Positive) return String; |
| -- Returns Value formatted given the information in F_Spec |
| |
| procedure Raise_Wrong_Format (Format : Formatted_String) with No_Return; |
| -- Raise the Format_Error exception which information about the context |
| |
| generic |
| type Flt is private; |
| |
| with procedure Put |
| (To : out String; |
| Item : Flt; |
| Aft : Text_IO.Field; |
| Exp : Text_IO.Field); |
| function P_Flt_Format |
| (Format : Formatted_String; |
| Var : Flt) return Formatted_String; |
| -- Generic routine which handles all floating point numbers |
| |
| generic |
| type Int is private; |
| |
| with function To_Integer (Item : Int) return Integer; |
| |
| with function Sign (Item : Int) return Sign_Kind; |
| |
| with procedure Put |
| (To : out String; |
| Item : Int; |
| Base : Text_IO.Number_Base); |
| function P_Int_Format |
| (Format : Formatted_String; |
| Var : Int) return Formatted_String; |
| -- Generic routine which handles all the integer numbers |
| |
| --------- |
| -- "+" -- |
| --------- |
| |
| function "+" (Format : String) return Formatted_String is |
| begin |
| return Formatted_String' |
| (Finalization.Controlled with |
| D => new Data'(Format'Length, 1, Format, 1, |
| Null_Unbounded_String, 0, 0, (0, 0))); |
| end "+"; |
| |
| --------- |
| -- "-" -- |
| --------- |
| |
| function "-" (Format : Formatted_String) return String is |
| F : String renames Format.D.Format; |
| J : Natural renames Format.D.Index; |
| R : Unbounded_String := Format.D.Result; |
| |
| begin |
| -- Make sure we get the remaining character up to the next unhandled |
| -- format specifier. |
| |
| while (J <= F'Length and then F (J) /= '%') |
| or else (J < F'Length - 1 and then F (J + 1) = '%') |
| loop |
| Append (R, F (J)); |
| |
| -- If we have two consecutive %, skip the second one |
| |
| if F (J) = '%' and then J < F'Length - 1 and then F (J + 1) = '%' then |
| J := J + 1; |
| end if; |
| |
| J := J + 1; |
| end loop; |
| |
| return To_String (R); |
| end "-"; |
| |
| --------- |
| -- "&" -- |
| --------- |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : Character) return Formatted_String |
| is |
| F : F_Data; |
| Start : Positive; |
| |
| begin |
| Next_Format (Format, F, Start); |
| |
| if F.Value_Needed > 0 then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| case F.Kind is |
| when Char => |
| Append (Format.D.Result, Get_Formatted (F, String'(1 => Var), 1)); |
| when others => |
| Raise_Wrong_Format (Format); |
| end case; |
| |
| return Format; |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : String) return Formatted_String |
| is |
| F : F_Data; |
| Start : Positive; |
| |
| begin |
| Next_Format (Format, F, Start); |
| |
| if F.Value_Needed > 0 then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| case F.Kind is |
| when Str => |
| declare |
| S : constant String := Get_Formatted (F, Var, Var'Length); |
| begin |
| if F.Precision = Unset then |
| Append (Format.D.Result, S); |
| else |
| Append |
| (Format.D.Result, |
| S (S'First .. S'First + F.Precision - 1)); |
| end if; |
| end; |
| |
| when others => |
| Raise_Wrong_Format (Format); |
| end case; |
| |
| return Format; |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : Boolean) return Formatted_String is |
| begin |
| return Format & Boolean'Image (Var); |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : Float) return Formatted_String |
| is |
| function Float_Format is new Flt_Format (Float, Float_Text_IO.Put); |
| begin |
| return Float_Format (Format, Var); |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : Long_Float) return Formatted_String |
| is |
| function Float_Format is |
| new Flt_Format (Long_Float, Long_Float_Text_IO.Put); |
| begin |
| return Float_Format (Format, Var); |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : Duration) return Formatted_String |
| is |
| package Duration_Text_IO is new Text_IO.Fixed_IO (Duration); |
| function Duration_Format is |
| new P_Flt_Format (Duration, Duration_Text_IO.Put); |
| begin |
| return Duration_Format (Format, Var); |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : Integer) return Formatted_String |
| is |
| function Integer_Format is |
| new Int_Format (Integer, Integer_Text_IO.Put); |
| begin |
| return Integer_Format (Format, Var); |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : Long_Integer) return Formatted_String |
| is |
| function Integer_Format is |
| new Int_Format (Long_Integer, Long_Integer_Text_IO.Put); |
| begin |
| return Integer_Format (Format, Var); |
| end "&"; |
| |
| function "&" |
| (Format : Formatted_String; |
| Var : System.Address) return Formatted_String |
| is |
| A_Img : constant String := System.Address_Image (Var); |
| F : F_Data; |
| Start : Positive; |
| |
| begin |
| Next_Format (Format, F, Start); |
| |
| if F.Value_Needed > 0 then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| case F.Kind is |
| when Pointer => |
| Append (Format.D.Result, Get_Formatted (F, A_Img, A_Img'Length)); |
| when others => |
| Raise_Wrong_Format (Format); |
| end case; |
| |
| return Format; |
| end "&"; |
| |
| ------------ |
| -- Adjust -- |
| ------------ |
| |
| overriding procedure Adjust (F : in out Formatted_String) is |
| begin |
| F.D.Ref_Count := F.D.Ref_Count + 1; |
| end Adjust; |
| |
| -------------------- |
| -- Decimal_Format -- |
| -------------------- |
| |
| function Decimal_Format |
| (Format : Formatted_String; |
| Var : Flt) return Formatted_String |
| is |
| function Flt_Format is new P_Flt_Format (Flt, Put); |
| begin |
| return Flt_Format (Format, Var); |
| end Decimal_Format; |
| |
| ----------------- |
| -- Enum_Format -- |
| ----------------- |
| |
| function Enum_Format |
| (Format : Formatted_String; |
| Var : Enum) return Formatted_String is |
| begin |
| return Format & Enum'Image (Var); |
| end Enum_Format; |
| |
| -------------- |
| -- Finalize -- |
| -------------- |
| |
| overriding procedure Finalize (F : in out Formatted_String) is |
| procedure Unchecked_Free is |
| new Unchecked_Deallocation (Data, Data_Access); |
| |
| D : Data_Access := F.D; |
| |
| begin |
| F.D := null; |
| |
| D.Ref_Count := D.Ref_Count - 1; |
| |
| if D.Ref_Count = 0 then |
| Unchecked_Free (D); |
| end if; |
| end Finalize; |
| |
| ------------------ |
| -- Fixed_Format -- |
| ------------------ |
| |
| function Fixed_Format |
| (Format : Formatted_String; |
| Var : Flt) return Formatted_String |
| is |
| function Flt_Format is new P_Flt_Format (Flt, Put); |
| begin |
| return Flt_Format (Format, Var); |
| end Fixed_Format; |
| |
| ---------------- |
| -- Flt_Format -- |
| ---------------- |
| |
| function Flt_Format |
| (Format : Formatted_String; |
| Var : Flt) return Formatted_String |
| is |
| function Flt_Format is new P_Flt_Format (Flt, Put); |
| begin |
| return Flt_Format (Format, Var); |
| end Flt_Format; |
| |
| ------------------- |
| -- Get_Formatted -- |
| ------------------- |
| |
| function Get_Formatted |
| (F_Spec : F_Data; |
| Value : String; |
| Len : Positive) return String |
| is |
| use Ada.Strings.Fixed; |
| |
| Res : Unbounded_String; |
| S : Positive := Value'First; |
| |
| begin |
| -- Handle the flags |
| |
| if F_Spec.Kind in Is_Number then |
| if F_Spec.Sign = Forced and then Value (Value'First) /= '-' then |
| Append (Res, "+"); |
| elsif F_Spec.Sign = Space and then Value (Value'First) /= '-' then |
| Append (Res, " "); |
| end if; |
| |
| if Value (Value'First) = '-' then |
| Append (Res, "-"); |
| S := S + 1; |
| end if; |
| end if; |
| |
| -- Zero padding if required and possible |
| |
| if F_Spec.Left_Justify = False |
| and then F_Spec.Zero_Pad |
| and then F_Spec.Width > Len + Value'First - S |
| then |
| Append (Res, String'((F_Spec.Width - Len + Value'First - S) * '0')); |
| end if; |
| |
| -- Add the value now |
| |
| Append (Res, Value (S .. Value'Last)); |
| |
| declare |
| R : String (1 .. Natural'Max (Natural'Max (F_Spec.Width, Len), |
| Length (Res))) := (others => ' '); |
| begin |
| if F_Spec.Left_Justify then |
| R (1 .. Length (Res)) := To_String (Res); |
| else |
| R (R'Last - Length (Res) + 1 .. R'Last) := To_String (Res); |
| end if; |
| |
| return R; |
| end; |
| end Get_Formatted; |
| |
| ---------------- |
| -- Int_Format -- |
| ---------------- |
| |
| function Int_Format |
| (Format : Formatted_String; |
| Var : Int) return Formatted_String |
| is |
| function Sign (Var : Int) return Sign_Kind is |
| (if Var < 0 then Neg elsif Var = 0 then Zero else Pos); |
| |
| function To_Integer (Var : Int) return Integer is |
| (Integer (Var)); |
| |
| function Int_Format is new P_Int_Format (Int, To_Integer, Sign, Put); |
| |
| begin |
| return Int_Format (Format, Var); |
| end Int_Format; |
| |
| ---------------- |
| -- Mod_Format -- |
| ---------------- |
| |
| function Mod_Format |
| (Format : Formatted_String; |
| Var : Int) return Formatted_String |
| is |
| function Sign (Var : Int) return Sign_Kind is |
| (if Var < 0 then Neg elsif Var = 0 then Zero else Pos); |
| |
| function To_Integer (Var : Int) return Integer is |
| (Integer (Var)); |
| |
| function Int_Format is new P_Int_Format (Int, To_Integer, Sign, Put); |
| |
| begin |
| return Int_Format (Format, Var); |
| end Mod_Format; |
| |
| ----------------- |
| -- Next_Format -- |
| ----------------- |
| |
| procedure Next_Format |
| (Format : Formatted_String; |
| F_Spec : out F_Data; |
| Start : out Positive) |
| is |
| F : String renames Format.D.Format; |
| J : Natural renames Format.D.Index; |
| S : Natural; |
| Width_From_Var : Boolean := False; |
| |
| begin |
| Format.D.Current := Format.D.Current + 1; |
| F_Spec.Value_Needed := 0; |
| |
| -- Got to next % |
| |
| while (J <= F'Last and then F (J) /= '%') |
| or else (J < F'Last - 1 and then F (J + 1) = '%') |
| loop |
| Append (Format.D.Result, F (J)); |
| |
| -- If we have two consecutive %, skip the second one |
| |
| if F (J) = '%' and then J < F'Last - 1 and then F (J + 1) = '%' then |
| J := J + 1; |
| end if; |
| |
| J := J + 1; |
| end loop; |
| |
| if F (J) /= '%' or else J = F'Last then |
| raise Format_Error with "no format specifier found for parameter" |
| & Positive'Image (Format.D.Current); |
| end if; |
| |
| Start := J; |
| |
| J := J + 1; |
| |
| -- Check for any flags |
| |
| Flags_Check : while J < F'Last loop |
| if F (J) = '-' then |
| F_Spec.Left_Justify := True; |
| elsif F (J) = '+' then |
| F_Spec.Sign := Forced; |
| elsif F (J) = ' ' then |
| F_Spec.Sign := Space; |
| elsif F (J) = '#' then |
| F_Spec.Base := C_Style; |
| elsif F (J) = '~' then |
| F_Spec.Base := Ada_Style; |
| elsif F (J) = '0' then |
| F_Spec.Zero_Pad := True; |
| else |
| exit Flags_Check; |
| end if; |
| |
| J := J + 1; |
| end loop Flags_Check; |
| |
| -- Check width if any |
| |
| if F (J) in '0' .. '9' then |
| |
| -- We have a width parameter |
| |
| S := J; |
| |
| while J < F'Last and then F (J + 1) in '0' .. '9' loop |
| J := J + 1; |
| end loop; |
| |
| F_Spec.Width := Natural'Value (F (S .. J)); |
| |
| J := J + 1; |
| |
| elsif F (J) = '*' then |
| |
| -- The width will be taken from the integer parameter |
| |
| F_Spec.Value_Needed := 1; |
| Width_From_Var := True; |
| |
| J := J + 1; |
| end if; |
| |
| if F (J) = '.' then |
| |
| -- We have a precision parameter |
| |
| J := J + 1; |
| |
| if F (J) in '0' .. '9' then |
| S := J; |
| |
| while J < F'Length and then F (J + 1) in '0' .. '9' loop |
| J := J + 1; |
| end loop; |
| |
| if F (J) = '.' then |
| |
| -- No precision, 0 is assumed |
| |
| F_Spec.Precision := 0; |
| |
| else |
| F_Spec.Precision := Natural'Value (F (S .. J)); |
| end if; |
| |
| J := J + 1; |
| |
| elsif F (J) = '*' then |
| |
| -- The prevision will be taken from the integer parameter |
| |
| F_Spec.Value_Needed := F_Spec.Value_Needed + 1; |
| J := J + 1; |
| end if; |
| end if; |
| |
| -- Skip the length specifier, this is not needed for this implementation |
| -- but yet for compatibility reason it is handled. |
| |
| Length_Check : |
| while J <= F'Last |
| and then F (J) in 'h' | 'l' | 'j' | 'z' | 't' | 'L' |
| loop |
| J := J + 1; |
| end loop Length_Check; |
| |
| if J > F'Last then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| -- Read next character which should be the expected type |
| |
| case F (J) is |
| when 'c' => F_Spec.Kind := Char; |
| when 's' => F_Spec.Kind := Str; |
| when 'd' | 'i' => F_Spec.Kind := Decimal_Int; |
| when 'u' => F_Spec.Kind := Unsigned_Decimal_Int; |
| when 'f' | 'F' => F_Spec.Kind := Decimal_Float; |
| when 'e' => F_Spec.Kind := Decimal_Scientific_Float; |
| when 'E' => F_Spec.Kind := Decimal_Scientific_Float_Up; |
| when 'g' => F_Spec.Kind := Shortest_Decimal_Float; |
| when 'G' => F_Spec.Kind := Shortest_Decimal_Float_Up; |
| when 'o' => F_Spec.Kind := Unsigned_Octal; |
| when 'x' => F_Spec.Kind := Unsigned_Hexadecimal_Int; |
| when 'X' => F_Spec.Kind := Unsigned_Hexadecimal_Int_Up; |
| |
| when others => |
| raise Format_Error with "unknown format specified for parameter" |
| & Positive'Image (Format.D.Current); |
| end case; |
| |
| J := J + 1; |
| |
| if F_Spec.Value_Needed > 0 |
| and then F_Spec.Value_Needed = Format.D.Stored_Value |
| then |
| if F_Spec.Value_Needed = 1 then |
| if Width_From_Var then |
| F_Spec.Width := Format.D.Stack (1); |
| else |
| F_Spec.Precision := Format.D.Stack (1); |
| end if; |
| |
| else |
| F_Spec.Width := Format.D.Stack (1); |
| F_Spec.Precision := Format.D.Stack (2); |
| end if; |
| end if; |
| end Next_Format; |
| |
| ------------------ |
| -- P_Flt_Format -- |
| ------------------ |
| |
| function P_Flt_Format |
| (Format : Formatted_String; |
| Var : Flt) return Formatted_String |
| is |
| F : F_Data; |
| Buffer : String (1 .. 50); |
| S, E : Positive := 1; |
| Start : Positive; |
| Aft : Text_IO.Field; |
| |
| begin |
| Next_Format (Format, F, Start); |
| |
| if F.Value_Needed > 0 then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| if F.Precision = Unset then |
| Aft := 6; |
| else |
| Aft := F.Precision; |
| end if; |
| |
| case F.Kind is |
| when Decimal_Float => |
| |
| Put (Buffer, Var, Aft, Exp => 0); |
| S := Strings.Fixed.Index_Non_Blank (Buffer); |
| E := Buffer'Last; |
| |
| when Decimal_Scientific_Float | Decimal_Scientific_Float_Up => |
| |
| Put (Buffer, Var, Aft, Exp => 3); |
| S := Strings.Fixed.Index_Non_Blank (Buffer); |
| E := Buffer'Last; |
| |
| if F.Kind = Decimal_Scientific_Float then |
| Buffer (S .. E) := |
| Characters.Handling.To_Lower (Buffer (S .. E)); |
| end if; |
| |
| when Shortest_Decimal_Float | Shortest_Decimal_Float_Up => |
| |
| -- Without exponent |
| |
| Put (Buffer, Var, Aft, Exp => 0); |
| S := Strings.Fixed.Index_Non_Blank (Buffer); |
| E := Buffer'Last; |
| |
| -- Check with exponent |
| |
| declare |
| Buffer2 : String (1 .. 50); |
| S2, E2 : Positive; |
| |
| begin |
| Put (Buffer2, Var, Aft, Exp => 3); |
| S2 := Strings.Fixed.Index_Non_Blank (Buffer2); |
| E2 := Buffer2'Last; |
| |
| -- If with exponent it is shorter, use it |
| |
| if (E2 - S2) < (E - S) then |
| Buffer := Buffer2; |
| S := S2; |
| E := E2; |
| end if; |
| end; |
| |
| if F.Kind = Shortest_Decimal_Float then |
| Buffer (S .. E) := |
| Characters.Handling.To_Lower (Buffer (S .. E)); |
| end if; |
| |
| when others => |
| Raise_Wrong_Format (Format); |
| end case; |
| |
| Append (Format.D.Result, |
| Get_Formatted (F, Buffer (S .. E), Buffer (S .. E)'Length)); |
| |
| return Format; |
| end P_Flt_Format; |
| |
| ------------------ |
| -- P_Int_Format -- |
| ------------------ |
| |
| function P_Int_Format |
| (Format : Formatted_String; |
| Var : Int) return Formatted_String |
| is |
| function Handle_Precision return Boolean; |
| -- Return True if nothing else to do |
| |
| F : F_Data; |
| Buffer : String (1 .. 50); |
| S, E : Positive := 1; |
| Len : Natural := 0; |
| Start : Positive; |
| |
| ---------------------- |
| -- Handle_Precision -- |
| ---------------------- |
| |
| function Handle_Precision return Boolean is |
| begin |
| if F.Precision = 0 and then Sign (Var) = Zero then |
| return True; |
| |
| elsif F.Precision = Natural'Last then |
| null; |
| |
| elsif F.Precision > E - S + 1 then |
| Len := F.Precision - (E - S + 1); |
| Buffer (S - Len .. S - 1) := (others => '0'); |
| S := S - Len; |
| end if; |
| |
| return False; |
| end Handle_Precision; |
| |
| -- Start of processing for P_Int_Format |
| |
| begin |
| Next_Format (Format, F, Start); |
| |
| if Format.D.Stored_Value < F.Value_Needed then |
| Format.D.Stored_Value := Format.D.Stored_Value + 1; |
| Format.D.Stack (Format.D.Stored_Value) := To_Integer (Var); |
| Format.D.Index := Start; |
| return Format; |
| end if; |
| |
| case F.Kind is |
| when Unsigned_Octal => |
| if Sign (Var) = Neg then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| Put (Buffer, Var, Base => 8); |
| S := Strings.Fixed.Index (Buffer, "8#") + 2; |
| E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1; |
| |
| if Handle_Precision then |
| return Format; |
| end if; |
| |
| case F.Base is |
| when None => null; |
| when C_Style => Len := 1; |
| when Ada_Style => Len := 3; |
| end case; |
| |
| when Unsigned_Hexadecimal_Int => |
| if Sign (Var) = Neg then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| Put (Buffer, Var, Base => 16); |
| S := Strings.Fixed.Index (Buffer, "16#") + 3; |
| E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1; |
| Buffer (S .. E) := Characters.Handling.To_Lower (Buffer (S .. E)); |
| |
| if Handle_Precision then |
| return Format; |
| end if; |
| |
| case F.Base is |
| when None => null; |
| when C_Style => Len := 2; |
| when Ada_Style => Len := 4; |
| end case; |
| |
| when Unsigned_Hexadecimal_Int_Up => |
| if Sign (Var) = Neg then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| Put (Buffer, Var, Base => 16); |
| S := Strings.Fixed.Index (Buffer, "16#") + 3; |
| E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1; |
| |
| if Handle_Precision then |
| return Format; |
| end if; |
| |
| case F.Base is |
| when None => null; |
| when C_Style => Len := 2; |
| when Ada_Style => Len := 4; |
| end case; |
| |
| when Unsigned_Decimal_Int => |
| if Sign (Var) = Neg then |
| Raise_Wrong_Format (Format); |
| end if; |
| |
| Put (Buffer, Var, Base => 10); |
| S := Strings.Fixed.Index_Non_Blank (Buffer); |
| E := Buffer'Last; |
| |
| if Handle_Precision then |
| return Format; |
| end if; |
| |
| when Decimal_Int => |
| Put (Buffer, Var, Base => 10); |
| S := Strings.Fixed.Index_Non_Blank (Buffer); |
| E := Buffer'Last; |
| |
| if Handle_Precision then |
| return Format; |
| end if; |
| |
| when Char => |
| S := Buffer'First; |
| E := Buffer'First; |
| Buffer (S) := Character'Val (To_Integer (Var)); |
| |
| if Handle_Precision then |
| return Format; |
| end if; |
| |
| when others => |
| Raise_Wrong_Format (Format); |
| end case; |
| |
| -- Then add base if needed |
| |
| declare |
| N : String := Get_Formatted (F, Buffer (S .. E), E - S + 1 + Len); |
| P : constant Positive := |
| (if F.Left_Justify |
| then N'First |
| else Natural'Max (Strings.Fixed.Index_Non_Blank (N) - 1, |
| N'First)); |
| begin |
| case F.Base is |
| when None => |
| null; |
| |
| when C_Style => |
| case F.Kind is |
| when Unsigned_Octal => |
| N (P) := 'O'; |
| |
| when Unsigned_Hexadecimal_Int => |
| if F.Left_Justify then |
| N (P .. P + 1) := "Ox"; |
| else |
| N (P - 1 .. P) := "0x"; |
| end if; |
| |
| when Unsigned_Hexadecimal_Int_Up => |
| if F.Left_Justify then |
| N (P .. P + 1) := "OX"; |
| else |
| N (P - 1 .. P) := "0X"; |
| end if; |
| |
| when others => |
| null; |
| end case; |
| |
| when Ada_Style => |
| case F.Kind is |
| when Unsigned_Octal => |
| if F.Left_Justify then |
| N (N'First + 2 .. N'Last) := N (N'First .. N'Last - 2); |
| else |
| N (P .. N'Last - 1) := N (P + 1 .. N'Last); |
| end if; |
| |
| N (N'First .. N'First + 1) := "8#"; |
| N (N'Last) := '#'; |
| |
| when Unsigned_Hexadecimal_Int | |
| Unsigned_Hexadecimal_Int_Up => |
| if F.Left_Justify then |
| N (N'First + 3 .. N'Last) := N (N'First .. N'Last - 3); |
| else |
| N (P .. N'Last - 1) := N (P + 1 .. N'Last); |
| end if; |
| |
| N (N'First .. N'First + 2) := "16#"; |
| N (N'Last) := '#'; |
| |
| when others => |
| null; |
| end case; |
| end case; |
| |
| Append (Format.D.Result, N); |
| end; |
| |
| return Format; |
| end P_Int_Format; |
| |
| ------------------------ |
| -- Raise_Wrong_Format -- |
| ------------------------ |
| |
| procedure Raise_Wrong_Format (Format : Formatted_String) is |
| begin |
| raise Format_Error with |
| "wrong format specified for parameter" |
| & Positive'Image (Format.D.Current); |
| end Raise_Wrong_Format; |
| |
| end GNAT.Formatted_String; |
