Patchwork [Ada] Illegal program not detected, self renames, PR15846

login
register
mail settings
Submitter coopht@gmail.com
Date Jan. 11, 2012, 8:43 p.m.
Message ID <4F0DF45A.3080904@gmail.com>
Download mbox | patch
Permalink /patch/135499/
State New
Headers show

Comments

coopht@gmail.com - Jan. 11, 2012, 8:43 p.m.
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
Arnaud Charlet - Jan. 23, 2012, 8:11 p.m.
> 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.

The patch for sem_ch8 is correct although we will incorporate a variant
that has a minor change that will leave things a bit clearer, stay tuned.

Regarding the proposed patch for exp_disp, it does not add any new
useful functionality apparently.

By the way, do you have a copyright assignment in place with the FSF?

Arno
coopht@gmail.com - Jan. 23, 2012, 9:01 p.m.
24.01.2012 00:11, Arnaud Charlet пишет:
>> 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.
> The patch for sem_ch8 is correct although we will incorporate a variant
> that has a minor change that will leave things a bit clearer, stay tuned.
Great!
>
> Regarding the proposed patch for exp_disp, it does not add any new
> useful functionality apparently.
The patch for exp_disp is related to renaming of predefined "="
operation for tagged type.
without this patch I've got ICE on the following testcase:

package renaming5 is

   type T1 is tagged null record;

   function "=" (left, right : in T1) return Boolean
     renames renaming5."=";  -- { dg-error "subprogram cannot rename itself" }

end renaming5;

Also this patch is partially fixes PR32164:

package Pak1 is
   type T1 is tagged null record;
   function  Eq(X, Y : T1) return Boolean renames "=";
   function Neq(X, Y : T1) return Boolean renames "/="; -- line 4
end Pak1;

It fixes ICE, but incorrect message still exists: "prefix of
"Unrestricted_Access" attribute cannot be intrinsic".
I will try to solve this problem a bit later.
>
> By the way, do you have a copyright assignment in place with the FSF?

No, I don't have it. What should I do?
>
> Arno

Patch

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 renaming5 is
+
+   type T1 is tagged null record;
+
+   function "=" (left, right : in T1) return Boolean
+     renames renaming5."=";  -- { dg-error "subprogram cannot rename itself" }
+
+end renaming5;
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 renaming6 is
+
+   type T1 is null record;
+
+   function "=" (left, right : in T1) return boolean
+     renames renaming6."=";  -- { dg-error "subprogram cannot rename itself" }
+
+end renaming6;