OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
This commit is contained in:
Piotr Trojanek 2018-01-11 08:56:07 +00:00 committed by Pierre-Marie de Rodat
parent a85dbeec8d
commit 791f2d03b4
2 changed files with 54 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -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

67
gcc/ada/sem_eval.adb
View File

@ -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 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 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;
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;
-------------