982 lines
27 KiB
Ada
982 lines
27 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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;
|