From patchwork Tue Oct 12 10:38:48 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 67521 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 EAC45B7043 for ; Tue, 12 Oct 2010 21:38:57 +1100 (EST) Received: (qmail 4729 invoked by alias); 12 Oct 2010 10:38:56 -0000 Received: (qmail 4721 invoked by uid 22791); 12 Oct 2010 10:38:55 -0000 X-SWARE-Spam-Status: No, hits=-1.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) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 12 Oct 2010 10:38:50 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 8C062CB01E0; Tue, 12 Oct 2010 12:38:48 +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 H974pkiQ3QuW; Tue, 12 Oct 2010 12:38:48 +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 74913CB01D8; Tue, 12 Oct 2010 12:38:48 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 55913D9BB5; Tue, 12 Oct 2010 12:38:48 +0200 (CEST) Date: Tue, 12 Oct 2010 12:38:48 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] String literals in nested subprograms in generic units Message-ID: <20101012103848.GA12373@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 A string literal subtype is constructed for every string. If the literal is the value of a declared constant, it may be used in a nested scope in another declaration. If the context is generic, the nested string may be elaborated in a different scope leading to elaboration problems in the backend. This patch forces the reanalysis of a string that appears in an instantiation, so that a new subtype can be created for it in the proper context. The following must compile quietly: --- with Q; procedure P is package My_Q is new Q (Name => "My_Q"); begin My_Q.Dummy; end; --- generic Name : String; package Q is procedure Dummy; end Q; --- package body Q is Scope : constant String := Name; generic I : Integer; procedure Proc_G; procedure Proc_G is Context : constant String := Scope; Scope : constant String := Context & ".Proc_G"; procedure Nested is Context : constant String := Scope; Scope : constant String := Context & ".Nested"; begin null; end; begin null; end; procedure Proc is new Proc_G (0); procedure Dummy is begin null; end; end Q; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-12 Ed Schonberg * sem_ch12.adb (Copy_Generic_Node): If node is a string literal, remove string_literal_subtype so that a new one can be constructed in the scope of the instance. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 165353) +++ sem_ch12.adb (working copy) @@ -6211,15 +6211,25 @@ package body Sem_Ch12 is end if; end; - elsif Nkind_In (N, N_Integer_Literal, - N_Real_Literal, - N_String_Literal) - then + elsif Nkind_In (N, N_Integer_Literal, N_Real_Literal) then + -- No descendant fields need traversing null; - -- For the remaining nodes, copy recursively their descendants + elsif Nkind (N) = N_String_Literal + and then Present (Etype (N)) + and then Instantiating + then + -- If the string is declared in an outer scope, the string_literal + -- subtype created for it may have the wrong scope. We force the + -- reanalysis of the constant to generate a new itype in the proper + -- context. + + Set_Etype (New_N, Empty); + Set_Analyzed (New_N, False); + + -- For the remaining nodes, copy their descendants recursively else Copy_Descendants;