From patchwork Tue Oct 9 15:09:38 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 981357 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-487213-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="SLNQ/d4Z"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 42V0zN3Jhhz9s55 for ; Wed, 10 Oct 2018 02:10:40 +1100 (AEDT) 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=FrSfwfeFsLmcpxvad79P1ZlEVqwFFQ8ro3psOV+XQeLaC8Td7q ibyjj/R/kaf94xs1HgmweMi0TDxHh9+WvYpPyixz+Bhwp3olS+GTfUMzHFgNoJM1 jpjeMxHHOJ2HRBZsuU0yp5L8i6Is1v+TQSlUFws9pSaF7O5Pibmss7bCA= 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=ty/TRPJBA7gNDQJGKMGnSJuT+38=; b=SLNQ/d4ZYG93fBW5qZrU KUgpQSWokFIRVF3UjgJcJN4CygapJayuucRpVBqbmUjqqON8JvvG+m0Xp8sRKAod fdcKRA9/GpI379tG4ihFN4ODqEvwTb/JKQOK3bPxqzRKnOmHnmTSjuHLYzECd3PY CvqwpbFk+8PYNHe63P+ACmU= Received: (qmail 32077 invoked by alias); 9 Oct 2018 15:09:46 -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 31977 invoked by uid 89); 9 Oct 2018 15:09:45 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=sk:make_ha 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 ESMTP; Tue, 09 Oct 2018 15:09:39 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 2A6E856016; Tue, 9 Oct 2018 11:09:38 -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 oLCboXaLogoe; Tue, 9 Oct 2018 11:09:38 -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 1950256012; Tue, 9 Oct 2018 11:09:38 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 1841D34B3; Tue, 9 Oct 2018 11:09:38 -0400 (EDT) Date: Tue, 9 Oct 2018 11:09:38 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix spurious -Wuninitialized warnings for small records Message-ID: <20181009150938.GA123390@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This change is aimed at getting rid of spurious -Wuninitialized warnings issued for small records passed by copy and containing default values for some of their components. The source of the problem is that the _Init parameter of the initialization routine is declared as an in/out parameter, so the uninitialized object is passed by copy to it and this can be flagged by -Wuninitialized. That's why the mode of the parameter is changed to out, except for the cases where information really needs to be passed in: unconstrained array types, protected and task types. For the following record type Rec! type Rec is record B : Boolean := True; end record; the initialization routine must now be: procedure r__recIP (_init : out r__rec1) is begin _init.b := true; return; end r__recIP; Tested on x86_64-pc-linux-gnu, committed on trunk 2018-10-09 Eric Botcazou gcc/ada/ * exp_ch3.adb (Is_Null_Statement_List): New predicate. (Build_Array_Init_Proc): Use it to find out whether the initialization procedure Is_Null_Init_Proc; if so, set Warnings_Off on the parameter. (Build_Init_Procedure): Likewise. (Init_Formals): Use an in/out first parameter only for unconstrained arrays and for records either containing or built for proteced types or task types; use an out parameter in all the other cases. * fe.h (Is_Init_Proc): Declare. * gcc-interface/decl.c (type_requires_init_of_formal): Do not return true for a discriminant in an unchecked union. (gnat_to_gnu_param): Do not create a PARM_DECL for the Out parameter of an initialization procedure. --- gcc/ada/exp_ch3.adb +++ gcc/ada/exp_ch3.adb @@ -202,6 +202,11 @@ package body Exp_Ch3 is -- Check if E is defined in the RTL (in a child of Ada or System). Used -- to avoid to bring in the overhead of _Input, _Output for tagged types. + function Is_Null_Statement_List (Stmts : List_Id) return Boolean; + -- Returns true if Stmts is made of null statements only, possibly wrapped + -- in a case statement, recursively. This latter pattern may occur for the + -- initialization procedure of an unchecked union. + function Is_User_Defined_Equality (Prim : Node_Id) return Boolean; -- Returns true if Prim is a user defined equality function @@ -529,6 +534,7 @@ package body Exp_Ch3 is Has_Default_Init : Boolean; Index_List : List_Id; Loc : Source_Ptr; + Parameters : List_Id; Proc_Id : Entity_Id; function Init_Component return List_Id; @@ -722,13 +728,14 @@ package body Exp_Ch3 is end if; Body_Stmts := Init_One_Dimension (1); + Parameters := Init_Formals (A_Type); Discard_Node ( Make_Subprogram_Body (Loc, Specification => Make_Procedure_Specification (Loc, Defining_Unit_Name => Proc_Id, - Parameter_Specifications => Init_Formals (A_Type)), + Parameter_Specifications => Parameters), Declarations => New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, @@ -753,18 +760,14 @@ package body Exp_Ch3 is -- where we have to generate a null procedure in case it is called -- by a client with Initialize_Scalars set). Such procedures have -- to be generated, but do not have to be called, so we mark them - -- as null to suppress the call. + -- as null to suppress the call. Kill also warnings for the _Init + -- out parameter, which is left entirely uninitialized. Set_Init_Proc (A_Type, Proc_Id); - if List_Length (Body_Stmts) = 1 - - -- We must skip SCIL nodes because they may have been added to this - -- list by Insert_Actions. - - and then Nkind (First_Non_SCIL_Node (Body_Stmts)) = N_Null_Statement - then + if Is_Null_Statement_List (Body_Stmts) then Set_Is_Null_Init_Proc (Proc_Id); + Set_Warnings_Off (Defining_Identifier (First (Parameters))); else -- Try to build a static aggregate to statically initialize @@ -2803,18 +2806,14 @@ package body Exp_Ch3 is -- where we have to generate a null procedure in case it is called -- by a client with Initialize_Scalars set). Such procedures have -- to be generated, but do not have to be called, so we mark them - -- as null to suppress the call. + -- as null to suppress the call. Kill also warnings for the _Init + -- out parameter, which is left entirely uninitialized. Set_Init_Proc (Rec_Type, Proc_Id); - if List_Length (Body_Stmts) = 1 - - -- We must skip SCIL nodes because they may have been added to this - -- list by Insert_Actions. - - and then Nkind (First_Non_SCIL_Node (Body_Stmts)) = N_Null_Statement - then + if Is_Null_Statement_List (Body_Stmts) then Set_Is_Null_Init_Proc (Proc_Id); + Set_Warnings_Off (Defining_Identifier (First (Parameters))); end if; end Build_Init_Procedure; @@ -8612,19 +8611,30 @@ package body Exp_Ch3 is ------------------ function Init_Formals (Typ : Entity_Id) return List_Id is + Unc_Arr : constant Boolean := + Is_Array_Type (Typ) and then not Is_Constrained (Typ); + With_Prot : constant Boolean := + Has_Protected (Typ) + or else (Is_Record_Type (Typ) + and then Is_Protected_Record_Type (Typ)); + With_Task : constant Boolean := + Has_Task (Typ) + or else (Is_Record_Type (Typ) + and then Is_Task_Record_Type (Typ)); Loc : constant Source_Ptr := Sloc (Typ); Formals : List_Id; begin - -- First parameter is always _Init : in out typ. Note that we need this - -- to be in/out because in the case of the task record value, there - -- are default record fields (_Priority, _Size, -Task_Info) that may - -- be referenced in the generated initialization routine. + -- The first parameter is always _Init : [in] out Typ. Note that we need + -- it to be in/out in the case of an unconstrained array, because of the + -- need to have the bounds, and in the case of protected or task record + -- value, because there are default record fields that may be referenced + -- in the generated initialization routine. Formals := New_List ( Make_Parameter_Specification (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uInit), - In_Present => True, + In_Present => Unc_Arr or else With_Prot or else With_Task, Out_Present => True, Parameter_Type => New_Occurrence_Of (Typ, Loc))); @@ -8632,9 +8642,7 @@ package body Exp_Ch3 is -- formals, _Master : Master_Id and _Chain : in out Activation_Chain -- We also add these parameters for the task record type case. - if Has_Task (Typ) - or else (Is_Record_Type (Typ) and then Is_Task_Record_Type (Typ)) - then + if With_Task then Append_To (Formals, Make_Parameter_Specification (Loc, Defining_Identifier => @@ -9022,6 +9030,43 @@ package body Exp_Ch3 is end loop; end Init_Secondary_Tags; + ---------------------------- + -- Is_Null_Statement_List -- + ---------------------------- + + function Is_Null_Statement_List (Stmts : List_Id) return Boolean is + Stmt : Node_Id; + + begin + -- We must skip SCIL nodes because they may have been added to the + -- list by Insert_Actions. + + Stmt := First_Non_SCIL_Node (Stmts); + while Present (Stmt) loop + if Nkind (Stmt) = N_Case_Statement then + declare + Alt : Node_Id; + begin + Alt := First (Alternatives (Stmt)); + while Present (Alt) loop + if not Is_Null_Statement_List (Statements (Alt)) then + return False; + end if; + + Next (Alt); + end loop; + end; + + elsif Nkind (Stmt) /= N_Null_Statement then + return False; + end if; + + Stmt := Next_Non_SCIL_Node (Stmt); + end loop; + + return True; + end Is_Null_Statement_List; + ------------------------------ -- Is_User_Defined_Equality -- ------------------------------ --- gcc/ada/fe.h +++ gcc/ada/fe.h @@ -156,6 +156,12 @@ extern void Setup_Asm_Outputs (Node_Id); extern void Get_Encoded_Name (Entity_Id); extern void Get_External_Name (Entity_Id, Boolean, String_Pointer); +/* exp_tss: */ + +#define Is_Init_Proc exp_tss__is_init_proc + +extern Boolean Is_Init_Proc (Entity_Id); + /* exp_util: */ #define Is_Fully_Repped_Tagged_Type exp_util__is_fully_repped_tagged_type --- gcc/ada/gcc-interface/decl.c +++ gcc/ada/gcc-interface/decl.c @@ -5153,7 +5153,7 @@ type_requires_init_of_formal (Entity_Id type) Present (field); field = Next_Entity (field)) { - if (Ekind (field) == E_Discriminant) + if (Ekind (field) == E_Discriminant && !Is_Unchecked_Union (type)) return true; if (Ekind (field) == E_Component @@ -5334,11 +5334,14 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, type doesn't require the initialization of formals, we don't make a PARM_DECL for it. Instead, it will be a VAR_DECL created when we process the procedure, so just return its type here. Likewise for - the special parameter of a valued procedure, never pass it in. */ + the _Init parameter of an initialization procedure or the special + parameter of a valued procedure, never pass them in. */ if (Ekind (gnat_param) == E_Out_Parameter && !by_ref && !by_component_ptr - && (!type_requires_init_of_formal (Etype (gnat_param)) || by_return)) + && (!type_requires_init_of_formal (Etype (gnat_param)) + || Is_Init_Proc (gnat_subprog) + || by_return)) return gnu_param_type; gnu_param = create_param_decl (gnu_param_name, gnu_param_type);