From: Ronan Desplanques <desplanq...@adacore.com>
The crash this patch fixes happened because calling the Errout.Error_Msg
procedures that don't have an N parameter is not allowed when not
parsing and -gnatdJ is on. And -gnatyB style checks are not emitted during
parsing but during semantic analysis.
This commit moves Check_Boolean_Operator from Styleg to Style so it can
call Errout.Error_Msg with a Node_Id parameter. This change of package
makes sense because:
1. The compiler is currently the only user of Check_Boolean_Operator.
2. Other tools don't do semantic analysis, and so cannot possibly
know when to use Check_Boolean_Operator anyway.
gcc/ada/
* styleg.ads (Check_Boolean_Operator): Moved ...
* style.ads (Check_Boolean_Operator): ... here.
* styleg.adb (Check_Boolean_Operator): Moved ...
* style.adb (Check_Boolean_Operator): ... here. Also add node
parameter to call to Errout.Error_Msg.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/style.adb | 81 ++++++++++++++++++++++++++++++++++++++++++++
gcc/ada/style.ads | 3 +-
gcc/ada/styleg.adb | 83 ----------------------------------------------
gcc/ada/styleg.ads | 4 ---
4 files changed, 82 insertions(+), 89 deletions(-)
diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb
index e73bfddb524..aaa668aab00 100644
--- a/gcc/ada/style.adb
+++ b/gcc/ada/style.adb
@@ -94,6 +94,87 @@ package body Style is
end if;
end Check_Array_Attribute_Index;
+ ----------------------------
+ -- Check_Boolean_Operator --
+ ----------------------------
+
+ procedure Check_Boolean_Operator (Node : Node_Id) is
+
+ function OK_Boolean_Operand (N : Node_Id) return Boolean;
+ -- Returns True for simple variable, or "not X1" or "X1 and X2" or
+ -- "X1 or X2" where X1, X2 are recursively OK_Boolean_Operand's.
+
+ ------------------------
+ -- OK_Boolean_Operand --
+ ------------------------
+
+ function OK_Boolean_Operand (N : Node_Id) return Boolean is
+ begin
+ if Nkind (N) in N_Identifier | N_Expanded_Name then
+ return True;
+
+ elsif Nkind (N) = N_Op_Not then
+ return OK_Boolean_Operand (Original_Node (Right_Opnd (N)));
+
+ elsif Nkind (N) in N_Op_And | N_Op_Or then
+ return OK_Boolean_Operand (Original_Node (Left_Opnd (N)))
+ and then
+ OK_Boolean_Operand (Original_Node (Right_Opnd (N)));
+
+ else
+ return False;
+ end if;
+ end OK_Boolean_Operand;
+
+ -- Start of processing for Check_Boolean_Operator
+
+ begin
+ if Style_Check_Boolean_And_Or
+ and then Comes_From_Source (Node)
+ then
+ declare
+ Orig : constant Node_Id := Original_Node (Node);
+
+ begin
+ if Nkind (Orig) in N_Op_And | N_Op_Or then
+ declare
+ L : constant Node_Id := Original_Node (Left_Opnd (Orig));
+ R : constant Node_Id := Original_Node (Right_Opnd (Orig));
+
+ begin
+ -- First OK case, simple boolean constants/identifiers
+
+ if OK_Boolean_Operand (L)
+ and then
+ OK_Boolean_Operand (R)
+ then
+ return;
+
+ -- Second OK case, modular types
+
+ elsif Is_Modular_Integer_Type (Etype (Node)) then
+ return;
+
+ -- Third OK case, array types
+
+ elsif Is_Array_Type (Etype (Node)) then
+ return;
+
+ -- Otherwise we have an error
+
+ elsif Nkind (Orig) = N_Op_And then
+ Error_Msg -- CODEFIX
+ ("(style) `AND THEN` required?B?", Sloc (Orig), Orig);
+ else
+ Error_Msg -- CODEFIX
+ ("(style) `OR ELSE` required?B?", Sloc (Orig), Orig);
+ end if;
+ end;
+ end if;
+ end;
+ end if;
+ end Check_Boolean_Operator;
+
----------------------
-- Check_Identifier --
----------------------
diff --git a/gcc/ada/style.ads b/gcc/ada/style.ads
index dc8b337f2bd..c0925e9ce34 100644
--- a/gcc/ada/style.ads
+++ b/gcc/ada/style.ads
@@ -90,8 +90,7 @@ package Style is
-- designator is a reserved word (access, digits, delta or range) to allow
-- differing rules for the two cases.
- procedure Check_Boolean_Operator (Node : Node_Id)
- renames Style_Inst.Check_Boolean_Operator;
+ procedure Check_Boolean_Operator (Node : Node_Id);
-- Called after resolving AND or OR node to check short circuit rules
procedure Check_Box
diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb
index 5c439c9a0b2..287589f92da 100644
--- a/gcc/ada/styleg.adb
+++ b/gcc/ada/styleg.adb
@@ -30,8 +30,6 @@
with Atree; use Atree;
with Casing; use Casing;
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;
@@ -194,87 +192,6 @@ package body Styleg is
end if;
end Check_Binary_Operator;
- ----------------------------
- -- Check_Boolean_Operator --
- ----------------------------
-
- procedure Check_Boolean_Operator (Node : Node_Id) is
-
- function OK_Boolean_Operand (N : Node_Id) return Boolean;
- -- Returns True for simple variable, or "not X1" or "X1 and X2" or
- -- "X1 or X2" where X1, X2 are recursively OK_Boolean_Operand's.
-
- ------------------------
- -- OK_Boolean_Operand --
- ------------------------
-
- function OK_Boolean_Operand (N : Node_Id) return Boolean is
- begin
- if Nkind (N) in N_Identifier | N_Expanded_Name then
- return True;
-
- elsif Nkind (N) = N_Op_Not then
- return OK_Boolean_Operand (Original_Node (Right_Opnd (N)));
-
- elsif Nkind (N) in N_Op_And | N_Op_Or then
- return OK_Boolean_Operand (Original_Node (Left_Opnd (N)))
- and then
- OK_Boolean_Operand (Original_Node (Right_Opnd (N)));
-
- else
- return False;
- end if;
- end OK_Boolean_Operand;
-
- -- Start of processing for Check_Boolean_Operator
-
- begin
- if Style_Check_Boolean_And_Or
- and then Comes_From_Source (Node)
- then
- declare
- Orig : constant Node_Id := Original_Node (Node);
-
- begin
- if Nkind (Orig) in N_Op_And | N_Op_Or then
- declare
- L : constant Node_Id := Original_Node (Left_Opnd (Orig));
- R : constant Node_Id := Original_Node (Right_Opnd (Orig));
-
- begin
- -- First OK case, simple boolean constants/identifiers
-
- if OK_Boolean_Operand (L)
- and then
- OK_Boolean_Operand (R)
- then
- return;
-
- -- Second OK case, modular types
-
- elsif Is_Modular_Integer_Type (Etype (Node)) then
- return;
-
- -- Third OK case, array types
-
- elsif Is_Array_Type (Etype (Node)) then
- return;
-
- -- Otherwise we have an error
-
- elsif Nkind (Orig) = N_Op_And then
- Error_Msg -- CODEFIX
- ("(style) `AND THEN` required?B?", Sloc (Orig));
- else
- Error_Msg -- CODEFIX
- ("(style) `OR ELSE` required?B?", Sloc (Orig));
- end if;
- end;
- end if;
- end;
- end if;
- end Check_Boolean_Operator;
-
---------------
-- Check_Box --
---------------
diff --git a/gcc/ada/styleg.ads b/gcc/ada/styleg.ads
index c86bfb4897e..9028e85cc4e 100644
--- a/gcc/ada/styleg.ads
+++ b/gcc/ada/styleg.ads
@@ -63,10 +63,6 @@ package Styleg is
-- the attribute designator is a reserved word (access, digits,
-- delta or range) to allow differing rules for the two cases.
- procedure Check_Boolean_Operator (Node : Node_Id);
- -- Node is a node for an AND or OR operator. Check that the usage meets
- -- the style rules.
-
procedure Check_Box;
-- Called after scanning out a box to check spacing
--
2.43.2
