diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2016-04-19 14:22:12 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2016-04-19 14:22:12 +0200 |
| commit | 87fd6836074fadc41833bf26686e99dbe574a638 (patch) | |
| tree | db80712bf51c3130061299a0c940026b2b325d7a /gcc/ada/sem_disp.adb | |
| parent | b35e5dcb14b85adb622f0f6ee4c629e9a44dcdd0 (diff) | |
| download | gcc-87fd6836074fadc41833bf26686e99dbe574a638.zip gcc-87fd6836074fadc41833bf26686e99dbe574a638.tar.gz gcc-87fd6836074fadc41833bf26686e99dbe574a638.tar.bz2 | |
[multiple changes]
2016-04-19 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Entry_Call): If the entry has
preconditions it is rewritten by means of a wrapper that
incorporates the original call. Before rewriting generate a
reference to the entry being called to prevent spurious warnings
and provide correct cross-reference information.
2016-04-19 Hristian Kirtchev <kirtchev@adacore.com>
* sem_disp.adb (Check_Dispatching_Context): Code cleanup. Add
local constant Scop. Ignore any internally generated loops when
performing the check concerning an abstract subprogram call
without a controlling argument.
* sem_util.ads, sem_util.adb (Current_Scope_No_Loops): New routine.
From-SVN: r235192
Diffstat (limited to 'gcc/ada/sem_disp.adb')
| -rw-r--r-- | gcc/ada/sem_disp.adb | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 2d9a746..4d8ef3f 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -510,7 +510,6 @@ package body Sem_Disp is procedure Check_Dispatching_Context (Call : Node_Id) is Subp : constant Entity_Id := Entity (Name (Call)); - Typ : constant Entity_Id := Etype (Subp); procedure Abstract_Context_Error; -- Error for abstract call dispatching on result is not dispatching @@ -530,14 +529,15 @@ package body Sem_Disp is else Error_Msg_N - ("call to abstract procedure must be dispatching", - N); + ("call to abstract procedure must be dispatching", N); end if; end Abstract_Context_Error; -- Local variables - Par : Node_Id; + Scop : constant Entity_Id := Current_Scope_No_Loops; + Typ : constant Entity_Id := Etype (Subp); + Par : Node_Id; -- Start of processing for Check_Dispatching_Context @@ -568,18 +568,20 @@ package body Sem_Disp is -- but will be legal in overridings of the operation. elsif In_Spec_Expression - and then (Is_Subprogram (Current_Scope) - or else Chars (Current_Scope) = Name_Postcondition) and then - ((Nkind (Parent (Current_Scope)) = N_Procedure_Specification - and then Null_Present (Parent (Current_Scope))) - or else Is_Abstract_Subprogram (Current_Scope)) + (Is_Subprogram (Scop) + or else Chars (Scop) = Name_Postcondition) + and then + (Is_Abstract_Subprogram (Scop) + or else + (Nkind (Parent (Scop)) = N_Procedure_Specification + and then Null_Present (Parent (Scop)))) then null; elsif Ekind (Current_Scope) = E_Function - and then Nkind (Unit_Declaration_Node (Current_Scope)) = - N_Generic_Subprogram_Declaration + and then Nkind (Unit_Declaration_Node (Scop)) = + N_Generic_Subprogram_Declaration then null; @@ -969,8 +971,8 @@ package body Sem_Disp is -- if the associated tagged type is already frozen. Has_Dispatching_Parent := - Present (Alias (Subp)) - and then Is_Dispatching_Operation (Alias (Subp)); + Present (Alias (Subp)) + and then Is_Dispatching_Operation (Alias (Subp)); if No (Tagged_Type) then |