From patchwork Fri Jun 21 08:58:08 2024 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: 1950648 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=iDFi0h3S; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.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 ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W5BGz6CGdz1ydW for ; Fri, 21 Jun 2024 19:03:39 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0FBED3896C36 for ; Fri, 21 Jun 2024 09:03:38 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x12c.google.com (mail-lf1-x12c.google.com [IPv6:2a00:1450:4864:20::12c]) by sourceware.org (Postfix) with ESMTPS id 3CAE93898384 for ; Fri, 21 Jun 2024 08:58:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3CAE93898384 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine 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 3CAE93898384 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::12c ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718960324; cv=none; b=g7+9Xpy36x7lHDQxSaZA/ZaFLMxo4MQFQUdMiJ1MPeL85qZotjnEvxIvWDlULZalxVzYLQA+wNmhs3zMJ5FahXxAKL6oTjMpB1J8U7S7qv7HcSB2B/4PurL8+ROTTtNaXTs0VmY1veaUXfYC+3+JcEvhFDA8J/5Br2i+8RAaIOU= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718960324; c=relaxed/simple; bh=LM72DJ4WePjpOrCjYamsR0aQw4zPfrJYGSX2cnsHzME=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=h7mfbVAhsRSoeou9Hex1MtEQOSWiwE7JcWciB95tLJk77RrusJ4nIz3GyckE5EHHlDvblY6Y+qnwYcuuptyutnqRirsf3YntXH8fj0FoszYMYVWLr7gbyQ7k7G0xs5tYE8Yaag/7CRrzatbhvS1QrUjam0GDIqhESSgg4pVaQzI= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lf1-x12c.google.com with SMTP id 2adb3069b0e04-52cd6784aa4so420189e87.3 for ; Fri, 21 Jun 2024 01:58:41 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718960320; x=1719565120; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=b5ML+0X0uT7iR64bHzEK9VgikLQDAWu+4zg4HA0tL8Y=; b=iDFi0h3SptL2EpsRdL6tn+9TnnxRFOIUJ03pgDfzsAuphU6Ja866hxV4Vlng+zxqFu wp82z1XLk0qNnatvhNMTDLJn06jLSzTdggYsIt55eKMNE9l0ESTzfRIYsoRffHElPYkc qDmcxh1j82irsgNciK13UG+Ii0ukmeTAUuReekF6vUrS3OIZBYbQHjzPlkhbmQQV9Xl1 /BcOxCCm+Ahqa10xkMyjc+qS4HHqEC1hJmjTjaSpzB/UjqKR2FZGOZxjOFnpZhQAn3lJ bXkhKBmcZJJzSmpK1RQxLH4CHtGFbWw7VfR0GtfnrtSboHmMfodEgjPzF2Kxh5FACf/J XCPw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718960320; x=1719565120; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=b5ML+0X0uT7iR64bHzEK9VgikLQDAWu+4zg4HA0tL8Y=; b=SyTSb0OXcR8BBE+6cVfyiotSbDCDtaSpkXLVaEDHmWTqEJoCiSU7tIi7uhEd4eVDpY ts9DKsZvnIXAiTCyvb+yNZe8QD3VrzEiK+bkHYHyrSF5bn1+nDR51f8juR/wjX0b2NqS hssPIulXeH7y7Xd0pFmZTdB0ERt2TYg9HQFTZy5YGDQ3OgDG4Xahb7InuKOWDqQBHvFs 67tbRpz0MR4gg10YuBOp+3oaa+kjyeCvQrlNyqcTO2JhZ7yjPZyH9bSJX9n+/x6qCitO iP+Ay7pWhDO3qkoW5pRvUmPbbiVGToeSOg8rt1ZUK4uK4Bor4OBT5b0gYNZ81mU1zB5O 3Kmg== X-Gm-Message-State: AOJu0YxSG6CzJ6wGz/8uTq2CEFKyyvCsmB5yp38KRptdE+yLxeuwGcRt L01BFZTBvbKvEbUHUaWp9fLJ4NW1ZMBUx1uGlqCiDTBmOoSkmZlM4CoXvjMrGm6BJ3fhRCBFa4s = X-Google-Smtp-Source: AGHT+IFe2UqaY8HezcsEooQ3NUXMI/FnSpKNHQ+96d79c2WkO7rlu2Fi6hLyQaLbyXIpZrQ/fGwpIQ== X-Received: by 2002:ac2:5dd9:0:b0:52c:a23b:ef2b with SMTP id 2adb3069b0e04-52ccaa5a381mr3978813e87.66.1718960319546; Fri, 21 Jun 2024 01:58:39 -0700 (PDT) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:a589:2704:bfe1:5d92]) by smtp.gmail.com with ESMTPSA id 5b1f17b1804b1-4247d0c5485sm55322375e9.21.2024.06.21.01.58.38 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 21 Jun 2024 01:58:39 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 12/22] ada: Small cleanup in processing of primitive operations Date: Fri, 21 Jun 2024 10:58:08 +0200 Message-ID: <20240621085819.2485987-12-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240621085819.2485987-1-poulhies@adacore.com> References: <20240621085819.2485987-1-poulhies@adacore.com> 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 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou The processing of primitive operations is now always uniform for tagged and untagged types, but the code contains left-overs from the time where it was specific to tagged types, in particular for the handling of subtypes. gcc/ada/ * einfo.ads (Direct_Primitive_Operations): Mention concurrent types as well as GNAT extensions instead of implementation details. (Primitive_Operations): Document that Direct_Primitive_Operations is also used for concurrent types as a fallback. * einfo-utils.adb (Primitive_Operations): Tweak formatting. * exp_util.ads (Find_Prim_Op): Adjust description. * exp_util.adb (Make_Subtype_From_Expr): In the private case with unknown discriminants, always copy Direct_Primitive_Operations and do not overwrite the Class_Wide_Type of the expression's base type. * sem_ch3.adb (Analyze_Incomplete_Type_Decl): Tweak comment. (Analyze_Subtype_Declaration): Remove older and now dead calls to Set_Direct_Primitive_Operations. Tweak comment. (Build_Derived_Private_Type): Likewise. (Build_Derived_Record_Type): Likewise. (Build_Discriminated_Subtype): Set Direct_Primitive_Operations in all cases instead of just for tagged types. (Complete_Private_Subtype): Likewise. (Derived_Type_Declaration): Tweak comment. * sem_ch4.ads (Try_Object_Operation): Adjust description. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo-utils.adb | 4 +-- gcc/ada/einfo.ads | 34 ++++++++++++----------- gcc/ada/exp_util.adb | 8 ++---- gcc/ada/exp_util.ads | 10 +++---- gcc/ada/sem_ch3.adb | 61 ++++++++++++++++++----------------------- gcc/ada/sem_ch4.ads | 5 ++-- 6 files changed, 55 insertions(+), 67 deletions(-) diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index 4c86ba1c3b1..c0c79f92e13 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -2422,8 +2422,8 @@ package body Einfo.Utils is begin if Is_Concurrent_Type (Id) then if Present (Corresponding_Record_Type (Id)) then - return Direct_Primitive_Operations - (Corresponding_Record_Type (Id)); + return + Direct_Primitive_Operations (Corresponding_Record_Type (Id)); -- When expansion is disabled, the corresponding record type is -- absent, but if this is a tagged type with ancestors, or if the diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index dd95ea051c1..de175310ee9 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -932,18 +932,17 @@ package Einfo is -- subtypes. Contains the Digits value specified in the declaration. -- Direct_Primitive_Operations --- Defined in tagged types and subtypes (including synchronized types), --- in tagged private types, and in tagged incomplete types. Moreover, it --- is also defined for untagged types, both when Extensions_Allowed is --- True (-gnatX) to support the extension feature of prefixed calls for --- untagged types, and when Extensions_Allowed is False to get better --- error messages. This field is an element list of entities for --- primitive operations of the type. For incomplete types the list is --- always empty. In order to follow the C++ ABI, entities of primitives --- that come from source must be stored in this list in the order of --- their occurrence in the sources. When expansion is disabled, the --- corresponding record type of a synchronized type is not constructed. --- In that case, such types carry this attribute directly. +-- Defined in concurrent types, tagged record types and subtypes, tagged +-- private types, and tagged incomplete types. Moreover, it is also +-- defined in untagged types, both when GNAT extensions are allowed, to +-- support prefixed calls for untagged types, and when GNAT extensions +-- are not allowed, to give better error messages. Set to a list of +-- entities for primitive operations of the type. For incomplete types +-- the list is always empty. In order to follow the C++ ABI, entities of +-- primitives that come from source must be stored in this list in the +-- order of their occurrence in the sources. When expansion is disabled, +-- the corresponding record type of concurrent types is not constructed; +-- in this case, such types carry this attribute directly. -- Directly_Designated_Type -- Defined in access types. This field points to the type that is @@ -4066,10 +4065,13 @@ package Einfo is -- Primitive_Operations (synthesized) -- Defined in concurrent types, tagged record types and subtypes, tagged --- private types and tagged incomplete types. For concurrent types whose --- Corresponding_Record_Type (CRT) is available, returns the list of --- Direct_Primitive_Operations of its CRT; otherwise returns No_Elist. --- For all the other types returns the Direct_Primitive_Operations. +-- private types, and tagged incomplete types. Moreover, it is also +-- defined in untagged types, both when GNAT extensions are allowed, to +-- support prefixed calls for untagged types, and when GNAT extensions +-- are not allowed, to give better error messages. For concurrent types +-- whose Corresponding_Record_Type (CRT) is available, returns the list +-- of Direct_Primitive_Operations of this CRT. In all the other cases, +-- returns the list of Direct_Primitive_Operations. -- Prival -- Defined in private components of protected types. Refers to the entity diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 7a756af97ea..e86e7037d1f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -10671,12 +10671,8 @@ package body Exp_Util is Set_Is_Itype (Priv_Subtyp); Set_Associated_Node_For_Itype (Priv_Subtyp, E); - if Is_Tagged_Type (Priv_Subtyp) then - Set_Class_Wide_Type - (Base_Type (Priv_Subtyp), Class_Wide_Type (Unc_Typ)); - Set_Direct_Primitive_Operations (Priv_Subtyp, - Direct_Primitive_Operations (Unc_Typ)); - end if; + Set_Direct_Primitive_Operations + (Priv_Subtyp, Direct_Primitive_Operations (Unc_Typ)); Set_Full_View (Priv_Subtyp, Full_Subtyp); diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 16d8e14976c..6460bf02c1b 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -578,11 +578,11 @@ package Exp_Util is -- Find the last initialization call related to object declaration Decl function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id; - -- Find the first primitive operation of a tagged type T with name Name. - -- This function allows the use of a primitive operation which is not - -- directly visible. If T is a class-wide type, then the reference is to an - -- operation of the corresponding root type. It is an error if no primitive - -- operation with the given name is found. + -- Find the first primitive operation of type T with the specified Name, + -- disregarding any visibility considerations. If T is a class-wide type, + -- then examine the primitive operations of its corresponding root type. + -- Raise Program_Error if no primitive operation with the specified Name + -- is found. function Find_Prim_Op (T : Entity_Id; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fa13bd23ac7..391727a37f4 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3554,8 +3554,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Core_Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (T, New_Elmt_List); @@ -5864,8 +5863,6 @@ package body Sem_Ch3 is Set_No_Tagged_Streams_Pragma (Id, No_Tagged_Streams_Pragma (T)); Set_Is_Abstract_Type (Id, Is_Abstract_Type (T)); - Set_Direct_Primitive_Operations - (Id, Direct_Primitive_Operations (T)); Set_Class_Wide_Type (Id, Class_Wide_Type (T)); if Is_Interface (T) then @@ -5895,8 +5892,6 @@ package body Sem_Ch3 is No_Tagged_Streams_Pragma (T)); Set_Is_Abstract_Type (Id, Is_Abstract_Type (T)); Set_Class_Wide_Type (Id, Class_Wide_Type (T)); - Set_Direct_Primitive_Operations (Id, - Direct_Primitive_Operations (T)); end if; -- In general the attributes of the subtype of a private type @@ -6000,16 +5995,6 @@ package body Sem_Ch3 is (Id, No_Tagged_Streams_Pragma (T)); end if; - -- For tagged types, or when prefixed-call syntax is allowed - -- for untagged types, initialize the list of primitive - -- operations to an empty list. - - if Is_Tagged_Type (Id) - or else Core_Extensions_Allowed - then - Set_Direct_Primitive_Operations (Id, New_Elmt_List); - end if; - -- Ada 2005 (AI-412): Decorate an incomplete subtype of an -- incomplete type visible through a limited with clause. @@ -6050,7 +6035,8 @@ package body Sem_Ch3 is -- When prefixed calls are enabled for untagged types, the subtype -- shares the primitive operations of its base type. Do this even - -- when Extensions_Allowed is False to issue better error messages. + -- when GNAT extensions are not allowed, in order to give better + -- error messages. Set_Direct_Primitive_Operations (Id, Direct_Primitive_Operations (Base_Type (T))); @@ -8462,8 +8448,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (Derived_Type, New_Elmt_List); @@ -9862,8 +9847,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (Derived_Type, New_Elmt_List); @@ -10911,6 +10895,14 @@ package body Sem_Ch3 is Make_Class_Wide_Type (Def_Id); end if; + -- When prefixed calls are enabled for untagged types, the subtype + -- shares the primitive operations of its base type. Do this even + -- when GNAT extensions are not allowed, in order to give better + -- error messages. + + Set_Direct_Primitive_Operations + (Def_Id, Direct_Primitive_Operations (T)); + Set_Stored_Constraint (Def_Id, No_Elist); if Has_Discrs then @@ -10921,17 +10913,11 @@ package body Sem_Ch3 is if Is_Tagged_Type (T) then -- Ada 2005 (AI-251): In case of concurrent types we inherit the - -- concurrent record type (which has the list of primitive - -- operations). + -- concurrent record type. - if Ada_Version >= Ada_2005 - and then Is_Concurrent_Type (T) - then - Set_Corresponding_Record_Type (Def_Id, - Corresponding_Record_Type (T)); - else - Set_Direct_Primitive_Operations (Def_Id, - Direct_Primitive_Operations (T)); + if Ada_Version >= Ada_2005 and then Is_Concurrent_Type (T) then + Set_Corresponding_Record_Type + (Def_Id, Corresponding_Record_Type (T)); end if; Set_Is_Abstract_Type (Def_Id, Is_Abstract_Type (T)); @@ -13083,6 +13069,14 @@ package body Sem_Ch3 is Set_First_Rep_Item (Full, First_Rep_Item (Full_Base)); Set_Depends_On_Private (Full, Has_Private_Component (Full)); + -- When prefixed calls are enabled for untagged types, the subtype + -- shares the primitive operations of its base type. Do this even + -- when GNAT extensions are not allowed, in order to give better + -- error messages. + + Set_Direct_Primitive_Operations + (Full, Direct_Primitive_Operations (Full_Base)); + -- Freeze the private subtype entity if its parent is delayed, and not -- already frozen. We skip this processing if the type is an anonymous -- subtype of a record component, or is the corresponding record of a @@ -13189,8 +13183,6 @@ package body Sem_Ch3 is Set_Is_Tagged_Type (Full); Set_Is_Limited_Record (Full, Is_Limited_Record (Full_Base)); - Set_Direct_Primitive_Operations - (Full, Direct_Primitive_Operations (Full_Base)); Set_No_Tagged_Streams_Pragma (Full, No_Tagged_Streams_Pragma (Full_Base)); @@ -17469,8 +17461,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (T, New_Elmt_List); diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads index 7aae598b32a..dbe0f9a73da 100644 --- a/gcc/ada/sem_ch4.ads +++ b/gcc/ada/sem_ch4.ads @@ -84,9 +84,8 @@ package Sem_Ch4 is -- true then N is an N_Selected_Component node which is part of a call to -- an entry or procedure of a tagged concurrent type and this routine is -- invoked to search for class-wide subprograms conflicting with the target - -- entity. If Allow_Extensions is True, then a prefixed call of a primitive - -- of a non-tagged type is allowed as if Extensions_Allowed returned True. - -- This is used to issue better error messages. + -- entity. If Allow_Extensions is True, then a prefixed call to a primitive + -- of an untagged type is allowed (used to give better error messages). procedure Unresolved_Operator (N : Node_Id); -- Give an error for an unresolved operator