From patchwork Tue Jul 18 13:13:43 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 122035 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:c923:0:b0:3e4:2afc:c1 with SMTP id j3csp1742241vqt; Tue, 18 Jul 2023 06:23:00 -0700 (PDT) X-Google-Smtp-Source: APBJJlHT4IfL8X6yDg/E4h/40qvrgVrI9cUBbi+xbu96nncVjWrbDCpvUT0P8wM0SjNr4ype3Iew X-Received: by 2002:a17:907:3d90:b0:997:d975:64eb with SMTP id he16-20020a1709073d9000b00997d97564ebmr2116677ejc.35.1689686580532; Tue, 18 Jul 2023 06:23:00 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1689686580; cv=none; d=google.com; s=arc-20160816; b=yZ5sVg2bw+p4r/gNXjn8NMmzof0w4XQoW/5Z6ac9jIUgZgx+DTC9ZQGFv2zDXFF7+W v5Vw8x7iKjVCEbsxNQQJB8PUQW6Or8SUhNcjsFjqr6WzvvlrjDaZ9ywInFGT4ekofOEp 5x1UZeMfSaNNkGA9zoGY3+2NesNHvXUTh1WBDOUZGTd9gLem58K4rGQ7ixil4y6WdPxi m87uk85URoe3HzhJuzF3T/ySHEpOuqIFoJkUilLVlOnjAkZRHiQkB5R0TOJm8cywoNXS pY19Pk/J2lGMK79+P5Mt7zmtSENd4eAZ01Hc+KyqAqlczwh9DHwERDrF9ecKWiNecdh2 h0eA== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence :content-transfer-encoding:mime-version:message-id:date:subject:cc :to:dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=rcPEN1DykcQejiAc2US5coZPxxXZPFTU9wooK2/BJ0g=; fh=mgcp2dPS/EOrPrvlUBKTekhhXYvk0GhGvlUG1Y0idUc=; b=U38KMEK/04xnxfY+Hag+8k36xUeX1C52Gx2k3vUvJbUKrWcmRtQdZt8gfLOtry3CbJ zamMTWbf0p1FrP0ITQq9Vtv/UOs10oI3yI7CYxUs+5PoB/MLToPV0fPVPjKj6LF+VF/u IA8MKoUJSemdZ+7s5wkqKFmQ7IWM+dh90BoLnpQcMoa7fU9dsM6IOi3/xTMmannH3h82 xMe+q+41L0yJHYcqLwfNF5m7JXYV4BqmQGBO0ltdEJQz44BYqGyzA85Oms1g2HAwtEV8 pjFYZpjROgjEjPKgJpjMK/RHjTJ3EYjtVH784IY3WLkTIkt0HPe1PzSJXjPopMqmOuPG XnXw== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=eQgglqLt; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id ot9-20020a170906ccc900b0098e291bed8fsi1182765ejb.451.2023.07.18.06.23.00 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 18 Jul 2023 06:23:00 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=eQgglqLt; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 495FE388265D for ; Tue, 18 Jul 2023 13:17:38 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 495FE388265D DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1689686258; bh=rcPEN1DykcQejiAc2US5coZPxxXZPFTU9wooK2/BJ0g=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=eQgglqLtHU4LSQaYIQo1sSgqyH08mNyMS04uQM414ndTOYNod3S0jVNGX8ziJqJEd A8jVZdKgn5uUu6npy5YbXO7VDusXywwGlwg1e0WB7gOpbUWxr1DXYmfHJCHOyhqNFT r1F3SLz3+4lbq0O6pT6NHpqbfOBjTxxwjzL8DhZk= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x435.google.com (mail-wr1-x435.google.com [IPv6:2a00:1450:4864:20::435]) by sourceware.org (Postfix) with ESMTPS id 112293857028 for ; Tue, 18 Jul 2023 13:13:46 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 112293857028 Received: by mail-wr1-x435.google.com with SMTP id ffacd0b85a97d-3159da54e95so5115313f8f.3 for ; Tue, 18 Jul 2023 06:13:46 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1689686025; x=1690290825; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=rcPEN1DykcQejiAc2US5coZPxxXZPFTU9wooK2/BJ0g=; b=gYdg5SRhiFpTz5Wpy6y4/QcNKqtxpzNfoK2egw6yqxE2HiK6WZXQFBfxjYpmePIZNc qB/vj0CspVzaJl+szOLb6eqozaWxQ6YkdoUSnVMOsakNTNIk1XvKiFBx9DoZP1Bekf3Q VZbHNwwj/8+G3Rge3XAQp3V2WyEMlzRx4q3YF8fdc8TAiMv5QiwQnNzIM9EUH5nEwpVN tyHAK/hXRMGaxnDSi4Oh09l0f7Sfq5Zx0Sm46eWgikpqNWWqjIaUUuYiJ4kuUsnEzw6q QyIa7KIOtg0agoh1XkYgTJACf8Q+ghVRTMaf9rcH0xJ76ctDwo0mbFQo/JyDUppr2ebL 2VVA== X-Gm-Message-State: ABy/qLaLfLgvwVglHNkSYB0n+iUy/8I1QxaCnWSCOPOSVFn0AtTl2Q0C gU9TtPjImNZNiwUPVDuzP7JUQJJR2peLh9dwUjSvPg== X-Received: by 2002:adf:e0c3:0:b0:315:ad1a:5abc with SMTP id m3-20020adfe0c3000000b00315ad1a5abcmr1690748wri.5.1689686024962; Tue, 18 Jul 2023 06:13:44 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id e16-20020adffc50000000b0031432c2fb95sm2390011wrs.88.2023.07.18.06.13.44 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 18 Jul 2023 06:13:44 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [COMMITTED] ada: Constraint_Error caused by 'Image applied to interface type Date: Tue, 18 Jul 2023 15:13:43 +0200 Message-Id: <20230718131343.81574-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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 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: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1771764795833733047 X-GMAIL-MSGID: 1771764795833733047 From: Javier Miranda When the prefix of 'Image is used with a class-wide interface type object, the frontend does not generate code to displace the pointer to the underlying object to reference its base, and this is required to invoke Ada.Tags.Wide_Wide_Expanded_Name. gcc/ada/ * exp_imgv.adb (Rewrite_Object_Image): fix type of formal. Found reading sources. (Expand_Wide_Image_Attribute): ditto. (Expand_Wide_Wide_Image_Attribute): ditto. (Rewrite_Object_Image): ditto. * exp_put_image.adb (Build_Image_Call): For class-wide interface type prefix generate code to displace the pointer to the object to reference the base of the underlying object. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_imgv.adb | 8 ++++---- gcc/ada/exp_put_image.adb | 36 ++++++++++++++++++++++++++++++++---- 2 files changed, 36 insertions(+), 8 deletions(-) diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index a31ce1d8c8f..6bcfec667a9 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -61,7 +61,7 @@ package body Exp_Imgv is procedure Rewrite_Object_Image (N : Node_Id; - Pref : Entity_Id; + Pref : Node_Id; Attr_Name : Name_Id; Str_Typ : Entity_Id); -- AI12-0124: Rewrite attribute 'Image when it is applied to an object @@ -1830,7 +1830,7 @@ package body Exp_Imgv is procedure Expand_Wide_Image_Attribute (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Pref : constant Entity_Id := Prefix (N); + Pref : constant Node_Id := Prefix (N); Rnn : constant Entity_Id := Make_Temporary (Loc, 'S'); Lnn : constant Entity_Id := Make_Temporary (Loc, 'P'); Rtyp : Entity_Id; @@ -1938,7 +1938,7 @@ package body Exp_Imgv is procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Pref : constant Entity_Id := Prefix (N); + Pref : constant Node_Id := Prefix (N); Rnn : constant Entity_Id := Make_Temporary (Loc, 'S'); Lnn : constant Entity_Id := Make_Temporary (Loc, 'P'); Rtyp : Entity_Id; @@ -2493,7 +2493,7 @@ package body Exp_Imgv is procedure Rewrite_Object_Image (N : Node_Id; - Pref : Entity_Id; + Pref : Node_Id; Attr_Name : Name_Id; Str_Typ : Entity_Id) is diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 9eda3231c6b..0c357f1c547 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -1190,10 +1190,41 @@ package body Exp_Put_Image is Parameter_Associations => New_List (Sink_Exp, String_Exp)); end Put_String_Exp; + -- Local variables + + Tag_Node : Node_Id; + -- Start of processing for Build_Image_Call begin if Is_Class_Wide_Type (U_Type) then + + -- For interface types we must generate code to displace the pointer + -- to the object to reference the base of the underlying object. + + -- Generate: + -- To_Tag_Ptr (Image_Prefix'Address).all + + -- Note that Image_Prefix'Address is recursively expanded into a + -- call to Ada.Tags.Base_Address (Image_Prefix'Address). + + if Is_Interface (U_Type) then + Tag_Node := + Make_Explicit_Dereference (Loc, + Unchecked_Convert_To (RTE (RE_Tag_Ptr), + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr (Image_Prefix), + Attribute_Name => Name_Address))); + + -- Common case + + else + Tag_Node := + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr (Image_Prefix), + Attribute_Name => Name_Tag); + end if; + -- Generate qualified-expression syntax; qualification name comes -- from calling Ada.Tags.Wide_Wide_Expanded_Name. @@ -1208,10 +1239,7 @@ package body Exp_Put_Image is (Make_Function_Call (Loc, Name => New_Occurrence_Of (RTE (RE_Wide_Wide_Expanded_Name), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Image_Prefix), - Attribute_Name => Name_Tag))), + Parameter_Associations => New_List (Tag_Node)), Wide_Wide => True); Qualification : constant Node_Id :=