From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x430.google.com (mail-wr1-x430.google.com [IPv6:2a00:1450:4864:20::430]) by sourceware.org (Postfix) with ESMTPS id 1CB73385770C for ; Thu, 15 Jun 2023 08:04:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1CB73385770C 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-wr1-x430.google.com with SMTP id ffacd0b85a97d-30fbf253dc7so358448f8f.0 for ; Thu, 15 Jun 2023 01:04:31 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1686816270; x=1689408270; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=d9trltaIPAMCRW2+T1/pKqc+w/pX+5B39d2Xrg3VY2g=; b=LcHez+lRj7n+0BFLYhCop9zecSlS+RUHxzW2tDTTfkPQ2uAZ8L5E1F4C2dPEXxOURA dGgQCQbCEOSMue6/Z0iUwQW7EruYQzR0DslgmZi+mc8ZZzguwYvrNgBu9K+fZmjO34s8 XoMEF7+vyGslr0f+jiIU/soT9apudGA4rhqsxylkQ8SJDcayzuVW6Rlon5u6SlgTjukg EA2UhxTsUcxe+pf5xzCQ1T/AVJHU2kuKu0XCiK6Gfm9n/5SHEyH8CCOHKdcb+6MqfpcP gazpy3rNpqw7tkaMI1azwRiUFauIJZfe5iOjvxkQGp3i/st9zl2ftp4kNtwVZwKISOkm 6bvQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1686816270; x=1689408270; 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=d9trltaIPAMCRW2+T1/pKqc+w/pX+5B39d2Xrg3VY2g=; b=AMfHIB+p0WaZPOJUSHQgLMIDeZ4at4TDvsqdXpFxfzEzh1DPK6FlK2SOg4yDBlhEY/ pizwIYlot7zzy5qtTNGhGBgAzsj/f0lhGBvfQcHmj2wMzLE2ZlpM3T1GJ8+vzBBYCcxn aTGhkKVwkKZxLK/G9lUj7gH367ykisdakBHjTZCSxkg9FEE1N87wzpyaIfa7SmZo82tp FIkpBgsyP6mPbBaauw+3XfWAQ9/IYl9ziwFHrBRkIOmI/5Q3vmGd7j/1Z8swOrApKPZA nxaCLzbpPwkKy5UdHGEcrbSKhcTzJmt+AYCaDnpGE52p2Dxjgzk3aGR+A0y6wO+2SZGm 5yUg== X-Gm-Message-State: AC+VfDzpCxFRPWL6KnOw6v1bAtvABVMbqetwCJzMj08TikEYGRdOVtmf JpbB6kxKikorDkMGs0G5//LYKoXUPXh2VIButYPung== X-Google-Smtp-Source: ACHHUZ5+5jZ/paTUGTeeC4yKZPZof92vBJw8txqjRqVUQBDwpKffw/KjaWOicHBBNNN5aBQH0CMO1Q== X-Received: by 2002:a5d:43cb:0:b0:311:f11:4c55 with SMTP id v11-20020a5d43cb000000b003110f114c55mr2864936wrr.13.1686816269777; Thu, 15 Jun 2023 01:04:29 -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 e2-20020a5d5942000000b003063db8f45bsm20164696wri.23.2023.06.15.01.04.28 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 Jun 2023 01:04:29 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix too small secondary stack allocation for returned conversion Date: Thu, 15 Jun 2023 10:04:28 +0200 Message-Id: <20230615080428.940106-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit 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 List-Id: From: Eric Botcazou The previous fix did not address a latent issue whereby the allocation would be made using the (static) subtype of the conversion instead of the (dynamic) subtype of the return object, so this change rewrites the code responsible for determining the type used for the allocation, and also contains a small improvement to the Has_Tag_Of_Type predicate. gcc/ada/ * exp_ch3.adb (Make_Allocator_For_Return): Rewrite the logic that determines the type used for the allocation and add assertions. * exp_util.adb (Has_Tag_Of_Type): Also return true for extension aggregates. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch3.adb | 92 +++++++++++++++++++++++++++++--------------- gcc/ada/exp_util.adb | 1 + 2 files changed, 63 insertions(+), 30 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 778eed7f16e..7ac4680b395 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7114,8 +7114,64 @@ package body Exp_Ch3 is function Make_Allocator_For_Return (Expr : Node_Id) return Node_Id is Alloc : Node_Id; Alloc_Expr : Entity_Id; + Alloc_Typ : Entity_Id; begin + -- If the return object's declaration does not include an expression, + -- then we use its subtype for the allocation. Likewise in the case + -- of a degenerate expression like a raise expression. + + if No (Expr) + or else Nkind (Original_Node (Expr)) = N_Raise_Expression + then + Alloc_Typ := Typ; + + -- If the return object's declaration includes an expression, then + -- there are two cases: either the nominal subtype of the object is + -- definite and we can use it for the allocation directly, or it is + -- not and Analyze_Object_Declaration should have built an actual + -- subtype from the expression. + + -- However, there are exceptions in the latter case for interfaces + -- (see Analyze_Object_Declaration), as well as class-wide types and + -- types with unknown discriminants if they are additionally limited + -- (see Expand_Subtype_From_Expr), so we must cope with them. + + elsif Is_Interface (Typ) then + pragma Assert (Is_Class_Wide_Type (Typ)); + + -- For interfaces, we use the type of the expression, except if + -- we need to put back a conversion that we have removed earlier + -- in the processing. + + if Is_Class_Wide_Type (Etype (Expr)) then + Alloc_Typ := Typ; + else + Alloc_Typ := Etype (Expr); + end if; + + elsif Is_Class_Wide_Type (Typ) then + + -- For class-wide types, we have to make sure that we use the + -- dynamic type of the expression for the allocation, either by + -- means of its (static) subtype or through the actual subtype. + + if Has_Tag_Of_Type (Expr) then + Alloc_Typ := Etype (Expr); + + else pragma Assert (Ekind (Typ) = E_Class_Wide_Subtype + and then Present (Equivalent_Type (Typ))); + + Alloc_Typ := Typ; + end if; + + else pragma Assert (Is_Definite_Subtype (Typ) + or else (Has_Unknown_Discriminants (Typ) + and then Is_Limited_View (Typ))); + + Alloc_Typ := Typ; + end if; + -- If the return object's declaration includes an expression and the -- declaration isn't marked as No_Initialization, then we generate an -- allocator with a qualified expression. Although this is necessary @@ -7141,46 +7197,22 @@ package body Exp_Ch3 is Alloc_Expr := New_Copy_Tree (Expr); - -- In the constrained array case, deal with a potential sliding. - -- In the interface case, put back a conversion that we may have - -- removed earlier in the processing. - - if (Ekind (Typ) = E_Array_Subtype - or else (Is_Interface (Typ) - and then Is_Class_Wide_Type (Etype (Alloc_Expr)))) - and then Typ /= Etype (Alloc_Expr) - then - Alloc_Expr := Convert_To (Typ, Alloc_Expr); + if Etype (Alloc_Expr) /= Alloc_Typ then + Alloc_Expr := Convert_To (Alloc_Typ, Alloc_Expr); end if; - -- We always use the type of the expression for the qualified - -- expression, rather than the return object's type. We cannot - -- always use the return object's type because the expression - -- might be of a specific type and the return object might not. - Alloc := Make_Allocator (Loc, Expression => Make_Qualified_Expression (Loc, Subtype_Mark => - New_Occurrence_Of (Etype (Alloc_Expr), Loc), + New_Occurrence_Of (Alloc_Typ, Loc), Expression => Alloc_Expr)); else - -- If the return object is of a class-wide type, we cannot use - -- its type for the allocator. Instead we use the type of the - -- expression, which must be an aggregate of a definite type. - - if Is_Class_Wide_Type (Typ) then - Alloc := - Make_Allocator (Loc, - Expression => New_Occurrence_Of (Etype (Expr), Loc)); - - else - Alloc := - Make_Allocator (Loc, - Expression => New_Occurrence_Of (Typ, Loc)); - end if; + Alloc := + Make_Allocator (Loc, + Expression => New_Occurrence_Of (Alloc_Typ, Loc)); -- If the return object requires default initialization, then it -- will happen later following the elaboration of the renaming. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 91959793638..0d0ad8a5d6c 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7283,6 +7283,7 @@ package body Exp_Util is when N_Indexed_Component | N_Selected_Component | N_Aggregate + | N_Extension_Aggregate => return True; -- 2.40.0