From patchwork Wed Jan 11 20:43:06 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "coopht@gmail.com" X-Patchwork-Id: 135499 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id B9E43B6EF3 for ; Thu, 12 Jan 2012 07:42:36 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1326919358; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Message-ID:Date:From:User-Agent:MIME-Version:To:CC: Subject:Content-Type:Mailing-List:Precedence:List-Id: List-Unsubscribe:List-Archive:List-Post:List-Help:Sender: Delivered-To; bh=LEf+i0z92mgAT5byleGZaZzEtK0=; b=BWoJTwP4wKA+D+M FfMbrL1f2IzGFN8zv28OQ0QJW62ie6f2hsvl7OtHuNLhkvcowCDOi41PUdF72XwJ FrsgIGT7IMlxDVB8+4jqLFxYszrg6TcLkKy3GW23x9PAB2YMs2lGs62tuaS1sC1k baf/ug1GtiM8PXb1jGj7FaVH0rKs= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject:Content-Type:X-IsSubscribed:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=yenFEYJa85W0epM4OIFKyyBqGsw6VEz9eQSgJ/us+WYqp1bm3GQ2XVq4i7IbXg IcllC0MFLrmnzm67a4Nw2HK9+NXr8XKlrhRYPi5ZuGBpUKPt5A8xl+uvXiP4mr9i 2yI2z7Qf2Ljg83/Co3fs1+ZvDAg8A3un96pDenTfoi/x8=; Received: (qmail 8323 invoked by alias); 11 Jan 2012 20:42:32 -0000 Received: (qmail 8311 invoked by uid 22791); 11 Jan 2012 20:42:31 -0000 X-SWARE-Spam-Status: No, hits=-2.0 required=5.0 tests=AWL, BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW X-Spam-Check-By: sourceware.org Received: from mail-ey0-f175.google.com (HELO mail-ey0-f175.google.com) (209.85.215.175) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 11 Jan 2012 20:42:17 +0000 Received: by eaao13 with SMTP id o13so387489eaa.20 for ; Wed, 11 Jan 2012 12:42:15 -0800 (PST) Received: by 10.205.125.144 with SMTP id gs16mr125866bkc.137.1326314535614; Wed, 11 Jan 2012 12:42:15 -0800 (PST) Received: from [192.168.0.101] ([188.123.237.121]) by mx.google.com with ESMTPS id gg11sm5620989bkc.9.2012.01.11.12.42.14 (version=TLSv1/SSLv3 cipher=OTHER); Wed, 11 Jan 2012 12:42:15 -0800 (PST) Message-ID: <4F0DF45A.3080904@gmail.com> Date: Thu, 12 Jan 2012 00:43:06 +0400 From: Alexander Basov User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:9.0) Gecko/20120106 Thunderbird/9.0 MIME-Version: 1.0 To: gcc-patches@gcc.gnu.org CC: coopht@gmail.com Subject: [PATCH, Ada] Illegal program not detected, self renames, PR15846 X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 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;