path: root/gcc/ada/libgnat/g-forstr.adb

------------------------------------------------------------------------------
--                                                                          --
--                         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-2024, 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;