diff mbox series

[COMMITTED] ada: Fix crash with -gnatyB and -gnatdJ

Message ID 20240514082313.832692-1-poulhies@adacore.com
State New
Headers show
Series [COMMITTED] ada: Fix crash with -gnatyB and -gnatdJ | expand

Commit Message

Marc Poulhiès May 14, 2024, 8:23 a.m. UTC
From: Ronan Desplanques <desplanques@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 mbox series

Patch

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