Sorry,
fixed patch is attached.
12.01.2012 00:43, Alexander Basov пишет:
> Hi,
>
> this patch fixes problem when gnat is not able
> to detect illegal program with self renaming of predefined operation,
> when renaming operation is defined with selected component of the same
> package as renaming declaration.
> (please correct me if I wrong in my explanation)
>
> And also this patch fixes ICE when T1 type is tagged record.
>
> package renaming6 is
>
> type T1 is null record;
>
> function "=" (left, right : in T1) return boolean
> renames renaming6."="; -- { dg-error "subprogram cannot rename
> itself" }
>
> end renaming6;
>
> Tested on x86_64-pc-linux-gnu.
>
> ChangeLog:
> * gcc/ada/exp_disp.adb (Make_DT):
> Check if flag Is_Dispatching_Operation is True before getting
> DT_Position flag ,
> present in function and procedure entities which are dispatching
>
> * gcc/ada/sem_ch8.adb (Analyze_Subprogram_Renaming):
> Added check if renaming entity package is the same as
> renaming_declaration package,
> in case if both operations has the same names.
>
> * gcc/testsuite/gnat.dg/specs/renamings1.ads: new testcase
> * gcc/testsuite/gnat.dg/specs/renamings2.ads: new testcase
>
--
Best regards,
Alexander Basov
Index: gcc/ada/exp_disp.adb
===================================================================
--- gcc/ada/exp_disp.adb (revision 183094)
+++ gcc/ada/exp_disp.adb (working copy)
@@ -4135,6 +4135,7 @@
Prim := Node (Prim_Elmt);
if Present (Interface_Alias (Prim))
+ and then Is_Dispatching_Operation (Prim)
and then Find_Dispatching_Type
(Interface_Alias (Prim)) = Iface
then
@@ -4247,7 +4248,6 @@
while Present (Prim_Elmt) loop
Prim := Node (Prim_Elmt);
E := Ultimate_Alias (Prim);
- Prim_Pos := UI_To_Int (DT_Position (E));
-- Do not reference predefined primitives because they are
-- located in a separate dispatch table; skip abstract and
@@ -4260,7 +4260,8 @@
and then not Is_Abstract_Subprogram (Alias (Prim))
and then not Is_Eliminated (Alias (Prim))
and then (not Is_CPP_Class (Root_Type (Typ))
- or else Prim_Pos > CPP_Nb_Prims)
+ or else UI_To_Int
+ (DT_Position (E)) > CPP_Nb_Prims)
and then Find_Dispatching_Type
(Interface_Alias (Prim)) = Iface
@@ -5764,7 +5765,6 @@
E : Entity_Id;
Prim : Entity_Id;
Prim_Elmt : Elmt_Id;
- Prim_Pos : Nat;
Prim_Table : array (Nat range 1 .. Nb_Prim) of Entity_Id;
begin
@@ -5777,8 +5777,7 @@
-- Retrieve the ultimate alias of the primitive for proper
-- handling of renamings and eliminated primitives.
- E := Ultimate_Alias (Prim);
- Prim_Pos := UI_To_Int (DT_Position (E));
+ E := Ultimate_Alias (Prim);
-- Do not reference predefined primitives because they are
-- located in a separate dispatch table; skip entities with
@@ -5794,7 +5793,8 @@
and then not Is_Abstract_Subprogram (E)
and then not Is_Eliminated (E)
and then (not Is_CPP_Class (Root_Type (Typ))
- or else Prim_Pos > CPP_Nb_Prims)
+ or else UI_To_Int
+ (DT_Position (E)) > CPP_Nb_Prims)
then
pragma Assert
(UI_To_Int (DT_Position (Prim)) <= Nb_Prim);
Index: gcc/ada/sem_ch8.adb
===================================================================
--- gcc/ada/sem_ch8.adb (revision 183094)
+++ gcc/ada/sem_ch8.adb (working copy)
@@ -2662,10 +2662,13 @@
end if;
end if;
- if not Is_Actual
- and then (Old_S = New_S
- or else (Nkind (Nam) /= N_Expanded_Name
- and then Chars (Old_S) = Chars (New_S)))
+ if not Is_Actual and then
+ (Old_S = New_S
+ or else (Nkind (Nam) /= N_Expanded_Name
+ and then Chars (Old_S) = Chars (New_S))
+ or else (Nkind (Nam) = N_Expanded_Name
+ and then Scope (New_S) = Entity (Prefix (Nam))
+ and then Chars (Old_S) = Chars (New_S)))
then
Error_Msg_N ("subprogram cannot rename itself", N);
end if;
Index: gcc/testsuite/gnat.dg/specs/renamings1.ads
===================================================================
--- gcc/testsuite/gnat.dg/specs/renamings1.ads (revision 0)
+++ gcc/testsuite/gnat.dg/specs/renamings1.ads (working copy)
@@ -0,0 +1,10 @@
+-- { dg-do compile}
+
+package renamings1 is
+
+ type T1 is tagged null record;
+
+ function "=" (left, right : in T1) return Boolean
+ renames renamings1."="; -- { dg-error "subprogram cannot rename itself" }
+
+end renamings1;
Index: gcc/testsuite/gnat.dg/specs/renamings2.ads
===================================================================
--- gcc/testsuite/gnat.dg/specs/renamings2.ads (revision 0)
+++ gcc/testsuite/gnat.dg/specs/renamings2.ads (working copy)
@@ -0,0 +1,10 @@
+-- { dg-do compile}
+
+package renamings2 is
+
+ type T1 is null record;
+
+ function "=" (left, right : in T1) return boolean
+ renames renamings2."="; -- { dg-error "subprogram cannot rename itself" }
+
+end renamings2;
