From patchwork Thu Aug 5 09:22:38 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 60941 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 31CE0B6EF3 for ; Thu, 5 Aug 2010 19:22:51 +1000 (EST) Received: (qmail 27008 invoked by alias); 5 Aug 2010 09:22:49 -0000 Received: (qmail 26989 invoked by uid 22791); 5 Aug 2010 09:22:47 -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; Thu, 05 Aug 2010 09:22:41 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id CDA15CB0215; Thu, 5 Aug 2010 11:22:38 +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 WdkEmuCTqZra; Thu, 5 Aug 2010 11:22:38 +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 B75B5CB026E; Thu, 5 Aug 2010 11:22:38 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 9353DD9BB4; Thu, 5 Aug 2010 11:22:38 +0200 (CEST) Date: Thu, 5 Aug 2010 11:22:38 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Nested elaboration checks and conditional expression Message-ID: <20100805092238.GA25998@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 Most elaboration checks are generated after a unit has been analyzed. In the case of calls to external subprograms, the call is rewritten as a conditional expression and analyzed in place. Subsequent expansion of the conditional may generate temporaries that are inserted and analyzed upstream from the call. If an actual in such a call is itself a call to an external subprogram, the corresponding expansion is nested within an outer conditional that has already been analyzed. In this case the expansion code must be inserted upstream as well, given that the enclosing conditional will not be expanded further. The following must compile quietly: gnatmake -gnatE check_elab.adb --- with pack2; procedure Test_Elab is begin null; end; --- package Pack is type T is tagged null record; function Make (x : Integer) return T; function OK (Obj : T) return Boolean; end; --- package body Pack is function Make (x : Integer) return T is Result : T; begin return Result; end; function OK (Obj : T) return Boolean is begin return True; end; end; --- package Pack2 is procedure Init; end; --- with Pack; use Pack; package body Pack2 is procedure Init is begin null; end; task Tsk; task body Tsk is begin if OK (Make (15)) then -- nested elaboration checks. null; end if; end; begin null; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-08-05 Ed Schonberg * exp_util.adb (Insert_Actions): If the action appears within a conditional expression that is already analyzed, insert action further out. Index: exp_util.adb =================================================================== --- exp_util.adb (revision 162906) +++ exp_util.adb (working copy) @@ -814,8 +814,8 @@ package body Exp_Util is Stats : constant List_Id := New_List; begin - -- For a dynamic task, the name comes from the target variable. - -- For a static one it is a formal of the enclosing init proc. + -- For a dynamic task, the name comes from the target variable. For a + -- static one it is a formal of the enclosing init proc. if Dyn then Get_Name_String (Chars (Entity (Prefix (Id_Ref)))); @@ -1105,8 +1105,8 @@ package body Exp_Util is IR : Node_Id; begin - -- An itype reference must only be created if this is a local - -- itype, so that gigi can elaborate it on the proper objstack. + -- An itype reference must only be created if this is a local itype, so + -- that gigi can elaborate it on the proper objstack. if Is_Itype (Typ) and then Scope (Typ) = Current_Scope @@ -1356,9 +1356,9 @@ package body Exp_Util is pragma Assert (Is_Class_Wide_Type (Unc_Type)); null; - -- In Ada95, nothing to be done if the type of the expression is - -- limited, because in this case the expression cannot be copied, - -- and its use can only be by reference. + -- In Ada95 nothing to be done if the type of the expression is limited, + -- because in this case the expression cannot be copied, and its use can + -- only be by reference. -- In Ada2005, the context can be an object declaration whose expression -- is a function that returns in place. If the nominal subtype has @@ -1823,9 +1823,9 @@ package body Exp_Util is if Nkind (Cond) = N_And_Then or else Nkind (Cond) = N_Op_And then - -- Don't ever try to invert a condition that is of the form - -- of an AND or AND THEN (since we are not doing sufficiently - -- general processing to allow this). + -- Don't ever try to invert a condition that is of the form of an + -- AND or AND THEN (since we are not doing sufficiently general + -- processing to allow this). if Sens = False then Op := N_Empty; @@ -2002,8 +2002,8 @@ package body Exp_Util is end; -- ELSIF part. Condition is known true within the referenced - -- ELSIF, known False in any subsequent ELSIF or ELSE part, and - -- unknown before the ELSE part or after the IF statement. + -- ELSIF, known False in any subsequent ELSIF or ELSE part, + -- and unknown before the ELSE part or after the IF statement. elsif Nkind (CV) = N_Elsif_Part then @@ -2386,12 +2386,19 @@ package body Exp_Util is ElseX : constant Node_Id := Next (ThenX); begin - -- Actions belong to the then expression, temporarily - -- place them as Then_Actions of the conditional expr. - -- They will be moved to the proper place later when - -- the conditional expression is expanded. + -- If the enclosing expression is already analyzed, as + -- is the case for nested elaboration checks, insert the + -- conditional further out. + + if Analyzed (P) then + null; + + -- Actions belong to the then expression, temporarily place + -- them as Then_Actions of the conditional expr. They will + -- be moved to the proper place later when the conditional + -- expression is expanded. - if N = ThenX then + elsif N = ThenX then if Present (Then_Actions (P)) then Insert_List_After_And_Analyze (Last (Then_Actions (P)), Ins_Actions); @@ -2427,9 +2434,9 @@ package body Exp_Util is end if; end; - -- Alternative of case expression, we place the action in - -- the Actions field of the case expression alternative, this - -- will be handled when the case expression is expanded. + -- Alternative of case expression, we place the action in the + -- Actions field of the case expression alternative, this will + -- be handled when the case expression is expanded. when N_Case_Expression_Alternative => if Present (Actions (P)) then @@ -2464,11 +2471,11 @@ package body Exp_Util is else Set_Condition_Actions (P, Ins_Actions); - -- Set the parent of the insert actions explicitly. - -- This is not a syntactic field, but we need the - -- parent field set, in particular so that freeze - -- can understand that it is dealing with condition - -- actions, and properly insert the freezing actions. + -- Set the parent of the insert actions explicitly. This + -- is not a syntactic field, but we need the parent field + -- set, in particular so that freeze can understand that + -- it is dealing with condition actions, and properly + -- insert the freezing actions. Set_Parent (Ins_Actions, P); Analyze_List (Condition_Actions (P)); @@ -2574,6 +2581,7 @@ package body Exp_Util is -- subsequent use in the back end: within a package spec the -- loop is part of the elaboration procedure and is only -- elaborated during the second pass. + -- If the loop comes from source, or the entity is local to -- the loop itself it must remain within. @@ -2596,10 +2604,9 @@ package body Exp_Util is return; end if; - -- A special case, N_Raise_xxx_Error can act either as a - -- statement or a subexpression. We tell the difference - -- by looking at the Etype. It is set to Standard_Void_Type - -- in the statement case. + -- A special case, N_Raise_xxx_Error can act either as a statement + -- or a subexpression. We tell the difference by looking at the + -- Etype. It is set to Standard_Void_Type in the statement case. when N_Raise_xxx_Error => @@ -2645,9 +2652,9 @@ package body Exp_Util is Decl : Node_Id; begin - -- Check whether these actions were generated - -- by a declaration that is part of the loop_ - -- actions for the component_association. + -- Check whether these actions were generated by a + -- declaration that is part of the loop_ actions + -- for the component_association. Decl := Assoc_Node; while Present (Decl) loop @@ -2855,9 +2862,9 @@ package body Exp_Util is if Nkind (Parent (N)) = N_Subunit then - -- This is the proper body corresponding to a stub. Insertion - -- must be done at the point of the stub, which is in the decla- - -- rative part of the parent unit. + -- This is the proper body corresponding to a stub. Insertion must + -- be done at the point of the stub, which is in the declarative + -- part of the parent unit. P := Corresponding_Stub (Parent (N));