diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-04-23 11:53:23 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-04-23 11:53:23 +0200 |
commit | e93f4e1244de0d4d7446237c7fa6995e57efca41 (patch) | |
tree | 7707a1974f10354ae188d09877f6b574d4ca66aa /gcc | |
parent | 9d5598bf839e572e6262367af623d1e1af91c4a6 (diff) | |
download | gcc-e93f4e1244de0d4d7446237c7fa6995e57efca41.zip gcc-e93f4e1244de0d4d7446237c7fa6995e57efca41.tar.gz gcc-e93f4e1244de0d4d7446237c7fa6995e57efca41.tar.bz2 |
[multiple changes]
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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
-rw-r--r-- | gcc/ada/aspects.adb | 6 | ||||
-rw-r--r-- | gcc/ada/einfo.adb | 14 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 22 | ||||
-rw-r--r-- | gcc/ada/prj-conf.ads | 6 | ||||
-rw-r--r-- | gcc/ada/prj-part.ads | 6 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 7 |
7 files changed, 60 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b81550c..984e97d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index f63cd2b..b72debb 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -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 diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 789a420..aa254f5 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 08e93c4..bbb7bde 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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; diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index 172356f..1c72fa7 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -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; diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index 438ec9d..1bf1366 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index db6ecf7..ee2483b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; |