From 42f11e4c26a824c2fa4b8f9bfc9e4af69fe86dc8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 2 May 2016 12:18:12 +0200 Subject: [multiple changes] 2016-05-02 Hristian Kirtchev * exp_prag.adb, comperr.adb: Minor reformatting. 2016-05-02 Ed Schonberg * exp_pakd.adb (Rj_Unchecked_Convert_To): Do not perform an unchecked conversion if the source size is 0 (indicating that its RM size is unknown). This will happen with packed arrays of non-discrete types, in which case the component type is known to match. 2016-05-02 Arnaud Charlet * debug.adb: Reserve -gnatd.V. 2016-05-02 Javier Miranda * sem_ch3.adb (Process_Full_View): Remove from visibility wrappers of synchronized types to avoid spurious errors with their wrapped entity. * exp_ch9.adb (Build_Wrapper_Spec): Do not generate the wrapper if no interface primitive is covered by the subprogram and this is not a primitive declared between two views; see Process_Full_View. (Build_Protected_Sub_Specification): Link the dispatching subprogram with its original non-dispatching protected subprogram since their names differ. (Expand_N_Protected_Type_Declaration): If a protected subprogram overrides an interface primitive then do not build a wrapper if it was already built. * einfo.ads, einfo.adb (Original_Protected_Subprogram): New attribute. * sem_ch4.adb (Names_Match): New subprogram. * sem_ch6.adb (Check_Synchronized_Overriding): Moved to library level and defined in the public part of the package to invoke it from Exp_Ch9.Build_Wrapper_Spec (Has_Matching_Entry_Or_Subprogram): New subprogram. (Report_Conflict): New subprogram. From-SVN: r235739 --- gcc/ada/sem_ch4.adb | 39 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) (limited to 'gcc/ada/sem_ch4.adb') diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index c867cf6..73fa521 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -8817,6 +8817,15 @@ package body Sem_Ch4 is -- is visible a direct call to it will dispatch to the private one, -- which is therefore a valid candidate. + function Names_Match + (Obj_Type : Entity_Id; + Prim_Op : Entity_Id; + Subprog : Entity_Id) return Boolean; + -- Return True if the names of Prim_Op and Subprog match. If Obj_Type + -- is a protected type then compare also the original name of Prim_Op + -- with the name of Subprog (since the expander may have added a + -- prefix to its original name --see Exp_Ch9.Build_Selected_Name). + function Valid_First_Argument_Of (Op : Entity_Id) return Boolean; -- Verify that the prefix, dereferenced if need be, is a valid -- controlling argument in a call to Op. The remaining actuals @@ -8993,6 +9002,34 @@ package body Sem_Ch4 is and then not Is_Hidden (Visible_Op); end Is_Private_Overriding; + ----------------- + -- Names_Match -- + ----------------- + + function Names_Match + (Obj_Type : Entity_Id; + Prim_Op : Entity_Id; + Subprog : Entity_Id) return Boolean is + begin + -- Common case: exact match + + if Chars (Prim_Op) = Chars (Subprog) then + return True; + + -- For protected type primitives the expander may have built the + -- name of the dispatching primitive prepending the type name to + -- avoid conflicts with the name of the protected subprogram (see + -- Exp_Ch9.Build_Selected_Name). + + elsif Is_Protected_Type (Obj_Type) then + return Present (Original_Protected_Subprogram (Prim_Op)) + and then Chars (Original_Protected_Subprogram (Prim_Op)) + = Chars (Subprog); + end if; + + return False; + end Names_Match; + ----------------------------- -- Valid_First_Argument_Of -- ----------------------------- @@ -9059,7 +9096,7 @@ package body Sem_Ch4 is while Present (Elmt) loop Prim_Op := Node (Elmt); - if Chars (Prim_Op) = Chars (Subprog) + if Names_Match (Obj_Type, Prim_Op, Subprog) and then Present (First_Formal (Prim_Op)) and then Valid_First_Argument_Of (Prim_Op) and then -- cgit v1.1