From patchwork Tue Nov 7 09:20:21 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: 162349 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:aa0b:0:b0:403:3b70:6f57 with SMTP id k11csp114064vqo; Tue, 7 Nov 2023 01:27:29 -0800 (PST) X-Google-Smtp-Source: AGHT+IGPyNcWpGsiaNctnVt79R/xAswpDY6U2Ax3+4mfex7mUeJ830Loc+RDQ3y/n2wHKuUJChNg X-Received: by 2002:a05:6214:240a:b0:66d:2d07:eab4 with SMTP id fv10-20020a056214240a00b0066d2d07eab4mr34868096qvb.42.1699349249568; Tue, 07 Nov 2023 01:27:29 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1699349249; cv=pass; d=google.com; s=arc-20160816; b=xXy2xTToatmuzRBVlUK75B9cudvaXQGrkRqH0gC3np1DyWeC/tsfEJeFOdAV4ASAcJ JE+ApFEIWzFDj/rixzCVthJj9mGohvHvAPjF5SIcz+pnlVDHAMZN6bxQNRXmSVG02iji ivfyr+Vbbn3H4HoWWl8OZtCMaiX55sS4KwMjAAWSlnuX7TUlKeAm4XpGxk5sqWAtxFIw EsbqmBOQUxxTRLMTOM6cTj3DkGQuTjLfBswV4/dvV/EV0+q7aSzo4xu7ZWu584bibkRJ +CjlOPRXdl47LMhNv6RSgYIYTeDi6zJVYt8JWTj8mHGSLstiv+6q98PIjOp8dKGSpV6m Rm+A== 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=tWfuUYcYPYsf+/o7K7yG5hjxEQosuWtv1iwsoQnr6V0=; fh=V3FUX71dhq7uYqp2NU3QsSvdKCASDvtMIqKaZekiAR8=; b=UWsQa44Pv3l7Gps98A5tSD/zGQqEf8UsTqIBJFuacH/JUAnr03g69GCmn+oCuDpU2o zMvUxyNA9bsE5PGPyiICciOrEi/i7LYYzYsHS2n4fgf7GHrujYK4oP+lthbEEhsddjeb KPmZ+x4s+n7l+63vJ9GDRZq1XJ2hUzqVGwxHHP39/yfJnlUIYD7YFO19ik8sG1m2Gks3 vM33sZAWqX7OhzgZtDdiq+L5rDaaN1xtw4v5+ptTq+t+im5Cn1I7Xg5krs0okNtw7hyj S1ak0iPCGERFMUbBt0c56n5reeKhCJk9CnvRvwpXgpxGtbFWrfe2OpImBq9lBXhIInlE DmXA== ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@adacore.com header.s=google header.b=XknrbsvR; 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 i6-20020a056214030600b0066cf18c5cd9si6620706qvu.606.2023.11.07.01.27.29 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 07 Nov 2023 01:27:29 -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=XknrbsvR; 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 1BAC0385802F for ; Tue, 7 Nov 2023 09:27:29 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x330.google.com (mail-wm1-x330.google.com [IPv6:2a00:1450:4864:20::330]) by sourceware.org (Postfix) with ESMTPS id 9CFEF386C5BD for ; Tue, 7 Nov 2023 09:20:28 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 9CFEF386C5BD 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 9CFEF386C5BD Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::330 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1699348837; cv=none; b=U7RKw5J1y3uBDFkuNbH4wFXW0YdYl4HEHyMMgvUHvHQEat0n7t1OQ40tIq/B3a4KWP/iRU+96Ek7brIPb2KdH7D16lTNcZackDLp6vHUW4UZMvkfukxE16Ol/gayuTp84ctAIXZdPsLc94M9FS63CV7o5St/uIu8GK4vNOzxY7E= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1699348837; c=relaxed/simple; bh=rYf99FQd99uemqGksJzKVsigk9/MlnWVdkdlDTvl0a8=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=G7U5tp4uTNg4qJwewqo3S/LLuLDGWO5NipujxNmRIXMB58HpDj83hyfP7EatmhG/QFlSAdRgIHOa5QqX6+9dljF2+I/jt6DjqbOJ2z8awW4AJdZlzRKOOyGVkT1Y4htiUlQyD5WZg95uk1kKSAapADMVoFN/HYX7gtLvCNaTE4U= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x330.google.com with SMTP id 5b1f17b1804b1-407c3adef8eso46770195e9.2 for ; Tue, 07 Nov 2023 01:20:28 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1699348827; x=1699953627; 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=tWfuUYcYPYsf+/o7K7yG5hjxEQosuWtv1iwsoQnr6V0=; b=XknrbsvRe6ubgp0YN861CyhxwH4PaxnhNjreVNYriMS0Y/RDoGh1STGYxoV/45Ww3O B67hp/dybGkasew2d29MWDB0LBu1faaXOO+89631QNWBQ3ybqtI6NfaRBi8tzMuDiUxU wxuKByX3qXwUhYWfsIR3N0Qo10wEJpU8uqs6mSacJQ20RgaeCo49w/SQtNFXLrBmS0Fx 5NMj9QzEOCl5bc61y4BKWi164PFSZh6brS5zFq2Dq1iZcxpBQjYpCJpJ70L30iHQ0+2h z3SXWm++BZd4SUBYPy6NLneQHmUx8JzZNQvVjVTlSW6rTxU4JTgVzA5jfcrPdcdlD4UY TCYA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1699348827; x=1699953627; 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=tWfuUYcYPYsf+/o7K7yG5hjxEQosuWtv1iwsoQnr6V0=; b=rasbKTh1v2TNY/0buPmulKPfRPTUvB5N3/Lx++domY6zpmQaLam1pQkvTMLFlnlr+t grp2b7jQ9z1PZCa+qCt1gVCKJvBzhNV7EJ53wncdxS2DlK8ohwBkMyUs3zq864QEcUyA uufDV4KLPL8CICGqMSQbEv9eBuvI87AE/O0IC0cAZcUTWM2sZJaIcT9KcbHcdtnNgXNh Gg9DR9TuLmFWzQlRETfB7QL/U3nZH4CzbMmcpJjBAV6A6ivwui3o1gR6T4pLfRDQPzD5 KaNWBK2k8YxQj23UAHx1n3x+i+ClO+InDeFZz1aidZ/DEX8AqUuT5/ZJ9lGc4GXWSYom DGaQ== X-Gm-Message-State: AOJu0Yz7iBIhwNx0cM1FwZbmLpnN4uREevbflHZ2nUWEMprjKcs2/tnN kMxtDyeaLbjPALQEDe7eRcY78QoY4Q0dDEAaPfqbVw== X-Received: by 2002:a05:600c:4585:b0:409:4e8f:4b27 with SMTP id r5-20020a05600c458500b004094e8f4b27mr1783093wmo.33.1699348826818; Tue, 07 Nov 2023 01:20:26 -0800 (PST) Received: from localhost.localdomain ([2001:861:3382:1a90:dbc1:a1d1:2e58:4040]) by smtp.gmail.com with ESMTPSA id f6-20020a05600c4e8600b003fefb94ccc9sm15349865wmq.11.2023.11.07.01.20.25 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 07 Nov 2023 01:20:26 -0800 (PST) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED] ada: Implement Aspects as fields under nodes Date: Tue, 7 Nov 2023 10:20:21 +0100 Message-ID: <20231107092022.3906466-1-poulhies@adacore.com> X-Mailer: git-send-email 2.42.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, 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: 1781896839173603824 X-GMAIL-MSGID: 1781896839173603824 From: Viljar Indus In the previous implementation Aspect Specifications were stored in a separate table and not directly under each node. This implementation included a lot of extra code that needed to be maintained manually. The new implementation stores Aspect_Specfications as a syntactic field under each node. This removes the extra code that was needed to store, traverse and clone aspects for nodes. gcc/ada/ * aspects.adb (Exchange_Aspects): Removed. This method was typically called after a Rewrite method. Now since the Rewrite switches the aspects between the new and the old node it is no longer needed. (Has_Aspects): Converted to a utility method that performs the same before as the previous Has_Aspects field did. Meaning it shows whether a node actually has aspects or not. (Copy_Aspects): New utility method that performs a deep copy of the From nodes aspects. (Aspect_Specfications): Removed. No longer needed. Replaced by the primitive operation for the Aspect_Specification fields. (Set_Aspect_Specifications): Likewise. (Aspect_Specifications_Hash_Table): Remove the table and all the utility methods for storing the old aspects. * aspects.ads: Likewise. * atree.adb (Copy_Separate_Tree): Remove custom code for aspects. (New_Copy): Likewise. (Replace): Likewise. (Rewrite): Likewise. * exp_ch3.adb (Expand_N_Object_Declaration): Keep the aspects from the old node. * exp_ch6.adb (Validate_Subprogram_Calls): Previously aspects were ignored because they were not on the tree. Explicitly ignore them here when traversing the tree. * exp_unst.adb (Build_Tables): Likewise * gen_il-fields.ads: Remove Has_Aspects and add Aspect_Specifications fields. * gen_il-gen-gen_nodes.adb: Add Aspect_Specification fields for all nodes that can have aspects. Additionally add Expression_Copy for Aspect_Speficiations to avoid reusing the Associated_Node for generic instantiation and aspect analysis. * ghost.adb (Remove_Ignored_Ghost_Node): Remove call to Remove_Aspects. The rewritten node is a Null_Statement that cannot have aspects and there is not anything to gain from removing them from the Orignal_Node of N since it technically is not part of the active tree. * inline.adb (Process_Formals_In_Aspects): Simplify code for node traversal. * par-ch13.adb: Avoid setting the parent explicitly for the Aspect_Specifications list. This is done explicitly in the setter. * par-ch6.adb: Likewise. * par_sco.adb (Traverse_Aspects): Handle early return. * sem_ch10.adb: Simplify code for Analyze_Aspect_Specifications. * sem_ch11.adb: Likewise. * sem_ch12.adb (Analyze_Formal_Derived_Interface_Type): Keep the aspects from the orignal node after rewrite. (Analyze_Formal_Derived_Type): Likewise. (Analyze_Formal_Interface_Type): Likewise. (Analyze_Formal_Object_Declaration): Simplify code for Analyze_Aspect_Specifications. (Analyze_Formal_Package_Declaration): Likewise. (Analyze_Formal_Subprogram_Declaration): Likewise. (Analyze_Formal_Type_Declaration): Likewise. (Analyze_Generic_Package_Declaration): Remove Exchange_Aspects. The new node already has the correct aspects after the rewrite. Also simplify code for Analyze_Aspect_Specifications. (Analyze_Generic_Subprogram_Declaration): Likewise. (Analyze_Package_Instantiation): Simplify code for Analyze_Aspect_Specifications. (Build_Instance_Compilation_Unit_Nodes): Remove explicit copy of aspects that is no longer needed. (Save_References): Update the traversal code to handle Aspect_Specifications in the tree. (Copy_Generic_Node): Remove explicit copy for aspects. New_Copy took care of that already. * sem_ch13.adb (Analyze_Aspect_Specifications): Add early return to simplify code for its calls. Avoid reusing the Entity(Associated_Node) field for storing the original expression. Instead use the new Expression_Copy field since Entity(Associated_Node) is also used in generic instantiation. (Analyze_Aspects_On_Subprogram_Body_Or_Stub): Simlify call to Analyze_Aspect_Specifications. (Check_Aspect_At_End_Of_Declarations): Use Expression_Copy instead of Entity. (Check_Aspect_At_Freeze_Point): Likewise. * sem_ch3.adb: Simplify calls to Analyze_Aspect_Specifications. * sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Simplify call to Analyze_Aspect_Specifications. (Analyze_Expression_Function): Keep the aspects from the original node after a rewrite. (Analyze_Generic_Subprogram_Body): Remove Exchange aspects that is no longer needed. Simplify call to Analyze_Aspect_Specifications. (Analyze_Null_Procedure): Keep the aspects from the original node after a rewrite. (Analyze_Subprogram_Body_Helper): Simplify calls to Analyze_Aspect_Specifications. (Analyze_Subprogram_Declaration): Likewise. * sem_ch7.adb (Analyze_Package_Body_Helper): Remove Exchange aspects that is no longer needed. Simplify call to Analyze_Aspect_Specifications. (Analyze_Package_Declaration): Simplify call to Analyze_Aspect_Specifications. (Analyze_Private_Type_Declaration): Likewise. * sem_ch8.adb: Simplify calls to Analyze_Aspect_Specifications. * sem_ch9.adb (Analyze_Entry_Body): Simplify call to Analyze_Aspects_On_Subprogram_Body_Or_Stub. (Analyze_Entry_Declaration): Simplify call to Analyze_Aspect_Specifications. (Analyze_Protected_Body): Likewise. (Analyze_Protected_Type_Declaration): Likewise. (Analyze_Single_Protected_Declaration): Keep the aspects from the original node after a rewrite. Simplify call to Analyze_Aspect_Specifications. (Analyze_Single_Task_Declaration): Likewise. (Analyze_Task_Body): Simplify call to Analyze_Aspect_Specifications. (Analyze_Task_Type_Declaration): Simplify calls to Analyze_Aspect_Specifications. * sem_dim.adb: Remove explicitly setting the parents for the Aspect_Specification list. * sem_disp.adb: Remove the with that is no longer required since Aspect_Specifications is a node operation now. * sem_util.adb (Copy_Node_With_Replacement): Remove explicit code for aspects. * treepr.adb (Print_Field): Remove the version that was used for printing aspects. (Print_Node): Remove aspect specific code. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.adb | 104 ++++++--------------------- gcc/ada/aspects.ads | 33 ++------- gcc/ada/atree.adb | 35 --------- gcc/ada/exp_ch3.adb | 4 ++ gcc/ada/exp_ch6.adb | 1 + gcc/ada/exp_unst.adb | 9 +-- gcc/ada/gen_il-fields.ads | 2 +- gcc/ada/gen_il-gen-gen_nodes.adb | 83 ++++++++++++++++------ gcc/ada/ghost.adb | 3 - gcc/ada/inline.adb | 11 +-- gcc/ada/par-ch13.adb | 1 - gcc/ada/par-ch6.adb | 2 - gcc/ada/par_sco.adb | 6 +- gcc/ada/sem_ch10.adb | 12 +--- gcc/ada/sem_ch11.adb | 4 +- gcc/ada/sem_ch12.adb | 118 ++++++++++++++----------------- gcc/ada/sem_ch13.adb | 20 ++++-- gcc/ada/sem_ch3.adb | 69 ++++++++++-------- gcc/ada/sem_ch6.adb | 36 +++------- gcc/ada/sem_ch7.adb | 17 +---- gcc/ada/sem_ch8.adb | 20 ++---- gcc/ada/sem_ch9.adb | 74 ++++++++----------- gcc/ada/sem_dim.adb | 2 - gcc/ada/sem_disp.adb | 1 - gcc/ada/sem_util.adb | 5 -- gcc/ada/treepr.adb | 56 --------------- 26 files changed, 266 insertions(+), 462 deletions(-) diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index cdef68e2914..1d322ed5af5 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -68,30 +68,6 @@ package body Aspects is Aspect_Variable_Indexing => True, others => False); - ------------------------------------------ - -- Hash Table for Aspect Specifications -- - ------------------------------------------ - - type AS_Hash_Range is range 0 .. 510; - -- Size of hash table headers - - function AS_Hash (F : Node_Id) return AS_Hash_Range; - -- Hash function for hash table - - function AS_Hash (F : Node_Id) return AS_Hash_Range is - begin - return AS_Hash_Range (F mod 511); - end AS_Hash; - - package Aspect_Specifications_Hash_Table is new - GNAT.HTable.Simple_HTable - (Header_Num => AS_Hash_Range, - Element => List_Id, - No_Element => No_List, - Key => Node_Id, - Hash => AS_Hash, - Equal => "="); - ------------------------------------- -- Hash Table for Aspect Id Values -- ------------------------------------- @@ -116,19 +92,6 @@ package body Aspects is Hash => AI_Hash, Equal => "="); - --------------------------- - -- Aspect_Specifications -- - --------------------------- - - function Aspect_Specifications (N : Node_Id) return List_Id is - begin - if Has_Aspects (N) then - return Aspect_Specifications_Hash_Table.Get (N); - else - return No_List; - end if; - end Aspect_Specifications; - -------------------------------- -- Aspects_On_Body_Or_Stub_OK -- -------------------------------- @@ -161,31 +124,6 @@ package body Aspects is return True; end Aspects_On_Body_Or_Stub_OK; - ---------------------- - -- Exchange_Aspects -- - ---------------------- - - procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id) is - begin - pragma Assert - (Permits_Aspect_Specifications (N1) - and then Permits_Aspect_Specifications (N2)); - - -- Perform the exchange only when both nodes have lists to be swapped - - if Has_Aspects (N1) and then Has_Aspects (N2) then - declare - L1 : constant List_Id := Aspect_Specifications (N1); - L2 : constant List_Id := Aspect_Specifications (N2); - begin - Set_Parent (L1, N2); - Set_Parent (L2, N1); - Aspect_Specifications_Hash_Table.Set (N1, L2); - Aspect_Specifications_Hash_Table.Set (N2, L1); - end; - end if; - end Exchange_Aspects; - ----------------- -- Find_Aspect -- ----------------- @@ -358,6 +296,12 @@ package body Aspects is return Present (Find_Aspect (Id, A, Class_Present => Class_Present)); end Has_Aspect; + function Has_Aspects (N : Node_Id) return Boolean + is (Atree.Present (N) and then + Permits_Aspect_Specifications (N) and then + Nlists.Present (Sinfo.Nodes.Aspect_Specifications (N)) and then + Nlists.Is_Non_Empty_List (Sinfo.Nodes.Aspect_Specifications (N))); + ------------------ -- Is_Aspect_Id -- ------------------ @@ -377,8 +321,7 @@ package body Aspects is begin if Has_Aspects (From) then Set_Aspect_Specifications (To, Aspect_Specifications (From)); - Aspect_Specifications_Hash_Table.Remove (From); - Set_Has_Aspects (From, False); + Set_Aspect_Specifications (From, No_List); end if; end Move_Aspects; @@ -485,6 +428,21 @@ package body Aspects is end if; end Move_Or_Merge_Aspects; + ------------------- + -- Copy_Aspects -- + ------------------- + + procedure Copy_Aspects (From : Node_Id; To : Node_Id) is + + begin + if not Has_Aspects (From) then + return; + end if; + + Set_Aspect_Specifications + (To, New_Copy_List (Aspect_Specifications (From))); + end Copy_Aspects; + ----------------------------------- -- Permits_Aspect_Specifications -- ----------------------------------- @@ -547,8 +505,7 @@ package body Aspects is procedure Remove_Aspects (N : Node_Id) is begin if Has_Aspects (N) then - Aspect_Specifications_Hash_Table.Remove (N); - Set_Has_Aspects (N, False); + Set_Aspect_Specifications (N, No_List); end if; end Remove_Aspects; @@ -595,21 +552,6 @@ package body Aspects is return Canonical_Aspect (A1) = Canonical_Aspect (A2); end Same_Aspect; - ------------------------------- - -- Set_Aspect_Specifications -- - ------------------------------- - - procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is - begin - pragma Assert (Permits_Aspect_Specifications (N)); - pragma Assert (not Has_Aspects (N)); - pragma Assert (L /= No_List); - - Set_Has_Aspects (N); - Set_Parent (L, N); - Aspect_Specifications_Hash_Table.Set (N, L); - end Set_Aspect_Specifications; - package body User_Aspect_Support is -- This is similar to the way that user-defined check names are diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index aaa5db9310e..8f4ae51b7ce 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -1147,28 +1147,12 @@ package Aspects is -- implemented internally with a hash table in the body, that provides -- access to aspect specifications. - function Aspect_Specifications (N : Node_Id) return List_Id; - -- Given a node N, returns the list of N_Aspect_Specification nodes that - -- are attached to this declaration node. If the node is in the class of - -- declaration nodes that permit aspect specifications, as defined by the - -- predicate above, and if their Has_Aspects flag is set to True, then this - -- will always be a non-empty list. If this flag is set to False, then - -- No_List is returned. Normally, the only nodes that have Has_Aspects set - -- True are the nodes for which Permits_Aspect_Specifications would return - -- True (i.e. the declaration nodes defined in the RM as permitting the - -- presence of Aspect_Specifications). However, it is possible for the - -- flag Has_Aspects to be set on other nodes as a result of Rewrite and - -- Replace calls, and this function may be used to retrieve the aspect - -- specifications for the original rewritten node in such cases. - function Aspects_On_Body_Or_Stub_OK (N : Node_Id) return Boolean; -- N denotes a body [stub] with aspects. Determine whether all aspects of N -- are allowed to appear on a body [stub]. - procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id); - -- Exchange the aspect specifications of two nodes. If either node lacks an - -- aspect specification list, the routine has no effect. It is assumed that - -- both nodes can support aspects. + procedure Copy_Aspects (From : Node_Id; To : Node_Id); + -- Create a copy of Aspect of From and add them to To. function Find_Aspect (Id : Entity_Id; A : Aspect_Id; @@ -1197,6 +1181,9 @@ package Aspects is Class_Present : Boolean := False) return Boolean; -- Determine whether entity Id has aspect A (or A'Class, if Class_Present) + function Has_Aspects (N : Node_Id) return Boolean; + -- Returns whether the node has any aspect specifications + procedure Move_Aspects (From : Node_Id; To : Node_Id); -- Relocate the aspect specifications of node From to node To. On entry it -- is assumed that To does not have aspect specifications. If From has no @@ -1227,16 +1214,6 @@ package Aspects is -- a simple equality test because e.g. Post and Postcondition are the same. -- This is used for detecting duplicate aspects. - procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id); - -- The node N must be in the class of declaration nodes that permit aspect - -- specifications and the Has_Aspects flag must be False on entry. L must - -- be a non-empty list of N_Aspect_Specification nodes. This procedure sets - -- the Has_Aspects flag to True, and makes an entry that can be retrieved - -- by a subsequent Aspect_Specifications call. It is an error to call this - -- procedure with a node that does not permit aspect specifications, or a - -- node that has its Has_Aspects flag set True on entry, or with L being an - -- empty list or No_List. - package User_Aspect_Support is procedure Register_UAD_Pragma (UAD_Pragma : Node_Id); -- Argument is a User_Aspect_Definition pragma. diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 8e4c4437636..f265526afb7 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -24,7 +24,6 @@ ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion; -with Aspects; use Aspects; with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; @@ -1460,16 +1459,6 @@ package body Atree is Walk (New_Id, Source); - -- Explicitly copy the aspect specifications as those do not reside - -- in a node field. - - if Permits_Aspect_Specifications (Source) - and then Has_Aspects (Source) - then - Set_Aspect_Specifications - (New_Id, Copy_List (Aspect_Specifications (Source))); - end if; - -- Set Entity field to Empty to ensure that no entity references -- are shared between the two, if the source is already analyzed. @@ -1873,11 +1862,6 @@ package body Atree is Set_Is_Overloaded (New_Id, False); end if; - -- Always clear Has_Aspects, the caller must take care of copying - -- aspects if this is required for the particular situation. - - Set_Has_Aspects (New_Id, False); - -- Mark the copy as Ghost depending on the current Ghost region if Nkind (New_Id) in N_Entity then @@ -2156,7 +2140,6 @@ package body Atree is procedure Replace (Old_Node, New_Node : Node_Id) is Old_Post : constant Boolean := Error_Posted (Old_Node); - Old_HasA : constant Boolean := Has_Aspects (Old_Node); Old_CFS : constant Boolean := Comes_From_Source (Old_Node); procedure Destroy_New_Node; @@ -2183,7 +2166,6 @@ package body Atree is Copy_Node (Source => New_Node, Destination => Old_Node); Set_Comes_From_Source (Old_Node, Old_CFS); Set_Error_Posted (Old_Node, Old_Post); - Set_Has_Aspects (Old_Node, Old_HasA); -- Fix parents of substituted node, since it has changed identity @@ -2224,8 +2206,6 @@ package body Atree is Old_Is_IGN : constant Boolean := Is_Ignored_Ghost_Node (Old_Node); Old_Error_Posted : constant Boolean := Error_Posted (Old_Node); - Old_Has_Aspects : constant Boolean := - Has_Aspects (Old_Node); Old_Must_Not_Freeze : constant Boolean := (if Nkind (Old_Node) in N_Subexpr then Must_Not_Freeze (Old_Node) @@ -2261,27 +2241,12 @@ package body Atree is Sav_Node := New_Copy (Old_Node); Set_Original_Node (Sav_Node, Sav_Node); Set_Original_Node (Old_Node, Sav_Node); - - -- Both the old and new copies of the node will share the same list - -- of aspect specifications if aspect specifications are present. - -- Restore the parent link of the aspect list to the old node, which - -- is the one linked in the tree. - - if Old_Has_Aspects then - declare - Aspects : constant List_Id := Aspect_Specifications (Old_Node); - begin - Set_Aspect_Specifications (Sav_Node, Aspects); - Set_Parent (Aspects, Old_Node); - end; - end if; end if; -- Copy substitute node into place, preserving old fields as required Copy_Node (Source => New_Node, Destination => Old_Node); Set_Error_Posted (Old_Node, Old_Error_Posted); - Set_Has_Aspects (Old_Node, Old_Has_Aspects); Set_Check_Actuals (Old_Node, Old_CA); Set_Is_Ignored_Ghost_Node (Old_Node, Old_Is_IGN); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index bb015986200..0217f8d7eb0 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8960,6 +8960,10 @@ package body Exp_Ch3 is Subtype_Mark => New_Occurrence_Of (Etype (Def_Id), Loc), Name => Expr_Q)); + -- Keep original aspects + + Move_Aspects (Original_Node (N), N); + -- We do not analyze this renaming declaration, because all its -- components have already been analyzed, and if we were to go -- ahead and analyze it, we would in effect be trying to generate diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 0e6f950f5d7..1a2a027265c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -10121,6 +10121,7 @@ package body Exp_Ch6 is return Skip; when N_Abstract_Subprogram_Declaration + | N_Aspect_Specification | N_At_Clause | N_Call_Marker | N_Empty diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 239cda02ea7..b01cfc13bf9 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -1255,11 +1255,12 @@ package body Exp_Unst is return Skip; end if; - -- Pragmas and component declarations are ignored. Quantified - -- expressions are expanded into explicit loops and the - -- original epression must be ignored. + -- Aspects, pragmas and component declarations are ignored. + -- Quantified expressions are expanded into explicit loops + -- and the original epression must be ignored. - when N_Component_Declaration + when N_Aspect_Specification + | N_Component_Declaration | N_Pragma | N_Quantified_Expression => diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index a017f45d9a6..1b40cd9472e 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -50,7 +50,6 @@ package Gen_IL.Fields is Error_Posted, Small_Paren_Count, Check_Actuals, - Has_Aspects, Is_Ignored_Ghost_Node, Link, @@ -77,6 +76,7 @@ package Gen_IL.Fields is Array_Aggregate, Aspect_On_Partial_View, Aspect_Rep_Item, + Aspect_Specifications, Assignment_OK, Attribute_Name, At_End_Proc, diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index 0d2a68ea681..fdf928d60a3 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -62,7 +62,6 @@ begin -- Gen_IL.Gen.Gen_Nodes Sm (Error_Posted, Flag), Sm (Small_Paren_Count, Small_Paren_Count_Type), Sm (Check_Actuals, Flag), - Sm (Has_Aspects, Flag), Sm (Is_Ignored_Ghost_Node, Flag), Sm (Link, Union_Id))); @@ -591,6 +590,7 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sy (Defining_Identifier, Node_Id), Sy (Component_Definition, Node_Id), Sy (Expression, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (More_Ids, Flag), Sm (Prev_Ids, Flag))); @@ -600,11 +600,13 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Parameter_Specifications, List_Id, Default_No_List), Sy (Must_Override, Flag), Sy (Must_Not_Override, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Corresponding_Body, Node_Id))); Cc (N_Expression_Function, N_Declaration, (Sy (Specification, Node_Id), Sy (Expression, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Corresponding_Spec, Node_Id))); Cc (N_Formal_Object_Declaration, N_Declaration, @@ -615,6 +617,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Subtype_Mark, Node_Id, Default_Empty), Sy (Access_Definition, Node_Id, Default_Empty), Sy (Default_Expression, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (More_Ids, Flag), Sm (Prev_Ids, Flag))); @@ -623,12 +626,14 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Formal_Type_Definition, Node_Id), Sy (Discriminant_Specifications, List_Id, Default_No_List), Sy (Unknown_Discriminants_Present, Flag), - Sy (Default_Subtype_Mark, Node_Id))); + Sy (Default_Subtype_Mark, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Full_Type_Declaration, N_Declaration, (Sy (Defining_Identifier, Node_Id), Sy (Discriminant_Specifications, List_Id, Default_No_List), Sy (Type_Definition, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Discr_Check_Funcs_Built, Flag), Sm (Incomplete_View, Node_Id))); @@ -661,6 +666,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Object_Definition, Node_Id), Sy (Expression, Node_Id, Default_Empty), Sy (Has_Init_Expression, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Assignment_OK, Flag), Sm (Corresponding_Generic_Association, Node_Id), Sm (Exception_Junk, Flag), @@ -676,6 +682,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Discriminant_Specifications, List_Id, Default_No_List), Sy (Interface_List, List_Id, Default_No_List), Sy (Protected_Definition, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Corresponding_Body, Node_Id))); Cc (N_Private_Extension_Declaration, N_Declaration, @@ -687,6 +694,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Synchronized_Present, Flag), Sy (Subtype_Indication, Node_Id, Default_Empty), Sy (Interface_List, List_Id, Default_No_List), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Uninitialized_Variable, Node_Id))); Cc (N_Private_Type_Declaration, N_Declaration, @@ -695,12 +703,14 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Unknown_Discriminants_Present, Flag), Sy (Abstract_Present, Flag), Sy (Tagged_Present, Flag), - Sy (Limited_Present, Flag))); + Sy (Limited_Present, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Subtype_Declaration, N_Declaration, (Sy (Defining_Identifier, Node_Id), Sy (Null_Exclusion_Present, Flag, Default_False), Sy (Subtype_Indication, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Exception_Junk, Flag), Sm (Generic_Parent_Type, Node_Id))); @@ -721,6 +731,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Null_Present, Flag), Sy (Must_Override, Flag), Sy (Must_Not_Override, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Null_Statement, Node_Id))); Ab (N_Access_To_Subprogram_Definition, Node_Kind); @@ -751,6 +762,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Discriminant_Specifications, List_Id, Default_No_List), Sy (Interface_List, List_Id, Default_No_List), Sy (Task_Definition, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Corresponding_Body, Node_Id))); Ab (N_Body_Stub, N_Later_Decl_Item, @@ -759,16 +771,20 @@ begin -- Gen_IL.Gen.Gen_Nodes Sm (Library_Unit, Node_Id))); Cc (N_Package_Body_Stub, N_Body_Stub, - (Sy (Defining_Identifier, Node_Id))); + (Sy (Defining_Identifier, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Protected_Body_Stub, N_Body_Stub, - (Sy (Defining_Identifier, Node_Id))); + (Sy (Defining_Identifier, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Subprogram_Body_Stub, N_Body_Stub, - (Sy (Specification, Node_Id))); + (Sy (Specification, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Task_Body_Stub, N_Body_Stub, - (Sy (Defining_Identifier, Node_Id))); + (Sy (Defining_Identifier, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Ab (N_Generic_Instantiation, N_Later_Decl_Item, (Sm (Instance_Spec, Node_Id), @@ -786,19 +802,22 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Name, Node_Id, Default_Empty), Sy (Generic_Associations, List_Id, Default_No_List), Sy (Must_Override, Flag), - Sy (Must_Not_Override, Flag))); + Sy (Must_Not_Override, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Procedure_Instantiation, N_Subprogram_Instantiation, (Sy (Defining_Unit_Name, Node_Id), Sy (Name, Node_Id, Default_Empty), Sy (Generic_Associations, List_Id, Default_No_List), Sy (Must_Override, Flag), - Sy (Must_Not_Override, Flag))); + Sy (Must_Not_Override, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Package_Instantiation, N_Generic_Instantiation, (Sy (Defining_Unit_Name, Node_Id), Sy (Name, Node_Id, Default_Empty), - Sy (Generic_Associations, List_Id, Default_No_List))); + Sy (Generic_Associations, List_Id, Default_No_List), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Ab (N_Proper_Body, N_Later_Decl_Item, (Sm (Corresponding_Spec, Node_Id), @@ -810,7 +829,8 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sy (Defining_Unit_Name, Node_Id), Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), - Sy (At_End_Proc, Node_Id, Default_Empty))); + Sy (At_End_Proc, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Subprogram_Body, N_Unit_Body, (Sy (Specification, Node_Id), @@ -818,6 +838,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (Bad_Is_Detected, Flag), Sy (At_End_Proc, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Activation_Chain_Entity, Node_Id), Sm (Acts_As_Spec, Flag), Sm (Corresponding_Entry_Body, Node_Id), @@ -833,13 +854,15 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Protected_Body, N_Proper_Body, (Sy (Defining_Identifier, Node_Id), Sy (Declarations, List_Id, Default_No_List), - Sy (End_Label, Node_Id, Default_Empty))); + Sy (End_Label, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Task_Body, N_Proper_Body, (Sy (Defining_Identifier, Node_Id), Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (At_End_Proc, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Activation_Chain_Entity, Node_Id), Sm (Is_Task_Master, Flag))); @@ -849,6 +872,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Package_Declaration, N_Later_Decl_Item, (Sy (Specification, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Activation_Chain_Entity, Node_Id), Sm (Corresponding_Body, Node_Id), Sm (Parent_Spec, Node_Id))); @@ -856,10 +880,12 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Single_Task_Declaration, N_Later_Decl_Item, (Sy (Defining_Identifier, Node_Id), Sy (Interface_List, List_Id, Default_No_List), - Sy (Task_Definition, Node_Id, Default_Empty))); + Sy (Task_Definition, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Subprogram_Declaration, N_Later_Decl_Item, (Sy (Specification, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Body_To_Inline, Node_Id), Sm (Corresponding_Body, Node_Id), Sm (Is_Entry_Barrier_Function, Flag), @@ -883,11 +909,13 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Generic_Package_Declaration, N_Generic_Declaration, (Sy (Specification, Node_Id), Sy (Generic_Formal_Declarations, List_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Activation_Chain_Entity, Node_Id))); Cc (N_Generic_Subprogram_Declaration, N_Generic_Declaration, (Sy (Specification, Node_Id), - Sy (Generic_Formal_Declarations, List_Id))); + Sy (Generic_Formal_Declarations, List_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Ab (N_Array_Type_Definition, Node_Kind); @@ -903,7 +931,8 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Exception_Renaming_Declaration, N_Renaming_Declaration, (Sy (Defining_Identifier, Node_Id), - Sy (Name, Node_Id, Default_Empty))); + Sy (Name, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Object_Renaming_Declaration, N_Renaming_Declaration, (Sy (Defining_Identifier, Node_Id), @@ -911,24 +940,28 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Subtype_Mark, Node_Id, Default_Empty), Sy (Access_Definition, Node_Id, Default_Empty), Sy (Name, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Comes_From_Iterator, Flag), Sm (Corresponding_Generic_Association, Node_Id))); Cc (N_Package_Renaming_Declaration, N_Renaming_Declaration, (Sy (Defining_Unit_Name, Node_Id), Sy (Name, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Parent_Spec, Node_Id))); Cc (N_Subprogram_Renaming_Declaration, N_Renaming_Declaration, (Sy (Specification, Node_Id), Sy (Name, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Corresponding_Formal_Spec, Node_Id), Sm (Corresponding_Spec, Node_Id), Sm (From_Default, Flag), Sm (Parent_Spec, Node_Id))); Ab (N_Generic_Renaming_Declaration, N_Renaming_Declaration, - (Sm (Parent_Spec, Node_Id))); + (Sy (Aspect_Specifications, List_Id, Default_No_List), + Sm (Parent_Spec, Node_Id))); Cc (N_Generic_Function_Renaming_Declaration, N_Generic_Renaming_Declaration, (Sy (Defining_Unit_Name, Node_Id), @@ -1148,13 +1181,15 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sy (Specification, Node_Id), Sy (Default_Name, Node_Id, Default_Empty), Sy (Expression, Node_Id, Default_Empty), - Sy (Box_Present, Flag))); + Sy (Box_Present, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Formal_Concrete_Subprogram_Declaration, N_Formal_Subprogram_Declaration, (Sy (Specification, Node_Id), Sy (Default_Name, Node_Id, Default_Empty), Sy (Expression, Node_Id, Default_Empty), - Sy (Box_Present, Flag))); + Sy (Box_Present, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Ab (N_Push_Pop_xxx_Label, Node_Kind); @@ -1191,7 +1226,8 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sy (Statements, List_Id, Default_Empty_List))); Cc (N_Abstract_Subprogram_Declaration, Node_Kind, - (Sy (Specification, Node_Id))); + (Sy (Specification, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Access_Definition, Node_Kind, (Sy (Null_Exclusion_Present, Flag, Default_False), @@ -1215,6 +1251,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sm (Aspect_On_Partial_View, Flag), Sm (Aspect_Rep_Item, Node_Id), Sm (Entity_Or_Associated_Node, Node_Id), -- just Entity + Sm (Expression_Copy, Node_Id), Sm (Is_Boolean_Aspect, Flag), Sm (Is_Checked, Flag), Sm (Is_Delayed_Aspect, Flag), @@ -1347,6 +1384,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (At_End_Proc, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Activation_Chain_Entity, Node_Id), Sm (Corresponding_Spec, Node_Id))); @@ -1361,6 +1399,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Exception_Declaration, N_Declaration, (Sy (Defining_Identifier, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Expression, Node_Id), Sm (More_Ids, Flag), Sm (Prev_Ids, Flag), @@ -1402,6 +1441,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Name, Node_Id, Default_Empty), Sy (Generic_Associations, List_Id, Default_No_List), Sy (Box_Present, Flag), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Instance_Spec, Node_Id), Sm (Is_Known_Guaranteed_ABE, Flag))); @@ -1485,6 +1525,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Visible_Declarations, List_Id), Sy (Private_Declarations, List_Id, Default_No_List), Sy (End_Label, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Generic_Parent, Node_Id), Sm (Limited_View_Installed, Flag))); @@ -1502,6 +1543,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Null_Exclusion_Present, Flag, Default_False), Sy (Parameter_Type, Node_Id), Sy (Expression, Node_Id, Default_Empty), + Sy (Aspect_Specifications, List_Id, Default_No_List), Sm (Default_Expression, Node_Id), Sm (More_Ids, Flag), Sm (Prev_Ids, Flag))); @@ -1560,7 +1602,8 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Single_Protected_Declaration, Node_Kind, (Sy (Defining_Identifier, Node_Id), Sy (Interface_List, List_Id, Default_No_List), - Sy (Protected_Definition, Node_Id))); + Sy (Protected_Definition, Node_Id), + Sy (Aspect_Specifications, List_Id, Default_No_List))); Cc (N_Subunit, Node_Kind, (Sy (Name, Node_Id, Default_Empty), diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 6cf87ce29b1..ceb5d0ad7df 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -2029,9 +2029,6 @@ package body Ghost is Rewrite (N, Make_Null_Statement (Sloc (N))); - -- Eliminate any aspects hanging off the ignored Ghost node - - Remove_Aspects (N); end if; end Remove_Ignored_Ghost_Node; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 4e8d0f1bb74..5fff88144b2 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -3629,16 +3629,9 @@ package body Inline is function Process_Formals_In_Aspects (N : Node_Id) return Traverse_Result is - A : Node_Id; - begin - if Has_Aspects (N) then - A := First (Aspect_Specifications (N)); - while Present (A) loop - Replace_Formals (Expression (A)); - - Next (A); - end loop; + if Nkind (N) = N_Aspect_Specification then + Replace_Formals (Expression (N)); end if; return OK; end Process_Formals_In_Aspects; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 075af019fee..85adad2d782 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -945,7 +945,6 @@ package body Ch13 is -- Here aspects are allowed, and we store them else - Set_Parent (Aspects, Decl); Set_Aspect_Specifications (Decl, Aspects); end if; end if; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 3171c5c3ce1..f041bbb2e49 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -935,7 +935,6 @@ package body Ch6 is -- the body. if Is_Non_Empty_List (Aspects) then - Set_Parent (Aspects, Body_Node); Set_Aspect_Specifications (Body_Node, Aspects); end if; @@ -974,7 +973,6 @@ package body Ch6 is else if Is_Non_Empty_List (Aspects) then - Set_Parent (Aspects, Decl_Node); Set_Aspect_Specifications (Decl_Node, Aspects); end if; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 5e65fa25de1..0639ca616e0 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -1689,6 +1689,10 @@ package body Par_SCO is C1 : Character; begin + if not Has_Aspects (N) then + return; + end if; + AN := First (Aspect_Specifications (N)); while Present (AN) loop AE := Expression (AN); @@ -2408,8 +2412,6 @@ package body Par_SCO is end if; end case; - -- Process aspects if present - Traverse_Aspects (N); end Traverse_One; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 90d2f3c6c74..7cca555f276 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1697,9 +1697,7 @@ package body Sem_Ch10 is Mutate_Ekind (Id, E_Package_Body); Set_Etype (Id, Standard_Void_Type); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); Set_Has_Completion (Nam); Set_Corresponding_Spec_Of_Stub (N, Nam); @@ -2039,9 +2037,7 @@ package body Sem_Ch10 is Mutate_Ekind (Id, E_Protected_Body); Set_Etype (Id, Standard_Void_Type); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); Set_Has_Completion (Etype (Nam)); Set_Corresponding_Spec_Of_Stub (N, Nam); @@ -2693,9 +2689,7 @@ package body Sem_Ch10 is Mutate_Ekind (Id, E_Task_Body); Set_Etype (Id, Standard_Void_Type); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); Generate_Reference (Nam, Id, 'b'); Set_Corresponding_Spec_Of_Stub (N, Nam); diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 73eca7a603e..eda3232264c 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -70,9 +70,7 @@ package body Sem_Ch11 is Set_Is_Statically_Allocated (Id); Set_Is_Pure (Id, PF); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); end Analyze_Exception_Declaration; -------------------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 80b3e16ea75..582940da74b 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2469,6 +2469,11 @@ package body Sem_Ch12 is Make_Full_Type_Declaration (Loc, Defining_Identifier => T, Type_Definition => Def)); + + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Analyze (N); Set_Is_Generic_Type (T); end Analyze_Formal_Derived_Interface_Type; @@ -2519,6 +2524,11 @@ package body Sem_Ch12 is end if; Rewrite (N, New_N); + + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Analyze (N); if Unk_Disc then @@ -2651,6 +2661,11 @@ package body Sem_Ch12 is Type_Definition => Def); Rewrite (N, New_N); + + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Analyze (N); Set_Is_Generic_Type (T); end Analyze_Formal_Interface_Type; @@ -2817,9 +2832,7 @@ package body Sem_Ch12 is end if; end if; - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); if Parent_Installed then Remove_Parent; @@ -3273,12 +3286,10 @@ package body Sem_Ch12 is Set_Has_Completion (Pack_Id, True); <> - if Has_Aspects (N) then - -- Unclear that any other aspects may appear here, analyze them - -- for completion, given that the grammar allows their appearance. + -- Unclear that any other aspects may appear here, analyze them + -- for completion, given that the grammar allows their appearance. - Analyze_Aspect_Specifications (N, Pack_Id); - end if; + Analyze_Aspect_Specifications (N, Pack_Id); Ignore_SPARK_Mode_Pragmas_In_Instance := Save_ISMP; end Analyze_Formal_Package_Declaration; @@ -3593,9 +3604,7 @@ package body Sem_Ch12 is end if; <> - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Nam); - end if; + Analyze_Aspect_Specifications (N, Nam); if Parent_Installed then Remove_Parent; @@ -3689,9 +3698,7 @@ package body Sem_Ch12 is Validate_Formal_Type_Default (N); end if; - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, T); - end if; + Analyze_Aspect_Specifications (N, T); if Parent_Installed then Remove_Parent; @@ -3839,11 +3846,6 @@ package body Sem_Ch12 is Set_Parent_Spec (New_N, Save_Parent); Rewrite (N, New_N); - -- Once the contents of the generic copy and the template are swapped, - -- do the same for their respective aspect specifications. - - Exchange_Aspects (N, New_N); - -- Collect all contract-related source pragmas found within the template -- and attach them to the contract of the package spec. This contract is -- used in the capture of global references within annotations. @@ -3881,9 +3883,7 @@ package body Sem_Ch12 is -- Analyze aspects now, so that generated pragmas appear in the -- declarations before building and analyzing the generic copy. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); Push_Scope (Id); Enter_Generic_Scope (Id); @@ -4003,11 +4003,6 @@ package body Sem_Ch12 is Set_Parent_Spec (New_N, Save_Parent); Rewrite (N, New_N); - -- Once the contents of the generic copy and the template are swapped, - -- do the same for their respective aspect specifications. - - Exchange_Aspects (N, New_N); - -- Collect all contract-related source pragmas found within the template -- and attach them to the contract of the subprogram spec. This contract -- is used in the capture of global references within annotations. @@ -4112,9 +4107,7 @@ package body Sem_Ch12 is -- Analyze the aspects of the generic copy to ensure that all generated -- pragmas (if any) perform their semantic effects. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); -- For a library unit, we have reconstructed the entity for the unit, -- and must reset it in the library tables. We also make sure that @@ -4950,9 +4943,7 @@ package body Sem_Ch12 is -- take into account categorization pragmas before analyzing the -- instance. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Act_Decl_Id); - end if; + Analyze_Aspect_Specifications (N, Act_Decl_Id); Analyze (Act_Decl); Set_Unit (Parent (N), N); @@ -5065,7 +5056,7 @@ package body Sem_Ch12 is end if; <> - if Has_Aspects (N) and then Nkind (Parent (N)) /= N_Compilation_Unit then + if Nkind (Parent (N)) /= N_Compilation_Unit then Analyze_Aspect_Specifications (N, Act_Decl_Id); end if; @@ -6355,14 +6346,6 @@ package body Sem_Ch12 is Rewrite (N, Act_Body); - -- Propagate the aspect specifications from the package body template to - -- the instantiated version of the package body. - - if Has_Aspects (Act_Body) then - Set_Aspect_Specifications - (N, New_Copy_List_Tree (Aspect_Specifications (Act_Body))); - end if; - Body_Cunit := Parent (N); -- The two compilation unit nodes are linked by the Library_Unit field @@ -8081,14 +8064,6 @@ package body Sem_Ch12 is New_N := New_Copy (N); - -- Copy aspects if present - - if Has_Aspects (N) then - Set_Has_Aspects (New_N, False); - Set_Aspect_Specifications - (New_N, Copy_Generic_List (Aspect_Specifications (N), Parent_Id)); - end if; - -- If we are instantiating, we want to adjust the sloc based on the -- current S_Adjustment. However, if this is the root node of a subunit, -- we need to defer that adjustment to below (see "elsif Instantiating @@ -16878,29 +16853,40 @@ package body Sem_Ch12 is elsif Nkind (N) = N_Pragma then Save_References_In_Pragma (N); - else - Save_References_In_Descendants (N); - end if; + elsif Nkind (N) = N_Aspect_Specification then + declare + P : constant Node_Id := Parent (N); + Expr : Node_Id; + begin - -- Save all global references found within the aspect specifications - -- of the related node. + if Permits_Aspect_Specifications (P) then - if Permits_Aspect_Specifications (N) and then Has_Aspects (N) then + -- The capture of global references within aspects + -- associated with generic packages, subprograms or + -- their bodies must be delayed due to timing of + -- annotation analysis. Global references are still + -- captured in routine Save_Global_References_In_Contract. - -- The capture of global references within aspects associated with - -- generic packages, subprograms or their bodies must be delayed - -- due to timing of annotation analysis. Global references are - -- still captured in routine Save_Global_References_In_Contract. + if Requires_Delayed_Save (Original_Node (P)) then + null; - if Requires_Delayed_Save (N) then - null; + -- Otherwise save all global references within the + -- aspects - -- Otherwise save all global references within the aspects + else + Expr := Expression (N); - else - Save_Global_References_In_Aspects (N); - end if; + if Present (Expr) then + Save_Global_References (Expr); + end if; + end if; + end if; + end; + + else + Save_References_In_Descendants (N); end if; + end Save_References; --------------------- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ae97da58da3..5747ee9c539 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1673,7 +1673,6 @@ package body Sem_Ch13 is Ent : Node_Id; L : constant List_Id := Aspect_Specifications (N); - pragma Assert (Present (L)); Ins_Node : Node_Id := N; -- Insert pragmas/attribute definition clause after this node when no @@ -1702,6 +1701,10 @@ package body Sem_Ch13 is -- visibility for the expression analysis. Thus, we just insert the -- pragma after the node N. + if No (L) then + return; + end if; + -- Loop through aspects Aspect := First (L); @@ -2880,9 +2883,9 @@ package body Sem_Ch13 is -- requires its own analysis procedure (see sem_ch6). if Nkind (Expr) = N_Operator_Symbol then - Set_Entity (Id, Expr); + Set_Expression_Copy (Aspect, Expr); else - Set_Entity (Id, New_Copy_Tree (Expr)); + Set_Expression_Copy (Aspect, New_Copy_Tree (Expr)); end if; -- Set Delay_Required as appropriate to aspect @@ -5122,7 +5125,10 @@ package body Sem_Ch13 is -- aspects are allowed to break this rule (for all applicable cases, see -- table Aspects.Aspect_On_Body_Or_Stub_OK). - if Spec_Id /= Body_Id and then not Aspects_On_Body_Or_Stub_OK (N) then + if Spec_Id /= Body_Id + and then Has_Aspects (N) + and then not Aspects_On_Body_Or_Stub_OK (N) + then Diagnose_Misplaced_Aspects (Spec_Id); else Analyze_Aspect_Specifications (N, Body_Id); @@ -10339,7 +10345,7 @@ package body Sem_Ch13 is -- Check_Aspect_At_xxx routines. if Present (Asp) then - Set_Entity (Identifier (Asp), New_Copy_Tree (Arg2_Copy)); + Set_Expression_Copy (Asp, New_Copy_Tree (Arg2_Copy)); end if; -- "and"-in the Arg2 condition to evolving expression @@ -11008,7 +11014,7 @@ package body Sem_Ch13 is Ident : constant Node_Id := Identifier (ASN); A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident)); - End_Decl_Expr : constant Node_Id := Entity (Ident); + End_Decl_Expr : constant Node_Id := Expression_Copy (ASN); -- Expression to be analyzed at end of declarations Freeze_Expr : constant Node_Id := Expression (ASN); @@ -11262,7 +11268,7 @@ package body Sem_Ch13 is -- Make a copy of the expression to be preanalyzed - Set_Expression (ASN, New_Copy_Tree (Entity (Ident))); + Set_Expression (ASN, New_Copy_Tree (Expression_Copy (ASN))); -- Find type for preanalyze call diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 8583ac05261..a38275133f4 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2311,9 +2311,7 @@ package body Sem_Ch3 is Set_Original_Record_Component (Id, Id); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); Analyze_Dimension (N); end Analyze_Component_Declaration; @@ -3525,25 +3523,22 @@ package body Sem_Ch3 is -- them to the entity for the type which is currently the partial -- view, but which is the one that will be frozen. - if Has_Aspects (N) then - - -- In most cases the partial view is a private type, and both views - -- appear in different declarative parts. In the unusual case where - -- the partial view is incomplete, perform the analysis on the - -- full view, to prevent freezing anomalies with the corresponding - -- class-wide type, which otherwise might be frozen before the - -- dispatch table is built. + -- In most cases the partial view is a private type, and both views + -- appear in different declarative parts. In the unusual case where + -- the partial view is incomplete, perform the analysis on the + -- full view, to prevent freezing anomalies with the corresponding + -- class-wide type, which otherwise might be frozen before the + -- dispatch table is built. - if Prev /= Def_Id - and then Ekind (Prev) /= E_Incomplete_Type - then - Analyze_Aspect_Specifications (N, Prev); + if Prev /= Def_Id + and then Ekind (Prev) /= E_Incomplete_Type + then + Analyze_Aspect_Specifications (N, Prev); - -- Normal case + -- Normal case - else - Analyze_Aspect_Specifications (N, Def_Id); - end if; + else + Analyze_Aspect_Specifications (N, Def_Id); end if; if Is_Derived_Type (Prev) @@ -5323,9 +5318,7 @@ package body Sem_Ch3 is Set_Encapsulating_State (Id, Empty); end if; - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); Analyze_Dimension (N); @@ -5604,9 +5597,7 @@ package body Sem_Ch3 is Set_Has_Private_Extension (Parent_Type); <> - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, T); - end if; + Analyze_Aspect_Specifications (N, T); end Analyze_Private_Extension_Declaration; --------------------------------- @@ -6226,9 +6217,7 @@ package body Sem_Ch3 is Check_Eliminated (Id); <> - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); Analyze_Dimension (N); @@ -7195,6 +7184,11 @@ package body Sem_Ch3 is Constraint => Constraint (Indic))); Rewrite (N, New_Indic); + + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Analyze (N); end if; @@ -7374,6 +7368,10 @@ package body Sem_Ch3 is Defining_Identifier => Derived_Type, Subtype_Indication => New_Indic)); + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Analyze (N); return; end; @@ -7802,12 +7800,16 @@ package body Sem_Ch3 is Make_Range_Constraint (Loc, Range_Expression => Rang_Expr)))); + -- Keep the aspects from the orignal node + + Move_Aspects (Original_Node (N), N); + Analyze (N); -- Propagate the aspects from the original type declaration to the -- declaration of the implicit base. - Move_Aspects (From => Original_Node (N), To => Type_Decl); + Copy_Aspects (From => N, To => Type_Decl); -- Apply a range check. Since this range expression doesn't have an -- Etype, we have to specifically pass the Source_Typ parameter. Is @@ -9466,6 +9468,10 @@ package body Sem_Ch3 is Defining_Identifier => Derived_Type, Subtype_Indication => New_Indic)); + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Analyze (N); -- Derivation of subprograms must be delayed until the full subtype @@ -10041,6 +10047,11 @@ package body Sem_Ch3 is Replace_Discriminants (Derived_Type, New_Decl); end if; + -- Relocate the aspects from the original type + + Remove_Aspects (New_Decl); + Move_Aspects (N, New_Decl); + -- Insert the new derived type declaration Rewrite (N, New_Decl); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 00f7e379cb2..3dd265901dd 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -290,9 +290,7 @@ package body Sem_Ch6 is Generate_Reference_To_Formals (Subp_Id); Check_Eliminated (Subp_Id); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Subp_Id); - end if; + Analyze_Aspect_Specifications (N, Subp_Id); end Analyze_Abstract_Subprogram_Declaration; --------------------------------- @@ -430,11 +428,10 @@ package body Sem_Ch6 is Generate_Reference (Prev, Defining_Entity (N), 'b', Force => True); Rewrite (N, New_Body); - -- Remove any existing aspects from the original node because the act - -- of rewriting causes the list to be shared between the two nodes. + -- Keep the aspects from the original node Orig_N := Original_Node (N); - Remove_Aspects (Orig_N); + Move_Aspects (Orig_N, N); -- Propagate any pragmas that apply to expression function to the -- proper body when the expression function acts as a completion. @@ -488,11 +485,10 @@ package body Sem_Ch6 is Rewrite (N, Make_Subprogram_Declaration (Loc, Specification => Spec)); - -- Remove any existing aspects from the original node because the act - -- of rewriting causes the list to be shared between the two nodes. + -- Keep the aspects from the original node Orig_N := Original_Node (N); - Remove_Aspects (Orig_N); + Move_Aspects (Orig_N, N); Analyze (N); @@ -1139,11 +1135,6 @@ package body Sem_Ch6 is New_N := Copy_Generic_Node (N, Empty, Instantiating => False); Rewrite (N, New_N); - -- Once the contents of the generic copy and the template are - -- swapped, do the same for their respective aspect specifications. - - Exchange_Aspects (N, New_N); - -- Collect all contract-related source pragmas found within the -- template and attach them to the contract of the subprogram body. -- This contract is used in the capture of global references within @@ -1289,9 +1280,7 @@ package body Sem_Ch6 is -- Analyze any aspect specifications that appear on the generic -- subprogram body. - if Has_Aspects (N) then - Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); - end if; + Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); -- Process the contract of the subprogram body after analyzing all -- the contract-related pragmas within the declarations. @@ -1506,6 +1495,7 @@ package body Sem_Ch6 is Is_Completion := True; Rewrite (N, Null_Body); + Move_Aspects (Original_Node (N), N); Analyze (N); end if; @@ -4363,9 +4353,7 @@ package body Sem_Ch6 is -- or a statement part, and it cannot be inlined. if Nkind (N) = N_Subprogram_Body_Stub then - if Has_Aspects (N) then - Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); - end if; + Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); goto Leave; end if; @@ -4612,9 +4600,7 @@ package body Sem_Ch6 is -- Analyze any aspect specifications that appear on the subprogram body - if Has_Aspects (N) then - Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); - end if; + Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); -- Process the contract of the subprogram body after analyzing all the -- contract-related pragmas within the declarations. @@ -5251,9 +5237,7 @@ package body Sem_Ch6 is -- case the subprogram is a compilation unit and one of its aspects is -- converted into a categorization pragma. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Designator); - end if; + Analyze_Aspect_Specifications (N, Designator); -- The legality of a function specification in SPARK depends on whether -- the function is a function with or without side-effects. Analyze the diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 1a49a53ad63..21a22267590 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -877,11 +877,6 @@ package body Sem_Ch7 is New_N := Copy_Generic_Node (N, Empty, Instantiating => False); Rewrite (N, New_N); - -- Once the contents of the generic copy and the template are - -- swapped, do the same for their respective aspect specifications. - - Exchange_Aspects (N, New_N); - -- Collect all contract-related source pragmas found within the -- template and attach them to the contract of the package body. -- This contract is used in the capture of global references within @@ -929,9 +924,7 @@ package body Sem_Ch7 is Set_Has_Completion (Spec_Id); Last_Spec_Entity := Last_Entity (Spec_Id); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Body_Id); - end if; + Analyze_Aspect_Specifications (N, Body_Id); Push_Scope (Spec_Id); @@ -1213,9 +1206,7 @@ package body Sem_Ch7 is -- Analyze aspect specifications immediately, since we need to recognize -- things like Pure early enough to diagnose violations during analysis. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); -- Ada 2005 (AI-217): Check if the package has been illegally named in -- a limited-with clause of its own context. In this case the error has @@ -2094,9 +2085,7 @@ package body Sem_Ch7 is Set_SPARK_Pragma (Id, SPARK_Mode_Pragma); Set_SPARK_Pragma_Inherited (Id); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); end Analyze_Private_Type_Declaration; ---------------------------------- diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 0d3c2349284..7f6accd7768 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -605,9 +605,7 @@ package body Sem_Ch8 is -- declaration, but not language-defined ones. The call to procedure -- Analyze_Aspect_Specifications will take care of this error check. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); end Analyze_Exception_Renaming; --------------------------- @@ -753,9 +751,7 @@ package body Sem_Ch8 is -- declaration, but not language-defined ones. The call to procedure -- Analyze_Aspect_Specifications will take care of this error check. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, New_P); - end if; + Analyze_Aspect_Specifications (N, New_P); end Analyze_Generic_Renaming; ----------------------------- @@ -1582,9 +1578,7 @@ package body Sem_Ch8 is -- declaration, but not language-defined ones. The call to procedure -- Analyze_Aspect_Specifications will take care of this error check. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Id); - end if; + Analyze_Aspect_Specifications (N, Id); -- Deal with dimensions @@ -1765,9 +1759,7 @@ package body Sem_Ch8 is -- declaration, but not language-defined ones. The call to procedure -- Analyze_Aspect_Specifications will take care of this error check. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, New_P); - end if; + Analyze_Aspect_Specifications (N, New_P); end Analyze_Package_Renaming; ------------------------------- @@ -4205,9 +4197,7 @@ package body Sem_Ch8 is -- declaration, but not language-defined ones. The call to procedure -- Analyze_Aspect_Specifications will take care of this error check. - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, New_S); - end if; + Analyze_Aspect_Specifications (N, New_S); -- AI12-0279 diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 72821c51c3f..365887cbe14 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1292,9 +1292,7 @@ package body Sem_Ch9 is -- Analyze any aspect specifications that appear on the entry body - if Has_Aspects (N) then - Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); - end if; + Analyze_Aspects_On_Subprogram_Body_Or_Stub (N); E := First_Entity (P_Type); while Present (E) loop @@ -1729,9 +1727,7 @@ package body Sem_Ch9 is Generate_Reference_To_Formals (Def_Id); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Def_Id); - end if; + Analyze_Aspect_Specifications (N, Def_Id); end Analyze_Entry_Declaration; --------------------------------------- @@ -1880,9 +1876,7 @@ package body Sem_Ch9 is Spec_Id := Etype (Spec_Id); end if; - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Body_Id); - end if; + Analyze_Aspect_Specifications (N, Body_Id); Push_Scope (Spec_Id); Set_Corresponding_Spec (N, Spec_Id); @@ -2046,9 +2040,7 @@ package body Sem_Ch9 is if No_Run_Time_Mode then Error_Msg_CRT ("protected type", N); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Def_Id); - end if; + Analyze_Aspect_Specifications (N, Def_Id); return; end if; @@ -2128,18 +2120,15 @@ package body Sem_Ch9 is -- If aspects are present, analyze them now. They can make references to -- the discriminants of the type, but not to any components. - if Has_Aspects (N) then - - -- The protected type is the full view of a private type. Analyze the - -- aspects with the entity of the private type to ensure that after - -- both views are exchanged, the aspect are actually associated with - -- the full view. + -- The protected type is the full view of a private type. Analyze the + -- aspects with the entity of the private type to ensure that after + -- both views are exchanged, the aspect are actually associated with + -- the full view. - if T /= Def_Id and then Is_Private_Type (Def_Id) then - Analyze_Aspect_Specifications (N, T); - else - Analyze_Aspect_Specifications (N, Def_Id); - end if; + if T /= Def_Id and then Is_Private_Type (Def_Id) then + Analyze_Aspect_Specifications (N, T); + else + Analyze_Aspect_Specifications (N, Def_Id); end if; Analyze (Protected_Definition (N)); @@ -2873,6 +2862,10 @@ package body Sem_Ch9 is -- Obj : Typ; + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Obj_Decl := Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, @@ -2915,9 +2908,7 @@ package body Sem_Ch9 is Analyze_Protected_Type_Declaration (N); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Obj_Id); - end if; + Analyze_Aspect_Specifications (N, Obj_Id); end Analyze_Single_Protected_Declaration; ------------------------------------- @@ -2959,6 +2950,10 @@ package body Sem_Ch9 is -- Obj : Typ; + -- Keep the aspects from the original node + + Move_Aspects (Original_Node (N), N); + Obj_Decl := Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, @@ -3011,9 +3006,7 @@ package body Sem_Ch9 is Analyze_Task_Type_Declaration (N); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Obj_Id); - end if; + Analyze_Aspect_Specifications (N, Obj_Id); end Analyze_Single_Task_Declaration; ----------------------- @@ -3094,9 +3087,7 @@ package body Sem_Ch9 is Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); Set_SPARK_Pragma_Inherited (Body_Id); - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Body_Id); - end if; + Analyze_Aspect_Specifications (N, Body_Id); Push_Scope (Spec_Id); Set_Corresponding_Spec (N, Spec_Id); @@ -3325,18 +3316,15 @@ package body Sem_Ch9 is Set_Is_Constrained (T, not Has_Discriminants (T)); - if Has_Aspects (N) then + -- The task type is the full view of a private type. Analyze the + -- aspects with the entity of the private type to ensure that after + -- both views are exchanged, the aspect are actually associated with + -- the full view. - -- The task type is the full view of a private type. Analyze the - -- aspects with the entity of the private type to ensure that after - -- both views are exchanged, the aspect are actually associated with - -- the full view. - - if T /= Def_Id and then Is_Private_Type (Def_Id) then - Analyze_Aspect_Specifications (N, T); - else - Analyze_Aspect_Specifications (N, Def_Id); - end if; + if T /= Def_Id and then Is_Private_Type (Def_Id) then + Analyze_Aspect_Specifications (N, T); + else + Analyze_Aspect_Specifications (N, Def_Id); end if; if Present (Task_Definition (N)) then diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index cc191dfa983..816870fc70a 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -23,7 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Aspects; use Aspects; with Atree; use Atree; with Einfo; use Einfo; with Einfo.Entities; use Einfo.Entities; @@ -2922,7 +2921,6 @@ package body Sem_Dim is Subtype_Indication => New_Occurrence_Of (Btyp_Of_L, Loc)); Append (New_Aspect, New_Aspects); - Set_Parent (New_Aspects, New_Subtyp_Decl_For_L); Set_Aspect_Specifications (New_Subtyp_Decl_For_L, New_Aspects); Analyze (New_Subtyp_Decl_For_L); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index b22407aafb8..ab7bc40978a 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -23,7 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; with Elists; use Elists; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index cfd8b88a26e..afe69da6a84 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -23601,11 +23601,6 @@ package body Sem_Util is Set_Chars (Result, Chars (Entity (Result))); end if; end if; - - if Has_Aspects (N) then - Set_Aspect_Specifications (Result, - Copy_List_With_Replacement (Aspect_Specifications (N))); - end if; end if; return Result; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 0a8bf55ca61..cf938d4f226 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -187,7 +187,6 @@ package body Treepr is -- Called if the node being printed is an entity. Prints fields from the -- extension, using routines in Einfo to get the field names and flags. - procedure Print_Field (Val : Union_Id; Format : UI_Format := Auto); procedure Print_Field (Prefix : String; Field : String; @@ -726,51 +725,6 @@ package body Treepr is function Get_Mechanism_Type is new Get_32_Bit_Field (Mechanism_Type) with Inline, Unreferenced; - procedure Print_Field (Val : Union_Id; Format : UI_Format := Auto) is - begin - if Phase /= Printing then - return; - end if; - - if Val in Node_Range then - Print_Node_Ref (Node_Id (Val)); - - elsif Val in List_Range then - Print_List_Ref (List_Id (Val)); - - elsif Val in Elist_Range then - Print_Elist_Ref (Elist_Id (Val)); - - elsif Val in Names_Range then - Print_Name (Name_Id (Val)); - Write_Str (" (Name_Id="); - Write_Int (Int (Val)); - Write_Char (')'); - - elsif Val in Strings_Range then - Write_String_Table_Entry (String_Id (Val)); - Write_Str (" (String_Id="); - Write_Int (Int (Val)); - Write_Char (')'); - - elsif Val in Uint_Range then - UI_Write (From_Union (Val), Format); - Write_Str (" (Uint = "); - Write_Int (Int (Val)); - Write_Char (')'); - - elsif Val in Ureal_Range then - UR_Write (From_Union (Val)); - Write_Str (" (Ureal = "); - Write_Int (Int (Val)); - Write_Char (')'); - - else - Print_Str ("****** Incorrect value = "); - Print_Int (Int (Val)); - end if; - end Print_Field; - procedure Print_Field (Prefix : String; Field : String; @@ -1393,7 +1347,6 @@ package body Treepr is | F_Assignment_OK | F_Do_Range_Check | F_Has_Dynamic_Length_Check - | F_Has_Aspects | F_Is_Controlling_Actual | F_Is_Overloaded | F_Is_Static_Expression @@ -1440,15 +1393,6 @@ package body Treepr is end loop; end; - -- Print aspects if present - - if Has_Aspects (N) then - Print_Str (Prefix); - Print_Str ("Aspect_Specifications = "); - Print_Field (Union_Id (Aspect_Specifications (N))); - Print_Eol; - end if; - -- Print entity information for entities if Nkind (N) in N_Entity then