diff mbox

[Ada] Friendlier behavior for "=" and ":="

Message ID 20151020121324.GA52422@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 20, 2015, 12:13 p.m. UTC 
This patch avoids race conditions in certain cases. This is not necessary,
because these cases are technically erroneous, but it seems friendlier to avoid
races. Furthermore, previous versions of the containers avoided some of these
races.

No test available; no change in behavior for correct programs.

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

2015-10-20  Bob Duff  <duff@adacore.com>

	* a-cbdlli.adb, a-cdlili.adb, a-chtgop.adb, a-cidlli.adb,
	* a-cobove.adb, a-coinve.adb, a-convec.adb, a-crbtgo.adb ("="): Avoid
	modifying the tampering counts unnecessarily.
	(Adjust): Zero tampering counts unconditionally.
diff mbox

Patch

Index: a-cdlili.adb
===================================================================
--- a-cdlili.adb	(revision 229049)
+++ a-cdlili.adb	(working copy)
@@ -73,31 +73,35 @@ 
    ---------
 
    function "=" (Left, Right : List) return Boolean is
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
-      Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
-
-      L      : Node_Access;
-      R      : Node_Access;
-
    begin
       if Left.Length /= Right.Length then
          return False;
       end if;
 
-      L := Left.First;
-      R := Right.First;
-      for J in 1 .. Left.Length loop
-         if L.Element /= R.Element then
-            return False;
-         end if;
+      if Left.Length = 0 then
+         return True;
+      end if;
 
-         L := L.Next;
-         R := R.Next;
-      end loop;
+      declare
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
 
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
+
+         L : Node_Access := Left.First;
+         R : Node_Access := Right.First;
+      begin
+         for J in 1 .. Left.Length loop
+            if L.Element /= R.Element then
+               return False;
+            end if;
+
+            L := L.Next;
+            R := R.Next;
+         end loop;
+      end;
+
       return True;
    end "=";
 
@@ -109,10 +113,15 @@ 
       Src : Node_Access := Container.First;
 
    begin
+      --  If the counts are nonzero, execution is technically erroneous, but
+      --  it seems friendly to allow things like concurrent "=" on shared
+      --  constants.
+
+      Zero_Counts (Container.TC);
+
       if Src = null then
          pragma Assert (Container.Last = null);
          pragma Assert (Container.Length = 0);
-         pragma Assert (Container.TC = (Busy => 0, Lock => 0));
          return;
       end if;
 
Index: a-coinve.adb
===================================================================
--- a-coinve.adb	(revision 229049)
+++ a-coinve.adb	(working copy)
@@ -103,30 +103,37 @@ 
    ---------
 
    overriding function "=" (Left, Right : Vector) return Boolean is
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
-      Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
    begin
       if Left.Last /= Right.Last then
          return False;
       end if;
 
-      for J in Index_Type range Index_Type'First .. Left.Last loop
-         if Left.Elements.EA (J) = null then
-            if Right.Elements.EA (J) /= null then
+      if Left.Length = 0 then
+         return True;
+      end if;
+
+      declare
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
+      begin
+         for J in Index_Type range Index_Type'First .. Left.Last loop
+            if Left.Elements.EA (J) = null then
+               if Right.Elements.EA (J) /= null then
+                  return False;
+               end if;
+
+            elsif Right.Elements.EA (J) = null then
                return False;
+
+            elsif Left.Elements.EA (J).all /= Right.Elements.EA (J).all then
+               return False;
             end if;
+         end loop;
+      end;
 
-         elsif Right.Elements.EA (J) = null then
-            return False;
-
-         elsif Left.Elements.EA (J).all /= Right.Elements.EA (J).all then
-            return False;
-         end if;
-      end loop;
-
       return True;
    end "=";
 
@@ -136,6 +143,12 @@ 
 
    procedure Adjust (Container : in out Vector) is
    begin
+      --  If the counts are nonzero, execution is technically erroneous, but
+      --  it seems friendly to allow things like concurrent "=" on shared
+      --  constants.
+
+      Zero_Counts (Container.TC);
+
       if Container.Last = No_Index then
          Container.Elements := null;
          return;
@@ -149,7 +162,6 @@ 
       begin
          Container.Elements := null;
          Container.Last := No_Index;
-         Zero_Counts (Container.TC);
 
          Container.Elements := new Elements_Type (L);
 
Index: a-crbtgo.adb
===================================================================
--- a-crbtgo.adb	(revision 229049)
+++ a-crbtgo.adb	(working copy)
@@ -514,9 +514,14 @@ 
       Root : constant Node_Access := Tree.Root;
       use type Helpers.Tamper_Counts;
    begin
+      --  If the counts are nonzero, execution is technically erroneous, but
+      --  it seems friendly to allow things like concurrent "=" on shared
+      --  constants.
+
+      Zero_Counts (Tree.TC);
+
       if N = 0 then
          pragma Assert (Root = null);
-         pragma Assert (Tree.TC = (Busy => 0, Lock => 0));
          return;
       end if;
 
@@ -623,16 +628,7 @@ 
    -------------------
 
    function Generic_Equal (Left, Right : Tree_Type) return Boolean is
-      Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
-      Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
-
-      L_Node : Node_Access;
-      R_Node : Node_Access;
    begin
-      if Left'Address = Right'Address then
-         return True;
-      end if;
-
       if Left.Length /= Right.Length then
          return False;
       end if;
@@ -644,17 +640,23 @@ 
          return True;
       end if;
 
-      L_Node := Left.First;
-      R_Node := Right.First;
-      while L_Node /= null loop
-         if not Is_Equal (L_Node, R_Node) then
-            return False;
-         end if;
+      declare
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
 
-         L_Node := Next (L_Node);
-         R_Node := Next (R_Node);
-      end loop;
+         L_Node : Node_Access := Left.First;
+         R_Node : Node_Access := Right.First;
+      begin
+         while L_Node /= null loop
+            if not Is_Equal (L_Node, R_Node) then
+               return False;
+            end if;
 
+            L_Node := Next (L_Node);
+            R_Node := Next (R_Node);
+         end loop;
+      end;
+
       return True;
    end Generic_Equal;
 
Index: a-cidlli.adb
===================================================================
--- a-cidlli.adb	(revision 229049)
+++ a-cidlli.adb	(working copy)
@@ -76,31 +76,35 @@ 
    ---------
 
    function "=" (Left, Right : List) return Boolean is
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
-      Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
-
-      L      : Node_Access;
-      R      : Node_Access;
-
    begin
       if Left.Length /= Right.Length then
          return False;
       end if;
 
-      L := Left.First;
-      R := Right.First;
-      for J in 1 .. Left.Length loop
-         if L.Element.all /= R.Element.all then
-            return False;
-         end if;
+      if Left.Length = 0 then
+         return True;
+      end if;
 
-         L := L.Next;
-         R := R.Next;
-      end loop;
+      declare
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
 
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
+
+         L : Node_Access := Left.First;
+         R : Node_Access := Right.First;
+      begin
+         for J in 1 .. Left.Length loop
+            if L.Element.all /= R.Element.all then
+               return False;
+            end if;
+
+            L := L.Next;
+            R := R.Next;
+         end loop;
+      end;
+
       return True;
    end "=";
 
@@ -113,10 +117,15 @@ 
       Dst : Node_Access;
 
    begin
+      --  If the counts are nonzero, execution is technically erroneous, but
+      --  it seems friendly to allow things like concurrent "=" on shared
+      --  constants.
+
+      Zero_Counts (Container.TC);
+
       if Src = null then
          pragma Assert (Container.Last = null);
          pragma Assert (Container.Length = 0);
-         pragma Assert (Container.TC = (Busy => 0, Lock => 0));
          return;
       end if;
 
@@ -127,7 +136,6 @@ 
       Container.First := null;
       Container.Last := null;
       Container.Length := 0;
-      Zero_Counts (Container.TC);
 
       declare
          Element : Element_Access := new Element_Type'(Src.Element.all);
Index: a-chtgop.adb
===================================================================
--- a-chtgop.adb	(revision 229049)
+++ a-chtgop.adb	(working copy)
@@ -357,22 +357,7 @@ 
    function Generic_Equal
      (L, R : Hash_Table_Type) return Boolean
    is
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      Lock_L : With_Lock (L.TC'Unrestricted_Access);
-      Lock_R : With_Lock (R.TC'Unrestricted_Access);
-
-      L_Index : Hash_Type;
-      L_Node  : Node_Access;
-
-      N : Count_Type;
-
    begin
-      if L'Address = R'Address then
-         return True;
-      end if;
-
       if L.Length /= R.Length then
          return False;
       end if;
@@ -381,44 +366,57 @@ 
          return True;
       end if;
 
-      --  Find the first node of hash table L
+      declare
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
 
-      L_Index := 0;
-      loop
-         L_Node := L.Buckets (L_Index);
-         exit when L_Node /= null;
-         L_Index := L_Index + 1;
-      end loop;
+         Lock_L : With_Lock (L.TC'Unrestricted_Access);
+         Lock_R : With_Lock (R.TC'Unrestricted_Access);
 
-      --  For each node of hash table L, search for an equivalent node in hash
-      --  table R.
+         L_Index : Hash_Type;
+         L_Node  : Node_Access;
 
-      N := L.Length;
-      loop
-         if not Find (HT => R, Key => L_Node) then
-            return False;
-         end if;
+         N : Count_Type;
+      begin
+         --  Find the first node of hash table L
 
-         N := N - 1;
+         L_Index := 0;
+         loop
+            L_Node := L.Buckets (L_Index);
+            exit when L_Node /= null;
+            L_Index := L_Index + 1;
+         end loop;
 
-         L_Node := Next (L_Node);
+         --  For each node of hash table L, search for an equivalent node in
+         --  hash table R.
 
-         if L_Node = null then
-            --  We have exhausted the nodes in this bucket
-
-            if N = 0 then
-               return True;
+         N := L.Length;
+         loop
+            if not Find (HT => R, Key => L_Node) then
+               return False;
             end if;
 
-            --  Find the next bucket
+            N := N - 1;
 
-            loop
-               L_Index := L_Index + 1;
-               L_Node := L.Buckets (L_Index);
-               exit when L_Node /= null;
-            end loop;
-         end if;
-      end loop;
+            L_Node := Next (L_Node);
+
+            if L_Node = null then
+               --  We have exhausted the nodes in this bucket
+
+               if N = 0 then
+                  return True;
+               end if;
+
+               --  Find the next bucket
+
+               loop
+                  L_Index := L_Index + 1;
+                  L_Node := L.Buckets (L_Index);
+                  exit when L_Node /= null;
+               end loop;
+            end if;
+         end loop;
+      end;
    end Generic_Equal;
 
    -----------------------
Index: a-cobove.adb
===================================================================
--- a-cobove.adb	(revision 229051)
+++ a-cobove.adb	(working copy)
@@ -269,22 +269,29 @@ 
    ---------
 
    overriding function "=" (Left, Right : Vector) return Boolean is
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
-      Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
    begin
       if Left.Last /= Right.Last then
          return False;
       end if;
 
-      for J in Count_Type range 1 .. Left.Length loop
-         if Left.Elements (J) /= Right.Elements (J) then
-            return False;
-         end if;
-      end loop;
+      if Left.Length = 0 then
+         return True;
+      end if;
 
+      declare
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
+      begin
+         for J in Count_Type range 1 .. Left.Length loop
+            if Left.Elements (J) /= Right.Elements (J) then
+               return False;
+            end if;
+         end loop;
+      end;
+
       return True;
    end "=";
 
Index: a-convec.adb
===================================================================
--- a-convec.adb	(revision 229049)
+++ a-convec.adb	(working copy)
@@ -100,22 +100,29 @@ 
    ---------
 
    overriding function "=" (Left, Right : Vector) return Boolean is
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
-      Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
    begin
       if Left.Last /= Right.Last then
          return False;
       end if;
 
-      for J in Index_Type range Index_Type'First .. Left.Last loop
-         if Left.Elements.EA (J) /= Right.Elements.EA (J) then
-            return False;
-         end if;
-      end loop;
+      if Left.Length = 0 then
+         return True;
+      end if;
 
+      declare
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
+      begin
+         for J in Index_Type range Index_Type'First .. Left.Last loop
+            if Left.Elements.EA (J) /= Right.Elements.EA (J) then
+               return False;
+            end if;
+         end loop;
+      end;
+
       return True;
    end "=";
 
@@ -125,6 +132,12 @@ 
 
    procedure Adjust (Container : in out Vector) is
    begin
+      --  If the counts are nonzero, execution is technically erroneous, but
+      --  it seems friendly to allow things like concurrent "=" on shared
+      --  constants.
+
+      Zero_Counts (Container.TC);
+
       if Container.Last = No_Index then
          Container.Elements := null;
          return;
@@ -137,7 +150,6 @@ 
 
       begin
          Container.Elements := null;
-         Zero_Counts (Container.TC);
 
          --  Note: it may seem that the following assignment to Container.Last
          --  is useless, since we assign it to L below. However this code is
Index: a-cbdlli.adb
===================================================================
--- a-cbdlli.adb	(revision 229049)
+++ a-cbdlli.adb	(working copy)
@@ -84,33 +84,38 @@ 
    ---------
 
    function "=" (Left, Right : List) return Boolean is
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
-      Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
-
-      LN : Node_Array renames Left.Nodes;
-      RN : Node_Array renames Right.Nodes;
-
-      LI : Count_Type;
-      RI : Count_Type;
    begin
       if Left.Length /= Right.Length then
          return False;
       end if;
 
-      LI := Left.First;
-      RI := Right.First;
-      for J in 1 .. Left.Length loop
-         if LN (LI).Element /= RN (RI).Element then
-            return False;
-         end if;
+      if Left.Length = 0 then
+         return True;
+      end if;
 
-         LI := LN (LI).Next;
-         RI := RN (RI).Next;
-      end loop;
+      declare
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
 
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
+
+         LN : Node_Array renames Left.Nodes;
+         RN : Node_Array renames Right.Nodes;
+
+         LI : Count_Type := Left.First;
+         RI : Count_Type := Right.First;
+      begin
+         for J in 1 .. Left.Length loop
+            if LN (LI).Element /= RN (RI).Element then
+               return False;
+            end if;
+
+            LI := LN (LI).Next;
+            RI := RN (RI).Next;
+         end loop;
+      end;
+
       return True;
    end "=";