diff options
Diffstat (limited to 'gcc/ada/exp_disp.adb')
| -rw-r--r-- | gcc/ada/exp_disp.adb | 56 |
1 files changed, 43 insertions, 13 deletions
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index c0613bb80ce..e8fb0897fa6 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -64,7 +64,6 @@ with Stringt; use Stringt; with SCIL_LL; use SCIL_LL; with Targparm; use Targparm; with Tbuild; use Tbuild; -with Uintp; use Uintp; package body Exp_Disp is @@ -8046,7 +8045,7 @@ package body Exp_Disp is -- way we ensure that the final position of all the primitives is -- established by the following stages of this algorithm. - Set_DT_Position (Prim, No_Uint); + Set_DT_Position_Value (Prim, No_Uint); Next_Elmt (Prim_Elmt); end loop; @@ -8104,8 +8103,9 @@ package body Exp_Disp is if Chars (Node (Op_Elmt_2)) = Chars (Parent_Subp) and then Type_Conformant (Prim_Op, Node (Op_Elmt_2)) then - Set_DT_Position (Prim_Op, DT_Position (Parent_Subp)); - Set_DT_Position (Node (Op_Elmt_2), + Set_DT_Position_Value (Prim_Op, + DT_Position (Parent_Subp)); + Set_DT_Position_Value (Node (Op_Elmt_2), DT_Position (Parent_Subp)); Set_Fixed_Prim (UI_To_Int (DT_Position (Prim_Op))); @@ -8163,10 +8163,11 @@ package body Exp_Disp is if In_Predef_Prims_DT (Prim) then if Is_Predefined_Dispatching_Operation (Prim) then - Set_DT_Position (Prim, Default_Prim_Op_Position (Prim)); + Set_DT_Position_Value (Prim, + Default_Prim_Op_Position (Prim)); else pragma Assert (Present (Alias (Prim))); - Set_DT_Position (Prim, + Set_DT_Position_Value (Prim, Default_Prim_Op_Position (Ultimate_Alias (Prim))); end if; @@ -8181,12 +8182,12 @@ package body Exp_Disp is and then Present (DTC_Entity (Interface_Alias (Prim)))); E := Interface_Alias (Prim); - Set_DT_Position (Prim, DT_Position (E)); + Set_DT_Position_Value (Prim, DT_Position (E)); pragma Assert (DT_Position (Alias (Prim)) = No_Uint or else DT_Position (Alias (Prim)) = DT_Position (E)); - Set_DT_Position (Alias (Prim), DT_Position (E)); + Set_DT_Position_Value (Alias (Prim), DT_Position (E)); Set_Fixed_Prim (UI_To_Int (DT_Position (Prim))); -- Overriding primitives must use the same entry as the @@ -8202,7 +8203,7 @@ package body Exp_Disp is and then Present (DTC_Entity (Alias (Prim))) then E := Alias (Prim); - Set_DT_Position (Prim, DT_Position (E)); + Set_DT_Position_Value (Prim, DT_Position (E)); if not Is_Predefined_Dispatching_Alias (E) then Set_Fixed_Prim (UI_To_Int (DT_Position (E))); @@ -8239,7 +8240,7 @@ package body Exp_Disp is exit when not Fixed_Prim (Nb_Prim); end loop; - Set_DT_Position (Prim, UI_From_Int (Nb_Prim)); + Set_DT_Position_Value (Prim, UI_From_Int (Nb_Prim)); Set_Fixed_Prim (Nb_Prim); end if; @@ -8268,14 +8269,14 @@ package body Exp_Disp is Use_Full_View => True) then pragma Assert (DT_Position (Alias (Prim)) /= No_Uint); - Set_DT_Position (Prim, DT_Position (Alias (Prim))); + Set_DT_Position_Value (Prim, DT_Position (Alias (Prim))); -- Otherwise it will be placed in the secondary DT else pragma Assert (DT_Position (Interface_Alias (Prim)) /= No_Uint); - Set_DT_Position (Prim, + Set_DT_Position_Value (Prim, DT_Position (Interface_Alias (Prim))); end if; end if; @@ -8713,6 +8714,25 @@ package body Exp_Disp is end if; end Set_CPP_Constructors; + --------------------------- + -- Set_DT_Position_Value -- + --------------------------- + + procedure Set_DT_Position_Value (Prim : Entity_Id; Value : Uint) is + begin + Set_DT_Position (Prim, Value); + + -- Propagate the value to the wrapped subprogram (if one is present) + + if Ekind_In (Prim, E_Function, E_Procedure) + and then Is_Primitive_Wrapper (Prim) + and then Present (Wrapped_Entity (Prim)) + and then Is_Dispatching_Operation (Wrapped_Entity (Prim)) + then + Set_DT_Position (Wrapped_Entity (Prim), Value); + end if; + end Set_DT_Position_Value; + -------------------------- -- Set_DTC_Entity_Value -- -------------------------- @@ -8734,6 +8754,16 @@ package body Exp_Disp is Set_DTC_Entity (Prim, First_Tag_Component (Tagged_Type)); end if; + + -- Propagate the value to the wrapped subprogram (if one is present) + + if Ekind_In (Prim, E_Function, E_Procedure) + and then Is_Primitive_Wrapper (Prim) + and then Present (Wrapped_Entity (Prim)) + and then Is_Dispatching_Operation (Wrapped_Entity (Prim)) + then + Set_DTC_Entity (Wrapped_Entity (Prim), DTC_Entity (Prim)); + end if; end Set_DTC_Entity_Value; ----------------- |