From patchwork Sat Jul 7 10:37:36 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 940786 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-481156-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="SV1eEmBk"; 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 41N7N10dvPz9s0n for ; Sat, 7 Jul 2018 20:37:49 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=SY7ZIWNLFxw0JlnU g6Bm8rTCw75qiqpMWp42vqRvdFeyjv1N946q9ieaXh9P2TfrK7TZLWDqwiJgAJVx FP5ldbuFZR3LFkxi0V8pOxgBGHXXIbl2kfG9uKx8QVmRmWVX5h0ZehYCOjm277Xq GS5UiecKfUX0lvuHtQXRHE+g+Mw= 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:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=kAX3nSGsPagA9ruvjDfZL/ nNPuE=; b=SV1eEmBkSr6k4Uipxl/0Hh1RpjjE+4fCIh3qoqhEO8Giskoq2XU633 AJNWju7xmIXzhgIMOVJ1B6CNdhHyC/RIUZYm/P/gkYmhByK3pGIDlaEvjplSz4ZJ KWezDvrzEFRyuP3J4h4DsYXpsDQew7WHlpUhIttgWxGBk3Q7Eu2sk= Received: (qmail 111695 invoked by alias); 7 Jul 2018 10:37:42 -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 111686 invoked by uid 89); 7 Jul 2018 10:37:41 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.4 required=5.0 tests=AWL, 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:has_com X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 07 Jul 2018 10:37:39 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 4EE8181386 for ; Sat, 7 Jul 2018 12:37:37 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id in4LFtTyM3f2 for ; Sat, 7 Jul 2018 12:37:37 +0200 (CEST) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 0DCDA81368 for ; Sat, 7 Jul 2018 12:37:36 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Reduce -Wstack-usage false positives on variant records Date: Sat, 07 Jul 2018 12:37:36 +0200 Message-ID: <1621213.tUdijo6jlR@polaris> MIME-Version: 1.0 This reduces the number of false positives of -Wstack-usage in the presence of variables whose nominal subtype is a discriminated record with a variant part. Tested on x86-64/Linux, applied on the mainline. 2018-07-07 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity): Add GNAT_DECL local variable and use it throughout. : If the nominal subtype of the object is unconstrained, compute the Ada size separately and put in on the padding type if the size is not fixed. : Minor tweak. * gcc-interface/misc.c (gnat_type_max_size): Rename max_size_unit into max_size_unit throughout. 2018-07-07 Eric Botcazou * gnat.dg/stack_usage6.adb: New test. * gnat.dg/stack_usage6_pkg.ads: New helper. Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 262497) +++ gcc-interface/decl.c (working copy) @@ -273,7 +273,9 @@ static bool intrin_profiles_compatible_p tree gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) { - /* Contains the kind of the input GNAT node. */ + /* The construct that declared the entity. */ + const Node_Id gnat_decl = Declaration_Node (gnat_entity); + /* The kind of the entity. */ const Entity_Kind kind = Ekind (gnat_entity); /* True if this is a type. */ const bool is_type = IN (kind, Type_Kind); @@ -578,7 +580,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit if (definition && !gnu_expr && No (Address_Clause (gnat_entity)) - && !No_Initialization (Declaration_Node (gnat_entity)) + && !No_Initialization (gnat_decl) && No (Renamed_Object (gnat_entity))) { gnu_decl = error_mark_node; @@ -611,9 +613,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit may contain N_Expression_With_Actions nodes and thus declarations of objects from other units that we need to discard. */ if (!definition - && !No_Initialization (Declaration_Node (gnat_entity)) + && !No_Initialization (gnat_decl) && !Is_Dispatch_Table_Entity (gnat_entity) - && Present (gnat_temp = Expression (Declaration_Node (gnat_entity))) + && Present (gnat_temp = Expression (gnat_decl)) && Nkind (gnat_temp) != N_Allocator && (!type_annotate_only || Compile_Time_Known_Value (gnat_temp))) gnu_expr = gnat_to_gnu_external (gnat_temp); @@ -634,9 +636,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit && !(kind == E_Variable && Present (Linker_Section_Pragma (gnat_entity))) && !Treat_As_Volatile (gnat_entity) - && (((Nkind (Declaration_Node (gnat_entity)) - == N_Object_Declaration) - && Present (Expression (Declaration_Node (gnat_entity)))) + && (((Nkind (gnat_decl) == N_Object_Declaration) + && Present (Expression (gnat_decl))) || Present (Renamed_Object (gnat_entity)) || imported_p)); bool inner_const_flag = const_flag; @@ -650,7 +651,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit bool used_by_ref = false; tree gnu_ext_name = NULL_TREE; tree renamed_obj = NULL_TREE; - tree gnu_object_size; + tree gnu_ada_size = NULL_TREE; /* We need to translate the renamed object even though we are only referencing the renaming. But it may contain a call for which @@ -755,8 +756,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit { if (gnu_expr && kind == E_Constant) { - tree size = TYPE_SIZE (TREE_TYPE (gnu_expr)); - if (CONTAINS_PLACEHOLDER_P (size)) + gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr)); + gnu_ada_size = TYPE_ADA_SIZE (TREE_TYPE (gnu_expr)); + if (CONTAINS_PLACEHOLDER_P (gnu_size)) { /* If the initializing expression is itself a constant, despite having a nominal type with self-referential @@ -768,27 +770,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entit && (TREE_READONLY (TREE_OPERAND (gnu_expr, 0)) || DECL_READONLY_ONCE_ELAB (TREE_OPERAND (gnu_expr, 0)))) - gnu_size = DECL_SIZE (TREE_OPERAND (gnu_expr, 0)); + { + gnu_size = DECL_SIZE (TREE_OPERAND (gnu_expr, 0)); + gnu_ada_size = gnu_size; + } else - gnu_size - = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, gnu_expr); + { + gnu_size + = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_size, + gnu_expr); + gnu_ada_size + = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_ada_size, + gnu_expr); + } } - else - gnu_size = size; } /* We may have no GNU_EXPR because No_Initialization is set even though there's an Expression. */ else if (kind == E_Constant - && (Nkind (Declaration_Node (gnat_entity)) - == N_Object_Declaration) - && Present (Expression (Declaration_Node (gnat_entity)))) - gnu_size - = TYPE_SIZE (gnat_to_gnu_type - (Etype - (Expression (Declaration_Node (gnat_entity))))); + && Nkind (gnat_decl) == N_Object_Declaration + && Present (Expression (gnat_decl))) + { + tree gnu_expr_type + = gnat_to_gnu_type (Etype (Expression (gnat_decl))); + gnu_size = TYPE_SIZE (gnu_expr_type); + gnu_ada_size = TYPE_ADA_SIZE (gnu_expr_type); + } else { gnu_size = max_size (TYPE_SIZE (gnu_type), true); + /* We can be called on unconstrained arrays in this mode. */ + if (!type_annotate_only) + gnu_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true); mutable_p = true; } @@ -904,7 +917,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit /* Make a new type with the desired size and alignment, if needed. But do not take into account alignment promotions to compute the size of the object. */ - gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type); + tree gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type); if (gnu_size || align > 0) { tree orig_type = gnu_type; @@ -912,6 +925,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entit gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity, false, false, definition, true); + /* If the nominal subtype of the object is unconstrained and its + size is not fixed, compute the Ada size from the Ada size of + the subtype and/or the expression; this will make it possible + for gnat_type_max_size to easily compute a maximum size. */ + if (gnu_ada_size && gnu_size && !TREE_CONSTANT (gnu_size)) + SET_TYPE_ADA_SIZE (gnu_type, gnu_ada_size); + /* If a padding record was made, declare it now since it will never be declared otherwise. This is necessary to ensure that its subtrees are properly marked. */ @@ -2941,23 +2961,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entit the tree. */ case E_Record_Type: - if (Has_Complex_Representation (gnat_entity)) - { - gnu_type - = build_complex_type - (get_unpadded_type - (Etype (Defining_Entity - (First (Component_Items - (Component_List - (Type_Definition - (Declaration_Node (gnat_entity))))))))); + { + Node_Id record_definition = Type_Definition (gnat_decl); - break; - } + if (Has_Complex_Representation (gnat_entity)) + { + const Node_Id first_component + = First (Component_Items (Component_List (record_definition))); + tree gnu_component_type + = get_unpadded_type (Etype (Defining_Entity (first_component))); + gnu_type = build_complex_type (gnu_component_type); + break; + } - { - Node_Id full_definition = Declaration_Node (gnat_entity); - Node_Id record_definition = Type_Definition (full_definition); Node_Id gnat_constr; Entity_Id gnat_field, gnat_parent_type; tree gnu_field, gnu_field_list = NULL_TREE; Index: gcc-interface/misc.c =================================================================== --- gcc-interface/misc.c (revision 262468) +++ gcc-interface/misc.c (working copy) @@ -736,25 +736,25 @@ gnat_type_max_size (const_tree gnu_type) /* First see what we can get from TYPE_SIZE_UNIT, which might not be constant even for simple expressions if it has already been elaborated and possibly replaced by a VAR_DECL. */ - tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true); + tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true); /* If we don't have a constant, try to look at attributes which should have stayed untouched. */ - if (!tree_fits_uhwi_p (max_unitsize)) + if (!tree_fits_uhwi_p (max_size_unit)) { /* For record types, see what we can get from TYPE_ADA_SIZE. */ if (RECORD_OR_UNION_TYPE_P (gnu_type) && !TYPE_FAT_POINTER_P (gnu_type) && TYPE_ADA_SIZE (gnu_type)) { - tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true); + tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true); /* If we have succeeded in finding a constant, round it up to the type's alignment and return the result in units. */ - if (tree_fits_uhwi_p (max_adasize)) - max_unitsize + if (tree_fits_uhwi_p (max_ada_size)) + max_size_unit = size_binop (CEIL_DIV_EXPR, - round_up (max_adasize, TYPE_ALIGN (gnu_type)), + round_up (max_ada_size, TYPE_ALIGN (gnu_type)), bitsize_unit_node); } @@ -784,7 +784,7 @@ gnat_type_max_size (const_tree gnu_type) = fold_build2 (PLUS_EXPR, ctype, fold_build2 (MINUS_EXPR, ctype, hb, lb), build_int_cst (ctype, 1)); - max_unitsize + max_size_unit = fold_build2 (MULT_EXPR, sizetype, fold_convert (sizetype, length), TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))); @@ -793,7 +793,7 @@ gnat_type_max_size (const_tree gnu_type) } } - return max_unitsize; + return max_size_unit; } static tree get_array_bit_stride (tree);