aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2019-07-22 13:57:22 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-22 13:57:22 +0000
commita517030d8b76ae338c7e33253fcd0177979dde2b (patch)
treea92e4621fe3c684b7e5fc3f9b175a6625cd5d651 /gcc
parent2c26d262eb40998040308a57d420849fd764ef53 (diff)
downloadgcc-a517030d8b76ae338c7e33253fcd0177979dde2b.zip
gcc-a517030d8b76ae338c7e33253fcd0177979dde2b.tar.gz
gcc-a517030d8b76ae338c7e33253fcd0177979dde2b.tar.bz2
[Ada] Type inconsistency in floating_point type declarations
This patch fixes an inconsistency in the typing of the bounds of a floting point type declaration, when some bound is given by a dtatic constant of an explicit type, instead of a real literal, Previous to this patch the bound of the type retained the given type, leading to spurious errors in Codepeer. 2019-07-22 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * sem_ch3.adb (Convert_Bound): Subsidiary of Floating_Point_Type_Declaration, to handle properly range specifications with bounds that may include static constants of a given type rather than real literals. From-SVN: r273680
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/sem_ch3.adb48
2 files changed, 36 insertions, 19 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 202dfc7..2d0beb3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-22 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Convert_Bound): Subsidiary of
+ Floating_Point_Type_Declaration, to handle properly range
+ specifications with bounds that may include static constants of
+ a given type rather than real literals.
+
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
* sem_aggr.adb (Rewrite_Bound): Be prepared for discriminals
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ae0a7bf..5bee503 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -17827,12 +17827,16 @@ package body Sem_Ch3 is
Digs_Val : Uint;
Base_Typ : Entity_Id;
Implicit_Base : Entity_Id;
- Bound : Node_Id;
function Can_Derive_From (E : Entity_Id) return Boolean;
-- Find if given digits value, and possibly a specified range, allows
-- derivation from specified type
+ procedure Convert_Bound (B : Node_Id);
+ -- If specified, the bounds must be static but may be of different
+ -- types. They must be converted into machine numbers of the base type,
+ -- in accordance with RM 4.9(38).
+
function Find_Base_Type return Entity_Id;
-- Find a predefined base type that Def can derive from, or generate
-- an error and substitute Long_Long_Float if none exists.
@@ -17870,6 +17874,28 @@ package body Sem_Ch3 is
return True;
end Can_Derive_From;
+ -------------------
+ -- Convert_Bound --
+ --------------------
+
+ procedure Convert_Bound (B : Node_Id) is
+ begin
+ -- If the bound is not a literal it can only be static if it is
+ -- a static constant, possibly of a specified type.
+
+ if Is_Entity_Name (B)
+ and then Ekind (Entity (B)) = E_Constant
+ then
+ Rewrite (B, Constant_Value (Entity (B)));
+ end if;
+
+ if Nkind (B) = N_Real_Literal then
+ Set_Realval (B, Machine (Base_Typ, Realval (B), Round, B));
+ Set_Is_Machine_Number (B);
+ Set_Etype (B, Base_Typ);
+ end if;
+ end Convert_Bound;
+
--------------------
-- Find_Base_Type --
--------------------
@@ -17967,24 +17993,8 @@ package body Sem_Ch3 is
Set_Scalar_Range (T, Real_Range_Specification (Def));
Set_Is_Constrained (T);
- -- The bounds of this range must be converted to machine numbers
- -- in accordance with RM 4.9(38).
-
- Bound := Type_Low_Bound (T);
-
- if Nkind (Bound) = N_Real_Literal then
- Set_Realval
- (Bound, Machine (Base_Typ, Realval (Bound), Round, Bound));
- Set_Is_Machine_Number (Bound);
- end if;
-
- Bound := Type_High_Bound (T);
-
- if Nkind (Bound) = N_Real_Literal then
- Set_Realval
- (Bound, Machine (Base_Typ, Realval (Bound), Round, Bound));
- Set_Is_Machine_Number (Bound);
- end if;
+ Convert_Bound (Type_Low_Bound (T));
+ Convert_Bound (Type_High_Bound (T));
else
Set_Scalar_Range (T, Scalar_Range (Base_Typ));