From patchwork Tue Jan 7 12:53:33 2025 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: 104244 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1F895386100C for ; Tue, 7 Jan 2025 13:07:56 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x335.google.com (mail-wm1-x335.google.com [IPv6:2a00:1450:4864:20::335]) by sourceware.org (Postfix) with ESMTPS id 63C423856277 for ; Tue, 7 Jan 2025 12:54:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 63C423856277 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 63C423856277 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::335 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1736254461; cv=none; b=kvc5cdxGOX+me/N9blsKU3hh1/FfvUjPCoKJE9BmhzKoB+KnD7HOV47SrQFgBSEFKI4krgYXvjuivZNfSpxm3Ohk/Rz4mL1cCT4lZvVxiwXDjgeoZBXdzsZG+JzWT9KKHUmHSp7qxJY+pEQsOaqXi0v//rePvblHgKke0C7Q2QM= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1736254461; c=relaxed/simple; bh=6mIbIDX7wzMtq+igOuhKt0B4x75qyOogLplFK1gyGvo=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Y5NIDQp+vwpvtyJW2UOBRUxDN6rGR7/PNGxt7XBrO4HdnruuR/GVZ2Seph9euRC0dXeMDA0UQIwbVepDIlKN9rgVS7xXWzflCIYoAY/O8jL2Vc2kFec5IOOBrZkcD7E0MKjL7Aq9puTK4OvlEbRhdUO4Fsnlm3b5YwAff1djl4g= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 63C423856277 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=iPF3+yLh Received: by mail-wm1-x335.google.com with SMTP id 5b1f17b1804b1-436281c8a38so110871765e9.3 for ; Tue, 07 Jan 2025 04:54:21 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1736254460; x=1736859260; 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=zFD5TcqRhCrBwMoRKm6s5Xd07wxsFFTOXO6/hWUHO5c=; b=iPF3+yLh/bJAOlom7z9V/h54jQW/5Fy2gwOQUPTO/xtrZ9Md2TRqKD5z6AO484DC73 BbKc2np9hLm/yxNEsm8dAlH58HUZFbhMFOOlNacgsGtAHYiuZIPYonImRJfRqhdvmhUx Z6M3ks7EQML43nVSqon/gP+QNW9UQWzKATr7Y4tf/OXaTE0ETH1LI2TjPUxtJqDhOaBa UMb8jEnAny0OTJlKGGdfzVFf1+/u7BzwtLS3+HnGqmlYKhaf4/KT/4ODwdWIk0ofFv1c LqzGxHZpnycfg/JhQCBsmn5qj2GXMi1gH1E3eTEjVUHNef9yThuGeRiA2vGhZGrzipqu JPCA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1736254460; x=1736859260; 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=zFD5TcqRhCrBwMoRKm6s5Xd07wxsFFTOXO6/hWUHO5c=; b=ISmUcLjsg3QwAZLAPgNOVFTvm8nMQYreRIyLxfv4Y9mlbQs2bbXmBXT9q89OzpArG+ 96YquJz/X/rtoKL0h/TOBc+jCc5wpPMDXd6DjGXa1gXiNljO/2pYBmzZHUEWwb3578TV 89loRj6nLBjCYnNwJZX1ZnHAiRwUav6bTlIPt1c9n90Ik+lg/LINxvYj0QULNpH/ha1F 6SOiuHIcozRBw9/a15De9FvI/W9PFEjXOIfjqeRw0TJrscgw+fkNst5hF9FcJYRb0Osd yZD6+xyLreMjpOR0NbIewJSe7sZZTCrTd4I186LzBgNyDVlMWmFOhb8IrbRprxwIf119 6LpQ== X-Gm-Message-State: AOJu0Yx9rM6jn/LaFMU7+Fi3YSmg9ExveZPmkTF3BPO8r1DDKwlY5QsC pV/eRfbz46+VoU1av/pvLM0kZuBvBtXk8MFhFBinqzzfBW/xB7poiWYYKMrd0zGoKPStII+Genc = X-Gm-Gg: ASbGncv3aDLC2j+0g78JYOA3SuZ7rkteHlfkB1gB3dkzTLbKL4zxDKkkL22qqt1NDKY rjcq4NJg6LmMCG2RN2AOlEVUczR5gXMfkRu18xiS1kthaKU02aF2Eroseg1fOE+aLHzTq9RaJFB W+OpSrMONTNxLXV6yohE4Lt/2T8jiJvn9G+hUZHfKrAnb1akX02hUTzB7KZF1fhbdhtIxxpOXp4 bziGp2iPCoSthvM2dXS2NiKJ1alhm1vDIMJV7uffEvDaSMx8cQF+DViHKdPg8TeByapa0AMMsmD jplHQmgKfu/RPkRhQ3HzEo4AVNYh0Hvn4YHxVVpfnqlAcDFI8UE3kRxKNwFId5Pn3Oxw1XKX X-Google-Smtp-Source: AGHT+IFSiq5T8RkofCMg/9R4c2aB++hW4yykVS170cC6NmJkdpMt4xPdZ4yTHRSxDWwqgxqnmCvXaA== X-Received: by 2002:a05:600c:1d25:b0:434:fdf3:2c26 with SMTP id 5b1f17b1804b1-43668646362mr520813715e9.19.1736254460021; Tue, 07 Jan 2025 04:54:20 -0800 (PST) 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 5b1f17b1804b1-43656af6c42sm631014805e9.9.2025.01.07.04.54.19 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 07 Jan 2025 04:54:19 -0800 (PST) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Piotr Trojanek Subject: [COMMITTED 15/31] ada: Handle attributes related to Ada 2012 iterators as internal Date: Tue, 7 Jan 2025 13:53:33 +0100 Message-ID: <20250107125350.619654-15-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250107125350.619654-1-poulhies@adacore.com> References: <20250107125350.619654-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~patchwork=sourceware.org@gcc.gnu.org From: Piotr Trojanek Use existing machinery for internal attributes to handle attributes related to Ada 2012 iterators. All these attributes exist exclusively as a mean to delay processing. Code cleanup. The only change in behavior is the wording of error emitted when one of the internal attributes appears in source code: from "illegal attribute" (which used to be emitted in the analysis) to "unrecognized attribute (which is emitted by the parser). gcc/ada/ChangeLog: * exp_attr.adb (Expand_N_Attribute_Reference): Remove explicit handling of attributes related to Ada 2012 iterators. * sem_attr.adb (Analyze_Attribute, Eval_Attribute): Likewise; move attribute Reduce according to alphabetic order. * snames.adb-tmpl (Get_Attribute_Id): Add support for new internal attributes. * snames.ads-tmpl: Recognize names of new internal attributes. (Attribute_Id): Recognize new internal attributes. (Internal_Attribute_Id): Likewise. (Is_Internal_Attribute_Name): Avoid duplication in comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_attr.adb | 12 ------------ gcc/ada/sem_attr.adb | 32 +++++++------------------------- gcc/ada/snames.adb-tmpl | 33 ++++++++++++++++++++++++--------- gcc/ada/snames.ads-tmpl | 32 +++++++++++++++----------------- 4 files changed, 46 insertions(+), 63 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 904293bbd1d..911b9dcf807 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2266,18 +2266,6 @@ package body Exp_Attr is case Id is - -- Attributes related to Ada 2012 iterators. They are only allowed in - -- attribute definition clauses and should never be expanded. - - when Attribute_Constant_Indexing - | Attribute_Default_Iterator - | Attribute_Implicit_Dereference - | Attribute_Iterable - | Attribute_Iterator_Element - | Attribute_Variable_Indexing - => - raise Program_Error; - -- Internal attributes used to deal with Ada 2012 delayed aspects. These -- were already rejected by the parser. Thus they shouldn't appear here. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7295784704f..53b96501d78 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3423,18 +3423,6 @@ package body Sem_Attr is case Attr_Id is - -- Attributes related to Ada 2012 iterators. Attribute specifications - -- exist for these, but they cannot be queried. - - when Attribute_Constant_Indexing - | Attribute_Default_Iterator - | Attribute_Implicit_Dereference - | Attribute_Iterator_Element - | Attribute_Iterable - | Attribute_Variable_Indexing - => - Error_Msg_N ("illegal attribute", N); - -- Internal attributes used to deal with Ada 2012 delayed aspects. These -- were already rejected by the parser. Thus they shouldn't appear here. @@ -9015,19 +9003,6 @@ package body Sem_Attr is case Id is - -- Attributes related to Ada 2012 iterators; nothing to evaluate for - -- these. - - when Attribute_Constant_Indexing - | Attribute_Default_Iterator - | Attribute_Implicit_Dereference - | Attribute_Iterator_Element - | Attribute_Iterable - | Attribute_Reduce - | Attribute_Variable_Indexing - => - null; - -- Internal attributes used to deal with Ada 2012 delayed aspects. -- These were already rejected by the parser. Thus they shouldn't -- appear here. @@ -10208,6 +10183,13 @@ package body Sem_Attr is end case; end Range_Length; + ------------ + -- Reduce -- + ------------ + + when Attribute_Reduce => + null; + --------- -- Ref -- --------- diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index d49fdf4d74a..62ca4de4866 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -125,15 +125,30 @@ package body Snames is function Get_Attribute_Id (N : Name_Id) return Attribute_Id is begin - if N = Name_CPU then - return Attribute_CPU; - elsif N = Name_Dispatching_Domain then - return Attribute_Dispatching_Domain; - elsif N = Name_Interrupt_Priority then - return Attribute_Interrupt_Priority; - else - return Attribute_Id'Val (N - First_Attribute_Name); - end if; + case N is + when Name_Constant_Indexing => + return Attribute_Constant_Indexing; + when Name_CPU => + return Attribute_CPU; + when Name_Default_Iterator => + return Attribute_Default_Iterator; + when Name_Dispatching_Domain => + return Attribute_Dispatching_Domain; + when Name_Implicit_Dereference => + return Attribute_Implicit_Dereference; + when Name_Interrupt_Priority => + return Attribute_Interrupt_Priority; + when Name_Iterable => + return Attribute_Iterable; + when Name_Iterator_Element => + return Attribute_Iterator_Element; + when Name_Variable_Indexing => + return Attribute_Variable_Indexing; + when First_Attribute_Name .. Last_Attribute_Name => + return Attribute_Id'Val (N - First_Attribute_Name); + when others => + raise Program_Error; + end case; end Get_Attribute_Id; ----------------------- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 59637940bee..4e0d94f5113 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -943,12 +943,10 @@ package Snames is Name_Compiler_Version : constant Name_Id := N + $; -- GNAT Name_Component_Size : constant Name_Id := N + $; Name_Compose : constant Name_Id := N + $; - Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT Name_Constrained : constant Name_Id := N + $; Name_Count : constant Name_Id := N + $; Name_Default_Bit_Order : constant Name_Id := N + $; -- GNAT Name_Default_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT - Name_Default_Iterator : constant Name_Id := N + $; -- GNAT Name_Definite : constant Name_Id := N + $; Name_Delta : constant Name_Id := N + $; Name_Denorm : constant Name_Id := N + $; @@ -975,13 +973,10 @@ package Snames is Name_Has_Same_Storage : constant Name_Id := N + $; -- Ada 12 Name_Has_Tagged_Values : constant Name_Id := N + $; -- GNAT Name_Identity : constant Name_Id := N + $; - Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT Name_Index : constant Name_Id := N + $; -- Ada 22 Name_Initialized : constant Name_Id := N + $; -- GNAT Name_Integer_Value : constant Name_Id := N + $; -- GNAT Name_Invalid_Value : constant Name_Id := N + $; -- GNAT - Name_Iterator_Element : constant Name_Id := N + $; -- GNAT - Name_Iterable : constant Name_Id := N + $; -- GNAT Name_Large : constant Name_Id := N + $; -- Ada 83 Name_Last : constant Name_Id := N + $; Name_Last_Bit : constant Name_Id := N + $; @@ -1063,7 +1058,6 @@ package Snames is Name_Valid : constant Name_Id := N + $; Name_Valid_Scalars : constant Name_Id := N + $; -- GNAT Name_Value_Size : constant Name_Id := N + $; -- GNAT - Name_Variable_Indexing : constant Name_Id := N + $; -- GNAT Name_Version : constant Name_Id := N + $; Name_Wchar_T_Size : constant Name_Id := N + $; -- GNAT Name_Wide_Wide_Width : constant Name_Id := N + $; -- Ada 05 @@ -1152,10 +1146,16 @@ package Snames is -- internal attributes is not permitted). First_Internal_Attribute_Name : constant Name_Id := N + $; + Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT Name_CPU : constant Name_Id := N + $; + Name_Default_Iterator : constant Name_Id := N + $; -- GNAT Name_Dispatching_Domain : constant Name_Id := N + $; + Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT Name_Interrupt_Priority : constant Name_Id := N + $; + Name_Iterable : constant Name_Id := N + $; -- GNAT + Name_Iterator_Element : constant Name_Id := N + $; -- GNAT Name_Secondary_Stack_Size : constant Name_Id := N + $; -- GNAT + Name_Variable_Indexing : constant Name_Id := N + $; -- GNAT Last_Internal_Attribute_Name : constant Name_Id := N + $; -- Names of recognized locking policy identifiers @@ -1480,12 +1480,10 @@ package Snames is Attribute_Compiler_Version, Attribute_Component_Size, Attribute_Compose, - Attribute_Constant_Indexing, Attribute_Constrained, Attribute_Count, Attribute_Default_Bit_Order, Attribute_Default_Scalar_Storage_Order, - Attribute_Default_Iterator, Attribute_Definite, Attribute_Delta, Attribute_Denorm, @@ -1512,13 +1510,10 @@ package Snames is Attribute_Has_Same_Storage, Attribute_Has_Tagged_Values, Attribute_Identity, - Attribute_Implicit_Dereference, Attribute_Index, Attribute_Initialized, Attribute_Integer_Value, Attribute_Invalid_Value, - Attribute_Iterator_Element, - Attribute_Iterable, Attribute_Large, Attribute_Last, Attribute_Last_Bit, @@ -1600,7 +1595,6 @@ package Snames is Attribute_Valid, Attribute_Valid_Scalars, Attribute_Value_Size, - Attribute_Variable_Indexing, Attribute_Version, Attribute_Wchar_T_Size, Attribute_Wide_Wide_Width, @@ -1662,12 +1656,18 @@ package Snames is -- the special processing required to deal with the fact that their -- names are not attribute names. + Attribute_Constant_Indexing, Attribute_CPU, + Attribute_Default_Iterator, Attribute_Dispatching_Domain, - Attribute_Interrupt_Priority); + Attribute_Implicit_Dereference, + Attribute_Interrupt_Priority, + Attribute_Iterable, + Attribute_Iterator_Element, + Attribute_Variable_Indexing); subtype Internal_Attribute_Id is Attribute_Id - range Attribute_CPU .. Attribute_Interrupt_Priority; + range Attribute_Constant_Indexing .. Attribute_Variable_Indexing; type Attribute_Set is array (Attribute_Id) of Boolean; -- Type used to build attribute classification flag arrays @@ -2058,9 +2058,7 @@ package Snames is -- i.e. an attribute reference that returns an entity. function Is_Internal_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of an INT attribute (Name_CPU, - -- Name_Dispatching_Domain, Name_Interrupt_Priority, - -- Name_Secondary_Stack_Size). + -- Test to see if the name N is the name of an internal attribute function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean; -- Test to see if the name N is the name of a recognized attribute that