From patchwork Mon May 25 08:16:26 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 1297175 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=adacore-com.20150623.gappssmtp.com header.i=@adacore-com.20150623.gappssmtp.com header.a=rsa-sha256 header.s=20150623 header.b=kNfEeOmn; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 49VqgR3flGz9sSg for ; Mon, 25 May 2020 18:16:34 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E835E3840C33; Mon, 25 May 2020 08:16:31 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x331.google.com (mail-wm1-x331.google.com [IPv6:2a00:1450:4864:20::331]) by sourceware.org (Postfix) with ESMTPS id 540273858D35 for ; Mon, 25 May 2020 08:16:29 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 540273858D35 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=botcazou@adacore.com Received: by mail-wm1-x331.google.com with SMTP id y5so2566563wmi.5 for ; Mon, 25 May 2020 01:16:29 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore-com.20150623.gappssmtp.com; s=20150623; h=from:to:subject:date:message-id:mime-version :content-transfer-encoding; bh=QlokjM66zMPlquGqab9lDeQQdHUiqS6eKBb4pR61DYc=; b=kNfEeOmnmTfuKYO+D6VqacM0DYQfUHsAu2XSM94EhTiMixAIPMU6SRamaMh8SfZmJH uK3H2n/WROI3f2T0rPLLxgsmZgSzjWTtL8Qag1OooINYbAil608kPh2pcDR1s3abf1Ax c1Lx/96fuXm8/SDZhqu4H6869uhPjs/UflUcyjBzW+uEX5+lmV76MfB2dWQyLOt4jwQ9 +qkC9IRSUPz+Ad0x1m6dOuzfTrHy7syO22RkVtQ+vQB7N2smX3P8i3rIZaxwrAI+5YQF BDWtpLGlR1FPTU40JdGZQC19MvXfDoJ5xY2z+KsiT2VSuECooiL8iW0rAzpgIRIpcae6 mZFw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:mime-version :content-transfer-encoding; bh=QlokjM66zMPlquGqab9lDeQQdHUiqS6eKBb4pR61DYc=; b=TU/X6Zpfl9wS7TbWkk+5Ep5rRdTXkHZvXQPSIN9U2DL1B5bGl3yZ0z3LcsLKwie5Fl ZzfQ3oy3B6B1+VQLp5R8wVxdvUed1gJWZW1+PgBLADMLvgh7i/b2QvLHztFCdMRfk7Tv DRUn65jXZtSECDiQ4rep3Z8jPbN7ojQcUpy5fxJPB/bze16tLKwlnnDWIKdv6IXNcypf L4fNco4TAxcHTQnq7dp/gZMmZdCNmGXSozB/5/bKhVnMuJcsh7lgg8V/Sa5BR0NF0uMj DtrI/gartEhuKDcySsffl3zubBDAg7hIQHQKjpEPWQA/u9e3fHewKfuVhinU60/sFyb5 sCNQ== X-Gm-Message-State: AOAM5317D/v0/uvvGZTiXVZVn7vYGvtayBK9XUHJaajXQvTFK4HFhLpJ eAf8RHuHU9peds1iSWt7aqi+Yl+D89jKbw== X-Google-Smtp-Source: ABdhPJyl08KFGquYgU5eEM810UydVeNh8h0bpRPlQ9AFIxM3J81hIor/axRrn1A8DDzZnlrifRQdqA== X-Received: by 2002:a05:600c:2258:: with SMTP id a24mr23740365wmm.111.1590394588184; Mon, 25 May 2020 01:16:28 -0700 (PDT) Received: from polaris.localnet ([2a01:e0a:41b:9230:1a03:73ff:fe45:373a]) by smtp.gmail.com with ESMTPSA id w15sm17124650wmi.35.2020.05.25.01.16.27 for (version=TLS1_2 cipher=ECDHE-ECDSA-AES128-GCM-SHA256 bits=128/128); Mon, 25 May 2020 01:16:27 -0700 (PDT) From: Eric Botcazou X-Google-Original-From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix missing back-annotation for derived types Date: Mon, 25 May 2020 10:16:26 +0200 Message-ID: <6468583.PdmNSjZ4L5@polaris> MIME-Version: 1.0 X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Gigi fails to back-annotate the Present_Expr field of variants present in a type derived from a discriminated untagged record type, which is for example visible in the output -gnatRj. Tested on x86-64/Linux, applied on the mainline. 2020-05-25 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity) : Tidy up. (build_variant_list): Add GNAT_VARIANT_PART parameter and annotate its variants if it is present. Adjust the recursive call by passing the variant subpart of variants, if any. (copy_and_substitute_in_layout): Rename GNU_SUBST_LIST to SUBST_LIST and adjust throughout. For a type, pass the variant part in the call to build_variant_list. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ab6e79ce3c1..bd69c3ab306 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -230,7 +230,7 @@ static Uint annotate_value (tree); static void annotate_rep (Entity_Id, tree); static tree build_position_list (tree, bool, tree, tree, unsigned int, tree); static vec build_subst_list (Entity_Id, Entity_Id, bool); -static vec build_variant_list (tree, vec, +static vec build_variant_list (tree, Node_Id, vec, vec); static tree maybe_saturate_size (tree); static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool, @@ -2992,15 +2992,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* Record Types and Subtypes - The following fields are defined on record types: - - Has_Discriminants True if the record has discriminants - First_Discriminant Points to head of list of discriminants - First_Entity Points to head of list of fields - Is_Tagged_Type True if the record is tagged - - Implementation of Ada records and discriminated records: - A record type definition is transformed into the equivalent of a C struct definition. The fields that are the discriminants which are found in the Full_Type_Declaration node and the elements of the @@ -8886,20 +8877,29 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition) return gnu_list; } -/* Scan all fields in QUAL_UNION_TYPE and return a list describing the - variants of QUAL_UNION_TYPE that are still relevant after applying - the substitutions described in SUBST_LIST. GNU_LIST is a pre-existing +/* Scan all fields in {GNU_QUAL_UNION_TYPE,GNAT_VARIANT_PART} and return a list + describing the variants of GNU_QUAL_UNION_TYPE that are still relevant after + applying the substitutions described in SUBST_LIST. GNU_LIST is an existing list to be prepended to the newly created entries. */ static vec -build_variant_list (tree qual_union_type, vec subst_list, - vec gnu_list) +build_variant_list (tree gnu_qual_union_type, Node_Id gnat_variant_part, + vec subst_list, vec gnu_list) { + Node_Id gnat_variant; tree gnu_field; - for (gnu_field = TYPE_FIELDS (qual_union_type); + for (gnu_field = TYPE_FIELDS (gnu_qual_union_type), + gnat_variant + = Present (gnat_variant_part) + ? First_Non_Pragma (Variants (gnat_variant_part)) + : Empty; gnu_field; - gnu_field = DECL_CHAIN (gnu_field)) + gnu_field = DECL_CHAIN (gnu_field), + gnat_variant + = Present (gnat_variant_part) + ? Next_Non_Pragma (gnat_variant) + : Empty) { tree qual = DECL_QUALIFIER (gnu_field); unsigned int i; @@ -8918,11 +8918,21 @@ build_variant_list (tree qual_union_type, vec subst_list, gnu_list.safe_push (v); + /* Annotate the GNAT node if present. */ + if (Present (gnat_variant)) + Set_Present_Expr (gnat_variant, annotate_value (qual)); + /* Recurse on the variant subpart of the variant, if any. */ variant_subpart = get_variant_part (variant_type); if (variant_subpart) - gnu_list = build_variant_list (TREE_TYPE (variant_subpart), - subst_list, gnu_list); + gnu_list + = build_variant_list (TREE_TYPE (variant_subpart), + Present (gnat_variant) + ? Variant_Part + (Component_List (gnat_variant)) + : Empty, + subst_list, + gnu_list); /* If the new qualifier is unconditionally true, the subsequent variants cannot be accessed. */ @@ -9806,7 +9816,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, Entity_Id gnat_old_type, tree gnu_new_type, tree gnu_old_type, - vec gnu_subst_list, + vec subst_list, bool debug_info_p) { const bool is_subtype = (Ekind (gnat_new_type) == E_Record_Subtype); @@ -9825,11 +9835,18 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, build a new qualified union for the variants that are still relevant. */ if (gnu_variant_part) { + const Node_Id gnat_decl = Declaration_Node (gnat_new_type); variant_desc *v; unsigned int i; - gnu_variant_list = build_variant_list (TREE_TYPE (gnu_variant_part), - gnu_subst_list, vNULL); + gnu_variant_list + = build_variant_list (TREE_TYPE (gnu_variant_part), + is_subtype + ? Empty + : Variant_Part + (Component_List (Type_Definition (gnat_decl))), + subst_list, + vNULL); /* If all the qualifiers are unconditionally true, the innermost variant is statically selected. */ @@ -9855,8 +9872,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, IDENTIFIER_POINTER (suffix)); TYPE_REVERSE_STORAGE_ORDER (new_variant) = TYPE_REVERSE_STORAGE_ORDER (gnu_new_type); - copy_and_substitute_in_size (new_variant, old_variant, - gnu_subst_list); + copy_and_substitute_in_size (new_variant, old_variant, subst_list); v->new_type = new_variant; } } @@ -9967,7 +9983,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, gnu_field = create_field_decl_from (gnu_old_field, gnu_field_type, gnu_cont_type, gnu_size, - gnu_pos_list, gnu_subst_list); + gnu_pos_list, subst_list); gnu_pos = DECL_FIELD_OFFSET (gnu_field); /* If the context is a variant, put it in the new variant directly. */ @@ -10054,13 +10070,13 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, tree new_variant_part = create_variant_part_from (gnu_variant_part, gnu_variant_list, gnu_new_type, gnu_pos_list, - gnu_subst_list, debug_info_p); + subst_list, debug_info_p); DECL_CHAIN (new_variant_part) = gnu_field_list; gnu_field_list = new_variant_part; } gnu_variant_list.release (); - gnu_subst_list.release (); + subst_list.release (); /* If NEW_TYPE is a subtype, it inherits all the attributes from OLD_TYPE. Otherwise sizes and alignment must be computed independently. */