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

[multiple changes]

Browse Source 
2013-04-23  Vincent Celier  <celier@adacore.com>

	* prj-part.ads, prj-conf.ads: Minor comment updates.

2013-04-23  Ed Schonberg  <schonberg@adacore.com>

	* einfo.adb (Predicate_Function): For a private type, retrieve
	predicate function from full view.
	* aspects.adb (Find_Aspect): Ditto.
	* exp_ch6.adb (Expand_Actuals): If the formal is class-wide and
	the actual is a definite type, apply predicate check after call.
	* sem_res.adb: Do not apply a predicate check before the call to
	a generated Init_Proc.

From-SVN: r198185
This commit is contained in:
Arnaud Charlet 2013-04-23 11:53:23 +02:00
parent 9d5598bf83
commit e93f4e1244
7 changed files with 60 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2013-04-23 Vincent Celier <celier@adacore.com>
* prj-part.ads, prj-conf.ads: Minor comment updates.
2013-04-23 Ed Schonberg <schonberg@adacore.com>
* einfo.adb (Predicate_Function): For a private type, retrieve
predicate function from full view.
* aspects.adb (Find_Aspect): Ditto.
* exp_ch6.adb (Expand_Actuals): If the formal is class-wide and
the actual is a definite type, apply predicate check after call.
* sem_res.adb: Do not apply a predicate check before the call to
a generated Init_Proc.
2013-04-23 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Significant

6
gcc/ada/aspects.adb
View File

@ -163,6 +163,12 @@ package body Aspects is
if Is_Class_Wide_Type (Owner) and then Inherited_Aspect (A) then
Owner := Root_Type (Owner);
end if;
if Is_Private_Type (Owner)
and then Present (Full_View (Owner))
then
Owner := Full_View (Owner);
end if;
end if;
-- Search the representation items for the desired aspect

14
gcc/ada/einfo.adb
View File

@ -7168,15 +7168,25 @@ package body Einfo is
function Predicate_Function (Id : E) return E is
S : Entity_Id;
T : Entity_Id;
begin
pragma Assert (Is_Type (Id));
if No (Subprograms_For_Type (Id)) then
-- If type is private and has a completion, predicate may be defined
-- on the full view.
if Is_Private_Type (Id) and then Present (Full_View (Id)) then
T := Full_View (Id);
else
T := Id;
end if;
if No (Subprograms_For_Type (T)) then
return Empty;
else
S := Subprograms_For_Type (Id);
S := Subprograms_For_Type (T);
while Present (S) loop
if Is_Predicate_Function (S) then
return S;

22
gcc/ada/exp_ch6.adb
View File

@ -1720,15 +1720,19 @@ package body Exp_Ch6 is
-- this is harder to verify, and there may be a redundant check.
-- Note also that Subp may be either a subprogram entity for
-- direct calls, or a type entity for indirect calls, hence the
-- test that Is_Overloadable returns True before testing whether
-- Subp is an inherited operation.
-- direct calls, or a type entity for indirect calls, which must
-- be handled separately because the name does not denote an
-- overloadable entity.
if (Present (Find_Aspect (E_Actual, Aspect_Predicate))
-- If the formal is class-wide the corresponding postcondition
-- procedure does not include a predicate call, so it has to be
-- generated explicitly.
if (Has_Aspect (E_Actual, Aspect_Predicate)
or else
Present (Find_Aspect (E_Actual, Aspect_Dynamic_Predicate))
Has_Aspect (E_Actual, Aspect_Dynamic_Predicate)
or else
Present (Find_Aspect (E_Actual, Aspect_Static_Predicate)))
Has_Aspect (E_Actual, Aspect_Static_Predicate))
and then not Is_Init_Proc (Subp)
then
if (Is_Derived_Type (E_Actual)
@ -1738,6 +1742,12 @@ package body Exp_Ch6 is
then
Append_To
(Post_Call, Make_Predicate_Check (E_Actual, Actual));
elsif Is_Class_Wide_Type (E_Formal)
and then not Is_Class_Wide_Type (E_Actual)
then
Append_To
(Post_Call, Make_Predicate_Check (E_Actual, Actual));
end if;
end if;

6
gcc/ada/prj-conf.ads
View File

@ -89,8 +89,10 @@ package Prj.Conf is
--
-- If Implicit_Project is True, the main project file being parsed is
-- deemed to be in the current working directory, even if it is not the
-- case.
-- Why is this ever useful???
-- case. Implicit_Project is set to True when a tool such as gprbuild is
-- invoked without a project file and is using an implicit project file
-- that is virtually in the current working directory, but is physically
-- in another directory.
procedure Process_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;

6
gcc/ada/prj-part.ads
View File

@ -70,7 +70,9 @@ package Prj.Part is
--
-- If Implicit_Project is True, the main project file being parsed is
-- deemed to be in the current working directory, even if it is not the
-- case.
-- Why is this ever useful???
-- case. Implicit_Project is set to True when a tool such as gprbuild is
-- invoked without a project file and is using an implicit project file
-- that is virtually in the current working directory, but is physically
-- in another directory.
end Prj.Part;

7
gcc/ada/sem_res.adb
View File

@ -3946,12 +3946,13 @@ package body Sem_Res is
-- Apply predicate checks, unless this is a call to the
-- predicate check function itself, which would cause an
-- infinite recursion.
-- infinite recursion, or it is a call to an initialization
-- procedure whose operand is of course an unfinished object.
if not (Ekind (Nam) = E_Function
and then (Is_Predicate_Function (Nam)
or else
Is_Predicate_Function_M (Nam)))
or else Is_Predicate_Function_M (Nam)))
and then not Is_Init_Proc (Nam)
then
Apply_Predicate_Check (A, F_Typ);
end if;