[COMMITTED] ada: Improve -gnatyx style check
Checks
Commit Message
From: Arnaud Charlet <charlet@adacore.com>
Check redundant parentheses in many more places, for now only under
-gnatdQ, while pending violations are fixed.
gcc/ada/
* par-ch3.adb, sem_ch4.adb (P_Discrete_Range, Analyze_Logical_Op,
Analyze_Short_Circuit): Add calls to Check_Xtra_Parentheses.
* par-ch5.adb (P_Condition): Move logic to Check_Xtra_Parentheses.
* style.ads, styleg.adb, styleg.ads (Check_Xtra_Parens): Move logic
related to expressions requiring parentheses here.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/par-ch3.adb | 10 ++++++++++
gcc/ada/par-ch5.adb | 17 +++--------------
gcc/ada/sem_ch4.adb | 27 +++++++++++++++++++++++++++
gcc/ada/style.ads | 7 ++++---
gcc/ada/styleg.adb | 20 +++++++++++++++++---
gcc/ada/styleg.ads | 7 ++++---
6 files changed, 65 insertions(+), 23 deletions(-)
@@ -3064,10 +3064,20 @@ package body Ch3 is
elsif Token = Tok_Dot_Dot then
Range_Node := New_Node (N_Range, Token_Ptr);
Set_Low_Bound (Range_Node, Expr_Node);
+
+ if Style_Check then
+ Style.Check_Xtra_Parens (Expr_Node);
+ end if;
+
Scan; -- past ..
Expr_Node := P_Expression;
Check_Simple_Expression (Expr_Node);
Set_High_Bound (Range_Node, Expr_Node);
+
+ if Style_Check then
+ Style.Check_Xtra_Parens (Expr_Node);
+ end if;
+
return Range_Node;
-- Otherwise we must have a subtype mark, or an Ada 2012 iterator
@@ -1355,22 +1355,11 @@ package body Ch5 is
return Cond;
- -- Otherwise check for redundant parentheses but do not emit messages
- -- about expressions that require parentheses (e.g. conditional,
- -- quantified or declaration expressions).
+ -- Otherwise check for redundant parentheses
else
- if Style_Check
- and then
- Paren_Count (Cond) >
- (if Nkind (Cond) in N_Case_Expression
- | N_Expression_With_Actions
- | N_If_Expression
- | N_Quantified_Expression
- then 1
- else 0)
- then
- Style.Check_Xtra_Parens (First_Sloc (Cond));
+ if Style_Check then
+ Style.Check_Xtra_Parens (Cond, Enable => True);
end if;
-- And return the result
@@ -65,6 +65,7 @@ with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
with Snames; use Snames;
+with Style; use Style;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Warnsw; use Warnsw;
@@ -3134,6 +3135,20 @@ package body Sem_Ch4 is
Operator_Check (N);
Check_Function_Writable_Actuals (N);
+
+ if Style_Check then
+ if Nkind (L) not in N_Short_Circuit | N_Op_And | N_Op_Or | N_Op_Xor
+ and then Is_Boolean_Type (Etype (L))
+ then
+ Check_Xtra_Parens (L);
+ end if;
+
+ if Nkind (R) not in N_Short_Circuit | N_Op_And | N_Op_Or | N_Op_Xor
+ and then Is_Boolean_Type (Etype (R))
+ then
+ Check_Xtra_Parens (R);
+ end if;
+ end if;
end Analyze_Logical_Op;
---------------------------
@@ -6006,6 +6021,18 @@ package body Sem_Ch4 is
Resolve (R, Standard_Boolean);
Set_Etype (N, Standard_Boolean);
end if;
+
+ if Style_Check then
+ if Nkind (L) not in N_Short_Circuit | N_Op_And | N_Op_Or | N_Op_Xor
+ then
+ Check_Xtra_Parens (L);
+ end if;
+
+ if Nkind (R) not in N_Short_Circuit | N_Op_And | N_Op_Or | N_Op_Xor
+ then
+ Check_Xtra_Parens (R);
+ end if;
+ end if;
end Analyze_Short_Circuit;
-------------------
@@ -28,6 +28,7 @@
-- gathered in a separate package so that they can more easily be customized.
-- Calls to these subprograms are only made if Opt.Style_Check is set True.
+with Debug; use Debug;
with Errout;
with Styleg;
with Types; use Types;
@@ -192,10 +193,10 @@ package Style is
renames Style_Inst.Check_Vertical_Bar;
-- Called after scanning a vertical bar to check spacing
- procedure Check_Xtra_Parens (Loc : Source_Ptr)
+ procedure Check_Xtra_Parens (N : Node_Id; Enable : Boolean := Debug_Flag_QQ)
renames Style_Inst.Check_Xtra_Parens;
- -- Called after scanning an if, case or quantified expression that has at
- -- least one level of parentheses around the entire expression.
+ -- Called after scanning an expression (N) that does not require an extra
+ -- level of parentheses around the entire expression.
function Mode_In_Check return Boolean
renames Style_Inst.Mode_In_Check;
@@ -33,6 +33,7 @@ with Csets; use Csets;
with Einfo; use Einfo;
with Einfo.Utils; use Einfo.Utils;
with Err_Vars; use Err_Vars;
+with Errout;
with Opt; use Opt;
with Scans; use Scans;
with Sinfo; use Sinfo;
@@ -1118,11 +1119,24 @@ package body Styleg is
-- Check_Xtra_Parens --
-----------------------
- procedure Check_Xtra_Parens (Loc : Source_Ptr) is
+ procedure Check_Xtra_Parens (N : Node_Id; Enable : Boolean) is
begin
- if Style_Check_Xtra_Parens then
+ -- Do not emit messages about expressions that may require parentheses
+
+ if Style_Check_Xtra_Parens
+ and then Enable
+ and then
+ Paren_Count (N) >
+ (if Nkind (N) in N_Case_Expression
+ | N_Expression_With_Actions
+ | N_If_Expression
+ | N_Quantified_Expression
+ | N_Raise_Expression
+ then 1
+ else 0)
+ then
Error_Msg -- CODEFIX
- ("(style) redundant parentheses?x?", Loc);
+ ("(style) redundant parentheses?x?", Errout.First_Sloc (N));
end if;
end Check_Xtra_Parens;
@@ -160,9 +160,10 @@ package Styleg is
procedure Check_Vertical_Bar;
-- Called after scanning a vertical bar to check spacing
- procedure Check_Xtra_Parens (Loc : Source_Ptr);
- -- Called after scanning an if, case, or quantified expression that has at
- -- least one level of parentheses around the entire expression.
+ procedure Check_Xtra_Parens (N : Node_Id; Enable : Boolean);
+ -- Called after scanning an expression (N) that does not require an extra
+ -- level of parentheses around the entire expression.
+ -- Enable is a temporary parameter before enabling these checks by default.
function Mode_In_Check return Boolean;
pragma Inline (Mode_In_Check);