From patchwork Wed Nov 10 08:58:43 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 47373 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 2252A385801F for ; Wed, 10 Nov 2021 09:09:09 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 2252A385801F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636535349; bh=2wdMyAnNL+U5hEMDyq1n1/vrQJUJH54ZkalV4LZs8gU=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=IHu+LvkDOncUYy1oCCiAZCD05sMuKQGQFEwhQc97J+L1uIINLjnbppRJBdDpcHuM1 OwPqaycwyqi57XWmKuQbfehYnzGTynO8v+lypY6fYbzgWzxM9fde4eMWWyhrzXODh+ OgJAsi4hUowArm7HKIOeXKvGa53ktW4mLoC8i+nI= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x131.google.com (mail-lf1-x131.google.com [IPv6:2a00:1450:4864:20::131]) by sourceware.org (Postfix) with ESMTPS id 254433857C56 for ; Wed, 10 Nov 2021 08:58:46 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 254433857C56 Received: by mail-lf1-x131.google.com with SMTP id f18so4333479lfv.6 for ; Wed, 10 Nov 2021 00:58:46 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=2wdMyAnNL+U5hEMDyq1n1/vrQJUJH54ZkalV4LZs8gU=; b=KpBQakXFLIporNzWhDfRjMX2TwUbgSwdMnngmvmBEd+geknrSXxjsv3CBhUeuTfKDK ZRkvvA9fUcjPHg46eQZ/IW0RG8p059kY9VJ3WXGBntHVfwztwknM6mTu4R42ybUfGbUI l4K2+09YTLYrV4CEaWzJ1+V1YFIz5HA/s59NvVhiyXZObs0YtfAntBNv6FgYst4SguMK Hed/wUEvhValIkgUKKZ/mu/xbd7RfZ8KpBAuP33MoFoVE1SGwbx7MdqgOJJsZuUMWeEA psZT1wxiPaR8GHR5eJDqohmKLoBc9aR5KVS0vd33fOa6SfoY7lFW4htWoZ25JQvxZS4N fsHg== X-Gm-Message-State: AOAM5334sankGLkET0EIR76k//pEzcYMLLWBdYp8fxrReXBXAErnPOPa ZEUIeTiQUnHdLFBrPc1/+x8TR7DTwNygOT6U X-Google-Smtp-Source: ABdhPJwmb/lMFCZg4t4GaXG04Cw9ah3+sjk2jXM5PoCVJErsNpRpylfGCTVmT9D+uyA8xCsxv1iJKw== X-Received: by 2002:a05:6512:3f1b:: with SMTP id y27mr13088865lfa.606.1636534725057; Wed, 10 Nov 2021 00:58:45 -0800 (PST) Received: from adacore.com ([2a02:2ab8:224:2ce:72b5:e8ff:feef:ee60]) by smtp.gmail.com with ESMTPSA id o14sm594846lfk.225.2021.11.10.00.58.43 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 10 Nov 2021 00:58:44 -0800 (PST) Date: Wed, 10 Nov 2021 08:58:43 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] ACATS BDC1002 shall not error on arbitrary aspect Message-ID: <20211110085843.GA2811181@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.6 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 autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Etienne Servais Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" When giving an arbitrary pragma Restrictions (No_Specification_of_Aspect => Future_Aspect); Future_Aspect shall not be rejected. Nevertheless a warning shall be emitted. In case the unknown aspect might be a misspelling, a hint should be emitted accordingly. To ease this spell-checking, Aspect_Spell_Check and Attribute_Spell_Check are introduced. Introduce a Bad_Aspect function similar to Bad_Attribute. The expression `Get_Aspect_Id (N) /= No_Aspect` is used enough to introduce the wrapper `Is_Aspect_Id` as is done with `Is_Attribute_Name`. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * aspects.adb, aspects.ads (Is_Aspect_Id): New function. * namet-sp.ads, namet-sp.adb (Aspect_Spell_Check, Attribute_Spell_Check): New Functions. * par-ch13.adb (Possible_Misspelled_Aspect): Removed. (With_Present): Use Aspect_Spell_Check, use Is_Aspect_Id. (Get_Aspect_Specifications): Use Aspect_Spell_Check, Is_Aspect_Id, Bad_Aspect. * par-sync.adb (Resync_Past_Malformed_Aspect): Use Is_Aspect_Id. * sem_ch13.adb (Check_One_Attr): Use Is_Aspect_Id. * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): Introduce the Process_No_Specification_Of_Aspect, emit a warning instead of an error on unknown aspect, hint for typos. Introduce Process_No_Use_Of_Attribute to add spell check for attributes too. (Set_Error_Msg_To_Profile_Name): Use Is_Aspect_Id. * sem_util.adb (Bad_Attribute): Use Attribute_Spell_Check. (Bad_Aspect): New function. * sem_util.ads (Bad_Aspect): New function. diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -323,6 +323,16 @@ package body Aspects is return Present (Find_Aspect (Id, A, Class_Present => Class_Present)); end Has_Aspect; + ------------------ + -- Is_Aspect_Id -- + ------------------ + + function Is_Aspect_Id (Aspect : Name_Id) return Boolean is + (Get_Aspect_Id (Aspect) /= No_Aspect); + + function Is_Aspect_Id (Aspect : Node_Id) return Boolean is + (Get_Aspect_Id (Aspect) /= No_Aspect); + ------------------ -- Move_Aspects -- ------------------ diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -773,6 +773,14 @@ package Aspects is -- Given an aspect specification, return the corresponding aspect_id value. -- If the name does not match any aspect, return No_Aspect. + function Is_Aspect_Id (Aspect : Name_Id) return Boolean; + pragma Inline (Is_Aspect_Id); + -- Return True if a corresponding aspect id exists + + function Is_Aspect_Id (Aspect : Node_Id) return Boolean; + pragma Inline (Is_Aspect_Id); + -- Return True if a corresponding aspect id exists + ------------------------------------ -- Delaying Evaluation of Aspects -- ------------------------------------ diff --git a/gcc/ada/namet-sp.adb b/gcc/ada/namet-sp.adb --- a/gcc/ada/namet-sp.adb +++ b/gcc/ada/namet-sp.adb @@ -23,6 +23,8 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; +with Snames; with System.WCh_Cnv; use System.WCh_Cnv; with GNAT.UTF_32_Spelling_Checker; @@ -44,6 +46,44 @@ package body Namet.Sp is -- either Name_Buffer or Name_Len. The result is in Result (1 .. Length). -- The caller must ensure that the result buffer is long enough. + ------------------------ + -- Aspect_Spell_Check -- + ------------------------ + + function Aspect_Spell_Check (Name : Name_Id) return Boolean is + (Aspect_Spell_Check (Name) /= No_Name); + + function Aspect_Spell_Check (Name : Name_Id) return Name_Id is + use Aspects; + begin + for J in Aspect_Id_Exclude_No_Aspect loop + if Is_Bad_Spelling_Of (Name, Aspect_Names (J)) then + return Aspect_Names (J); + end if; + end loop; + + return No_Name; + end Aspect_Spell_Check; + + --------------------------- + -- Attribute_Spell_Check -- + --------------------------- + + function Attribute_Spell_Check (N : Name_Id) return Boolean is + (Attribute_Spell_Check (N) /= No_Name); + + function Attribute_Spell_Check (N : Name_Id) return Name_Id is + use Snames; + begin + for J in First_Attribute_Name .. Last_Attribute_Name loop + if Is_Bad_Spelling_Of (N, J) then + return J; + end if; + end loop; + + return No_Name; + end Attribute_Spell_Check; + ---------------------------- -- Get_Name_String_UTF_32 -- ---------------------------- diff --git a/gcc/ada/namet-sp.ads b/gcc/ada/namet-sp.ads --- a/gcc/ada/namet-sp.ads +++ b/gcc/ada/namet-sp.ads @@ -31,6 +31,20 @@ package Namet.Sp is + function Aspect_Spell_Check (Name : Name_Id) return Boolean; + -- Returns True, if Name is a misspelling of some aspect name + + function Aspect_Spell_Check (Name : Name_Id) return Name_Id; + -- Returns a possible correction, if Name is a misspelling of some aspect + -- name. If not, return No_Name. + + function Attribute_Spell_Check (N : Name_Id) return Boolean; + -- Returns True, if Name is a misspelling of some attribute name + + function Attribute_Spell_Check (N : Name_Id) return Name_Id; + -- Returns a possible correction, if Name is a misspelling of some + -- attribute name. If not, return No_Name. + function Is_Bad_Spelling_Of (Found, Expect : Name_Id) return Boolean; -- Compares two identifier names from the names table, and returns True if -- Found is a plausible misspelling of Expect. This function properly deals diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -47,28 +47,10 @@ package body Ch13 is Scan_State : Saved_Scan_State; Result : Boolean; - function Possible_Misspelled_Aspect return Boolean; - -- Returns True, if Token_Name is a misspelling of some aspect name - function With_Present return Boolean; -- Returns True if WITH is present, indicating presence of aspect -- specifications. Also allows incorrect use of WHEN in place of WITH. - -------------------------------- - -- Possible_Misspelled_Aspect -- - -------------------------------- - - function Possible_Misspelled_Aspect return Boolean is - begin - for J in Aspect_Id_Exclude_No_Aspect loop - if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then - return True; - end if; - end loop; - - return False; - end Possible_Misspelled_Aspect; - ------------------ -- With_Present -- ------------------ @@ -89,7 +71,7 @@ package body Ch13 is Scan; -- past WHEN if Token = Tok_Identifier - and then Get_Aspect_Id (Token_Name) /= No_Aspect + and then Is_Aspect_Id (Token_Name) then Error_Msg_SC ("WHEN should be WITH"); Restore_Scan_State (Scan_State); @@ -149,8 +131,8 @@ package body Ch13 is -- specification is ill-formed. elsif not Strict then - if Get_Aspect_Id (Token_Name) /= No_Aspect - or else Possible_Misspelled_Aspect + if Is_Aspect_Id (Token_Name) + or else Aspect_Spell_Check (Token_Name) then Result := True; else @@ -164,7 +146,7 @@ package body Ch13 is -- is still an aspect specification so we give an appropriate message. else - if Get_Aspect_Id (Token_Name) = No_Aspect then + if not Is_Aspect_Id (Token_Name) then Result := False; else @@ -271,21 +253,10 @@ package body Ch13 is begin Check_Restriction (Msg_Issued, No_Unrecognized_Aspects, Aspect); if not Msg_Issued then - Error_Msg_Warn := not Debug_Flag_2; - Error_Msg_N - ("<<& is not a valid aspect identifier", Token_Node); - OK := False; + Bad_Aspect (Token_Node, Token_Name, not Debug_Flag_2); - -- Check bad spelling + OK := False; - for J in Aspect_Id_Exclude_No_Aspect loop - if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then - Error_Msg_Name_1 := Aspect_Names (J); - Error_Msg_N -- CODEFIX - ("\< ... if Token = Tok_Identifier - and then Get_Aspect_Id (Token_Name) /= No_Aspect + and then Is_Aspect_Id (Token_Name) then Restore_Scan_State (Scan_State); @@ -588,7 +559,7 @@ package body Ch13 is -- and proceed to the next aspect. elsif Token = Tok_Identifier - and then Get_Aspect_Id (Token_Name) /= No_Aspect + and then Is_Aspect_Id (Token_Name) then declare Scan_State : Saved_Scan_State; @@ -626,7 +597,7 @@ package body Ch13 is Scan; -- past semicolon if Token = Tok_Identifier - and then Get_Aspect_Id (Token_Name) /= No_Aspect + and then Is_Aspect_Id (Token_Name) then Scan; -- past identifier diff --git a/gcc/ada/par-sync.adb b/gcc/ada/par-sync.adb --- a/gcc/ada/par-sync.adb +++ b/gcc/ada/par-sync.adb @@ -172,7 +172,7 @@ package body Sync is -- current malformed aspect has been successfully skipped. if Token = Tok_Identifier - and then Get_Aspect_Id (Token_Name) /= No_Aspect + and then Is_Aspect_Id (Token_Name) then Restore_Scan_State (Scan_State); exit; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6249,7 +6249,7 @@ package body Sem_Ch13 is Check_Restriction_No_Use_Of_Attribute (N); - if Get_Aspect_Id (Chars (N)) /= No_Aspect then + if Is_Aspect_Id (Chars (N)) then -- 6.1/3 No_Specification_of_Aspect: Identifies an aspect for which -- no aspect_specification, attribute_definition_clause, or pragma -- is given. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10444,6 +10444,49 @@ package body Sem_Prag is Expr : Node_Id; Val : Uint; + procedure Process_No_Specification_of_Aspect; + -- Process the No_Specification_of_Aspect restriction + + procedure Process_No_Use_Of_Attribute; + -- Process the No_Use_Of_Attribute restriction + + ---------------------------------------- + -- Process_No_Specification_of_Aspect -- + ---------------------------------------- + + procedure Process_No_Specification_of_Aspect is + Name : constant Name_Id := Chars (Expr); + begin + if Nkind (Expr) = N_Identifier + and then Is_Aspect_Id (Name) + then + Set_Restriction_No_Specification_Of_Aspect (Expr, Warn); + else + Bad_Aspect (Expr, Name, Warn => True); + + raise Pragma_Exit; + end if; + end Process_No_Specification_of_Aspect; + + --------------------------------- + -- Process_No_Use_Of_Attribute -- + --------------------------------- + + procedure Process_No_Use_Of_Attribute is + Name : constant Name_Id := Chars (Expr); + begin + if Nkind (Expr) = N_Identifier + and then Is_Attribute_Name (Name) + then + Set_Restriction_No_Use_Of_Attribute (Expr, Warn); + else + Bad_Attribute (Expr, Name, Warn => True); + end if; + + end Process_No_Use_Of_Attribute; + + -- Start of processing for Process_Restrictions_Or_Restriction_Warnings + begin -- Ignore all Restrictions pragmas in CodePeer mode @@ -10668,34 +10711,12 @@ package body Sem_Prag is -- Case of No_Specification_Of_Aspect => aspect-identifier elsif Id = Name_No_Specification_Of_Aspect then - declare - A_Id : Aspect_Id; - - begin - if Nkind (Expr) /= N_Identifier then - A_Id := No_Aspect; - else - A_Id := Get_Aspect_Id (Chars (Expr)); - end if; - - if A_Id = No_Aspect then - Error_Pragma_Arg ("invalid restriction name", Arg); - else - Set_Restriction_No_Specification_Of_Aspect (Expr, Warn); - end if; - end; + Process_No_Specification_of_Aspect; -- Case of No_Use_Of_Attribute => attribute-identifier elsif Id = Name_No_Use_Of_Attribute then - if Nkind (Expr) /= N_Identifier - or else not Is_Attribute_Name (Chars (Expr)) - then - Error_Msg_N ("unknown attribute name??", Expr); - - else - Set_Restriction_No_Use_Of_Attribute (Expr, Warn); - end if; + Process_No_Use_Of_Attribute; -- Case of No_Use_Of_Entity => fully-qualified-name @@ -11488,7 +11509,7 @@ package body Sem_Prag is Check_Restriction_No_Use_Of_Pragma (N); - if Get_Aspect_Id (Chars (Pragma_Identifier (N))) /= No_Aspect then + if Is_Aspect_Id (Chars (Pragma_Identifier (N))) then -- 6.1/3 No_Specification_of_Aspect: Identifies an aspect for which -- no aspect_specification, attribute_definition_clause, or pragma -- is given. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1606,6 +1606,27 @@ package body Sem_Util is and then Scope_Depth (ST) >= Scope_Depth (SCT); end Available_Full_View_Of_Component; + ---------------- + -- Bad_Aspect -- + ---------------- + + procedure Bad_Aspect + (N : Node_Id; + Nam : Name_Id; + Warn : Boolean := False) + is + begin + Error_Msg_Warn := Warn; + Error_Msg_N ("<<& is not a valid aspect identifier", N); + + -- Check bad spelling + Error_Msg_Name_1 := Aspect_Spell_Check (Nam); + if Error_Msg_Name_1 /= No_Name then + Error_Msg_N -- CODEFIX + ("\<