aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2018-01-11 08:56:07 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-01-11 08:56:07 +0000
commit791f2d03b4c611040b0d20b61441b438eecef8b8 (patch)
treef4ba25915623884bc147bc5501680703099e5650 /gcc/ada
parenta85dbeec8d84e07ee549fca50dc118234f16d3f1 (diff)
downloadgcc-791f2d03b4c611040b0d20b61441b438eecef8b8.zip
gcc-791f2d03b4c611040b0d20b61441b438eecef8b8.tar.gz
gcc-791f2d03b4c611040b0d20b61441b438eecef8b8.tar.bz2
[Ada] Allow uses of range utility routines on private types
Frontend only calls Is_Null_Range and Not_Null_Range routines on full views of types, but backends (for example GNATprove) might call them also on private types. This patch adapts those routines to transparently retrieve the full type when called on a private type. No frontend test, because only external backends are affected. 2018-01-11 Piotr Trojanek <trojanek@adacore.com> gcc/ada/ * sem_eval.adb (Is_Null_Range): Retrieve the full view when called on a private (sub)type; refactor to avoid early return statement. (Not_Null_Range): Same as above. From-SVN: r256522
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/sem_eval.adb67
2 files changed, 54 insertions, 19 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1eabde4..7b26e37 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-01-11 Piotr Trojanek <trojanek@adacore.com>
+
+ * sem_eval.adb (Is_Null_Range): Retrieve the full view when called on a
+ private (sub)type; refactor to avoid early return statement.
+ (Not_Null_Range): Same as above.
+
2018-01-11 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb (Freeze_Entity): Ensure that a Ghost type is not
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index adefea5..93536cb 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -4755,19 +4755,33 @@ package body Sem_Eval is
-------------------
function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean is
- Typ : constant Entity_Id := Etype (Lo);
-
begin
- if not Compile_Time_Known_Value (Lo)
- or else not Compile_Time_Known_Value (Hi)
+ if Compile_Time_Known_Value (Lo)
+ and then Compile_Time_Known_Value (Hi)
then
- return False;
- end if;
+ declare
+ Typ : Entity_Id := Etype (Lo);
+ Full_Typ : constant Entity_Id := Full_View (Typ);
+ begin
+ -- When called from the frontend, as part of the analysis of
+ -- potentially static expressions, Typ will be the full view of a
+ -- type with all the info needed to answer this query. When called
+ -- from the backend, for example to know whether a range of a loop
+ -- is null, Typ might be a private type and we need to explicitly
+ -- switch to its corresponding full view to access the same info.
+
+ if Present (Full_Typ) then
+ Typ := Full_Typ;
+ end if;
- if Is_Discrete_Type (Typ) then
- return Expr_Value (Lo) > Expr_Value (Hi);
- else pragma Assert (Is_Real_Type (Typ));
- return Expr_Value_R (Lo) > Expr_Value_R (Hi);
+ if Is_Discrete_Type (Typ) then
+ return Expr_Value (Lo) > Expr_Value (Hi);
+ else pragma Assert (Is_Real_Type (Typ));
+ return Expr_Value_R (Lo) > Expr_Value_R (Hi);
+ end if;
+ end;
+ else
+ return False;
end if;
end Is_Null_Range;
@@ -5330,20 +5344,35 @@ package body Sem_Eval is
--------------------
function Not_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean is
- Typ : constant Entity_Id := Etype (Lo);
-
begin
- if not Compile_Time_Known_Value (Lo)
- or else not Compile_Time_Known_Value (Hi)
+ if Compile_Time_Known_Value (Lo)
+ and then Compile_Time_Known_Value (Hi)
then
+ declare
+ Typ : Entity_Id := Etype (Lo);
+ Full_Typ : constant Entity_Id := Full_View (Typ);
+ begin
+ -- When called from the frontend, as part of the analysis of
+ -- potentially static expressions, Typ will be the full view of a
+ -- type with all the info needed to answer this query. When called
+ -- from the backend, for example to know whether a range of a loop
+ -- is null, Typ might be a private type and we need to explicitly
+ -- switch to its corresponding full view to access the same info.
+
+ if Present (Full_Typ) then
+ Typ := Full_Typ;
+ end if;
+
+ if Is_Discrete_Type (Typ) then
+ return Expr_Value (Lo) <= Expr_Value (Hi);
+ else pragma Assert (Is_Real_Type (Typ));
+ return Expr_Value_R (Lo) <= Expr_Value_R (Hi);
+ end if;
+ end;
+ else
return False;
end if;
- if Is_Discrete_Type (Typ) then
- return Expr_Value (Lo) <= Expr_Value (Hi);
- else pragma Assert (Is_Real_Type (Typ));
- return Expr_Value_R (Lo) <= Expr_Value_R (Hi);
- end if;
end Not_Null_Range;
-------------