s-fatgen$(objext) \
s-fatlfl$(objext) \
s-fatllf$(objext) \
- s-fatsfl$(objext) \
s-ficobl$(objext) \
s-filatt$(objext) \
s-fileio$(objext) \
s-vafi32$(objext) \
s-vafi64$(objext) \
s-valenu$(objext) \
+ s-valflt$(objext) \
s-valint$(objext) \
+ s-vallfl$(objext) \
+ s-valllf$(objext) \
s-vallli$(objext) \
s-valllu$(objext) \
s-valrea$(objext) \
-- All we do is use the root type (historically this dealt with
-- VAX-float .. to be cleaned up further later ???)
- Fat_Type := Rtyp;
+ if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
+ Fat_Type := Standard_Float;
+ Fat_Pkg := RE_Attr_Float;
- if Fat_Type = Standard_Short_Float then
- Fat_Pkg := RE_Attr_Short_Float;
+ elsif Rtyp = Standard_Long_Float then
+ Fat_Type := Standard_Long_Float;
+ Fat_Pkg := RE_Attr_Long_Float;
- elsif Fat_Type = Standard_Float then
- Fat_Pkg := RE_Attr_Float;
-
- elsif Fat_Type = Standard_Long_Float then
- Fat_Pkg := RE_Attr_Long_Float;
-
- elsif Fat_Type = Standard_Long_Long_Float then
- Fat_Pkg := RE_Attr_Long_Long_Float;
+ elsif Rtyp = Standard_Long_Long_Float then
+ Fat_Type := Standard_Long_Long_Float;
+ Fat_Pkg := RE_Attr_Long_Long_Float;
-- Universal real (which is its own root type) is treated as being
-- equivalent to Standard.Long_Long_Float, since it is defined to
-- have the same precision as the longest Float type.
- elsif Fat_Type = Universal_Real then
+ elsif Rtyp = Universal_Real then
Fat_Type := Standard_Long_Long_Float;
- Fat_Pkg := RE_Attr_Long_Long_Float;
+ Fat_Pkg := RE_Attr_Long_Long_Float;
else
raise Program_Error;
then
Vid := RE_Value_Fixed128;
else
- Vid := RE_Value_Real;
+ Vid := RE_Value_Long_Long_Float;
end if;
- if Vid /= RE_Value_Real then
+ if Vid /= RE_Value_Long_Long_Float then
Append_To (Args,
Make_Integer_Literal (Loc, -Norm_Num (Small_Value (Rtyp))));
end;
elsif Is_Floating_Point_Type (Rtyp) then
- Vid := RE_Value_Real;
+ if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
+ Vid := RE_Value_Float;
+
+ elsif Rtyp = Standard_Long_Float then
+ Vid := RE_Value_Long_Float;
+
+ elsif Rtyp = Standard_Long_Long_Float then
+ Vid := RE_Value_Long_Long_Float;
+
+ else
+ raise Program_Error;
+ end if;
-- Only other possibility is user-defined enumeration type
------------------------------------------------------------------------------
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
-with Ada.Text_IO.Float_Aux;
with System.Img_Real; use System.Img_Real;
package body Ada.Text_IO.Complex_Aux is
- package Aux renames Ada.Text_IO.Float_Aux;
-
---------
-- Get --
---------
procedure Get
(File : File_Type;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
procedure Gets
(From : String;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Last : out Positive)
is
Paren : Boolean;
procedure Put
(File : File_Type;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Fore : Field;
Aft : Field;
Exp : Field)
procedure Puts
(To : out String;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Aft : Field;
Exp : Field)
is
-- Both parts are initially converted with a Fore of 0
Rptr := 0;
- Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp);
Iptr := 0;
- Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp);
-- Check room for both parts plus parens plus comma (RM G.1.3(34))
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Text_IO.Complex_IO that are
--- shared among separate instantiations of this package. The routines in
--- this package are identical semantically to those in Complex_IO itself,
--- except that the generic parameter Complex has been replaced by separate
--- real and imaginary values of type Long_Long_Float, and default parameters
--- have been removed because they are supplied explicitly by the calls from
--- within the generic template.
+-- shared among separate instantiations of this package. The routines in this
+-- package are identical semantically to those in Complex_IO, except that the
+-- generic parameter Complex has been replaced by separate real and imaginary
+-- parameters, and default parameters have been removed because they are
+-- supplied explicitly by the calls from within the generic template.
+
+with Ada.Text_IO.Float_Aux;
+
+private generic
+
+ type Num is digits <>;
+
+ with package Aux is new Ada.Text_IO.Float_Aux (Num, <>);
package Ada.Text_IO.Complex_Aux is
procedure Get
(File : File_Type;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Width : Field);
procedure Put
(File : File_Type;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Fore : Field;
Aft : Field;
Exp : Field);
procedure Gets
(From : String;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Last : out Positive);
procedure Puts
(To : out String;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Aft : Field;
Exp : Field);
-- --
------------------------------------------------------------------------------
-with Ada.Text_IO;
-
with Ada.Text_IO.Complex_Aux;
+with Ada.Text_IO.Float_Aux;
+with System.Val_Flt; use System.Val_Flt;
+with System.Val_LFlt; use System.Val_LFlt;
+with System.Val_LLF; use System.Val_LLF;
package body Ada.Text_IO.Complex_IO is
use Complex_Types;
- package Aux renames Ada.Text_IO.Complex_Aux;
+ package Scalar_Float is new
+ Ada.Text_IO.Float_Aux (Float, Scan_Float);
+
+ package Scalar_Long_Float is new
+ Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
+
+ package Scalar_Long_Long_Float is new
+ Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
+ package Aux_Float is new
+ Ada.Text_IO.Complex_Aux (Float, Scalar_Float);
+
+ package Aux_Long_Float is new
+ Ada.Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float);
- subtype LLF is Long_Long_Float;
- -- Type used for calls to routines in Aux
+ package Aux_Long_Long_Float is new
+ Ada.Text_IO.Complex_Aux (Long_Long_Float, Scalar_Long_Long_Float);
+
+ -- Throughout this generic body, we distinguish between the case where type
+ -- Float is OK, where type Long_Float is OK and where type Long_Long_Float
+ -- is needed. These boolean constants are used to test for this, such that
+ -- only code for the relevant case is included in the instance.
+
+ OK_Float : constant Boolean := Real'Base'Digits <= Float'Digits;
+
+ OK_Long_Float : constant Boolean := Real'Base'Digits <= Long_Float'Digits;
---------
-- Get --
procedure Get
(File : File_Type;
- Item : out Complex_Types.Complex;
+ Item : out Complex;
Width : Field := 0)
is
Real_Item : Real'Base;
Imag_Item : Real'Base;
begin
- Aux.Get (File, LLF (Real_Item), LLF (Imag_Item), Width);
+ if OK_Float then
+ Aux_Float.Get (File, Float (Real_Item), Float (Imag_Item), Width);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Get
+ (File, Long_Float (Real_Item), Long_Float (Imag_Item), Width);
+ else
+ Aux_Long_Long_Float.Get
+ (File, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
+ Width);
+ end if;
+
Item := (Real_Item, Imag_Item);
exception
---------
procedure Get
- (Item : out Complex_Types.Complex;
+ (Item : out Complex;
Width : Field := 0)
is
begin
procedure Get
(From : String;
- Item : out Complex_Types.Complex;
+ Item : out Complex;
Last : out Positive)
is
Real_Item : Real'Base;
Imag_Item : Real'Base;
begin
- Aux.Gets (From, LLF (Real_Item), LLF (Imag_Item), Last);
+ if OK_Float then
+ Aux_Float.Gets (From, Float (Real_Item), Float (Imag_Item), Last);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Gets
+ (From, Long_Float (Real_Item), Long_Float (Imag_Item), Last);
+ else
+ Aux_Long_Long_Float.Gets
+ (From, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
+ Last);
+ end if;
+
Item := (Real_Item, Imag_Item);
exception
procedure Put
(File : File_Type;
- Item : Complex_Types.Complex;
+ Item : Complex;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp)
is
begin
- Aux.Put (File, LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
+ if OK_Float then
+ Aux_Float.Put
+ (File, Float (Re (Item)), Float (Im (Item)), Fore, Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Put
+ (File, Long_Float (Re (Item)), Long_Float (Im (Item)), Fore, Aft,
+ Exp);
+ else
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
+ Fore, Aft, Exp);
+ end if;
end Put;
---------
---------
procedure Put
- (Item : Complex_Types.Complex;
+ (Item : Complex;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp)
procedure Put
(To : out String;
- Item : Complex_Types.Complex;
+ Item : Complex;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp)
is
begin
- Aux.Puts (To, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
+ if OK_Float then
+ Aux_Float.Puts (To, Float (Re (Item)), Float (Im (Item)), Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Puts
+ (To, Long_Float (Re (Item)), Long_Float (Im (Item)), Aft, Exp);
+ else
+ Aux_Long_Long_Float.Puts
+ (To, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
+ Aft, Exp);
+ end if;
end Put;
end Ada.Text_IO.Complex_IO;
------------------------------------------------------------------------------
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
-with Ada.Text_IO.Float_Aux; use Ada.Text_IO.Float_Aux;
package body Ada.Text_IO.Decimal_Aux is
------------------------------------------------------------------------------
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
-with Ada.Text_IO.Float_Aux; use Ada.Text_IO.Float_Aux;
package body Ada.Text_IO.Fixed_Aux is
with System.Img_Fixed_64; use System.Img_Fixed_64;
with System.Val_Fixed_32; use System.Val_Fixed_32;
with System.Val_Fixed_64; use System.Val_Fixed_64;
+with System.Val_LLF; use System.Val_LLF;
package body Ada.Text_IO.Fixed_IO is
package Aux64 is new
Ada.Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64);
+ package Aux_Long_Long_Float is new
+ Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
-- Throughout this generic body, we distinguish between the case where type
-- Int32 is OK and where type Int64 is OK. These boolean constants are used
-- to test for this, such that only code for the relevant case is included
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Get (File, Long_Long_Float (Item), Width);
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
end if;
exception
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Gets (From, Long_Long_Float (Item), Last);
+ Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last);
end if;
exception
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
end if;
end Put;
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Puts (To, Long_Long_Float (Item), Aft, Exp);
+ Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp);
end if;
end Put;
with System.Val_Fixed_32; use System.Val_Fixed_32;
with System.Val_Fixed_64; use System.Val_Fixed_64;
with System.Val_Fixed_128; use System.Val_Fixed_128;
+with System.Val_LLF; use System.Val_LLF;
package body Ada.Text_IO.Fixed_IO is
package Aux128 is new
Ada.Text_IO.Fixed_Aux (Int128, Scan_Fixed128, Set_Image_Fixed128);
+ package Aux_Long_Long_Float is new
+ Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
-- Throughout this generic body, we distinguish between the case where type
-- Int32 is OK, where type Int64 is OK and where type Int128 is OK. These
-- boolean constants are used to test for this, such that only code for the
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Get (File, Long_Long_Float (Item), Width);
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
end if;
exception
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Gets (From, Long_Long_Float (Item), Last);
+ Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last);
end if;
exception
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
end if;
end Put;
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Puts (To, Long_Long_Float (Item), Aft, Exp);
+ Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp);
end if;
end Put;
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
with System.Img_Real; use System.Img_Real;
-with System.Val_Real; use System.Val_Real;
package body Ada.Text_IO.Float_Aux is
procedure Get
(File : File_Type;
- Item : out Long_Long_Float;
+ Item : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr := 1;
end if;
- Item := Scan_Real (Buf, Ptr'Access, Stop);
+ Item := Scan (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get;
procedure Gets
(From : String;
- Item : out Long_Long_Float;
+ Item : out Num;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
- Item := Scan_Real (From, Pos'Access, From'Last);
+ Item := Scan (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
when Constraint_Error => raise Data_Error;
end Gets;
- ---------------
- -- Load_Real --
- ---------------
-
- procedure Load_Real
- (File : File_Type;
- Buf : out String;
- Ptr : in out Natural)
- is
- Loaded : Boolean;
-
- begin
- -- Skip initial blanks, and load possible sign
-
- Load_Skip (File);
- Load (File, Buf, Ptr, '+', '-');
-
- -- Case of .nnnn
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Digits (File, Buf, Ptr, Loaded);
-
- -- Hopeless junk if no digits loaded
-
- if not Loaded then
- return;
- end if;
-
- -- Otherwise must have digits to start
-
- else
- Load_Digits (File, Buf, Ptr, Loaded);
-
- -- Hopeless junk if no digits loaded
-
- if not Loaded then
- return;
- end if;
-
- -- Based cases. We recognize either the standard '#' or the
- -- allowed alternative replacement ':' (see RM J.2(3)).
-
- Load (File, Buf, Ptr, '#', ':', Loaded);
-
- if Loaded then
-
- -- Case of nnn#.xxx#
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Extended_Digits (File, Buf, Ptr);
- Load (File, Buf, Ptr, '#', ':');
-
- -- Case of nnn#xxx.[xxx]# or nnn#xxx#
-
- else
- Load_Extended_Digits (File, Buf, Ptr);
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Extended_Digits (File, Buf, Ptr);
- end if;
-
- -- As usual, it seems strange to allow mixed base characters,
- -- but that is what ACVC tests expect, see CE3804M, case (3).
-
- Load (File, Buf, Ptr, '#', ':');
- end if;
-
- -- Case of nnn.[nnn] or nnn
-
- else
- -- Prevent the potential processing of '.' in cases where the
- -- initial digits have a trailing underscore.
-
- if Buf (Ptr) = '_' then
- return;
- end if;
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Digits (File, Buf, Ptr);
- end if;
- end if;
- end if;
-
- -- Deal with exponent
-
- Load (File, Buf, Ptr, 'E', 'e', Loaded);
-
- if Loaded then
- Load (File, Buf, Ptr, '+', '-');
- Load_Digits (File, Buf, Ptr);
- end if;
- end Load_Real;
-
---------
-- Put --
---------
procedure Put
(File : File_Type;
- Item : Long_Long_Float;
+ Item : Num;
Fore : Field;
Aft : Field;
Exp : Field)
Ptr : Natural := 0;
begin
- Set_Image_Real (Item, Buf, Ptr, Fore, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp);
Put_Item (File, Buf (1 .. Ptr));
end Put;
procedure Puts
(To : out String;
- Item : Long_Long_Float;
+ Item : Num;
Aft : Field;
Exp : Field)
is
Ptr : Natural := 0;
begin
- Set_Image_Real (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
+ Set_Image_Real
+ (Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
if Ptr > To'Length then
raise Layout_Error;
-- This package contains the routines for Ada.Text_IO.Float_IO that are
-- shared among separate instantiations of this package. The routines in
--- this package are identical semantically to those in Float_IO itself,
--- except that generic parameter Num has been replaced by Long_Long_Float,
--- and the default parameters have been removed because they are supplied
+-- this package are identical semantically to those in Float_IO, except
+-- that the default parameters have been removed because they are supplied
-- explicitly by the calls from within the generic template. This package
--- is also used by Ada.Text_IO.Fixed_IO, and Ada.Text_IO.Decimal_IO.
+-- is also used by Ada.Text_IO.Fixed_IO and Ada.Text_IO.Decimal_IO.
-private package Ada.Text_IO.Float_Aux is
+private generic
- procedure Load_Real
- (File : File_Type;
- Buf : out String;
- Ptr : in out Natural);
- -- This is an auxiliary routine that is used to load a possibly signed
- -- real literal value from the input file into Buf, starting at Ptr + 1.
+ type Num is digits <>;
+
+ with function Scan
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer) return Num;
+
+package Ada.Text_IO.Float_Aux is
procedure Get
(File : File_Type;
- Item : out Long_Long_Float;
+ Item : out Num;
Width : Field);
procedure Put
(File : File_Type;
- Item : Long_Long_Float;
+ Item : Num;
Fore : Field;
Aft : Field;
Exp : Field);
procedure Gets
(From : String;
- Item : out Long_Long_Float;
+ Item : out Num;
Last : out Positive);
procedure Puts
(To : out String;
- Item : Long_Long_Float;
+ Item : Num;
Aft : Field;
Exp : Field);
------------------------------------------------------------------------------
with Ada.Text_IO.Float_Aux;
+with System.Val_Flt; use System.Val_Flt;
+with System.Val_LFlt; use System.Val_LFlt;
+with System.Val_LLF; use System.Val_LLF;
package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is
- package Aux renames Ada.Text_IO.Float_Aux;
+ package Aux_Float is new
+ Ada.Text_IO.Float_Aux (Float, Scan_Float);
+
+ package Aux_Long_Float is new
+ Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
+
+ package Aux_Long_Long_Float is new
+ Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
+ -- Throughout this generic body, we distinguish between the case where type
+ -- Float is OK, where type Long_Float is OK and where type Long_Long_Float
+ -- is needed. These boolean constants are used to test for this, such that
+ -- only code for the relevant case is included in the instance.
+
+ OK_Float : constant Boolean := Num'Base'Digits <= Float'Digits;
+
+ OK_Long_Float : constant Boolean := Num'Base'Digits <= Long_Float'Digits;
---------
-- Get --
pragma Unsuppress (Range_Check);
begin
- Aux.Get (File, Long_Long_Float (Item), Width);
+ if OK_Float then
+ Aux_Float.Get (File, Float (Item), Width);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Get (File, Long_Float (Item), Width);
+ else
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
+ end if;
-- In the case where the type is unconstrained (e.g. Standard'Float),
-- the above conversion may result in an infinite value, which is
(Item : out Num;
Width : Field := 0)
is
- pragma Unsuppress (Range_Check);
-
begin
- Aux.Get (Current_In, Long_Long_Float (Item), Width);
-
- -- In the case where the type is unconstrained (e.g. Standard'Float),
- -- the above conversion may result in an infinite value, which is
- -- normally fine for a conversion, but in this case, we want to treat
- -- that as a data error.
-
- if not Item'Valid then
- raise Data_Error;
- end if;
-
- exception
- when Constraint_Error => raise Data_Error;
+ Get (Current_In, Item, Width);
end Get;
procedure Get
pragma Unsuppress (Range_Check);
begin
- Aux.Gets (From, Long_Long_Float (Item), Last);
+ if OK_Float then
+ Aux_Float.Gets (From, Float (Item), Last);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Gets (From, Long_Float (Item), Last);
+ else
+ Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last);
+ end if;
-- In the case where the type is unconstrained (e.g. Standard'Float),
-- the above conversion may result in an infinite value, which is
Exp : Field := Default_Exp)
is
begin
- Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ if OK_Float then
+ Aux_Float.Put (File, Float (Item), Fore, Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp);
+ else
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ end if;
end Put;
procedure Put
Exp : Field := Default_Exp)
is
begin
- Aux.Put (Current_Out, Long_Long_Float (Item), Fore, Aft, Exp);
+ Put (Current_Out, Item, Fore, Aft, Exp);
end Put;
procedure Put
Exp : Field := Default_Exp)
is
begin
- Aux.Puts (To, Long_Long_Float (Item), Aft, Exp);
+ if OK_Float then
+ Aux_Float.Puts (To, Float (Item), Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Puts (To, Long_Float (Item), Aft, Exp);
+ else
+ Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp);
+ end if;
end Put;
end Ada.Text_IO.Float_IO;
end if;
end Load_Integer;
+ ---------------
+ -- Load_Real --
+ ---------------
+
+ procedure Load_Real
+ (File : File_Type;
+ Buf : out String;
+ Ptr : in out Natural)
+ is
+ Loaded : Boolean;
+
+ begin
+ -- Skip initial blanks, and load possible sign
+
+ Load_Skip (File);
+ Load (File, Buf, Ptr, '+', '-');
+
+ -- Case of .nnnn
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Digits (File, Buf, Ptr, Loaded);
+
+ -- Hopeless junk if no digits loaded
+
+ if not Loaded then
+ return;
+ end if;
+
+ -- Otherwise must have digits to start
+
+ else
+ Load_Digits (File, Buf, Ptr, Loaded);
+
+ -- Hopeless junk if no digits loaded
+
+ if not Loaded then
+ return;
+ end if;
+
+ -- Based cases. We recognize either the standard '#' or the
+ -- allowed alternative replacement ':' (see RM J.2(3)).
+
+ Load (File, Buf, Ptr, '#', ':', Loaded);
+
+ if Loaded then
+
+ -- Case of nnn#.xxx#
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Extended_Digits (File, Buf, Ptr);
+ Load (File, Buf, Ptr, '#', ':');
+
+ -- Case of nnn#xxx.[xxx]# or nnn#xxx#
+
+ else
+ Load_Extended_Digits (File, Buf, Ptr);
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Extended_Digits (File, Buf, Ptr);
+ end if;
+
+ -- As usual, it seems strange to allow mixed base characters,
+ -- but that is what ACVC tests expect, see CE3804M, case (3).
+
+ Load (File, Buf, Ptr, '#', ':');
+ end if;
+
+ -- Case of nnn.[nnn] or nnn
+
+ else
+ -- Prevent the potential processing of '.' in cases where the
+ -- initial digits have a trailing underscore.
+
+ if Buf (Ptr) = '_' then
+ return;
+ end if;
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Digits (File, Buf, Ptr);
+ end if;
+ end if;
+ end if;
+
+ -- Deal with exponent
+
+ Load (File, Buf, Ptr, 'E', 'e', Loaded);
+
+ if Loaded then
+ Load (File, Buf, Ptr, '+', '-');
+ Load_Digits (File, Buf, Ptr);
+ end if;
+ end Load_Real;
+
---------------
-- Load_Skip --
---------------
Ptr : in out Natural);
-- Loads a possibly signed integer literal value
+ procedure Load_Real
+ (File : File_Type;
+ Buf : out String;
+ Ptr : in out Natural);
+ -- Loads a possibly signed real literal value
+
function Nextc (File : File_Type) return Integer;
-- Like Getc, but includes a call to Ungetc, so that the file
-- pointer is not moved by the call.
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
-with Ada.Wide_Text_IO.Float_Aux;
with System.Img_Real; use System.Img_Real;
package body Ada.Wide_Text_IO.Complex_Aux is
- package Aux renames Ada.Wide_Text_IO.Float_Aux;
-
---------
-- Get --
---------
procedure Get
(File : File_Type;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
procedure Gets
(From : String;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Last : out Positive)
is
Paren : Boolean;
procedure Put
(File : File_Type;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Fore : Field;
Aft : Field;
Exp : Field)
procedure Puts
(To : out String;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Aft : Field;
Exp : Field)
is
-- Both parts are initially converted with a Fore of 0
Rptr := 0;
- Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp);
Iptr := 0;
- Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp);
-- Check room for both parts plus parens plus comma (RM G.1.3(34))
-- --
------------------------------------------------------------------------------
--- This package contains the routines for Ada.Wide_Text_IO.Complex_IO that
--- are shared among separate instantiations of this package. The routines
--- in this package are identical semantically to those in Complex_IO itself,
--- except that the generic parameter Complex has been replaced by separate
--- real and imaginary values of type Long_Long_Float, and default parameters
--- have been removed because they are supplied explicitly by the calls from
--- within the generic template.
+-- This package contains the routines for Ada.Wide_Text_IO.Complex_IO that are
+-- shared among separate instantiations of this package. The routines in this
+-- package are identical semantically to those in Complex_IO, except that the
+-- generic parameter Complex has been replaced by separate real and imaginary
+-- parameters, and default parameters have been removed because they are
+-- supplied explicitly by the calls from within the generic template.
+
+with Ada.Wide_Text_IO.Float_Aux;
+
+private generic
+
+ type Num is digits <>;
+
+ with package Aux is new Ada.Wide_Text_IO.Float_Aux (Num, <>);
package Ada.Wide_Text_IO.Complex_Aux is
procedure Get
(File : File_Type;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Width : Field);
- procedure Gets
- (From : String;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
- Last : out Positive);
-
procedure Put
(File : File_Type;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Fore : Field;
Aft : Field;
Exp : Field);
+ procedure Gets
+ (From : String;
+ ItemR : out Num;
+ ItemI : out Num;
+ Last : out Positive);
+
procedure Puts
(To : out String;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Aft : Field;
Exp : Field);
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Complex_Aux;
+with Ada.Wide_Text_IO.Float_Aux;
+with System.Val_Flt; use System.Val_Flt;
+with System.Val_LFlt; use System.Val_LFlt;
+with System.Val_LLF; use System.Val_LLF;
+with System.WCh_Con; use System.WCh_Con;
+with System.WCh_WtS; use System.WCh_WtS;
-with System.WCh_Con; use System.WCh_Con;
-with System.WCh_WtS; use System.WCh_WtS;
+package body Ada.Wide_Text_IO.Complex_IO is
-with Ada.Unchecked_Conversion;
+ use Complex_Types;
-package body Ada.Wide_Text_IO.Complex_IO is
+ package Scalar_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float);
+
+ package Scalar_Long_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
+
+ package Scalar_Long_Long_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
+ package Aux_Float is new
+ Ada.Wide_Text_IO.Complex_Aux (Float, Scalar_Float);
- package Aux renames Ada.Wide_Text_IO.Complex_Aux;
+ package Aux_Long_Float is new
+ Ada.Wide_Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float);
- subtype LLF is Long_Long_Float;
- -- Type used for calls to routines in Aux
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Text_IO.Complex_Aux (Long_Long_Float, Scalar_Long_Long_Float);
- function TFT is new
- Ada.Unchecked_Conversion (File_Type, Ada.Wide_Text_IO.File_Type);
- -- This unchecked conversion is to get around a visibility bug in
- -- GNAT version 2.04w. It should be possible to simply use the
- -- subtype declared above and do normal checked conversions.
+ -- Throughout this generic body, we distinguish between the case where type
+ -- Float is OK, where type Long_Float is OK and where type Long_Long_Float
+ -- is needed. These boolean constants are used to test for this, such that
+ -- only code for the relevant case is included in the instance.
+
+ OK_Float : constant Boolean := Real'Base'Digits <= Float'Digits;
+
+ OK_Long_Float : constant Boolean := Real'Base'Digits <= Long_Float'Digits;
---------
-- Get --
Imag_Item : Real'Base;
begin
- Aux.Get (TFT (File), LLF (Real_Item), LLF (Imag_Item), Width);
+ if OK_Float then
+ Aux_Float.Get (File, Float (Real_Item), Float (Imag_Item), Width);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Get
+ (File, Long_Float (Real_Item), Long_Float (Imag_Item), Width);
+ else
+ Aux_Long_Long_Float.Get
+ (File, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
+ Width);
+ end if;
+
Item := (Real_Item, Imag_Item);
exception
-- Aux.Gets will raise Data_Error in any case.
begin
- Aux.Gets (S, LLF (Real_Item), LLF (Imag_Item), Last);
+ if OK_Float then
+ Aux_Float.Gets (S, Float (Real_Item), Float (Imag_Item), Last);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Gets
+ (S, Long_Float (Real_Item), Long_Float (Imag_Item), Last);
+ else
+ Aux_Long_Long_Float.Gets
+ (S, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
+ Last);
+ end if;
+
Item := (Real_Item, Imag_Item);
exception
Exp : Field := Default_Exp)
is
begin
- Aux.Put (TFT (File), LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
+ if OK_Float then
+ Aux_Float.Put
+ (File, Float (Re (Item)), Float (Im (Item)), Fore, Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Put
+ (File, Long_Float (Re (Item)), Long_Float (Im (Item)), Fore, Aft,
+ Exp);
+ else
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
+ Fore, Aft, Exp);
+ end if;
end Put;
---------
S : String (To'First .. To'Last);
begin
- Aux.Puts (S, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
+ if OK_Float then
+ Aux_Float.Puts (S, Float (Re (Item)), Float (Im (Item)), Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Puts
+ (S, Long_Float (Re (Item)), Long_Float (Im (Item)), Aft, Exp);
+ else
+ Aux_Long_Long_Float.Puts
+ (S, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
+ Aft, Exp);
+ end if;
for J in S'Range loop
To (J) := Wide_Character'Val (Character'Pos (S (J)));
package Ada.Wide_Text_IO.Complex_IO is
- use Complex_Types;
-
Default_Fore : Field := 2;
- Default_Aft : Field := Real'Digits - 1;
+ Default_Aft : Field := Complex_Types.Real'Digits - 1;
Default_Exp : Field := 3;
procedure Get
(File : File_Type;
- Item : out Complex;
+ Item : out Complex_Types.Complex;
Width : Field := 0);
procedure Get
- (Item : out Complex;
+ (Item : out Complex_Types.Complex;
Width : Field := 0);
procedure Put
(File : File_Type;
- Item : Complex;
+ Item : Complex_Types.Complex;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
procedure Put
- (Item : Complex;
+ (Item : Complex_Types.Complex;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
procedure Get
(From : Wide_String;
- Item : out Complex;
+ Item : out Complex_Types.Complex;
Last : out Positive);
procedure Put
(To : out Wide_String;
- Item : Complex;
+ Item : Complex_Types.Complex;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
-with Ada.Wide_Text_IO.Float_Aux; use Ada.Wide_Text_IO.Float_Aux;
package body Ada.Wide_Text_IO.Decimal_Aux is
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
-with Ada.Wide_Text_IO.Float_Aux; use Ada.Wide_Text_IO.Float_Aux;
package body Ada.Wide_Text_IO.Fixed_Aux is
with System.Img_Fixed_64; use System.Img_Fixed_64;
with System.Val_Fixed_32; use System.Val_Fixed_32;
with System.Val_Fixed_64; use System.Val_Fixed_64;
+with System.Val_LLF; use System.Val_LLF;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package Aux64 is new
Ada.Wide_Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64);
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
-- Throughout this generic body, we distinguish between the case where type
-- Int32 is OK and where type Int64 is OK. These boolean constants are used
-- to test for this, such that only code for the relevant case is included
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Get (File, Long_Long_Float (Item), Width);
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
end if;
exception
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Gets (S, Long_Long_Float (Item), Last);
+ Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
end if;
exception
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
end if;
end Put;
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
end if;
for J in S'Range loop
with System.Val_Fixed_32; use System.Val_Fixed_32;
with System.Val_Fixed_64; use System.Val_Fixed_64;
with System.Val_Fixed_128; use System.Val_Fixed_128;
+with System.Val_LLF; use System.Val_LLF;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package Aux128 is new
Ada.Wide_Text_IO.Fixed_Aux (Int128, Scan_Fixed128, Set_Image_Fixed128);
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
-- Throughout this generic body, we distinguish between the case where type
-- Int32 is OK, where type Int64 is OK and where type Int128 is OK. These
-- boolean constants are used to test for this, such that only code for the
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Get (File, Long_Long_Float (Item), Width);
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
end if;
exception
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Gets (S, Long_Long_Float (Item), Last);
+ Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
end if;
exception
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
end if;
end Put;
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
end if;
for J in S'Range loop
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
-with System.Img_Real; use System.Img_Real;
-with System.Val_Real; use System.Val_Real;
+with System.Img_Real; use System.Img_Real;
package body Ada.Wide_Text_IO.Float_Aux is
procedure Get
(File : File_Type;
- Item : out Long_Long_Float;
+ Item : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
- Ptr : aliased Integer := 1;
+ Ptr : aliased Integer;
begin
if Width /= 0 then
String_Skip (Buf, Ptr);
else
Load_Real (File, Buf, Stop);
+ Ptr := 1;
end if;
- Item := Scan_Real (Buf, Ptr'Access, Stop);
-
+ Item := Scan (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get;
procedure Gets
(From : String;
- Item : out Long_Long_Float;
+ Item : out Num;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
- Item := Scan_Real (From, Pos'Access, From'Last);
+ Item := Scan (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
- when Constraint_Error =>
- raise Data_Error;
+ when Constraint_Error => raise Data_Error;
end Gets;
- ---------------
- -- Load_Real --
- ---------------
-
- procedure Load_Real
- (File : File_Type;
- Buf : out String;
- Ptr : in out Natural)
- is
- Loaded : Boolean;
-
- begin
- -- Skip initial blanks and load possible sign
-
- Load_Skip (File);
- Load (File, Buf, Ptr, '+', '-');
-
- -- Case of .nnnn
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Digits (File, Buf, Ptr, Loaded);
-
- -- Hopeless junk if no digits loaded
-
- if not Loaded then
- return;
- end if;
-
- -- Otherwise must have digits to start
-
- else
- Load_Digits (File, Buf, Ptr, Loaded);
-
- -- Hopeless junk if no digits loaded
-
- if not Loaded then
- return;
- end if;
-
- -- Deal with based case. We recognize either the standard '#' or the
- -- allowed alternative replacement ':' (see RM J.2(3)).
-
- Load (File, Buf, Ptr, '#', ':', Loaded);
-
- if Loaded then
-
- -- Case of nnn#.xxx#
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Extended_Digits (File, Buf, Ptr);
- Load (File, Buf, Ptr, '#', ':');
-
- -- Case of nnn#xxx.[xxx]# or nnn#xxx#
-
- else
- Load_Extended_Digits (File, Buf, Ptr);
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Extended_Digits (File, Buf, Ptr);
- end if;
-
- -- As usual, it seems strange to allow mixed base characters,
- -- but that is what ACVC tests expect, see CE3804M, case (3).
-
- Load (File, Buf, Ptr, '#', ':');
- end if;
-
- -- Case of nnn.[nnn] or nnn
-
- else
- -- Prevent the potential processing of '.' in cases where the
- -- initial digits have a trailing underscore.
-
- if Buf (Ptr) = '_' then
- return;
- end if;
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Digits (File, Buf, Ptr);
- end if;
- end if;
- end if;
-
- -- Deal with exponent
-
- Load (File, Buf, Ptr, 'E', 'e', Loaded);
-
- if Loaded then
- Load (File, Buf, Ptr, '+', '-');
- Load_Digits (File, Buf, Ptr);
- end if;
- end Load_Real;
-
---------
-- Put --
---------
procedure Put
(File : File_Type;
- Item : Long_Long_Float;
+ Item : Num;
Fore : Field;
Aft : Field;
Exp : Field)
is
- Buf : String (1 .. Field'Last);
+ Buf : String (1 .. Max_Real_Image_Length);
Ptr : Natural := 0;
begin
- Set_Image_Real (Item, Buf, Ptr, Fore, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp);
Put_Item (File, Buf (1 .. Ptr));
end Put;
procedure Puts
(To : out String;
- Item : Long_Long_Float;
+ Item : Num;
Aft : Field;
Exp : Field)
is
- Buf : String (1 .. Field'Last);
+ Buf : String (1 .. Max_Real_Image_Length);
Ptr : Natural := 0;
begin
- Set_Image_Real (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
+ Set_Image_Real
+ (Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
if Ptr > To'Length then
raise Layout_Error;
-- This package contains the routines for Ada.Wide_Text_IO.Float_IO that
-- are shared among separate instantiations of this package. The routines
--- in this package are identical semantically to those in Float_IO itself,
--- except that generic parameter Num has been replaced by Long_Long_Float,
--- and the default parameters have been removed because they are supplied
+-- in this package are identical semantically to those in Float_IO, except
+-- that the default parameters have been removed because they are supplied
-- explicitly by the calls from within the generic template. This package
--- is also used by Ada.Wide_Text_IO.Fixed_IO, Ada.Wide_Text_IO.Decimal_IO.
+-- is also used by Ada.Wide_Text_IO.Fixed_IO and Ada.Wide_Text_IO.Decimal_IO.
-private package Ada.Wide_Text_IO.Float_Aux is
+private generic
- procedure Load_Real
- (File : File_Type;
- Buf : out String;
- Ptr : in out Natural);
- -- This is an auxiliary routine that is used to load a possibly signed
- -- real literal value from the input file into Buf, starting at Ptr + 1.
+ type Num is digits <>;
+
+ with function Scan
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer) return Num;
+
+package Ada.Wide_Text_IO.Float_Aux is
procedure Get
(File : File_Type;
- Item : out Long_Long_Float;
+ Item : out Num;
Width : Field);
- procedure Gets
- (From : String;
- Item : out Long_Long_Float;
- Last : out Positive);
-
procedure Put
(File : File_Type;
- Item : Long_Long_Float;
+ Item : Num;
Fore : Field;
Aft : Field;
Exp : Field);
+ procedure Gets
+ (From : String;
+ Item : out Num;
+ Last : out Positive);
+
procedure Puts
(To : out String;
- Item : Long_Long_Float;
+ Item : Num;
Aft : Field;
Exp : Field);
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Float_Aux;
-
-with System.WCh_Con; use System.WCh_Con;
-with System.WCh_WtS; use System.WCh_WtS;
+with System.Val_Flt; use System.Val_Flt;
+with System.Val_LFlt; use System.Val_LFlt;
+with System.Val_LLF; use System.Val_LLF;
+with System.WCh_Con; use System.WCh_Con;
+with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Text_IO.Float_IO is
- package Aux renames Ada.Wide_Text_IO.Float_Aux;
+ package Aux_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float);
+
+ package Aux_Long_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
+
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
+ -- Throughout this generic body, we distinguish between the case where type
+ -- Float is OK, where type Long_Float is OK and where type Long_Long_Float
+ -- is needed. These boolean constants are used to test for this, such that
+ -- only code for the relevant case is included in the instance.
+
+ OK_Float : constant Boolean := Num'Base'Digits <= Float'Digits;
+
+ OK_Long_Float : constant Boolean := Num'Base'Digits <= Long_Float'Digits;
---------
-- Get --
Item : out Num;
Width : Field := 0)
is
+ pragma Unsuppress (Range_Check);
+
begin
- Aux.Get (File, Long_Long_Float (Item), Width);
+ if OK_Float then
+ Aux_Float.Get (File, Float (Item), Width);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Get (File, Long_Float (Item), Width);
+ else
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
+ end if;
+
+ -- In the case where the type is unconstrained (e.g. Standard'Float),
+ -- the above conversion may result in an infinite value, which is
+ -- normally fine for a conversion, but in this case, we want to treat
+ -- that as a data error.
+
+ if not Item'Valid then
+ raise Data_Error;
+ end if;
exception
when Constraint_Error => raise Data_Error;
Item : out Num;
Last : out Positive)
is
+ pragma Unsuppress (Range_Check);
+
S : constant String := Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
-- Aux.Gets will raise Data_Error in any case.
begin
- Aux.Gets (S, Long_Long_Float (Item), Last);
+ if OK_Float then
+ Aux_Float.Gets (S, Float (Item), Last);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Gets (S, Long_Float (Item), Last);
+ else
+ Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
+ end if;
+
+ -- In the case where the type is unconstrained (e.g. Standard'Float),
+ -- the above conversion may result in an infinite value, which is
+ -- normally fine for a conversion, but in this case, we want to treat
+ -- that as a data error.
+
+ if not Item'Valid then
+ raise Data_Error;
+ end if;
exception
when Constraint_Error => raise Data_Error;
Exp : Field := Default_Exp)
is
begin
- Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ if OK_Float then
+ Aux_Float.Put (File, Float (Item), Fore, Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp);
+ else
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ end if;
end Put;
procedure Put
S : String (To'First .. To'Last);
begin
- Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ if OK_Float then
+ Aux_Float.Puts (S, Float (Item), Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp);
+ else
+ Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ end if;
for J in S'Range loop
To (J) := Wide_Character'Val (Character'Pos (S (J)));
end if;
end Load_Integer;
+ ---------------
+ -- Load_Real --
+ ---------------
+
+ procedure Load_Real
+ (File : File_Type;
+ Buf : out String;
+ Ptr : in out Natural)
+ is
+ Loaded : Boolean;
+
+ begin
+ -- Skip initial blanks and load possible sign
+
+ Load_Skip (File);
+ Load (File, Buf, Ptr, '+', '-');
+
+ -- Case of .nnnn
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Digits (File, Buf, Ptr, Loaded);
+
+ -- Hopeless junk if no digits loaded
+
+ if not Loaded then
+ return;
+ end if;
+
+ -- Otherwise must have digits to start
+
+ else
+ Load_Digits (File, Buf, Ptr, Loaded);
+
+ -- Hopeless junk if no digits loaded
+
+ if not Loaded then
+ return;
+ end if;
+
+ -- Deal with based case. We recognize either the standard '#' or the
+ -- allowed alternative replacement ':' (see RM J.2(3)).
+
+ Load (File, Buf, Ptr, '#', ':', Loaded);
+
+ if Loaded then
+
+ -- Case of nnn#.xxx#
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Extended_Digits (File, Buf, Ptr);
+ Load (File, Buf, Ptr, '#', ':');
+
+ -- Case of nnn#xxx.[xxx]# or nnn#xxx#
+
+ else
+ Load_Extended_Digits (File, Buf, Ptr);
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Extended_Digits (File, Buf, Ptr);
+ end if;
+
+ -- As usual, it seems strange to allow mixed base characters,
+ -- but that is what ACVC tests expect, see CE3804M, case (3).
+
+ Load (File, Buf, Ptr, '#', ':');
+ end if;
+
+ -- Case of nnn.[nnn] or nnn
+
+ else
+ -- Prevent the potential processing of '.' in cases where the
+ -- initial digits have a trailing underscore.
+
+ if Buf (Ptr) = '_' then
+ return;
+ end if;
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Digits (File, Buf, Ptr);
+ end if;
+ end if;
+ end if;
+
+ -- Deal with exponent
+
+ Load (File, Buf, Ptr, 'E', 'e', Loaded);
+
+ if Loaded then
+ Load (File, Buf, Ptr, '+', '-');
+ Load_Digits (File, Buf, Ptr);
+ end if;
+ end Load_Real;
+
---------------
-- Load_Skip --
---------------
Ptr : in out Natural);
-- Loads a possibly signed integer literal value
+ procedure Load_Real
+ (File : File_Type;
+ Buf : out String;
+ Ptr : in out Natural);
+ -- Loads a possibly signed real literal value
+
procedure Put_Item (File : File_Type; Str : String);
-- This routine is like Wide_Text_IO.Put, except that it checks for
-- overflow of bounded lines, as described in (RM A.10.6(8)). It is used
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
-with Ada.Wide_Wide_Text_IO.Float_Aux;
with System.Img_Real; use System.Img_Real;
package body Ada.Wide_Wide_Text_IO.Complex_Aux is
- package Aux renames Ada.Wide_Wide_Text_IO.Float_Aux;
-
---------
-- Get --
---------
procedure Get
(File : File_Type;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
procedure Gets
(From : String;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Last : out Positive)
is
Paren : Boolean;
procedure Put
(File : File_Type;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Fore : Field;
Aft : Field;
Exp : Field)
procedure Puts
(To : out String;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Aft : Field;
Exp : Field)
is
-- Both parts are initially converted with a Fore of 0
Rptr := 0;
- Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp);
Iptr := 0;
- Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp);
-- Check room for both parts plus parens plus comma (RM G.1.3(34))
-- This package contains the routines for Ada.Wide_Wide_Text_IO.Complex_IO
-- that are shared among separate instantiations of this package. The routines
--- in this package are identical semantically to those in Complex_IO itself,
--- except that the generic parameter Complex has been replaced by separate
--- real and imaginary values of type Long_Long_Float, and default parameters
--- have been removed because they are supplied explicitly by the calls from
--- within the generic template.
+-- in this package are identical semantically to those in Complex_IO, except
+-- that the generic parameter Complex has been replaced by separate real and
+-- imaginary parameters, and default parameters have been removed because they
+-- are supplied explicitly by the calls from within the generic template.
+
+with Ada.Wide_Wide_Text_IO.Float_Aux;
+
+private generic
+
+ type Num is digits <>;
+
+ with package Aux is new Ada.Wide_Wide_Text_IO.Float_Aux (Num, <>);
package Ada.Wide_Wide_Text_IO.Complex_Aux is
procedure Get
(File : File_Type;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
+ ItemR : out Num;
+ ItemI : out Num;
Width : Field);
- procedure Gets
- (From : String;
- ItemR : out Long_Long_Float;
- ItemI : out Long_Long_Float;
- Last : out Positive);
-
procedure Put
(File : File_Type;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Fore : Field;
Aft : Field;
Exp : Field);
+ procedure Gets
+ (From : String;
+ ItemR : out Num;
+ ItemI : out Num;
+ Last : out Positive);
+
procedure Puts
(To : out String;
- ItemR : Long_Long_Float;
- ItemI : Long_Long_Float;
+ ItemR : Num;
+ ItemI : Num;
Aft : Field;
Exp : Field);
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Complex_Aux;
-
-with System.WCh_Con; use System.WCh_Con;
-with System.WCh_WtS; use System.WCh_WtS;
+with Ada.Wide_Wide_Text_IO.Float_Aux;
+with System.Val_Flt; use System.Val_Flt;
+with System.Val_LFlt; use System.Val_LFlt;
+with System.Val_LLF; use System.Val_LLF;
+with System.WCh_Con; use System.WCh_Con;
+with System.WCh_WtS; use System.WCh_WtS;
with Ada.Unchecked_Conversion;
package body Ada.Wide_Wide_Text_IO.Complex_IO is
- package Aux renames Ada.Wide_Wide_Text_IO.Complex_Aux;
+ use Complex_Types;
+
+ package Scalar_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float);
+
+ package Scalar_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
+
+ package Scalar_Long_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
+ package Aux_Float is new
+ Ada.Wide_Wide_Text_IO.Complex_Aux (Float, Scalar_Float);
- subtype LLF is Long_Long_Float;
- -- Type used for calls to routines in Aux
+ package Aux_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float);
- function TFT is new
- Ada.Unchecked_Conversion (File_Type, Ada.Wide_Wide_Text_IO.File_Type);
- -- This unchecked conversion is to get around a visibility bug in
- -- GNAT version 2.04w. It should be possible to simply use the
- -- subtype declared above and do normal checked conversions.
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Complex_Aux
+ (Long_Long_Float, Scalar_Long_Long_Float);
+
+ -- Throughout this generic body, we distinguish between the case where type
+ -- Float is OK, where type Long_Float is OK and where type Long_Long_Float
+ -- is needed. These boolean constants are used to test for this, such that
+ -- only code for the relevant case is included in the instance.
+
+ OK_Float : constant Boolean := Real'Base'Digits <= Float'Digits;
+
+ OK_Long_Float : constant Boolean := Real'Base'Digits <= Long_Float'Digits;
---------
-- Get --
Imag_Item : Real'Base;
begin
- Aux.Get (TFT (File), LLF (Real_Item), LLF (Imag_Item), Width);
+ if OK_Float then
+ Aux_Float.Get (File, Float (Real_Item), Float (Imag_Item), Width);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Get
+ (File, Long_Float (Real_Item), Long_Float (Imag_Item), Width);
+ else
+ Aux_Long_Long_Float.Get
+ (File, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
+ Width);
+ end if;
+
Item := (Real_Item, Imag_Item);
exception
-- Aux.Gets will raise Data_Error in any case.
begin
- Aux.Gets (S, LLF (Real_Item), LLF (Imag_Item), Last);
+ if OK_Float then
+ Aux_Float.Gets (S, Float (Real_Item), Float (Imag_Item), Last);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Gets
+ (S, Long_Float (Real_Item), Long_Float (Imag_Item), Last);
+ else
+ Aux_Long_Long_Float.Gets
+ (S, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
+ Last);
+ end if;
+
Item := (Real_Item, Imag_Item);
exception
Exp : Field := Default_Exp)
is
begin
- Aux.Put (TFT (File), LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
+ if OK_Float then
+ Aux_Float.Put
+ (File, Float (Re (Item)), Float (Im (Item)), Fore, Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Put
+ (File, Long_Float (Re (Item)), Long_Float (Im (Item)), Fore, Aft,
+ Exp);
+ else
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
+ Fore, Aft, Exp);
+ end if;
end Put;
---------
S : String (To'First .. To'Last);
begin
- Aux.Puts (S, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
+ if OK_Float then
+ Aux_Float.Puts (S, Float (Re (Item)), Float (Im (Item)), Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Puts
+ (S, Long_Float (Re (Item)), Long_Float (Im (Item)), Aft, Exp);
+ else
+ Aux_Long_Long_Float.Puts
+ (S, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
+ Aft, Exp);
+ end if;
for J in S'Range loop
To (J) := Wide_Wide_Character'Val (Character'Pos (S (J)));
use Complex_Types;
Default_Fore : Field := 2;
- Default_Aft : Field := Real'Digits - 1;
+ Default_Aft : Field := Complex_Types.Real'Digits - 1;
Default_Exp : Field := 3;
procedure Get
(File : File_Type;
- Item : out Complex;
+ Item : out Complex_Types.Complex;
Width : Field := 0);
procedure Get
- (Item : out Complex;
+ (Item : out Complex_Types.Complex;
Width : Field := 0);
procedure Put
(File : File_Type;
- Item : Complex;
+ Item : Complex_Types.Complex;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
procedure Put
- (Item : Complex;
+ (Item : Complex_Types.Complex;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
procedure Get
(From : Wide_Wide_String;
- Item : out Complex;
+ Item : out Complex_Types.Complex;
Last : out Positive);
procedure Put
(To : out Wide_Wide_String;
- Item : Complex;
+ Item : Complex_Types.Complex;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
-with Ada.Wide_Wide_Text_IO.Float_Aux; use Ada.Wide_Wide_Text_IO.Float_Aux;
package body Ada.Wide_Wide_Text_IO.Decimal_Aux is
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
-with Ada.Wide_Wide_Text_IO.Float_Aux; use Ada.Wide_Wide_Text_IO.Float_Aux;
package body Ada.Wide_Wide_Text_IO.Fixed_Aux is
with System.Img_Fixed_64; use System.Img_Fixed_64;
with System.Val_Fixed_32; use System.Val_Fixed_32;
with System.Val_Fixed_64; use System.Val_Fixed_64;
+with System.Val_LLF; use System.Val_LLF;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
package Aux64 is new
Ada.Wide_Wide_Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64);
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
-- Throughout this generic body, we distinguish between the case where type
-- Int32 is OK and where type Int64 is OK. These boolean constants are used
-- to test for this, such that only code for the relevant case is included
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Get (File, Long_Long_Float (Item), Width);
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
end if;
exception
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Gets (S, Long_Long_Float (Item), Last);
+ Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
end if;
exception
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
end if;
end Put;
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
end if;
for J in S'Range loop
with System.Val_Fixed_32; use System.Val_Fixed_32;
with System.Val_Fixed_64; use System.Val_Fixed_64;
with System.Val_Fixed_128; use System.Val_Fixed_128;
+with System.Val_LLF; use System.Val_LLF;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
Ada.Wide_Wide_Text_IO.Fixed_Aux
(Int128, Scan_Fixed128, Set_Image_Fixed128);
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
-- Throughout this generic body, we distinguish between the case where type
-- Int32 is OK, where type Int64 is OK and where type Int128 is OK. These
-- boolean constants are used to test for this, such that only code for the
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Get (File, Long_Long_Float (Item), Width);
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
end if;
exception
-Num'Small_Numerator,
-Num'Small_Denominator));
else
- Float_Aux.Gets (S, Long_Long_Float (Item), Last);
+ Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
end if;
exception
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
end if;
end Put;
-Num'Small_Numerator, -Num'Small_Denominator,
For0, Num'Aft);
else
- Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
end if;
for J in S'Range loop
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
-with System.Img_Real; use System.Img_Real;
-with System.Val_Real; use System.Val_Real;
+with System.Img_Real; use System.Img_Real;
package body Ada.Wide_Wide_Text_IO.Float_Aux is
procedure Get
(File : File_Type;
- Item : out Long_Long_Float;
+ Item : out Num;
Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
- Ptr : aliased Integer := 1;
+ Ptr : aliased Integer;
begin
if Width /= 0 then
String_Skip (Buf, Ptr);
else
Load_Real (File, Buf, Stop);
+ Ptr := 1;
end if;
- Item := Scan_Real (Buf, Ptr'Access, Stop);
-
+ Item := Scan (Buf, Ptr'Access, Stop);
Check_End_Of_Field (Buf, Stop, Ptr, Width);
end Get;
procedure Gets
(From : String;
- Item : out Long_Long_Float;
+ Item : out Num;
Last : out Positive)
is
Pos : aliased Integer;
begin
String_Skip (From, Pos);
- Item := Scan_Real (From, Pos'Access, From'Last);
+ Item := Scan (From, Pos'Access, From'Last);
Last := Pos - 1;
exception
- when Constraint_Error =>
- raise Data_Error;
+ when Constraint_Error => raise Data_Error;
end Gets;
- ---------------
- -- Load_Real --
- ---------------
-
- procedure Load_Real
- (File : File_Type;
- Buf : out String;
- Ptr : in out Natural)
- is
- Loaded : Boolean;
-
- begin
- -- Skip initial blanks and load possible sign
-
- Load_Skip (File);
- Load (File, Buf, Ptr, '+', '-');
-
- -- Case of .nnnn
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Digits (File, Buf, Ptr, Loaded);
-
- -- Hopeless junk if no digits loaded
-
- if not Loaded then
- return;
- end if;
-
- -- Otherwise must have digits to start
-
- else
- Load_Digits (File, Buf, Ptr, Loaded);
-
- -- Hopeless junk if no digits loaded
-
- if not Loaded then
- return;
- end if;
-
- -- Deal with based case. We recognize either the standard '#' or the
- -- allowed alternative replacement ':' (see RM J.2(3)).
-
- Load (File, Buf, Ptr, '#', ':', Loaded);
-
- if Loaded then
-
- -- Case of nnn#.xxx#
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Extended_Digits (File, Buf, Ptr);
- Load (File, Buf, Ptr, '#', ':');
-
- -- Case of nnn#xxx.[xxx]# or nnn#xxx#
-
- else
- Load_Extended_Digits (File, Buf, Ptr);
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Extended_Digits (File, Buf, Ptr);
- end if;
-
- -- As usual, it seems strange to allow mixed base characters,
- -- but that is what ACVC tests expect, see CE3804M, case (3).
-
- Load (File, Buf, Ptr, '#', ':');
- end if;
-
- -- Case of nnn.[nnn] or nnn
-
- else
- -- Prevent the potential processing of '.' in cases where the
- -- initial digits have a trailing underscore.
-
- if Buf (Ptr) = '_' then
- return;
- end if;
-
- Load (File, Buf, Ptr, '.', Loaded);
-
- if Loaded then
- Load_Digits (File, Buf, Ptr);
- end if;
- end if;
- end if;
-
- -- Deal with exponent
-
- Load (File, Buf, Ptr, 'E', 'e', Loaded);
-
- if Loaded then
- Load (File, Buf, Ptr, '+', '-');
- Load_Digits (File, Buf, Ptr);
- end if;
- end Load_Real;
-
---------
-- Put --
---------
procedure Put
(File : File_Type;
- Item : Long_Long_Float;
+ Item : Num;
Fore : Field;
Aft : Field;
Exp : Field)
is
- Buf : String (1 .. Field'Last);
+ Buf : String (1 .. Max_Real_Image_Length);
Ptr : Natural := 0;
begin
- Set_Image_Real (Item, Buf, Ptr, Fore, Aft, Exp);
+ Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp);
Put_Item (File, Buf (1 .. Ptr));
end Put;
procedure Puts
(To : out String;
- Item : Long_Long_Float;
+ Item : Num;
Aft : Field;
Exp : Field)
is
- Buf : String (1 .. Field'Last);
- Ptr : Natural := 0;
+ Buf : String (1 .. Max_Real_Image_Length);
+ Ptr : Natural := 0;
begin
- Set_Image_Real (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
+ Set_Image_Real
+ (Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
if Ptr > To'Length then
raise Layout_Error;
-- This package contains the routines for Ada.Wide_Wide_Text_IO.Float_IO that
-- are shared among separate instantiations of this package. The routines
--- in this package are identical semantically to those in Float_IO itself,
--- except that generic parameter Num has been replaced by Long_Long_Float,
--- and the default parameters have been removed because they are supplied
+-- in this package are identical semantically to those in Float_IO, except
+-- that the default parameters have been removed because they are supplied
-- explicitly by the calls from within the generic template. Also used by
--- Ada.Wide_Wide_Text_IO.Fixed_IO, and by Ada.Wide_Wide_Text_IO.Decimal_IO.
+-- Ada.Wide_Wide_Text_IO.Fixed_IO and by Ada.Wide_Wide_Text_IO.Decimal_IO.
-private package Ada.Wide_Wide_Text_IO.Float_Aux is
+private generic
- procedure Load_Real
- (File : File_Type;
- Buf : out String;
- Ptr : in out Natural);
- -- This is an auxiliary routine that is used to load a possibly signed
- -- real literal value from the input file into Buf, starting at Ptr + 1.
+ type Num is digits <>;
+
+ with function Scan
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer) return Num;
+
+package Ada.Wide_Wide_Text_IO.Float_Aux is
procedure Get
(File : File_Type;
- Item : out Long_Long_Float;
+ Item : out Num;
Width : Field);
- procedure Gets
- (From : String;
- Item : out Long_Long_Float;
- Last : out Positive);
-
procedure Put
(File : File_Type;
- Item : Long_Long_Float;
+ Item : Num;
Fore : Field;
Aft : Field;
Exp : Field);
+ procedure Gets
+ (From : String;
+ Item : out Num;
+ Last : out Positive);
+
procedure Puts
(To : out String;
- Item : Long_Long_Float;
+ Item : Num;
Aft : Field;
Exp : Field);
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO.Float_Aux;
-with System.WCh_Con; use System.WCh_Con;
-with System.WCh_WtS; use System.WCh_WtS;
+with System.Val_Flt; use System.Val_Flt;
+with System.Val_LFlt; use System.Val_LFlt;
+with System.Val_LLF; use System.Val_LLF;
+with System.WCh_Con; use System.WCh_Con;
+with System.WCh_WtS; use System.WCh_WtS;
package body Ada.Wide_Wide_Text_IO.Float_IO is
- package Aux renames Ada.Wide_Wide_Text_IO.Float_Aux;
+ package Aux_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float);
+
+ package Aux_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
+
+ package Aux_Long_Long_Float is new
+ Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
+
+ -- Throughout this generic body, we distinguish between the case where type
+ -- Float is OK, where type Long_Float is OK and where type Long_Long_Float
+ -- is needed. These boolean constants are used to test for this, such that
+ -- only code for the relevant case is included in the instance.
+
+ OK_Float : constant Boolean := Num'Base'Digits <= Float'Digits;
+
+ OK_Long_Float : constant Boolean := Num'Base'Digits <= Long_Float'Digits;
---------
-- Get --
Item : out Num;
Width : Field := 0)
is
+ pragma Unsuppress (Range_Check);
+
begin
- Aux.Get (File, Long_Long_Float (Item), Width);
+ if OK_Float then
+ Aux_Float.Get (File, Float (Item), Width);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Get (File, Long_Float (Item), Width);
+ else
+ Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
+ end if;
+
+ -- In the case where the type is unconstrained (e.g. Standard'Float),
+ -- the above conversion may result in an infinite value, which is
+ -- normally fine for a conversion, but in this case, we want to treat
+ -- that as a data error.
+
+ if not Item'Valid then
+ raise Data_Error;
+ end if;
exception
when Constraint_Error => raise Data_Error;
Item : out Num;
Last : out Positive)
is
+ pragma Unsuppress (Range_Check);
+
S : constant String := Wide_Wide_String_To_String (From, WCEM_Upper);
-- String on which we do the actual conversion. Note that the method
-- used for wide character encoding is irrelevant, since if there is
-- Aux.Gets will raise Data_Error in any case.
begin
- Aux.Gets (S, Long_Long_Float (Item), Last);
+ if OK_Float then
+ Aux_Float.Gets (S, Float (Item), Last);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Gets (S, Long_Float (Item), Last);
+ else
+ Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
+ end if;
+
+ -- In the case where the type is unconstrained (e.g. Standard'Float),
+ -- the above conversion may result in an infinite value, which is
+ -- normally fine for a conversion, but in this case, we want to treat
+ -- that as a data error.
+
+ if not Item'Valid then
+ raise Data_Error;
+ end if;
exception
when Constraint_Error => raise Data_Error;
Exp : Field := Default_Exp)
is
begin
- Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ if OK_Float then
+ Aux_Float.Put (File, Float (Item), Fore, Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp);
+ else
+ Aux_Long_Long_Float.Put
+ (File, Long_Long_Float (Item), Fore, Aft, Exp);
+ end if;
end Put;
procedure Put
S : String (To'First .. To'Last);
begin
- Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ if OK_Float then
+ Aux_Float.Puts (S, Float (Item), Aft, Exp);
+ elsif OK_Long_Float then
+ Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp);
+ else
+ Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
+ end if;
for J in S'Range loop
To (J) := Wide_Wide_Character'Val (Character'Pos (S (J)));
end if;
end Load_Integer;
+ ---------------
+ -- Load_Real --
+ ---------------
+
+ procedure Load_Real
+ (File : File_Type;
+ Buf : out String;
+ Ptr : in out Natural)
+ is
+ Loaded : Boolean;
+
+ begin
+ -- Skip initial blanks and load possible sign
+
+ Load_Skip (File);
+ Load (File, Buf, Ptr, '+', '-');
+
+ -- Case of .nnnn
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Digits (File, Buf, Ptr, Loaded);
+
+ -- Hopeless junk if no digits loaded
+
+ if not Loaded then
+ return;
+ end if;
+
+ -- Otherwise must have digits to start
+
+ else
+ Load_Digits (File, Buf, Ptr, Loaded);
+
+ -- Hopeless junk if no digits loaded
+
+ if not Loaded then
+ return;
+ end if;
+
+ -- Deal with based case. We recognize either the standard '#' or the
+ -- allowed alternative replacement ':' (see RM J.2(3)).
+
+ Load (File, Buf, Ptr, '#', ':', Loaded);
+
+ if Loaded then
+
+ -- Case of nnn#.xxx#
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Extended_Digits (File, Buf, Ptr);
+ Load (File, Buf, Ptr, '#', ':');
+
+ -- Case of nnn#xxx.[xxx]# or nnn#xxx#
+
+ else
+ Load_Extended_Digits (File, Buf, Ptr);
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Extended_Digits (File, Buf, Ptr);
+ end if;
+
+ -- As usual, it seems strange to allow mixed base characters,
+ -- but that is what ACVC tests expect, see CE3804M, case (3).
+
+ Load (File, Buf, Ptr, '#', ':');
+ end if;
+
+ -- Case of nnn.[nnn] or nnn
+
+ else
+ -- Prevent the potential processing of '.' in cases where the
+ -- initial digits have a trailing underscore.
+
+ if Buf (Ptr) = '_' then
+ return;
+ end if;
+
+ Load (File, Buf, Ptr, '.', Loaded);
+
+ if Loaded then
+ Load_Digits (File, Buf, Ptr);
+ end if;
+ end if;
+ end if;
+
+ -- Deal with exponent
+
+ Load (File, Buf, Ptr, 'E', 'e', Loaded);
+
+ if Loaded then
+ Load (File, Buf, Ptr, '+', '-');
+ Load_Digits (File, Buf, Ptr);
+ end if;
+ end Load_Real;
+
---------------
-- Load_Skip --
---------------
Ptr : in out Natural);
-- Loads a possibly signed integer literal value
+ procedure Load_Real
+ (File : File_Type;
+ Buf : out String;
+ Ptr : in out Natural);
+ -- Loads a possibly signed real literal value
+
procedure Put_Item (File : File_Type; Str : String);
-- This routine is like Wide_Wide_Text_IO.Put, except that it checks for
-- overflow of bounded lines, as described in (RM A.10.6(8)). It is used
if Adjustment > IEEE_Emax - Exp then
XX := 0.0;
return (if Minus then -1.0 / XX else 1.0 / XX);
+ pragma Annotate
+ (CodePeer, Intentional, "overflow check", "Infinity produced");
pragma Annotate
(CodePeer, Intentional, "divide by zero", "Infinity produced");
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S Y S T E M . F A T _ S F L T --
--- --
--- S p e c --
--- --
--- Copyright (C) 1992-2020, 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. --
--- --
-------------------------------------------------------------------------------
-
--- This package contains an instantiation of the floating-point attribute
--- runtime routines for the type Short_Float.
-
-with System.Fat_Gen;
-
-package System.Fat_SFlt is
- pragma Pure;
-
- -- Note the only entity from this package that is accessed by Rtsfind
- -- is the name of the package instantiation. Entities within this package
- -- (i.e. the individual floating-point attribute routines) are accessed
- -- by name using selected notation.
-
- package Attr_Short_Float is new System.Fat_Gen (Short_Float);
-
-end System.Fat_SFlt;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . V A L _ F L T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2020, 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. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains routines for scanning real values for floating point
+-- type Float, for use in Text_IO.Float_IO and the Value attribute.
+
+with Interfaces;
+with System.Val_Real;
+
+package System.Val_Flt is
+ pragma Preelaborate;
+
+ package Impl is new Val_Real (Float, Interfaces.Unsigned_32);
+
+ function Scan_Float
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer) return Float
+ renames Impl.Scan_Real;
+
+ function Value_Float (Str : String) return Float
+ renames Impl.Value_Real;
+
+end System.Val_Flt;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . V A L _ L F L T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2020, 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. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains routines for scanning real values for floating point
+-- type Long_Float, for use in Text_IO.Float_IO and the Value attribute.
+
+with Interfaces;
+with System.Val_Real;
+
+package System.Val_LFlt is
+ pragma Preelaborate;
+
+ package Impl is new Val_Real (Long_Float, Interfaces.Unsigned_64);
+
+ function Scan_Long_Float
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer) return Long_Float
+ renames Impl.Scan_Real;
+
+ function Value_Long_Float (Str : String) return Long_Float
+ renames Impl.Value_Real;
+
+end System.Val_LFlt;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . V A L _ L L F --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2020, 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. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains routines for scanning real values for floating point
+-- type Long_Long_Float, for use in Text_IO.Float_IO and the Value attribute.
+
+with Interfaces;
+with System.Val_Real;
+
+package System.Val_LLF is
+ pragma Preelaborate;
+
+ package Impl is new Val_Real (Long_Long_Float, Interfaces.Unsigned_64);
+
+ function Scan_Long_Long_Float
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer) return Long_Long_Float
+ renames Impl.Scan_Real;
+
+ function Value_Long_Long_Float (Str : String) return Long_Long_Float
+ renames Impl.Value_Real;
+
+end System.Val_LLF;
package body System.Val_Real is
- package Impl is new Value_R (Long_Long_Unsigned, Floating => True);
+ package Impl is new Value_R (Uns, Floating => True);
function Integer_to_Real
(Str : String;
- Val : Long_Long_Unsigned;
+ Val : Uns;
Base : Unsigned;
Scale : Integer;
- Minus : Boolean) return Long_Long_Float;
+ Minus : Boolean) return Num;
-- Convert the real value from integer to real representation
---------------------
function Integer_to_Real
(Str : String;
- Val : Long_Long_Unsigned;
+ Val : Uns;
Base : Unsigned;
Scale : Integer;
- Minus : Boolean) return Long_Long_Float
+ Minus : Boolean) return Num
is
+ pragma Assert (Base in 2 .. 16);
+
pragma Unsuppress (Range_Check);
- R_Val : Long_Long_Float;
+ R_Val : Num;
begin
-- We call the floating-point processor reset routine so we can be sure
- -- that the processor is properly set for conversions. This is notably
+ -- that the x87 FPU is properly set for conversions. This is especially
-- needed on Windows, where calls to the operating system randomly reset
-- the processor into 64-bit mode.
- System.Float_Control.Reset;
+ if Num'Machine_Mantissa = 64 then
+ System.Float_Control.Reset;
+ end if;
- -- Compute the final value
+ -- Compute the final value with a single rounding if possible
- R_Val := Long_Long_Float (Val) * Long_Long_Float (Base) ** Scale;
+ if Scale < 0 then
+ R_Val := Num (Val) / Num (Base) ** (-Scale);
+ else
+ R_Val := Num (Val) * Num (Base) ** Scale;
+ end if;
-- Finally deal with initial minus sign, note that this processing is
-- done even if Uval is zero, so that -0.0 is correctly interpreted.
---------------
function Scan_Real
- (Str : String;
- Ptr : not null access Integer;
- Max : Integer)
- return Long_Long_Float
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer) return Num
is
Base : Unsigned;
Scale : Integer;
Extra : Unsigned;
+ pragma Unreferenced (Extra);
Minus : Boolean;
- Val : Long_Long_Unsigned;
+ Val : Uns;
begin
Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scale, Extra, Minus);
-- Value_Real --
----------------
- function Value_Real (Str : String) return Long_Long_Float is
+ function Value_Real (Str : String) return Num is
Base : Unsigned;
Scale : Integer;
Extra : Unsigned;
+ pragma Unreferenced (Extra);
Minus : Boolean;
- Val : Long_Long_Unsigned;
+ Val : Uns;
begin
Val := Impl.Value_Raw_Real (Str, Base, Scale, Extra, Minus);
-- --
------------------------------------------------------------------------------
+-- This package contains routines for scanning real values for use in
+-- Text_IO.Float_IO and the Value attribute.
+
+generic
+
+ type Num is digits <>;
+
+ type Uns is mod <>;
+
package System.Val_Real is
pragma Preelaborate;
function Scan_Real
(Str : String;
Ptr : not null access Integer;
- Max : Integer) return Long_Long_Float;
+ Max : Integer) return Num;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- real literal according to the syntax described in (RM 3.5(43)). The
-- substring scanned extends no further than Str (Max). There are three
-- If this occurs Program_Error is raised with a message noting that this
-- case is not supported. Most such cases are eliminated by the caller.
- function Value_Real (Str : String) return Long_Long_Float;
+ function Value_Real (Str : String) return Num;
-- Used in computing X'Value (Str) where X is a floating-point type or an
-- ordinary fixed-point type. Str is the string argument of the attribute.
-- Constraint_Error is raised if the string is malformed, or if the value
- -- out of range of Long_Long_Float.
+ -- out of range of Num.
end System.Val_Real;
package body System.Value_R is
- F_Limit : constant Uns := 2 ** (Long_Long_Float'Machine_Mantissa - 1);
- I_Limit : constant Uns := 2 ** (Uns'Size - 1);
- -- Absolute value of largest representable signed integer
-
- Precision_Limit : constant Uns := (if Floating then F_Limit else I_Limit);
+ Precision_Limit : constant Uns := 2 ** (Uns'Size - 1);
-- Limit beyond which additional digits are dropped
subtype Char_As_Digit is Unsigned range 0 .. 17;
is
pragma Assert (Base in 2 .. 16);
+ pragma Assert (Index in Str'Range);
+ pragma Assert (Max <= Str'Last);
Umax : constant Uns := (Precision_Limit - Uns (Base) + 1) / Uns (Base);
-- Max value which cannot overflow on accumulating next digit
-- Set to True if addition of a digit will cause Value to be superior
-- to Precision_Limit.
- Precision_Limit_Just_Reached : Boolean := False;
+ Precision_Limit_Just_Reached : Boolean;
-- Set to True if Precision_Limit_Reached was just set to True
+ -- Only used when Floating = False.
Digit : Char_As_Digit;
-- The current digit
Extra := 0;
end if;
+ if not Floating then
+ Precision_Limit_Just_Reached := False;
+ end if;
+
-- The function precondition is that the first character is a valid
-- digit.
-- continue only to assess the validity of the string.
if Precision_Limit_Reached then
- if Precision_Limit_Just_Reached and then not Floating then
+ if not Floating and then Precision_Limit_Just_Reached then
if Digit >= Base / 2 then
if Extra = Base - 1 then
Extra := 0;
else
Extra := Digit;
Precision_Limit_Reached := True;
- Precision_Limit_Just_Reached := True;
+
+ if not Floating then
+ Precision_Limit_Just_Reached := True;
+ end if;
end if;
end if;
end if;
-- Set to True if addition of a digit will cause Value to be superior
-- to Precision_Limit.
- Precision_Limit_Just_Reached : Boolean := False;
- -- Set to True if Precision_Limit_Reached was just set to True
+ Precision_Limit_Just_Reached : Boolean;
+ -- Set to True if Precision_Limit_Reached was just set to True.
+ -- Only used when Floating = False.
Digit : Char_As_Digit;
-- The current digit
Scale := 0;
Extra := 0;
+ if not Floating then
+ Precision_Limit_Just_Reached := False;
+ end if;
+
+ pragma Assert (Max <= Str'Last);
+
-- The function precondition is that the first character is a valid
-- digit.
if Precision_Limit_Reached then
Scale := Scale + 1;
- if Precision_Limit_Just_Reached and then not Floating then
+ if not Floating and then Precision_Limit_Just_Reached then
if Digit >= Base / 2 then
if Extra = Base - 1 then
Extra := 0;
else
Extra := Digit;
Precision_Limit_Reached := True;
- Precision_Limit_Just_Reached := True;
+
+ if not Floating then
+ Precision_Limit_Just_Reached := True;
+ end if;
+
Scale := Scale + 1;
end if;
end if;
end if;
end if;
end loop;
-
end Scan_Integral_Digits;
-------------------
Extra : out Unsigned;
Minus : out Boolean) return Uns
is
+ pragma Assert (Max <= Str'Last);
+
After_Point : Boolean;
-- True if a decimal should be parsed
-- Local copy of string pointer
Start : Positive;
- -- Position of starting non-blank character
+ pragma Unreferenced (Start);
Value : Uns;
-- Mantissa as an Integer
Scan_Sign (Str, Ptr, Max, Minus, Start);
Index := Ptr.all;
- Ptr.all := Start;
- -- First character can be either a decimal digit or a dot
+ pragma Assert (Index >= Str'First);
- if Str (Index) in '0' .. '9' then
- pragma Annotate
- (CodePeer, False_Positive, "test always true", "defensive code");
+ pragma Annotate (CodePeer, Modified, Str (Index));
+
+ -- First character can be either a decimal digit or a dot and for some
+ -- reason CodePeer incorrectly thinks it is always a digit.
+ if Str (Index) in '0' .. '9' then
After_Point := False;
-- If this is a digit it can indicates either the float decimal
-- Check if the first number encountered is a base
+ pragma Assert (Index >= Str'First);
+
if Index < Max
and then (Str (Index) = '#' or else Str (Index) = ':')
then
Base_Char := Str (Index);
- Base := Unsigned (Value);
- if Base < 2 or else Base > 16 then
+ if Value in 2 .. 16 then
+ Base := Unsigned (Value);
+ else
Base_Violation := True;
Base := 16;
end if;
-- Do we have a dot?
+ pragma Assert (Index >= Str'First);
+
if not After_Point and then Index <= Max and then Str (Index) = '.' then
-- At this stage if After_Point was not set, this means that an
-- Scan the decimal part
if After_Point then
+ pragma Assert (Index <= Max);
+
Scan_Decimal_Digits
(Str, Index, Max, Value, Scale, Char_As_Digit (Extra),
Base_Violation, Base, Base_Specified => Base_Char /= ASCII.NUL);
-- If an explicit base was specified ensure that the delimiter is found
if Base_Char /= ASCII.NUL then
+ pragma Assert (Index > Max or else Index in Str'Range);
+
if Index > Max or else Str (Index) /= Base_Char then
Bad_Value (Str);
else
System_Exp_Mod,
System_Exp_Uns,
System_Fat_Flt,
- System_Fat_IEEE_Long_Float,
- System_Fat_IEEE_Short_Float,
System_Fat_LFlt,
System_Fat_LLF,
System_Fat_SFlt,
System_Val_Fixed_32,
System_Val_Fixed_64,
System_Val_Fixed_128,
+ System_Val_Flt,
System_Val_Int,
+ System_Val_LFlt,
+ System_Val_LLF,
System_Val_LLI,
System_Val_LLLI,
System_Val_LLU,
System_Val_LLLU,
System_Val_Name,
- System_Val_Real,
System_Val_Uns,
System_Val_WChar,
System_Version_Control,
RE_Attr_Float, -- System.Fat_Flt
- RE_Attr_IEEE_Long, -- System.Fat_IEEE_Long_Float
- RE_Fat_IEEE_Long, -- System.Fat_IEEE_Long_Float
-
- RE_Attr_IEEE_Short, -- System.Fat_IEEE_Short_Float
- RE_Fat_IEEE_Short, -- System.Fat_IEEE_Short_Float
-
RE_Attr_Long_Float, -- System.Fat_LFlt
RE_Attr_Long_Long_Float, -- System.Fat_LLF
- RE_Attr_Short_Float, -- System.Fat_SFlt
-
RE_Attr_VAX_D_Float, -- System.Fat_VAX_D_Float
RE_Fat_VAX_D, -- System.Fat_VAX_D_Float
RE_Value_Fixed128, -- System_Val_Fixed_128
+ RE_Value_Float, -- System_Val_Flt
+
RE_Value_Integer, -- System.Val_Int
+ RE_Value_Long_Float, -- System_Val_LFlt
+
+ RE_Value_Long_Long_Float, -- System_Val_LLF
+
RE_Value_Long_Long_Integer, -- System.Val_LLI
RE_Value_Long_Long_Long_Integer, -- System.Val_LLLI
RE_Value_Long_Long_Long_Unsigned, -- System.Val_LLLU
- RE_Value_Real, -- System.Val_Real
-
RE_Value_Unsigned, -- System.Val_Uns
RE_Value_Wide_Character, -- System.Val_WChar
RE_Attr_Float => System_Fat_Flt,
- RE_Attr_IEEE_Long => System_Fat_IEEE_Long_Float,
- RE_Fat_IEEE_Long => System_Fat_IEEE_Long_Float,
-
- RE_Attr_IEEE_Short => System_Fat_IEEE_Short_Float,
- RE_Fat_IEEE_Short => System_Fat_IEEE_Short_Float,
-
RE_Attr_Long_Float => System_Fat_LFlt,
RE_Attr_Long_Long_Float => System_Fat_LLF,
- RE_Attr_Short_Float => System_Fat_SFlt,
-
RE_Attr_VAX_D_Float => System_Fat_VAX_D_Float,
RE_Fat_VAX_D => System_Fat_VAX_D_Float,
RE_Value_Fixed128 => System_Val_Fixed_128,
+ RE_Value_Float => System_Val_Flt,
+
RE_Value_Integer => System_Val_Int,
+ RE_Value_Long_Float => System_Val_LFlt,
+
+ RE_Value_Long_Long_Float => System_Val_LLF,
+
RE_Value_Long_Long_Integer => System_Val_LLI,
RE_Value_Long_Long_Long_Integer => System_Val_LLLI,
RE_Value_Long_Long_Long_Unsigned => System_Val_LLLU,
- RE_Value_Real => System_Val_Real,
-
RE_Value_Unsigned => System_Val_Uns,
RE_Value_Wide_Character => System_Val_WChar,
projects / gcc.git / commitdiff