diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2019-07-22 13:56:40 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-22 13:56:40 +0000 |
| commit | 4123b473427ca6854f874c77f5ce78c7e8c133a7 (patch) | |
| tree | 6c354aadb90dd3dfea9795411c01bb06c74658be | |
| parent | 2fdc20b65c2f3409591aeea810001a29ff1d6739 (diff) | |
| download | gcc-4123b473427ca6854f874c77f5ce78c7e8c133a7.zip gcc-4123b473427ca6854f874c77f5ce78c7e8c133a7.tar.gz gcc-4123b473427ca6854f874c77f5ce78c7e8c133a7.tar.bz2 | |
[Ada] Incorrect values in conversion from fixed-point subtype with 'Small
This patch fixes incorrect computations involving a fixed-point subtype
whose parent type has an aspect specification for 'Small.
Executing the following:
gnatmake -q conv
./conv
must yield:
9000.000000
9.00000000000000E+03
9000.000000
9.00000000000000E+03
9.00000000000000E+03
9.00000000000000E+03
9.00000000000000E+03
9.00000000000000E+03
----
with Text_IO; use Text_IO;
procedure Conv is
V_P : constant := 10.0 ** (-6);
M_V : constant := 9000.0;
N_V : constant := -9000.0;
type V_T is delta V_P range N_V .. M_V with Small => V_P;
subtype S_T is V_T range 0.0 .. M_V;
function Convert (Input : in S_T) return Long_Float is
begin
Put_Line (Input'Img);
Put_Line (Long_Float'Image (Long_Float (Input)));
return Long_Float (Input);
end Convert;
begin
declare
Var_S : constant S_T := S_T'Last;
Output : constant Long_Float := Convert (Var_S);
begin
Put_Line (Long_Float'Image (Convert (Var_S)));
Put_Line (Long_Float'Image (Long_Float (Var_S)));
Put_Line (Output'Img);
end;
Put_Line (Long_Float'Image (Long_Float (S_T'Last)));
end Conv;
2019-07-22 Ed Schonberg <schonberg@adacore.com>
gcc/ada/
* freeze.adb (Freeze_Fixed_Point_Type): When freezing a
fixed-point subtype, check whether the parent type declarastion
includes an aspect specification for the 'Small type attribute,
and inherit the specified value.
From-SVN: r273671
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 11 |
2 files changed, 18 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5cb3ab4..5113e77 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-22 Ed Schonberg <schonberg@adacore.com> + + * freeze.adb (Freeze_Fixed_Point_Type): When freezing a + fixed-point subtype, check whether the parent type declarastion + includes an aspect specification for the 'Small type attribute, + and inherit the specified value. + 2019-07-22 Javier Miranda <miranda@adacore.com> * freeze.adb (Freeze_Subprogram): Check that C++ constructors diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 728eaf2..00d20e9 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8003,6 +8003,7 @@ package body Freeze is Brng : constant Node_Id := Scalar_Range (Btyp); BLo : constant Node_Id := Low_Bound (Brng); BHi : constant Node_Id := High_Bound (Brng); + Par : constant Entity_Id := First_Subtype (Typ); Small : constant Ureal := Small_Value (Typ); Loval : Ureal; Hival : Ureal; @@ -8055,6 +8056,16 @@ package body Freeze is end if; end if; + -- The 'small attribute may have been specified with an aspect, + -- in which case it is processed after a subtype declaration, so + -- inherit now the specified value. + + if Typ /= Par + and then Present (Find_Aspect (Par, Aspect_Small)) + then + Set_Small_Value (Typ, Small_Value (Par)); + end if; + -- Immediate return if the range is already analyzed. This means that -- the range is already set, and does not need to be computed by this -- routine. |