diff mbox series

[Ada] Disable Vet calls when container checks are disabled

Message ID 20220518084325.GA3370909@adacore.com
State New
Headers show
Series [Ada] Disable Vet calls when container checks are disabled | expand

Commit Message

Pierre-Marie de Rodat May 18, 2022, 8:43 a.m. UTC 
Calls to various Vet functions are used throughout the containers
packages to check internal consistency. This patch improves efficiency
by disabling these calls when Container_Checks are suppressed.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnat/a-crbtgo.ads, libgnat/a-rbtgbo.ads,
	libgnat/a-cbdlli.adb, libgnat/a-cbhama.adb,
	libgnat/a-cbhase.adb, libgnat/a-cdlili.adb,
	libgnat/a-cfdlli.adb, libgnat/a-cfhama.adb,
	libgnat/a-cfhase.adb, libgnat/a-cidlli.adb,
	libgnat/a-cihama.adb, libgnat/a-cihase.adb,
	libgnat/a-cohama.adb, libgnat/a-cohase.adb,
	libgnat/a-crbtgo.adb, libgnat/a-crdlli.adb, libgnat/a-rbtgbo.adb
	(Vet): Make the Vet functions do nothing when
	Container_Checks'Enabled is False, and inline them, so the calls
	disappear when optimizing.
diff mbox series

Patch

diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb
--- a/gcc/ada/libgnat/a-cbdlli.adb
+++ b/gcc/ada/libgnat/a-cbdlli.adb
@@ -75,7 +75,7 @@  is
       Src_Pos : Count_Type;
       Tgt_Pos : out Count_Type);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
    --  Checks invariants of the cursor and its designated container, as a
    --  simple way of detecting dangling references (see operation Free for a
    --  description of the detection mechanism), returning True if all checks
@@ -2210,6 +2210,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = 0 then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb
--- a/gcc/ada/libgnat/a-cbhama.adb
+++ b/gcc/ada/libgnat/a-cbhama.adb
@@ -66,7 +66,7 @@  is
    procedure Set_Next (Node : in out Node_Type; Next : Count_Type);
    pragma Inline (Set_Next);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
 
    --------------------------
    -- Local Instantiations --
@@ -1175,6 +1175,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = 0 then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb
--- a/gcc/ada/libgnat/a-cbhase.adb
+++ b/gcc/ada/libgnat/a-cbhase.adb
@@ -79,7 +79,7 @@  is
    procedure Set_Next (Node : in out Node_Type; Next : Count_Type);
    pragma Inline (Set_Next);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
 
    --------------------------
    -- Local Instantiations --
@@ -1496,6 +1496,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = 0 then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb
--- a/gcc/ada/libgnat/a-cdlili.adb
+++ b/gcc/ada/libgnat/a-cdlili.adb
@@ -64,7 +64,7 @@  is
       Source   : in out List;
       Position : Node_Access);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
    --  Checks invariants of the cursor and its designated container, as a
    --  simple way of detecting dangling references (see operation Free for a
    --  description of the detection mechanism), returning True if all checks
@@ -1991,6 +1991,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = null then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cfdlli.adb b/gcc/ada/libgnat/a-cfdlli.adb
--- a/gcc/ada/libgnat/a-cfdlli.adb
+++ b/gcc/ada/libgnat/a-cfdlli.adb
@@ -48,7 +48,7 @@  is
       Before    : Count_Type;
       New_Node  : Count_Type);
 
-   function Vet (L : List; Position : Cursor) return Boolean;
+   function Vet (L : List; Position : Cursor) return Boolean with Inline;
 
    ---------
    -- "=" --
@@ -1766,8 +1766,11 @@  is
 
    function Vet (L : List; Position : Cursor) return Boolean is
       N : Node_Array renames L.Nodes;
-
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if L.Length = 0 then
          return False;
       end if;


diff --git a/gcc/ada/libgnat/a-cfhama.adb b/gcc/ada/libgnat/a-cfhama.adb
--- a/gcc/ada/libgnat/a-cfhama.adb
+++ b/gcc/ada/libgnat/a-cfhama.adb
@@ -68,7 +68,8 @@  is
    procedure Set_Next (Node : in out Node_Type; Next : Count_Type);
    pragma Inline (Set_Next);
 
-   function Vet (Container : Map; Position : Cursor) return Boolean;
+   function Vet (Container : Map; Position : Cursor) return Boolean
+     with Inline;
 
    --------------------------
    -- Local Instantiations --
@@ -901,6 +902,10 @@  is
 
    function Vet (Container : Map; Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = 0 then
          return True;
       end if;


diff --git a/gcc/ada/libgnat/a-cfhase.adb b/gcc/ada/libgnat/a-cfhase.adb
--- a/gcc/ada/libgnat/a-cfhase.adb
+++ b/gcc/ada/libgnat/a-cfhase.adb
@@ -89,7 +89,8 @@  is
    procedure Set_Next (Node : in out Node_Type; Next : Count_Type);
    pragma Inline (Set_Next);
 
-   function Vet (Container : Set; Position : Cursor) return Boolean;
+   function Vet (Container : Set; Position : Cursor) return Boolean
+     with Inline;
 
    --------------------------
    -- Local Instantiations --
@@ -1506,6 +1507,10 @@  is
 
    function Vet (Container : Set; Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = 0 then
          return True;
       end if;


diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb
--- a/gcc/ada/libgnat/a-cidlli.adb
+++ b/gcc/ada/libgnat/a-cidlli.adb
@@ -67,7 +67,7 @@  is
       Source   : in out List;
       Position : Node_Access);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
    --  Checks invariants of the cursor and its designated container, as a
    --  simple way of detecting dangling references (see operation Free for a
    --  description of the detection mechanism), returning True if all checks
@@ -2103,6 +2103,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = null then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb
--- a/gcc/ada/libgnat/a-cihama.adb
+++ b/gcc/ada/libgnat/a-cihama.adb
@@ -85,7 +85,7 @@  is
    procedure Set_Next (Node : Node_Access; Next : Node_Access);
    pragma Inline (Set_Next);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
 
    procedure Write_Node
      (Stream : not null access Root_Stream_Type'Class;
@@ -1299,6 +1299,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = null then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb
--- a/gcc/ada/libgnat/a-cihase.adb
+++ b/gcc/ada/libgnat/a-cihase.adb
@@ -99,7 +99,7 @@  is
    procedure Set_Next (Node : Node_Access; Next : Node_Access);
    pragma Inline (Set_Next);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
 
    procedure Write_Node
      (Stream : not null access Root_Stream_Type'Class;
@@ -1932,6 +1932,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = null then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb
--- a/gcc/ada/libgnat/a-cohama.adb
+++ b/gcc/ada/libgnat/a-cohama.adb
@@ -80,7 +80,7 @@  is
    procedure Set_Next (Node : Node_Access; Next : Node_Access);
    pragma Inline (Set_Next);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
 
    procedure Write_Node
      (Stream : not null access Root_Stream_Type'Class;
@@ -1156,6 +1156,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = null then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb
--- a/gcc/ada/libgnat/a-cohase.adb
+++ b/gcc/ada/libgnat/a-cohase.adb
@@ -99,7 +99,7 @@  is
    procedure Set_Next (Node : Node_Access; Next : Node_Access);
    pragma Inline (Set_Next);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
 
    procedure Write_Node
      (Stream : not null access Root_Stream_Type'Class;
@@ -1749,6 +1749,10 @@  is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = null then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-crbtgo.adb b/gcc/ada/libgnat/a-crbtgo.adb
--- a/gcc/ada/libgnat/a-crbtgo.adb
+++ b/gcc/ada/libgnat/a-crbtgo.adb
@@ -1060,6 +1060,10 @@  package body Ada.Containers.Red_Black_Trees.Generic_Operations is
 
    function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Node = null then
          return True;
       end if;


diff --git a/gcc/ada/libgnat/a-crbtgo.ads b/gcc/ada/libgnat/a-crbtgo.ads
--- a/gcc/ada/libgnat/a-crbtgo.ads
+++ b/gcc/ada/libgnat/a-crbtgo.ads
@@ -61,7 +61,8 @@  package Ada.Containers.Red_Black_Trees.Generic_Operations is
 
    --  procedure Check_Invariant (Tree : Tree_Type);
 
-   function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean;
+   function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean
+     with Inline;
    --  Inspects Node to determine (to the extent possible) whether
    --  the node is valid; used to detect if the node is dangling.
 


diff --git a/gcc/ada/libgnat/a-crdlli.adb b/gcc/ada/libgnat/a-crdlli.adb
--- a/gcc/ada/libgnat/a-crdlli.adb
+++ b/gcc/ada/libgnat/a-crdlli.adb
@@ -51,7 +51,7 @@  package body Ada.Containers.Restricted_Doubly_Linked_Lists is
       Before    : Count_Type;
       New_Node  : Count_Type);
 
-   function Vet (Position : Cursor) return Boolean;
+   function Vet (Position : Cursor) return Boolean with Inline;
 
    ---------
    -- "=" --
@@ -1330,6 +1330,10 @@  package body Ada.Containers.Restricted_Doubly_Linked_Lists is
 
    function Vet (Position : Cursor) return Boolean is
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Position.Node = 0 then
          return Position.Container = null;
       end if;


diff --git a/gcc/ada/libgnat/a-rbtgbo.adb b/gcc/ada/libgnat/a-rbtgbo.adb
--- a/gcc/ada/libgnat/a-rbtgbo.adb
+++ b/gcc/ada/libgnat/a-rbtgbo.adb
@@ -1038,8 +1038,11 @@  package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
    function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean is
       Nodes : Nodes_Type renames Tree.Nodes;
       Node  : Node_Type renames Nodes (Index);
-
    begin
+      if not Container_Checks'Enabled then
+         return True;
+      end if;
+
       if Parent (Node) = Index
         or else Left (Node) = Index
         or else Right (Node) = Index


diff --git a/gcc/ada/libgnat/a-rbtgbo.ads b/gcc/ada/libgnat/a-rbtgbo.ads
--- a/gcc/ada/libgnat/a-rbtgbo.ads
+++ b/gcc/ada/libgnat/a-rbtgbo.ads
@@ -70,7 +70,8 @@  package Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
    function Max (Tree : Tree_Type'Class; Node : Count_Type) return Count_Type;
    --  Returns the largest-valued node of the subtree rooted at Node
 
-   function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean;
+   function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean
+     with Inline;
    --  Inspects Node to determine (to the extent possible) whether
    --  the node is valid; used to detect if the node is dangling.