From patchwork Tue Dec 20 14:09:36 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 132431 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 5A6ECB6FBE for ; Wed, 21 Dec 2011 01:10:02 +1100 (EST) Received: (qmail 16370 invoked by alias); 20 Dec 2011 14:09:58 -0000 Received: (qmail 16360 invoked by uid 22791); 20 Dec 2011 14:09:56 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, FILL_THIS_FORM X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 20 Dec 2011 14:09:38 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id B701E2BACAD; Tue, 20 Dec 2011 09:09:36 -0500 (EST) 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 8GnmBZRw4Yns; Tue, 20 Dec 2011 09:09:36 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 896A32BAC81; Tue, 20 Dec 2011 09:09:36 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 85E2E3FEE8; Tue, 20 Dec 2011 09:09:36 -0500 (EST) Date: Tue, 20 Dec 2011 09:09:36 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Freeze node for nested generic instantiations Message-ID: <20111220140936.GA14973@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 This patches handles complex cases of nested package instantiations, and determines properly the placement of freeze nodes for instantiations of generic units that are themselves declared in a previous instantiaion in the same compilation unit. The following must compile quietly: gcc -c ppp.ads --- with QQQ; package PPP is package My_QQQ is new QQQ (""); end PPP; --- with RRR; generic Name : String; package QQQ is package My_RRR is new RRR (""); package My_Nested2 is new My_RRR.Nested2 (""); end QQQ; --- with SSS; generic Name : in String; package RRR is package Nested is package My_SSS renames SSS; end Nested; generic Name : in String; package Nested2 is package Inner is package My_Nested renames RRR.Nested; procedure Proc; end Inner; end Nested2; end RRR; --- package body RRR is package body Nested2 is package body Inner is package My_Inner is new My_Nested.My_SSS.Inner (""); procedure Proc is begin null; end; end Inner; end Nested2; end RRR; --- package SSS is generic Name : String; package Inner is procedure Proc2; end Inner; end SSS; --- with TTT; package body SSS is package body Inner is package My_Nested is new TTT.Nested (""); procedure Proc1 is begin null; end; package My_Inner is new My_Nested.Inner (""); procedure Proc2 is begin null; end; end Inner; end SSS; --- package TTT is generic Name : in String; package Nested is generic Name : in String; package Inner is procedure Proc; end Inner; end Nested; end TTT; --- package body TTT is package body Nested is package body Inner is procedure Proc is begin null; end; end Inner; end Nested; end TTT; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-12-20 Ed Schonberg * sem_ch12.adb (Insert_Freeze_Node_For_Instance): Further refinements on the placement of a freeze node for a package instantiation, when the generic appears within a previous instantiation in the same unit.If the current instance is within the one that contains the generic, the freeze node for the current one must appear in the current declarative part. Ditto if the current instance is within another package instance. In these cases the freeze node of the previous instance is is not relevant. New predicate Enclosing_Body simplifies the process. (Freeze_Subprogram_Body): Rename Enclosing_Body to Enclosing_Package_Body, to prevent confusion with subprogram of same name elsewhere. (Install_Body): Recognize enclosing subprogram bodies to determine whether freeze_node belongs in current declarative list. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 182532) +++ sem_ch12.adb (working copy) @@ -738,7 +738,8 @@ -- actuals themselves. function True_Parent (N : Node_Id) return Node_Id; - -- For a subunit, return parent of corresponding stub + -- For a subunit, return parent of corresponding stub, else return + -- parent of node. procedure Valid_Default_Attribute (Nam : Entity_Id; Def : Node_Id); -- Verify that an attribute that appears as the default for a formal @@ -6948,29 +6949,30 @@ Enc_I : Node_Id; F_Node : Node_Id; - function Enclosing_Body (N : Node_Id) return Node_Id; + function Enclosing_Package_Body (N : Node_Id) return Node_Id; -- Find innermost package body that encloses the given node, and which -- is not a compilation unit. Freeze nodes for the instance, or for its -- enclosing body, may be inserted after the enclosing_body of the - -- generic unit. + -- generic unit. Used to determine proper placement of freeze node for + -- both package and subprogram instances. function Package_Freeze_Node (B : Node_Id) return Node_Id; -- Find entity for given package body, and locate or create a freeze -- node for it. - -------------------- - -- Enclosing_Body -- - -------------------- + ---------------------------- + -- Enclosing_Package_Body -- + ---------------------------- - function Enclosing_Body (N : Node_Id) return Node_Id is - P : Node_Id := Parent (N); + function Enclosing_Package_Body (N : Node_Id) return Node_Id is + P : Node_Id; begin + P := Parent (N); while Present (P) and then Nkind (Parent (P)) /= N_Compilation_Unit loop if Nkind (P) = N_Package_Body then - if Nkind (Parent (P)) = N_Subunit then return Corresponding_Stub (Parent (P)); else @@ -6982,7 +6984,7 @@ end loop; return Empty; - end Enclosing_Body; + end Enclosing_Package_Body; ------------------------- -- Package_Freeze_Node -- @@ -6994,7 +6996,6 @@ begin if Nkind (B) = N_Package_Body then Id := Corresponding_Spec (B); - else pragma Assert (Nkind (B) = N_Package_Body_Stub); Id := Corresponding_Spec (Proper_Body (Unit (Library_Unit (B)))); end if; @@ -7014,8 +7015,8 @@ -- packages. Otherwise, the freeze node is placed at the end of the -- current declarative part. - Enc_G := Enclosing_Body (Gen_Body); - Enc_I := Enclosing_Body (Inst_Node); + Enc_G := Enclosing_Package_Body (Gen_Body); + Enc_I := Enclosing_Package_Body (Inst_Node); Ensure_Freeze_Node (Pack_Id); F_Node := Freeze_Node (Pack_Id); @@ -7496,17 +7497,49 @@ Decls : List_Id; Par_N : Node_Id; + function Enclosing_Body (N : Node_Id) return Node_Id; + -- Find enclosing package or subprogram body, if any. Freeze node + -- may be placed at end of current declarative list if previous + -- instance and current one have different enclosing bodies. + function Previous_Instance (Gen : Entity_Id) return Entity_Id; -- Find the local instance, if any, that declares the generic that is -- being instantiated. If present, the freeze node for this instance -- must follow the freeze node for the previous instance. + -------------------- + -- Enclosing_Body -- + -------------------- + + function Enclosing_Body (N : Node_Id) return Node_Id is + P : Node_Id; + + begin + P := Parent (N); + while Present (P) + and then Nkind (Parent (P)) /= N_Compilation_Unit + loop + if Nkind_In (P, N_Package_Body, N_Subprogram_Body) then + if Nkind (Parent (P)) = N_Subunit then + return Corresponding_Stub (Parent (P)); + else + return P; + end if; + end if; + + P := True_Parent (P); + end loop; + + return Empty; + end Enclosing_Body; + ----------------------- -- Previous_Instance -- ----------------------- function Previous_Instance (Gen : Entity_Id) return Entity_Id is S : Entity_Id; + begin S := Scope (Gen); while Present (S) @@ -7517,11 +7550,15 @@ then return S; end if; + S := Scope (S); end loop; + return Empty; end Previous_Instance; + -- Start of processing for Insert_Freeze_Node_For_Instance + begin if not Is_List_Member (F_Node) then Decls := List_Containing (N); @@ -7536,9 +7573,11 @@ and then Is_In_Main_Unit (N) then declare - Par_I : constant Entity_Id := - Previous_Instance (Generic_Parent (Parent (Inst))); - Scop : Entity_Id; + Enclosing_N : constant Node_Id := Enclosing_Body (N); + Par_I : constant Entity_Id := + Previous_Instance + (Generic_Parent (Parent (Inst))); + Scop : Entity_Id; begin if Present (Par_I) @@ -7549,15 +7588,18 @@ -- If the current instance is within the one that contains -- the generic, the freeze node for the current one must -- appear in the current declarative part. Ditto, if the - -- current instance is within another package instance. In - -- both of these cases the freeze node of the previous + -- current instance is within another package instance or + -- within a body that does not enclose the current instance. + -- In these three cases the freeze node of the previous -- instance is not relevant. while Present (Scop) and then Scop /= Standard_Standard loop exit when Scop = Par_I - or else Is_Generic_Instance (Scop); + or else + (Is_Generic_Instance (Scop) + and then Scope_Depth (Scop) > Scope_Depth (Par_I)); Scop := Scope (Scop); end loop; @@ -7566,11 +7608,28 @@ if Scop = Par_I then null; + -- If the next node is a source body we must freeze in + -- the current scope as well. + + elsif Present (Next (N)) + and then Nkind_In (Next (N), + N_Subprogram_Body, N_Package_Body) + and then Comes_From_Source (Next (N)) + then + null; + -- Current instance is within an unrelated instance elsif Is_Generic_Instance (Scop) then null; + -- Current instance is within an unrelated body + + elsif Present (Enclosing_N) + and then Enclosing_N /= Enclosing_Body (Par_I) + then + null; + else Insert_After (Freeze_Node (Par_I), F_Node); return; @@ -7595,9 +7654,9 @@ -- adhere to the general rule of a package or subprogram body causing -- freezing of anything before it in the same declarative region. In -- this case, the proper freeze point of a package instantiation is - -- before the first source body which follows, or before a stub. - -- This ensures that entities coming from the instance are already - -- frozen and usable in source bodies. + -- before the first source body which follows, or before a stub. This + -- ensures that entities coming from the instance are already frozen + -- and usable in source bodies. if Nkind (Par_N) /= N_Package_Declaration and then Ekind (Inst) = E_Package @@ -7665,9 +7724,10 @@ -------------------- function Enclosing_Subp (Id : Entity_Id) return Entity_Id is - Scop : Entity_Id := Scope (Id); + Scop : Entity_Id; begin + Scop := Scope (Id); while Scop /= Standard_Standard and then not Is_Overloadable (Scop) loop @@ -7702,7 +7762,6 @@ -- Start of processing for Install_Body begin - -- If the body is a subunit, the freeze point is the corresponding stub -- in the current compilation, not the subunit itself. @@ -7763,14 +7822,14 @@ if In_Same_Declarative_Part (Freeze_Node (Par), N) then -- Handle the following case: - -- + -- package Parent_Inst is new ... -- Parent_Inst [] - -- + -- procedure P ... -- this body freezes Parent_Inst - -- + -- package Inst is new ... - -- + -- In this particular scenario, the freeze node for Inst must -- be inserted in the same manner as that of Parent_Inst - -- before the next source body or at the end of the declarative @@ -7793,14 +7852,19 @@ -- Freeze package enclosing instance of inner generic after -- instance of enclosing generic. - elsif Nkind (Parent (N)) = N_Package_Body + elsif Nkind_In (Parent (N), N_Package_Body, N_Subprogram_Body) and then In_Same_Declarative_Part (Freeze_Node (Par), Parent (N)) then declare - Enclosing : constant Entity_Id := - Corresponding_Spec (Parent (N)); + Enclosing : Entity_Id; begin + Enclosing := Corresponding_Spec (Parent (N)); + + if No (Enclosing) then + Enclosing := Defining_Entity (Parent (N)); + end if; + Insert_Freeze_Node_For_Instance (N, F_Node); Ensure_Freeze_Node (Enclosing); @@ -7858,7 +7922,7 @@ begin E := First_Entity (Par); - -- In we are installing an instance parent, locate the formal packages + -- If we are installing an instance parent, locate the formal packages -- of its generic parent. if Is_Generic_Instance (Par) then @@ -8046,7 +8110,6 @@ -- Parent is not the name of an instantiation Install_Noninstance_Specs (Inst_Par); - exit; end if; @@ -8059,18 +8122,15 @@ if Present (First_Gen) then Append_Elmt (First_Par, Ancestors); - else Install_Noninstance_Specs (First_Par); end if; if not Is_Empty_Elmt_List (Ancestors) then Elmt := First_Elmt (Ancestors); - while Present (Elmt) loop Install_Spec (Node (Elmt)); Install_Formal_Packages (Node (Elmt)); - Next_Elmt (Elmt); end loop; end if; @@ -8202,11 +8262,9 @@ begin if Prims_List /= No_Elist then Prim_Elmt := First_Elmt (Prims_List); - while Present (Prim_Elmt) loop Prim := Node (Prim_Elmt); Set_Chars (Prim, Add_Suffix (Prim, 'P')); - Next_Elmt (Prim_Elmt); end loop; @@ -8734,9 +8792,7 @@ begin Gen_Scope := Scope (Analyzed_S); - while Present (Gen_Scope) - and then Is_Child_Unit (Gen_Scope) - loop + while Present (Gen_Scope) and then Is_Child_Unit (Gen_Scope) loop if Scope (Subp) = Scope (Gen_Scope) then return True; end if; @@ -8917,14 +8973,12 @@ and then Present (Entity (Nam)) then if not Is_Overloaded (Nam) then - if From_Parent_Scope (Entity (Nam)) then Set_Is_Immediately_Visible (Entity (Nam), False); Set_Entity (Nam, Empty); Set_Etype (Nam, Empty); Analyze (Nam); - Set_Is_Immediately_Visible (Entity (Nam)); end if; @@ -8935,7 +8989,6 @@ begin Get_First_Interp (Nam, I, It); - while Present (It.Nam) loop if From_Parent_Scope (It.Nam) then Remove_Interp (I);