From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 128840 invoked by alias); 16 Oct 2015 12:22:39 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 128825 invoked by uid 89); 16 Oct 2015 12:22:38 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.9 required=5.0 tests=BAYES_50,KAM_ASCII_DIVIDERS,KAM_LAZY_DOMAIN_SECURITY,RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Fri, 16 Oct 2015 12:22:36 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0F644118232; Fri, 16 Oct 2015 08:22:35 -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 pBuPBp0zkDTv; Fri, 16 Oct 2015 08:22:34 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id ECB5B29393; Fri, 16 Oct 2015 08:22:34 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id E8D7436E; Fri, 16 Oct 2015 08:22:34 -0400 (EDT) Date: Fri, 16 Oct 2015 12:27:00 -0000 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Gary Dismukes Subject: [Ada] Improper initialization of elementary parameters in entry calls Message-ID: <20151016122234.GA15295@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="+HP7ph2BbKc20aGI" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-SW-Source: 2015-10/txt/msg01579.txt.bz2 --+HP7ph2BbKc20aGI Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 1225 The compiler was incorrectly default initializing entry call parameters in cases where the parameter is of an access type or of a scalar type whose Default_Value aspect is set. The access type case caused a problem for CodePeer in the case where the formal parameter is a null-excluding access type, because the compiler was initializing the null-excluding parameter temporary to null. In case of a scalar out parameter with Default_Value, the compiler was default-initializing the parameter temporary rather than assigning the value of the actual to the temporary. The assignment of the actual is now generated in the Default_Value case, and the default initialization is suppressed in both cases. Tested on x86_64-pc-linux-gnu, committed on trunk 2015-10-16 Gary Dismukes * exp_ch9.adb (Build_Simple_Entry_Call): Set_Is_Internal on the temporary object used for a by-copy entry parameter, to ensure that the object doesn't get its No_Initialization flag reset later in Default_Initialize_Object. Also, generate the assignment of the actual to the temporary in the additional case of a scalar out parameter whose type has a Default_Value aspect. * exp_ch3.adb: Fix minor typo in comment. --+HP7ph2BbKc20aGI Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=difs Content-length: 7625 Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 228874) +++ exp_ch3.adb (working copy) @@ -5154,7 +5154,7 @@ -- Provide a default value if the object needs simple initialization -- and does not already have an initial value. A generated temporary - -- do not require initialization because it will be assigned later. + -- does not require initialization because it will be assigned later. elsif Needs_Simple_Initialization (Typ, Initialize_Scalars Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 228874) +++ exp_ch9.adb (working copy) @@ -4729,7 +4729,7 @@ Formal := First_Formal (Ent); while Present (Actual) loop - -- If it is a by_copy_type, copy it to a new variable. The + -- If it is a by-copy type, copy it to a new variable. The -- packaged record has a field that points to this variable. if Is_By_Copy_Type (Etype (Actual)) then @@ -4746,24 +4746,38 @@ Set_No_Initialization (N_Node); - -- We must make an assignment statement separate for the - -- case of limited type. We cannot assign it unless the + -- We must make a separate assignment statement for the + -- case of limited types. We cannot assign it unless the -- Assignment_OK flag is set first. An out formal of an - -- access type must also be initialized from the actual, - -- as stated in RM 6.4.1 (13), but no constraint is applied - -- before the call. + -- access type or whose type has a Default_Value must also + -- be initialized from the actual (see RM 6.4.1 (13-13.1)), + -- but no constraint, predicate, or null-exclusion check is + -- applied before the call. if Ekind (Formal) /= E_Out_Parameter or else Is_Access_Type (Etype (Formal)) + or else + (Is_Scalar_Type (Etype (Formal)) + and then + Present (Default_Aspect_Value (Etype (Formal)))) then N_Var := New_Occurrence_Of (Defining_Identifier (N_Node), Loc); Set_Assignment_OK (N_Var); Append_To (Stats, Make_Assignment_Statement (Loc, - Name => N_Var, + Name => N_Var, Expression => Relocate_Node (Actual))); + -- Mark the object as internal, so we don't later reset + -- No_Initialization flag in Default_Initialize_Object, + -- which would lead to needless default initialization. + -- We don't set this outside the if statement, because + -- out scalar parameters without Default_Value do require + -- default initialization if Initialize_Scalars applies. + + Set_Is_Internal (Defining_Identifier (N_Node)); + -- If actual is an out parameter of a null-excluding -- access type, there is access check on entry, so set -- Suppress_Assignment_Checks on the generated statement @@ -4777,8 +4791,9 @@ Append_To (Plist, Make_Attribute_Reference (Loc, Attribute_Name => Name_Unchecked_Access, - Prefix => - New_Occurrence_Of (Defining_Identifier (N_Node), Loc))); + Prefix => + New_Occurrence_Of + (Defining_Identifier (N_Node), Loc))); else -- Interface class-wide formal @@ -4800,7 +4815,7 @@ Make_Reference (Loc, Unchecked_Convert_To (Iface_Typ, Make_Selected_Component (Loc, - Prefix => + Prefix => Relocate_Node (Actual), Selector_Name => New_Occurrence_Of (Iface_Tag, Loc))))); @@ -4832,7 +4847,7 @@ Parm3 := Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (P, Loc), + Prefix => New_Occurrence_Of (P, Loc), Attribute_Name => Name_Address); Append (Pdecl, Decls); @@ -4896,8 +4911,9 @@ Call := Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of ( - RTE (RE_Protected_Single_Entry_Call), Loc), + Name => + New_Occurrence_Of + (RTE (RE_Protected_Single_Entry_Call), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, @@ -4914,7 +4930,8 @@ else Call := Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Call_Simple), Loc), + Name => + New_Occurrence_Of (RTE (RE_Call_Simple), Loc), Parameter_Associations => New_List (Parm1, Parm2, Parm3)); end if; @@ -4935,11 +4952,11 @@ then N_Node := Make_Assignment_Statement (Loc, - Name => New_Copy (Actual), + Name => New_Copy (Actual), Expression => Make_Explicit_Dereference (Loc, Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (P, Loc), + Prefix => New_Occurrence_Of (P, Loc), Selector_Name => Make_Identifier (Loc, Chars (Formal))))); @@ -5037,7 +5054,7 @@ Call := Make_Procedure_Call_Statement (Loc, - Name => Name, + Name => Name, Parameter_Associations => New_List (Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Chain, Loc), @@ -5320,7 +5337,7 @@ declare Bas : Entity_Id := Base_Type - (Etype (Discrete_Subtype_Definition (Parent (Efam)))); + (Etype (Discrete_Subtype_Definition (Parent (Efam)))); Bas_Decl : Node_Id := Empty; Lo, Hi : Node_Id; @@ -5590,10 +5607,8 @@ else if Is_Protected_Type (Ntyp) then Sel := Name_uObject; - elsif Is_Task_Type (Ntyp) then Sel := Name_uTask_Id; - else raise Program_Error; end if; @@ -5764,7 +5779,6 @@ -- Now add lengths of preceding entries and entry families Prev := First_Entity (Ttyp); - while Chars (Prev) /= Chars (Ent) or else (Ekind (Prev) /= Ekind (Ent)) or else not Sem_Ch6.Type_Conformant (Ent, Prev) --+HP7ph2BbKc20aGI--