From patchwork Tue Dec 19 14:30:49 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: 181016 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7300:24d3:b0:fb:cd0c:d3e with SMTP id r19csp1981980dyi; Tue, 19 Dec 2023 06:37:50 -0800 (PST) X-Google-Smtp-Source: AGHT+IEuzQuHiVPNth4UohjcoSw4XP3Lgl//YlBd6TtHgQmy5zBC7obOxh5CrOUqZmqDpWeFaB0h X-Received: by 2002:a0c:cdcc:0:b0:67a:27c4:31f9 with SMTP id a12-20020a0ccdcc000000b0067a27c431f9mr17393274qvn.11.1702996670054; Tue, 19 Dec 2023 06:37:50 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1702996670; cv=pass; d=google.com; s=arc-20160816; b=blxeJ3Shsq+RvXAqZYR+Of0XA16chUCr77mOBaWJdEDL0hVv+Zj8ishaOcXb98wzU5 aMD3iSxfuC9IIqePoS1tt1zFbKCJpSHz6fszTmJbBUSQpp8CM3AqBYs+o9YcE3Jn/rd+ CfKH5veQmTYxEeYtEhu08PMjE8Pvt4hhf+88WF0hWBhaZ19l6gnMjl0jSTnCzShPHvrq CbOWj4gxlrno4zgucMgLnq4TCLsXkMNIq8Hh2ETx/mXfh3BdO8TnoI6ZulAFq/oW+Bmv KUeocmoIbZqtuwHbYDS9ixUYJxLG3kj/2Xh7rgClj0TAhSXQyJrby1u/dXuotA0BZPwD 0fvw== ARC-Message-Signature: i=2; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:content-transfer-encoding :mime-version:message-id:date:subject:cc:to:from:dkim-signature :arc-filter:dmarc-filter:delivered-to; bh=2sQGVEADHYdSI2Whhq9lGOG9Y/CrSIFtFUMNaHP/8d0=; fh=hOhsC1930eHatDPYd2EALQ9Ry/g++vvN4vxlQkRuX+0=; b=pmNPdl6311tqmCVlPhliVBhJ1wFHJeuAlaKmPm6U6G7pAK6FgH1U+P7qkEMAQtBrNz UatGzAB8ghiDDHGfvTUGbbsVfTwBCFVX62vAMrJkB9hmoAIHE68yjFN1pi4RtMBiv5Bu xpcALM3lWbRIJ9BVAg5SwEGs0sRKFg9mAux17IXSeFv8Nw6HkT4GNBPQfY1R8vHcssYY 9aNBuXroMZplDAxpxexyKUfWpv6XwTqh+SIS9kcr2NaLpi/v7D1H61MH488d6XZ9URrb tG7FO/6MzqihFaJa2eG4dYzr3XL2aLAxwzQbU9t4vJekO2LQq0FIuFz6o7feEuf9qmur 8POw== ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@adacore.com header.s=google header.b=BIAwPslc; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=adacore.com Received: from server2.sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id j8-20020a0cf308000000b0067f43e14a15si4750497qvl.381.2023.12.19.06.37.49 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 19 Dec 2023 06:37:50 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@adacore.com header.s=google header.b=BIAwPslc; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=adacore.com Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 859333861834 for ; Tue, 19 Dec 2023 14:36:49 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32c.google.com (mail-wm1-x32c.google.com [IPv6:2a00:1450:4864:20::32c]) by sourceware.org (Postfix) with ESMTPS id 9F4343881D2C for ; Tue, 19 Dec 2023 14:30:51 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 9F4343881D2C Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 9F4343881D2C Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32c ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1702996255; cv=none; b=bHmLxbQ2c/GwElmDC51YiBa1hwzXf4cpggRtwFe/hcFMMqLkft/Gc6yoE8MvHcqejvFKKc1R87B8ebKKjlwlZx3YUitif7oyD4XT4HEumsg+xjIYI73OSIJr8ffq42QVpmEfzsdPzOPFCrTza7IohHryKMDOdTnNNzBnctQh1uI= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1702996255; c=relaxed/simple; bh=EfSfGedk9Pht2PLv+h/ttctlZApujzkM8Q9WZa24vNs=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=dRNTNEzqPQHXo/OXOeOoAsyz1rdvJyx16WiLn7982zBTz3FgEWlqz0R+xxZvsetRP2IKxFjXqISLinc3mByukoUeJX8CVUMfdX49J49XV9QSOPJibZJJPiNzTZmNCYju/foEAFAzXdxN/gQ+o5R+nt161vOoFB/QTkVrvri9BVE= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32c.google.com with SMTP id 5b1f17b1804b1-40d05ebe642so16123145e9.0 for ; Tue, 19 Dec 2023 06:30:51 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1702996250; x=1703601050; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=2sQGVEADHYdSI2Whhq9lGOG9Y/CrSIFtFUMNaHP/8d0=; b=BIAwPslc7XzZA8dfbjymp24MP3wX9ZipHtJyUtshZQ9e569jKyRfc14ednuzngq6mb UNupl2wbxoUXBANpqtL+Q+0+XR8m9aetDN2S38U6d8kuFfVAywnJpM74dRxFLuqDyEdy 2aCMtVsxVMDwf04aJXcG+U+rJlLV0QvJ0YSEHRR3IASTUnRTXCi/VqsH5tm/r2gvULX/ upeYRdX/2oWd2OYCzfuIocbLJ3+E+SqtILgAcc44RaGwWoryYMHJOaQmhb0aq0vqO9GS UOefdObSxGmZZgo5aaXizNBqd2I7g5i19mi6RgFxxlf26l0SG2LaQfbriE1KLccFqq7p +yFA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1702996250; x=1703601050; 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=2sQGVEADHYdSI2Whhq9lGOG9Y/CrSIFtFUMNaHP/8d0=; b=E5opjzPbLCFTPwxQlrfSNuTzl4rc3CVbZPRl0NYKifPfiK87H5k+36EWnfxDTDmYfS 2/ztQ1nBWEkcHMYRSO2gkCbRxTSVOW2k/u2i7gL6vrhoDFoyYrH96ImYVS2oWUW0AlEi rnjoqZ/XrbKMvGj+p81u0lAFoLgIWurvsHAAVS0vViDunJWvJ86iojnmIQYECi7ag/VV eo5te/wLsfo5Y+lcQJOOekRH9tkzG3Rg5K7qTvfLEjiaPKgmtTiPvx8+9TgBDe+n0tzP VvZ37F3lcgiY2ymhYi7D2H34YlGHlO4IX/8BvyBaUuQ1HoGYV72NH7JLGmeWgYQGKi6s 5MoA== X-Gm-Message-State: AOJu0YwbOXKHxR21TJN853yTXlSAFwqVDddbWOFmqRwXnkSGsc0IYaHd haZQQhCzxpwQQcHrNjdHLS5qOKveHfSEPxPuhz4= X-Received: by 2002:a05:600c:290b:b0:40b:5e4a:2362 with SMTP id i11-20020a05600c290b00b0040b5e4a2362mr577609wmd.100.1702996250366; Tue, 19 Dec 2023 06:30:50 -0800 (PST) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:fe1e:443:c34f:edaa]) by smtp.gmail.com with ESMTPSA id h20-20020a05600c315400b004094d4292aesm3073516wmo.18.2023.12.19.06.30.49 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 19 Dec 2023 06:30:49 -0800 (PST) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Rename Is_Constr_Subt_For_UN_Aliased flag Date: Tue, 19 Dec 2023 15:30:49 +0100 Message-ID: <20231219143049.455426-1-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.6 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1785721436332781561 X-GMAIL-MSGID: 1785721436332781561 From: Eric Botcazou The flag is set on the constructed subtype of an object with unconstrained nominal subtype that is aliased and is used by the code generator to adjust the layout of the object. But it is actually only used for array subtypes, where it determines whether the object is allocated with its bounds, and this usage could be extended to other cases than the original case. gcc/ada/ * einfo.ads (Is_Constr_Subt_For_UN_Aliased): Rename into... (Is_Constr_Array_Subt_With_Bounds): ...this. * exp_ch3.adb (Expand_N_Object_Declaration): Adjust to above renaming and remove now redundant test. * sem_ch3.adb (Analyze_Object_Declaration): Likewise, but set Is_Constr_Array_Subt_With_Bounds only on arrays. * gen_il-fields.ads (Opt_Field_Enum): Apply same renaming. * gen_il-gen-gen_entities.adb (Entity_Kind): Likewise. * gen_il-internals.adb (Image): Remove specific processing for Is_Constr_Subt_For_UN_Aliased. * treepr.adb (Image): Likewise. * gcc-interface/decl.cc (gnat_to_gnu_entity): Adjust to renaming and remove now redundant tests. * gcc-interface/trans.cc (Identifier_to_gnu): Likewise. (Call_to_gnu): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo.ads | 14 ++++----- gcc/ada/exp_ch3.adb | 3 +- gcc/ada/gcc-interface/decl.cc | 44 +++++++++++++---------------- gcc/ada/gcc-interface/trans.cc | 16 +++++------ gcc/ada/gen_il-fields.ads | 2 +- gcc/ada/gen_il-gen-gen_entities.adb | 2 +- gcc/ada/gen_il-internals.adb | 2 -- gcc/ada/sem_ch3.adb | 27 ++++++++++++------ gcc/ada/treepr.adb | 2 -- 9 files changed, 55 insertions(+), 57 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 1dd55494a53..d08f02ba5cb 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2474,17 +2474,17 @@ package Einfo is -- and subtypes, string types and subtypes, and all numeric types). -- Set if the type or subtype is constrained. +-- Is_Constr_Array_Subt_With_Bounds +-- Defined in all types and subtypes. Set only for an array subtype +-- which is constrained but nevertheless requires objects of this +-- subtype to be allocated with their bounds. This flag is used by +-- the back end to determine whether the bounds must be constructed. + -- Is_Constr_Subt_For_U_Nominal -- Defined in all types and subtypes. Set only for the constructed -- subtype of an object whose nominal subtype is unconstrained. Note -- that the constructed subtype itself will be constrained. --- Is_Constr_Subt_For_UN_Aliased --- Defined in all types and subtypes. This flag can be set only if --- Is_Constr_Subt_For_U_Nominal is also set. It indicates that in --- addition the object concerned is aliased. This flag is used by --- the backend to determine whether a template must be constructed. - -- Is_Constructor -- Defined in function and procedure entities. Set if a pragma -- CPP_Constructor applies to the subprogram. @@ -5058,8 +5058,8 @@ package Einfo is -- Is_Abstract_Type -- Is_Asynchronous -- Is_Atomic + -- Is_Constr_Array_Subt_With_Bounds -- Is_Constr_Subt_For_U_Nominal - -- Is_Constr_Subt_For_UN_Aliased -- Is_Controlled_Active (base type only) -- Is_Eliminated -- Is_Frozen diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f88ac7e6542..d616c5cba9f 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8107,8 +8107,7 @@ package body Exp_Ch3 is -- initialization expression has an unconstrained subtype too, -- because the bounds must be present within X. - and then not (Is_Array_Type (Typ) - and then Is_Constr_Subt_For_UN_Aliased (Typ) + and then not (Is_Constr_Array_Subt_With_Bounds (Typ) and then Is_Constrained (Etype (Expr_Q))) -- We may use a renaming if the initialization expression is a diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index d2456bfbc01..c3d2de22b65 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -889,7 +889,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) || (TYPE_SIZE (gnu_type) && integer_zerop (TYPE_SIZE (gnu_type)) && !TREE_OVERFLOW (TYPE_SIZE (gnu_type)))) - && !Is_Constr_Subt_For_UN_Aliased (gnat_type) + && !Is_Constr_Array_Subt_With_Bounds (gnat_type) && No (gnat_renamed_obj) && No (Address_Clause (gnat_entity))) gnu_size = bitsize_unit_node; @@ -907,7 +907,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) && kind != E_Exception && kind != E_Out_Parameter && Is_Composite_Type (gnat_type) - && !Is_Constr_Subt_For_UN_Aliased (gnat_type) + && !Is_Constr_Array_Subt_With_Bounds (gnat_type) && !Is_Exported (gnat_entity) && !imported_p && No (gnat_renamed_obj) @@ -932,11 +932,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) check_ok_for_atomic_type (gnu_inner, gnat_entity, true); } - /* If this is an aliased object with an unconstrained array nominal - subtype, make a type that includes the template. We will either - allocate or create a variable of that type, see below. */ - if (Is_Constr_Subt_For_UN_Aliased (gnat_type) - && Is_Array_Type (gnat_und_type) + /* If this is an array allocated with its bounds, make a type that + includes the template. We will either allocate it or create a + variable of that type, see below. */ + if (Is_Constr_Array_Subt_With_Bounds (gnat_type) && !type_annotate_only) { tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_type)); @@ -986,7 +985,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) size might be zero at run time, we force at least the unit size. */ if (Is_Aliased (gnat_entity) && Is_Constrained (gnat_type) - && !Is_Constr_Subt_For_UN_Aliased (gnat_type) + && !Is_Constr_Array_Subt_With_Bounds (gnat_type) && Is_Array_Type (gnat_und_type) && !TREE_CONSTANT (gnu_object_size)) gnu_size = size_binop (MAX_EXPR, gnu_object_size, bitsize_unit_node); @@ -1145,12 +1144,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) the entity as indirect reference to the renamed object. */ if (Materialize_Entity (gnat_entity)) { - /* If this is an aliased object with an unconstrained array - nominal subtype, we make its type a thin reference, i.e. - the reference counterpart of a thin pointer, exactly as - we would have done in the non-renaming case below. */ - if (Is_Constr_Subt_For_UN_Aliased (gnat_type) - && Is_Array_Type (gnat_und_type) + /* If this is an array allocated with its bounds, we make + its type a thin reference, the reference counterpart of + a thin pointer, exactly as we would have done in the + non-renaming case below. */ + if (Is_Constr_Array_Subt_With_Bounds (gnat_type) && !type_annotate_only) { tree gnu_array @@ -1253,8 +1251,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* If this is an aliased object with an unconstrained array nominal subtype, then it can overlay only another aliased object with an unconstrained array nominal subtype and compatible template. */ - if (Is_Constr_Subt_For_UN_Aliased (gnat_type) - && Is_Array_Type (gnat_und_type) + if (Is_Constr_Array_Subt_With_Bounds (gnat_type) && !type_annotate_only) { tree rec_type = TREE_TYPE (gnu_type); @@ -1488,14 +1485,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) static_flag = true; - /* If this is an aliased object with an unconstrained array nominal - subtype, we make its type a thin reference, i.e. the reference - counterpart of a thin pointer, so it points to the array part. - This is aimed to make it easier for the debugger to decode the - object. Note that we have to do it this late because of the - couple of allocation adjustments that might be made above. */ - if (Is_Constr_Subt_For_UN_Aliased (gnat_type) - && Is_Array_Type (gnat_und_type) + /* If this is an array allocated with its bounds, we make its type a + thin reference, i.e. the reference counterpart of a thin pointer, + so that it points to the array part. This is aimed at making it + easier for the debugger to decode the object. Note that we have + to do it this late because of the couple of allocation adjustments + that might be made above. */ + if (Is_Constr_Array_Subt_With_Bounds (gnat_type) && !type_annotate_only) { /* In case the object with the template has already been allocated diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 5e9e92d8b72..f5ba9164b17 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -1322,7 +1322,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) avoid problematic conversions to the nominal subtype. But remove any padding from the resulting type. */ if (FUNC_OR_METHOD_TYPE_P (TREE_TYPE (gnu_result)) - || Is_Constr_Subt_For_UN_Aliased (gnat_result_type) + || Is_Constr_Array_Subt_With_Bounds (gnat_result_type) || (Ekind (gnat_entity) == E_Constant && Present (Full_View (gnat_entity)) && Has_Discriminants (gnat_result_type) @@ -5039,16 +5039,14 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)), gnu_actual); - /* If we have the constructed subtype of an aliased object - with an unconstrained nominal subtype, the type of the - actual includes the template, although it is formally - constrained. So we need to convert it back to the real - constructed subtype to retrieve the constrained part - and takes its address. */ + /* If it is the constructed subtype of an array allocated with + its bounds, the type of the actual includes the template, + although it is formally constrained. So we need to convert + it back to the real constructed subtype to retrieve the + constrained part and takes its address. */ if (TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (gnu_actual)) - && Is_Constr_Subt_For_UN_Aliased (Etype (gnat_actual)) - && Is_Array_Type (Underlying_Type (Etype (gnat_actual)))) + && Is_Constr_Array_Subt_With_Bounds (Etype (gnat_actual))) gnu_actual = convert (gnu_actual_type, gnu_actual); } diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 8a62eac889d..5cc4b00c30a 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -686,8 +686,8 @@ package Gen_IL.Fields is Is_Compilation_Unit, Is_Completely_Hidden, Is_Concurrent_Record_Type, + Is_Constr_Array_Subt_With_Bounds, Is_Constr_Subt_For_U_Nominal, - Is_Constr_Subt_For_UN_Aliased, Is_Constrained, Is_Constructor, Is_Controlled_Active, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index b7e7865a0ba..d7d71b44deb 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -129,8 +129,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Is_Class_Wide_Equivalent_Type, Flag), Sm (Is_Compilation_Unit, Flag), Sm (Is_Concurrent_Record_Type, Flag), + Sm (Is_Constr_Array_Subt_With_Bounds, Flag), Sm (Is_Constr_Subt_For_U_Nominal, Flag), - Sm (Is_Constr_Subt_For_UN_Aliased, Flag), Sm (Is_Constrained, Flag), Sm (Is_Constructor, Flag), Sm (Is_Controlled_Active, Flag, Base_Type_Only), diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb index 9c1ce2649f6..4aef64b92d3 100644 --- a/gcc/ada/gen_il-internals.adb +++ b/gcc/ada/gen_il-internals.adb @@ -289,8 +289,6 @@ package body Gen_IL.Internals is return "Has_SP_Choice"; when Ignore_SPARK_Mode_Pragmas => return "Ignore_SPARK_Mode_Pragmas"; - when Is_Constr_Subt_For_UN_Aliased => - return "Is_Constr_Subt_For_UN_Aliased"; when Is_CPP_Class => return "Is_CPP_Class"; when Is_CUDA_Kernel => diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 96fd16dc171..33d8f116bc2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4957,23 +4957,32 @@ package body Sem_Ch3 is if Act_T /= T then declare - Full_View_Present : constant Boolean := - Is_Private_Type (Act_T) - and then Present (Full_View (Act_T)); + Full_Act_T : constant Entity_Id := + (if Is_Private_Type (Act_T) + then Full_View (Act_T) + else Empty); -- Propagate attributes to full view when needed begin Set_Is_Constr_Subt_For_U_Nominal (Act_T); - if Full_View_Present then - Set_Is_Constr_Subt_For_U_Nominal (Full_View (Act_T)); + if Present (Full_Act_T) then + Set_Is_Constr_Subt_For_U_Nominal (Full_Act_T); end if; - if Aliased_Present (N) then - Set_Is_Constr_Subt_For_UN_Aliased (Act_T); + -- If the object is aliased, then it may be pointed to by an + -- access-to-unconstrained-array value, which means that it + -- must be allocated with its bounds. - if Full_View_Present then - Set_Is_Constr_Subt_For_UN_Aliased (Full_View (Act_T)); + if Aliased_Present (N) + and then (Is_Array_Type (Act_T) + or else (Present (Full_Act_T) + and then Is_Array_Type (Full_Act_T))) + then + Set_Is_Constr_Array_Subt_With_Bounds (Act_T); + + if Present (Full_Act_T) then + Set_Is_Constr_Array_Subt_With_Bounds (Full_Act_T); end if; end if; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index cf938d4f226..7e135443944 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -328,8 +328,6 @@ package body Treepr is return "Has_RACW"; when F_Ignore_SPARK_Mode_Pragmas => return "Ignore_SPARK_Mode_Pragmas"; - when F_Is_Constr_Subt_For_UN_Aliased => - return "Is_Constr_Subt_For_UN_Aliased"; when F_Is_CPP_Class => return "Is_CPP_Class"; when F_Is_CUDA_Kernel =>