| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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-2025, 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; |
| 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 |
| G_Specifier, -- %g |
| G_Specifier_Up, -- %G |
| Char, -- %c |
| Str, -- %s |
| Pointer -- %p |
| ); |
| |
| type Sign_Kind is (Neg, Zero, Pos); |
| |
| subtype Is_Number is F_Kind range Decimal_Int .. G_Specifier_Up; |
| |
| 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; |
| |
| type Notation is (Decimal, Scientific); |
| |
| procedure Advance_And_Accumulate_Until_Next_Specifier |
| (Format : Formatted_String); |
| -- Advance Format.D.Index until either the next format specifier is |
| -- encountered, or the end of Format.D.Format is reached. The characters |
| -- advanced over are appended to Format.D.Result. |
| |
| 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 |
| |
| procedure Determine_Notation_And_Aft |
| (Exponent : Integer; |
| Precision : Text_IO.Field; |
| Nota : out Notation; |
| Aft : out Text_IO.Field); |
| -- Determine whether to use scientific or decimal notation and the value of |
| -- Aft given the exponent and precision of a real number, as described in |
| -- the C language specification, section 7.21.6.1. |
| |
| function Get_Formatted |
| (F_Spec : F_Data; |
| Value : String; |
| Len : Positive) return String; |
| -- Returns Value formatted given the information in F_Spec |
| |
| procedure Increment_Integral_Part |
| (Buffer : in out String; |
| First_Non_Blank : in out Positive; |
| Last_Digit_Position : Positive); |
| -- Buffer must contain the textual representation of a number. |
| -- Last_Digit_Position must be the position of the rightmost digit of the |
| -- integral part. Buffer must have at least one padding blank. Increment |
| -- the integral part. |
| |
| 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 |
| |
| procedure Remove_Extraneous_Decimal_Digit |
| (Textual_Rep : in out String; |
| First_Non_Blank : in out Positive); |
| -- Remove the unique digit to the right of the point in Textual_Rep |
| |
| procedure Trim_Fractional_Part |
| (Textual_Rep : in out String; |
| First_Non_Blank : in out Positive); |
| -- Remove trailing zeros from Textual_Rep, which must be the textual |
| -- representation of a real number. If the fractional part only contains |
| -- zeros, also remove the point. |
| |
| --------- |
| -- "+" -- |
| --------- |
| |
| function "+" (Format : String) return Formatted_String is |
| begin |
| return Formatted_String' |
| (Finalization.Controlled with |
| D => new Data'(Format'Length, 1, 1, |
| Null_Unbounded_String, 0, 0, [0, 0], Format)); |
| end "+"; |
| |
| --------- |
| -- "-" -- |
| --------- |
| |
| function "-" (Format : Formatted_String) return String is |
| begin |
| -- Make sure we get the remaining character up to the next unhandled |
| -- format specifier. |
| |
| Advance_And_Accumulate_Until_Next_Specifier (Format); |
| |
| return To_String (Format.D.Result); |
| 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; |
| |
| ------------------------------------------------- |
| -- Advance_And_Accumulate_Until_Next_Specifier -- |
| ------------------------------------------------- |
| |
| procedure Advance_And_Accumulate_Until_Next_Specifier |
| (Format : Formatted_String) |
| is |
| begin |
| loop |
| if Format.D.Index > Format.D.Format'Last then |
| exit; |
| end if; |
| |
| if Format.D.Format (Format.D.Index) /= '%' then |
| Append (Format.D.Result, Format.D.Format (Format.D.Index)); |
| Format.D.Index := Format.D.Index + 1; |
| elsif Format.D.Index + 1 <= Format.D.Format'Last |
| and then Format.D.Format (Format.D.Index + 1) = '%' |
| then |
| Append (Format.D.Result, '%'); |
| Format.D.Index := Format.D.Index + 2; |
| else |
| exit; |
| end if; |
| end loop; |
| end Advance_And_Accumulate_Until_Next_Specifier; |
| |
| -------------------------------- |
| -- Determine_Notation_And_Aft -- |
| -------------------------------- |
| |
| procedure Determine_Notation_And_Aft |
| (Exponent : Integer; |
| Precision : Text_IO.Field; |
| Nota : out Notation; |
| Aft : out Text_IO.Field) |
| is |
| -- The constants use the same names as those from the C specification |
| -- in order to match the description of the predicate. |
| P : constant Text_IO.Field := (if Precision /= 0 then Precision else 1); |
| X : constant Integer := Exponent; |
| begin |
| if P > X and X >= -4 then |
| Nota := Decimal; |
| Aft := P - (X + 1); |
| else |
| Nota := Scientific; |
| Aft := P - 1; |
| end if; |
| end Determine_Notation_And_Aft; |
| |
| -------------------- |
| -- 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 not F_Spec.Left_Justify |
| 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; |
| |
| ----------------------------- |
| -- Increment_Integral_Part -- |
| ----------------------------- |
| |
| procedure Increment_Integral_Part |
| (Buffer : in out String; |
| First_Non_Blank : in out Positive; |
| Last_Digit_Position : Positive) |
| is |
| Cursor : Natural := Last_Digit_Position; |
| begin |
| while Buffer (Cursor) = '9' loop |
| Buffer (Cursor) := '0'; |
| Cursor := Cursor - 1; |
| end loop; |
| |
| pragma Assert (Cursor > 0); |
| |
| if Buffer (Cursor) in '0' .. '8' then |
| Buffer (Cursor) := Character'Succ (Buffer (Cursor)); |
| else |
| Ada.Strings.Fixed.Insert |
| (Buffer, |
| Cursor + 1, |
| "1"); |
| First_Non_Blank := First_Non_Blank - 1; |
| end if; |
| end Increment_Integral_Part; |
| |
| ---------------- |
| -- 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 % |
| |
| Advance_And_Accumulate_Until_Next_Specifier (Format); |
| |
| if J >= F'Last or else F (J) /= '%' 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 := G_Specifier; |
| when 'G' => F_Spec.Kind := G_Specifier_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 |
| procedure Compute_Exponent |
| (Var : Flt; |
| Valid : out Boolean; |
| Exponent : out Integer); |
| -- If Var is invalid (for example, a NaN of an inf), set Valid False and |
| -- set Exponent to 0. Otherwise, set Valid True, and store the exponent |
| -- of the scientific notation representation of Var in Exponent. The |
| -- exponent can also be defined as: |
| -- - If Var = 0, 0. |
| -- - Otherwise, Floor (Log_10 (Abs (Var))). |
| |
| procedure Format_With_Notation |
| (Var : Flt; |
| Nota : Notation; |
| Aft : Text_IO.Field; |
| Buffer : out String); |
| -- Fill buffer with the formatted value of Var following the notation |
| -- specified through Nota. |
| |
| procedure Handle_G_Specifier |
| (Buffer : out String; |
| First_Non_Blank : out Positive; |
| Aft : Text_IO.Field); |
| -- Fill Buffer with the formatted value of Var according to the rules of |
| -- the "%g" specifier. Buffer is right-justified and padded with blanks. |
| |
| ---------------------- |
| -- Compute_Exponent -- |
| ---------------------- |
| |
| procedure Compute_Exponent |
| (Var : Flt; |
| Valid : out Boolean; |
| Exponent : out Integer) |
| is |
| -- The way the exponent is computed is convoluted. It is not possible |
| -- to use the logarithm in base 10 of Var and floor it, because the |
| -- math functions for this are not available for fixed point types. |
| -- Instead, use the generic Put procedure to produce a scientific |
| -- representation of Var, and parse the exponent part of that back |
| -- into an Integer. |
| Scientific_Rep : String (1 .. 50); |
| |
| E_Position : Natural; |
| begin |
| Put (Scientific_Rep, Var, Aft => 1, Exp => 1); |
| |
| E_Position := Ada.Strings.Fixed.Index (Scientific_Rep, "E"); |
| |
| if E_Position = 0 then |
| Valid := False; |
| Exponent := 0; |
| else |
| Valid := True; |
| Exponent := |
| Integer'Value |
| (Scientific_Rep (E_Position + 1 .. Scientific_Rep'Last)); |
| end if; |
| end Compute_Exponent; |
| |
| -------------------------- |
| -- Format_With_Notation -- |
| -------------------------- |
| |
| procedure Format_With_Notation |
| (Var : Flt; |
| Nota : Notation; |
| Aft : Text_IO.Field; |
| Buffer : out String) |
| is |
| Exp : constant Text_IO.Field := |
| (case Nota is when Decimal => 0, when Scientific => 3); |
| begin |
| Put (Buffer, Var, Aft, Exp); |
| end Format_With_Notation; |
| |
| ------------------------ |
| -- Handle_G_Specifier -- |
| ------------------------ |
| |
| procedure Handle_G_Specifier |
| (Buffer : out String; |
| First_Non_Blank : out Positive; |
| Aft : Text_IO.Field) |
| is |
| -- There is nothing that is directly equivalent to the "%g" specifier |
| -- in the standard Ada functionality provided by Ada.Text_IO. The |
| -- procedure Put will still be used, but significant postprocessing |
| -- will be performed on the output of that procedure. |
| |
| -- The following code is intended to match the behavior of C's printf |
| -- for %g, as described by paragraph "7.21.6.1 The fprintf function" |
| -- of the C language specification. |
| |
| -- As explained in the C specification, we're going to have to make a |
| -- choice between decimal notation and scientific notation. One of |
| -- the elements we need in order to make that choice is the value of |
| -- the exponent in the decimal representation of Var. We will store |
| -- that value in Exponent. |
| Exponent : Integer; |
| Valid : Boolean; |
| |
| Nota : Notation; |
| |
| -- The value of the formal Aft comes from the precision specifier in |
| -- the format string. For %g, the precision specifier corresponds to |
| -- the number of significant figures desired, whereas the formal Aft |
| -- in Put corresponds to the number of digits after the point. |
| -- Effective_Aft is what will be passed to Put as Aft in order to |
| -- respect the semantics of %g. |
| Effective_Aft : Text_IO.Field; |
| |
| Textual_Rep : String (Buffer'Range); |
| begin |
| Compute_Exponent (Var, Valid, Exponent); |
| |
| Determine_Notation_And_Aft |
| (Exponent, Aft, Nota, Effective_Aft); |
| |
| Format_With_Notation (Var, Nota, Effective_Aft, Textual_Rep); |
| |
| First_Non_Blank := Strings.Fixed.Index_Non_Blank (Textual_Rep); |
| |
| if not Valid then |
| null; |
| elsif Effective_Aft = 0 then |
| -- Special case: it is possible at this point that Effective_Aft |
| -- is zero. But when Put is passed zero through Aft, it still |
| -- outputs one digit after the point. See the reference manual, |
| -- A.10.9.25. |
| |
| Remove_Extraneous_Decimal_Digit (Textual_Rep, First_Non_Blank); |
| else |
| Trim_Fractional_Part |
| (Textual_Rep, First_Non_Blank); |
| end if; |
| |
| Buffer := Textual_Rep; |
| end Handle_G_Specifier; |
| |
| -- Local variables |
| |
| F : F_Data; |
| Buffer : String (1 .. 50); |
| S, E : Positive := 1; |
| Start : Positive; |
| Aft : Text_IO.Field; |
| |
| -- Start of processing for P_Flt_Format |
| |
| begin |
| Next_Format (Format, F, Start); |
| |
| if F.Value_Needed /= Format.D.Stored_Value then |
| Raise_Wrong_Format (Format); |
| end if; |
| Format.D.Stored_Value := 0; |
| |
| 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 G_Specifier |
| | G_Specifier_Up |
| => |
| Handle_G_Specifier (Buffer, S, Aft); |
| E := Buffer'Last; |
| |
| if F.Kind = G_Specifier 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; |
| Format.D.Stored_Value := 0; |
| |
| 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; |
| |
| ------------------------------------- |
| -- Remove_Extraneous_Decimal_Digit -- |
| ------------------------------------- |
| |
| procedure Remove_Extraneous_Decimal_Digit |
| (Textual_Rep : in out String; |
| First_Non_Blank : in out Positive) |
| is |
| Point_Position : constant Positive := Ada.Strings.Fixed.Index |
| (Textual_Rep, |
| ".", |
| First_Non_Blank); |
| |
| Integral_Part_Needs_Increment : constant Boolean := |
| Textual_Rep (Point_Position + 1) in '5' .. '9'; |
| begin |
| Ada.Strings.Fixed.Delete |
| (Textual_Rep, |
| Point_Position, |
| Point_Position + 1, |
| Ada.Strings.Right); |
| |
| First_Non_Blank := First_Non_Blank + 2; |
| |
| if Integral_Part_Needs_Increment then |
| Increment_Integral_Part |
| (Textual_Rep, |
| First_Non_Blank, |
| Last_Digit_Position => Point_Position + 1); |
| end if; |
| end Remove_Extraneous_Decimal_Digit; |
| |
| -------------------------- |
| -- Trim_Fractional_Part -- |
| -------------------------- |
| |
| procedure Trim_Fractional_Part |
| (Textual_Rep : in out String; |
| First_Non_Blank : in out Positive) |
| is |
| Cursor : Positive := |
| Ada.Strings.Fixed.Index (Textual_Rep, ".", First_Non_Blank); |
| |
| First_To_Trim : Positive; |
| Fractional_Part_Last : Positive; |
| begin |
| while Cursor + 1 <= Textual_Rep'Last |
| and then Textual_Rep (Cursor + 1) in '0' .. '9' loop |
| Cursor := Cursor + 1; |
| end loop; |
| |
| Fractional_Part_Last := Cursor; |
| |
| while Textual_Rep (Cursor) = '0' loop |
| Cursor := Cursor - 1; |
| end loop; |
| |
| if Textual_Rep (Cursor) = '.' then |
| Cursor := Cursor - 1; |
| end if; |
| |
| First_To_Trim := Cursor + 1; |
| |
| Ada.Strings.Fixed.Delete |
| (Textual_Rep, First_To_Trim, Fractional_Part_Last, Ada.Strings.Right); |
| |
| First_Non_Blank := |
| First_Non_Blank + (Fractional_Part_Last - First_To_Trim + 1); |
| end Trim_Fractional_Part; |
| |
| end GNAT.Formatted_String; |
