From patchwork Mon Jul 8 07:44:15 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 257480 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 1DB102C0040 for ; Mon, 8 Jul 2013 17:44:29 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=HzKz0ph9IUg46TPWg7Ou91vlHD/ChRvhf6VQ8TshJq0RnVRwu7 7XPt37ETJR9YLQHCYYtUcMzmLCQAeg8ogY8ESBlzODSDzoGsx/k5+VWh3rNvU9jq MEfBvTABZGpuzHEBWrptDSy9tt+3v91x8ti94yD8O3jI3jIBHEnu66mzo= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=ZeueAmXrjgPvQq/R5JrePGU1Nzs=; b=TxBRrXmdReYv1tQmP0cO DofYRsUDH2QQrHe6hhLMsJpQNYi4fBwLFmOytqtsFQJ/QcnsR9D6rAJDtKeCDuvD SR2DYwVM68sFtfkV0BY81Amry6ReoiPS7L1nzp6Stlc68NAI+0EEyJTSxaz6Dy6d lCe78ElzqQfpsNtAYhgZcXE= Received: (qmail 12141 invoked by alias); 8 Jul 2013 07:44:18 -0000 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 Received: (qmail 12108 invoked by uid 89); 8 Jul 2013 07:44:18 -0000 X-Spam-SWARE-Status: No, score=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO autolearn=ham version=3.3.1 Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Mon, 08 Jul 2013 07:44:17 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5BB261C671B; Mon, 8 Jul 2013 03:44:15 -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 gNjVt0YCHxQ9; Mon, 8 Jul 2013 03:44:15 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 37A181C6677; Mon, 8 Jul 2013 03:44:15 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 345EA3FB31; Mon, 8 Jul 2013 03:44:15 -0400 (EDT) Date: Mon, 8 Jul 2013 03:44:15 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [Ada] Avoid spurious error reported by the compiler Message-ID: <20130708074415.GA28739@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) X-Virus-Found: No This patch modifies the approach taken by the compiler to save/restore the scope stack. The save routine now returns the list of entitites which have been temporarily removed from visibility, and that list is passed to the restore routine to restore their visibility. This approach consumes more memory than the previous approach but avoids latent problems caused by the previous approach. After this patch the following test compiles silently. package P is type Root_Type is abstract tagged limited record N : Natural; end record; type Child_Type is abstract limited new Root_Type with null record; type Interface_Type is limited interface; function F (N : Natural) return Interface_Type is abstract; end P; generic package P.Generic_Child_Package is type T is new P.Child_Type and P.Interface_Type with null record; overriding function F (N : in Natural) return T; end P.Generic_Child_Package; with P.Generic_Child_Package; package Q is package Instance_Package is new P.Generic_Child_Package; X : Instance_Package.T := Instance_Package.F (10); end Q; Command: gcc -c -gnat05 q.ads Tested on x86_64-pc-linux-gnu, committed on trunk 2013-07-08 Javier Miranda * sem_ch8.ad[sb] (Save_Scope_Stack): Modified to return the list of entities which have been temporarily removed from immediate visibility. (Restore_Scope_Stack): Modified to receive an additional parameter with the list of entities whose immediate visibility must be restored. * sem.adb (Do_Analyze): Use new version of Save_Scope_Stack/Restore_Scope_Stack * sem_ch12.adb (Inline_Instance_Body): Use new version of Save_Scope_Stack and Restore_Scope_Stack Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 200704) +++ sem_ch12.adb (working copy) @@ -4084,6 +4084,7 @@ Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id; Instances : array (1 .. Scope_Stack_Depth) of Entity_Id; Inner_Scopes : array (1 .. Scope_Stack_Depth) of Entity_Id; + List : Elist_Id; Num_Inner : Int := 0; N_Instances : Int := 0; S : Entity_Id; @@ -4187,7 +4188,7 @@ -- Remove entities in current scopes from visibility, so that -- instance body is compiled in a clean environment. - Save_Scope_Stack (Handle_Use => False); + List := Save_Scope_Stack (Handle_Use => False); if Is_Child_Unit (S) then @@ -4261,7 +4262,7 @@ end loop; end if; - Restore_Scope_Stack (Handle_Use => False); + Restore_Scope_Stack (List, Handle_Use => False); if Present (Curr_Scope) and then Index: sem.adb =================================================================== --- sem.adb (revision 200688) +++ sem.adb (working copy) @@ -1340,8 +1340,10 @@ ---------------- procedure Do_Analyze is + List : Elist_Id; + begin - Save_Scope_Stack; + List := Save_Scope_Stack; Push_Scope (Standard_Standard); Scope_Suppress := Suppress_Options; Scope_Stack.Table @@ -1362,7 +1364,7 @@ -- Then pop entry for Standard, and pop implicit types Pop_Scope; - Restore_Scope_Stack; + Restore_Scope_Stack (List); end Do_Analyze; Already_Analyzed : constant Boolean := Analyzed (Comp_Unit); Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 200705) +++ sem_ch8.adb (working copy) @@ -7654,119 +7654,20 @@ -- Restore_Scope_Stack -- ------------------------- - procedure Restore_Scope_Stack (Handle_Use : Boolean := True) is - E : Entity_Id; - S : Entity_Id; - Comp_Unit : Node_Id; - In_Child : Boolean := False; - Full_Vis : Boolean := True; - SS_Last : constant Int := Scope_Stack.Last; + procedure Restore_Scope_Stack + (List : Elist_Id; + Handle_Use : Boolean := True) + is + SS_Last : constant Int := Scope_Stack.Last; + Elmt : Elmt_Id; begin -- Restore visibility of previous scope stack, if any - for J in reverse 0 .. Scope_Stack.Last loop - exit when Scope_Stack.Table (J).Entity = Standard_Standard - or else No (Scope_Stack.Table (J).Entity); - - S := Scope_Stack.Table (J).Entity; - - if not Is_Hidden_Open_Scope (S) then - - -- If the parent scope is hidden, its entities are hidden as - -- well, unless the entity is the instantiation currently - -- being analyzed. - - if not Is_Hidden_Open_Scope (Scope (S)) - or else not Analyzed (Parent (S)) - or else Scope (S) = Standard_Standard - then - Set_Is_Immediately_Visible (S, True); - end if; - - E := First_Entity (S); - while Present (E) loop - if Is_Child_Unit (E) then - if not From_With_Type (E) then - Set_Is_Immediately_Visible (E, - Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E)); - - else - pragma Assert - (Nkind (Parent (E)) = N_Defining_Program_Unit_Name - and then - Nkind (Parent (Parent (E))) = - N_Package_Specification); - Set_Is_Immediately_Visible (E, - Limited_View_Installed (Parent (Parent (E)))); - end if; - else - Set_Is_Immediately_Visible (E, True); - end if; - - Next_Entity (E); - - if not Full_Vis and then Is_Package_Or_Generic_Package (S) then - - -- We are in the visible part of the package scope - - exit when E = First_Private_Entity (S); - end if; - end loop; - - -- The visibility of child units (siblings of current compilation) - -- must be restored in any case. Their declarations may appear - -- after the private part of the parent. - - if not Full_Vis then - while Present (E) loop - if Is_Child_Unit (E) then - Set_Is_Immediately_Visible (E, - Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E)); - end if; - - Next_Entity (E); - end loop; - end if; - end if; - - if Is_Child_Unit (S) - and not In_Child -- check only for current unit - then - In_Child := True; - - -- Restore visibility of parents according to whether the child - -- is private and whether we are in its visible part. - - Comp_Unit := Parent (Unit_Declaration_Node (S)); - - if Nkind (Comp_Unit) = N_Compilation_Unit - and then Private_Present (Comp_Unit) - then - Full_Vis := True; - - elsif Is_Package_Or_Generic_Package (S) - and then (In_Private_Part (S) or else In_Package_Body (S)) - then - Full_Vis := True; - - -- if S is the scope of some instance (which has already been - -- seen on the stack) it does not affect the visibility of - -- other scopes. - - elsif Is_Hidden_Open_Scope (S) then - null; - - elsif Ekind_In (S, E_Procedure, E_Function) - and then Has_Completion (S) - then - Full_Vis := True; - else - Full_Vis := False; - end if; - else - Full_Vis := True; - end if; + Elmt := First_Elmt (List); + while Present (Elmt) loop + Set_Is_Immediately_Visible (Node (Elmt)); + Next_Elmt (Elmt); end loop; if SS_Last >= Scope_Stack.First @@ -7781,11 +7682,24 @@ -- Save_Scope_Stack -- ---------------------- - procedure Save_Scope_Stack (Handle_Use : Boolean := True) is + function Save_Scope_Stack (Handle_Use : Boolean := True) return Elist_Id is + Result : constant Elist_Id := New_Elmt_List; E : Entity_Id; S : Entity_Id; SS_Last : constant Int := Scope_Stack.Last; + procedure Remove_From_Visibility (E : Entity_Id); + -- If E is immediately visible then append it to the result and remove + -- it temporarily from visibility + + procedure Remove_From_Visibility (E : Entity_Id) is + begin + if Is_Immediately_Visible (E) then + Append_Elmt (E, Result); + Set_Is_Immediately_Visible (E, False); + end if; + end Remove_From_Visibility; + begin if SS_Last >= Scope_Stack.First and then Scope_Stack.Table (SS_Last).Entity /= Standard_Standard @@ -7803,16 +7717,19 @@ or else No (Scope_Stack.Table (J).Entity); S := Scope_Stack.Table (J).Entity; - Set_Is_Immediately_Visible (S, False); + Remove_From_Visibility (S); + E := First_Entity (S); while Present (E) loop - Set_Is_Immediately_Visible (E, False); + Remove_From_Visibility (E); Next_Entity (E); end loop; end loop; end if; + + return Result; end Save_Scope_Stack; ------------- Index: sem_ch8.ads =================================================================== --- sem_ch8.ads (revision 200688) +++ sem_ch8.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -148,9 +148,11 @@ -- with-clause on system. N is absent when the function is called to find -- the visibility of implicit operators. - procedure Restore_Scope_Stack (Handle_Use : Boolean := True); - procedure Save_Scope_Stack (Handle_Use : Boolean := True); - -- These two procedures are called from Semantics, when a unit U1 is to + function Save_Scope_Stack (Handle_Use : Boolean := True) return Elist_Id; + procedure Restore_Scope_Stack + (List : Elist_Id; + Handle_Use : Boolean := True); + -- These two subprograms are called from Semantics, when a unit U1 is to -- be compiled in the course of the compilation of another unit U2. This -- happens whenever Rtsfind is called. U1, the unit retrieved by Rtsfind, -- must be compiled in its own context, and the current scope stack @@ -159,7 +161,9 @@ -- Handle_Use indicates whether local use clauses must be removed or -- installed. In the case of inlining of instance bodies, the visibility -- handling is done fully in Inline_Instance_Body, and use clauses are - -- handled there. + -- handled there. Save_Scope_Stack returns the list of entities which have + -- been temporarily removed from visibility; that list must be passed to + -- Restore_Scope_Stack to restore their visibility. procedure Set_Use (L : List_Id); -- Find use clauses that are declarative items in a package declaration