From patchwork Tue Oct 19 10:24:20 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 68301 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 1BB44B70D5 for ; Tue, 19 Oct 2010 21:24:30 +1100 (EST) Received: (qmail 654 invoked by alias); 19 Oct 2010 10:24:28 -0000 Received: (qmail 644 invoked by uid 22791); 19 Oct 2010 10:24:27 -0000 X-SWARE-Spam-Status: No, hits=-0.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 19 Oct 2010 10:24:22 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 995A9CB02D8; Tue, 19 Oct 2010 12:24:20 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id QzjFIdDIioU9; Tue, 19 Oct 2010 12:24:20 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 85449CB0286; Tue, 19 Oct 2010 12:24:20 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 66091D9BB5; Tue, 19 Oct 2010 12:24:20 +0200 (CEST) Date: Tue, 19 Oct 2010 12:24:20 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Instantiation of a renaming of an implicit child unit Message-ID: <20101019102420.GA14742@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i 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 The implicit child unit that is present in the instantiation of a parent generic is not materialized in the parent instance, but retrieved when instantiated. This requires installing the parent instance on the scope stack. This patch handles the case where the generic unit being instantiated is a renaming of the implicit child within a parent unit, where additional tree traversal is needed to retrieve the parent instance. The following must compile and execute quietly: with p; with decl; procedure main is package x is new decl.r; begin if X.Var /= 1111 then raise Program_Error; end if; end main; --- generic X : integer; package gp1 is Val : Integer := X; type some_type is new integer; end gp1; --- generic package gp1.gp2 is type and_now_something_completely_different is new some_type; Var : integer := Val; end; --- with gp1; package p is new gp1 (1111); --- with gp1.gp2; with p; package decl is generic package r renames p.gp2; end decl; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-19 Ed Schonberg * sem_ch12.adb (Check_Generic_Child_Unit): Handle properly the case of an instantiation of a renaming of the implicit generic child that appears within an instance of its parent. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 165687) +++ sem_ch12.adb (working copy) @@ -5309,6 +5309,25 @@ package body Sem_Ch12 is then Install_Parent (Inst_Par); Parent_Installed := True; + + -- The generic unit may be the renaming of the implicit child + -- present in an instance. In that case the parent instance is + -- obtained from the name of the renamed entity. + + elsif Ekind (Entity (Gen_Id)) = E_Generic_Package + and then Present (Renamed_Entity (Entity (Gen_Id))) + and then Is_Child_Unit (Renamed_Entity (Entity (Gen_Id))) + then + declare + Renamed_Package : constant Node_Id := + Name (Parent (Entity (Gen_Id))); + begin + if Nkind (Renamed_Package) = N_Expanded_Name then + Inst_Par := Entity (Prefix (Renamed_Package)); + Install_Parent (Inst_Par); + Parent_Installed := True; + end if; + end; end if; end if;