public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-5096] [Ada] ACATS BDC1002 shall not error on arbitrary aspect
@ 2021-11-10 8:59 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-11-10 8:59 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:5fc6b47ac69605297ade8ff79468eaa836d707a0
commit r12-5096-g5fc6b47ac69605297ade8ff79468eaa836d707a0
Author: Etienne Servais <servais@adacore.com>
Date: Wed Nov 3 15:48:42 2021 +0100
[Ada] ACATS BDC1002 shall not error on arbitrary aspect
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:
---
gcc/ada/aspects.adb | 10 ++++++++
gcc/ada/aspects.ads | 8 ++++++
gcc/ada/namet-sp.adb | 40 +++++++++++++++++++++++++++++
gcc/ada/namet-sp.ads | 14 +++++++++++
gcc/ada/par-ch13.adb | 47 +++++++---------------------------
gcc/ada/par-sync.adb | 2 +-
gcc/ada/sem_ch13.adb | 2 +-
gcc/ada/sem_prag.adb | 71 ++++++++++++++++++++++++++++++++++------------------
gcc/ada/sem_util.adb | 38 ++++++++++++++++++++--------
gcc/ada/sem_util.ads | 8 ++++++
10 files changed, 164 insertions(+), 76 deletions(-)
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index a6e4f28f2cb..bf661b97a9b 100644
--- 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
index ab11bfda2f9..4bb28ceb7a1 100644
--- 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
index bc145ff1bdc..f10373ff45a 100644
--- 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
index 2953aa70965..23dbd2bd28c 100644
--- 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
index 616d398d2f9..227696afcd7 100644
--- 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
- ("\<<possible misspelling of%", Token_Node);
- exit;
- end if;
- end loop;
end if;
end;
@@ -456,7 +427,7 @@ package body Ch13 is
-- Aspect => ...
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
index 4ad4627848e..05188a7e1f2 100644
--- 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
index be9b84e5ec7..f6679456f2b 100644
--- 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
index f50f440d3a8..c3ea16df54d 100644
--- 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
index c8362f57b17..5feb83d3151 100644
--- 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
+ ("\<<possible misspelling of %", N);
+ end if;
+ end Bad_Aspect;
+
-------------------
-- Bad_Attribute --
-------------------
@@ -1617,20 +1638,15 @@ package body Sem_Util is
is
begin
Error_Msg_Warn := Warn;
- Error_Msg_N ("unrecognized attribute&<<", N);
+ Error_Msg_N ("<<unrecognized attribute&", N);
-- Check for possible misspelling
- Error_Msg_Name_1 := First_Attribute_Name;
- while Error_Msg_Name_1 <= Last_Attribute_Name loop
- if Is_Bad_Spelling_Of (Nam, Error_Msg_Name_1) then
- Error_Msg_N -- CODEFIX
- ("\possible misspelling of %<<", N);
- exit;
- end if;
-
- Error_Msg_Name_1 := Error_Msg_Name_1 + 1;
- end loop;
+ Error_Msg_Name_1 := Attribute_Spell_Check (Nam);
+ if Error_Msg_Name_1 /= No_Name then
+ Error_Msg_N -- CODEFIX
+ ("\<<possible misspelling of %", N);
+ end if;
end Bad_Attribute;
--------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 85010b57130..abc18ec8d63 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -209,6 +209,14 @@ package Sem_Util is
-- are open, and the scope of the array is not outside the scope of the
-- component.
+ procedure Bad_Aspect
+ (N : Node_Id;
+ Nam : Name_Id;
+ Warn : Boolean := False);
+ -- Called when node N is expected to contain a valid aspect name, and
+ -- Nam is found instead. If Warn is set True this is a warning, else this
+ -- is an error.
+
procedure Bad_Attribute
(N : Node_Id;
Nam : Name_Id;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-11-10 8:59 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-10 8:59 [gcc r12-5096] [Ada] ACATS BDC1002 shall not error on arbitrary aspect Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).