From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 15104 invoked by alias); 11 Jun 2018 09:21:31 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 15094 invoked by uid 89); 11 Jun 2018 09:21:30 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=BAYES_00,GIT_PATCH_2,GIT_PATCH_3,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.2 spammy=parents, relation, placement X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 11 Jun 2018 09:21:28 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 4E287560ED; Mon, 11 Jun 2018 05:21:27 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 9wZk3lpnADWW; Mon, 11 Jun 2018 05:21:27 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 3A736560EC; Mon, 11 Jun 2018 05:21:27 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 369F154C; Mon, 11 Jun 2018 05:21:27 -0400 (EDT) Date: Mon, 11 Jun 2018 09:21:00 -0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Crash on instantiation of nested generic in private part Message-ID: <20180611092127.GA134788@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="pWyiEgJYm5f9v55/" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes X-SW-Source: 2018-06/txt/msg00552.txt.bz2 --pWyiEgJYm5f9v55/ Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 849 This patch fixes a compiler abort on an instantiation of a generic nested within another instance, when the outer instance is declared in the visible part of a package and the inner intance is in the private part of the same package. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-06-11 Ed Schonberg gcc/ada/ * sem_ch12.adb (Install_Body): In order to determine the placement of the freeze node for an instance of a generic nested within another instance, take into account that the outer instance may be declared in the visible part of a package and the inner intance may be in the private part of the same package. gcc/testsuite/ * gnat.dg/nested_generic2.adb, gnat.dg/nested_generic2.ads, gnat.dg/nested_generic2_g1.adb, gnat.dg/nested_generic2_g1.ads, gnat.dg/nested_generic2_g2.ads: New testcase. --pWyiEgJYm5f9v55/ Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" Content-length: 2633 --- gcc/ada/sem_ch12.adb +++ gcc/ada/sem_ch12.adb @@ -9527,9 +9527,13 @@ package body Sem_Ch12 is -- the freeze node for Inst must be inserted after that of -- Parent_Inst. This relation is established by comparing -- the Slocs of Parent_Inst freeze node and Inst. + -- We examine the parents of the enclosing lists to handle + -- the case where the parent instance is in the visible part + -- of a package declaration, and the inner instance is in + -- the corresponding private part. - if List_Containing (Get_Unit_Instantiation_Node (Par)) = - List_Containing (N) + if Parent (List_Containing (Get_Unit_Instantiation_Node (Par))) + = Parent (List_Containing (N)) and then Sloc (Freeze_Node (Par)) < Sloc (N) then Insert_Freeze_Node_For_Instance (N, F_Node); --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/nested_generic2.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Nested_Generic2 is + procedure Dummy is null; +end Nested_Generic2; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/nested_generic2.ads @@ -0,0 +1,13 @@ +with Nested_Generic2_G1; +with Nested_Generic2_G2; + +package Nested_Generic2 is + + package My_G1 is new Nested_Generic2_G1 ("Lewis"); + package My_G2 is new Nested_Generic2_G2 (T => Integer, P => My_G1); + + procedure Dummy; + +private + package My_Nested is new My_G1.Nested ("Clark"); +end Nested_Generic2; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/nested_generic2_g1.adb @@ -0,0 +1,15 @@ +package body Nested_Generic2_G1 is + + procedure Debug (Msg : String; Prefix : String) is + begin + null; + end; + + package body Nested is + procedure Debug (Msg : String) is + begin + Debug (Msg, Prefix); + end; + end Nested; + +end Nested_Generic2_G1; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/nested_generic2_g1.ads @@ -0,0 +1,13 @@ +generic + S : String; +package Nested_Generic2_G1 is + + procedure Debug (Msg : String; Prefix : String); + + generic + Prefix : String; + package Nested is + procedure Debug (Msg : String); + end Nested; + +end Nested_Generic2_G1; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/nested_generic2_g2.ads @@ -0,0 +1,7 @@ +with Nested_Generic2_G1; + +generic + type T is private; + with package P is new Nested_Generic2_G1 (<>); +package Nested_Generic2_G2 is +end Nested_Generic2_G2; --pWyiEgJYm5f9v55/--