From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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 68F6F384D1AC for ; Tue, 6 Sep 2022 07:16:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 68F6F384D1AC Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wm1-x331.google.com with SMTP id h204-20020a1c21d5000000b003a5b467c3abso8991488wmh.5 for ; Tue, 06 Sep 2022 00:16:06 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-disposition:mime-version:message-id:subject:cc:to:from:date :from:to:cc:subject:date; bh=CrGB7PSh0uklZShYdtXiZgn6xLNxHxNFdMlHbkiRXuo=; b=Uhz5RI2XfH2GHL4JTjMZ6kTKd8OPL8F+qjnZApZ34RvJ0jrhI/sv9k6qKRU1k/yagK Gwxc1wm3ORhoxn1A8m0+hALn5FzmrU9ovCWJvdTydGZ2lXkElahjOQP++06kCSop0u8n F1j30T1u7D3VecmnIqL2FiqCMgRWAJUdWbx+YwkQv+M4Rel+Sn/RT6RjA6p6YnMJkDfU EDwkSKCYm86eLIAcaBrTTM/rhn3Q11lzpnfWSu9+A3yV89hZpM3z1QOpg8U4rd80p8dB BjZt0sRpQd7f8gyRmZhaA2DJM6kC1fCfPRAwSVIR2In7ruNYMTHNl3zqsRIlnJWMNtdo XcGw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-disposition:mime-version:message-id:subject:cc:to:from:date :x-gm-message-state:from:to:cc:subject:date; bh=CrGB7PSh0uklZShYdtXiZgn6xLNxHxNFdMlHbkiRXuo=; b=zK7vCQp+lOTaQUlsQCXrvvwEwMBqa7CSa1zG6/PTpcnMDMIilW7nTrtNBvh91hGvP2 Wd4eR9aITVkkQYibrhKyPKuXmAqe5c+EGB+w5yrUfiiVcTMjkHs93CYcD4cyGR6Rf3Oz 31azaolAB2XDjddxIGpDsUat5ODv1zHHZgyrHQsv3xqu0nDPXepS/lrN7Q7e0in8jGc+ ndTeM/A6CHkF3mHEeKexUq+3npOzDsD8Gh18zuM12Wb1EwNM0ClXLRbtpF5OphOOGwD7 NMliPV9lvo4eqT9kPq6gd1GcIhfibDoC7Zt1/hk/o6hTkxBc/tkKCeR4To6gHwSEPaeM FHOQ== X-Gm-Message-State: ACgBeo0EKLMvzRa3qZLoDTunvof2j2N9+pRNPaFPmp0KUtFBIX1U4Wnf qfxNSqquiYPwFrKVUrGsZvNvhU8htT2N4g== X-Google-Smtp-Source: AA6agR6Bvqj/Yl6eiCgcU+tb3QKek6MdYP1NvRT/yFWEKkNB9PY3K35tQVP3FSYHTDmUBahc0pK/+g== X-Received: by 2002:a05:600c:3514:b0:3a5:dc71:d9c4 with SMTP id h20-20020a05600c351400b003a5dc71d9c4mr13022993wmq.42.1662448565245; Tue, 06 Sep 2022 00:16:05 -0700 (PDT) Received: from poulhies-Precision-5550 (static-176-191-105-132.ftth.abo.bbox.fr. [176.191.105.132]) by smtp.gmail.com with ESMTPSA id r7-20020a05600c35c700b003a5b6086381sm21762281wmq.48.2022.09.06.00.16.04 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Sep 2022 00:16:04 -0700 (PDT) Date: Tue, 6 Sep 2022 09:16:04 +0200 From: Marc =?iso-8859-1?Q?Poulhi=E8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix internal error on double renaming of private constant Message-ID: <20220906071604.GA1280560@poulhies-Precision-5550> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="AqsLC8rIMeq19msA" Content-Disposition: inline X-Spam-Status: No, score=-13.0 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: --AqsLC8rIMeq19msA Content-Type: text/plain; charset=us-ascii Content-Disposition: inline The first renaming uses the type of the full view of the constant but not the second, which introduces problematic view conversions downstream. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * gcc-interface/trans.cc (Full_View_Of_Private_Constant): New function returning the Full_View of a private constant, after looking through a chain of renamings, if any. (Identifier_to_gnu): Call it on the entity. Small cleanup. --AqsLC8rIMeq19msA Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -1088,6 +1088,28 @@ Gigi_Types_Compatible (Entity_Id type, Entity_Id def_type) return false; } +/* Return the full view of a private constant E, or of a renaming thereof, if + its type has discriminants, and Empty otherwise. */ + +static Entity_Id +Full_View_Of_Private_Constant (Entity_Id E) +{ + while (Present (Renamed_Object (E)) && Is_Entity_Name (Renamed_Object (E))) + E = Entity (Renamed_Object (E)); + + if (Ekind (E) != E_Constant || No (Full_View (E))) + return Empty; + + const Entity_Id T = Etype (E); + + if (Is_Private_Type (T) + && (Has_Unknown_Discriminants (T) + || (Present (Full_View (T)) && Has_Discriminants (Full_View (T))))) + return Full_View (E); + + return Empty; +} + /* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Identifier, to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to where we should place the result type. */ @@ -1095,21 +1117,19 @@ Gigi_Types_Compatible (Entity_Id type, Entity_Id def_type) static tree Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) { - /* The entity of GNAT_NODE and its type. */ - Node_Id gnat_entity = (Nkind (gnat_node) == N_Defining_Identifier - || Nkind (gnat_node) == N_Defining_Operator_Symbol) - ? gnat_node : Entity (gnat_node); - Node_Id gnat_entity_type = Etype (gnat_entity); + Entity_Id gnat_entity = (Nkind (gnat_node) == N_Defining_Identifier + || Nkind (gnat_node) == N_Defining_Operator_Symbol) + ? gnat_node : Entity (gnat_node); + Entity_Id gnat_result_type; + tree gnu_result, gnu_result_type; /* If GNAT_NODE is a constant, whether we should use the initialization value instead of the constant entity, typically for scalars with an address clause when the parent doesn't require an lvalue. */ - bool use_constant_initializer = false; + bool use_constant_initializer; /* Whether we should require an lvalue for GNAT_NODE. Needed in specific circumstances only, so evaluated lazily. < 0 means unknown, > 0 means known true, 0 means known false. */ - int require_lvalue = -1; - Entity_Id gnat_result_type; - tree gnu_result, gnu_result_type; + int require_lvalue; /* If the Etype of this node is not the same as that of the Entity, then something went wrong, probably in generic instantiation. However, this @@ -1118,25 +1138,17 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) may have been changed to a subtype by Exp_Ch3.Adjust_Discriminants. */ gcc_assert (!Is_Object (gnat_entity) || Ekind (gnat_entity) == E_Discriminant - || Etype (gnat_node) == gnat_entity_type - || Gigi_Types_Compatible (Etype (gnat_node), gnat_entity_type)); + || Etype (gnat_node) == Etype (gnat_entity) + || Gigi_Types_Compatible (Etype (gnat_node), + Etype (gnat_entity))); - /* If this is a reference to a deferred constant whose partial view is an + /* If this is a reference to a deferred constant whose partial view is of unconstrained private type, the proper type is on the full view of the - constant, not on the full view of the type, which may be unconstrained. - - This may be a reference to a type, for example in the prefix of the - attribute Position, generated for dispatching code (see Make_DT in - exp_disp,adb). In that case we need the type itself, not is parent, - in particular if it is a derived type */ - if (Ekind (gnat_entity) == E_Constant - && Is_Private_Type (gnat_entity_type) - && (Has_Unknown_Discriminants (gnat_entity_type) - || (Present (Full_View (gnat_entity_type)) - && Has_Discriminants (Full_View (gnat_entity_type)))) - && Present (Full_View (gnat_entity))) + constant, not on the full view of the type which may be unconstrained. */ + const Entity_Id gnat_full_view = Full_View_Of_Private_Constant (gnat_entity); + if (Present (gnat_full_view)) { - gnat_entity = Full_View (gnat_entity); + gnat_entity = gnat_full_view; gnat_result_type = Etype (gnat_entity); } else @@ -1184,7 +1196,13 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) = lvalue_required_p (gnat_node, gnu_result_type, true, false); use_constant_initializer = !require_lvalue; } + else + { + require_lvalue = -1; + use_constant_initializer = false; + } + /* Fetch the initialization value of a constant if requested. */ if (use_constant_initializer) { /* If this is a deferred constant, the initializer is attached to --AqsLC8rIMeq19msA--