Commit 2546734c by Arnaud Charlet

[multiple changes]

2009-11-30  Thomas Quinot  <quinot@adacore.com>

	* g-sechas.adb: Minor reformatting

2009-11-30  Matthew Heaney  <heaney@adacore.com>

	* a-crbtgo.adb (Delete_Fixup): Add comments explaining why predicates
	were removed.
	* a-cdlili.adb (Vet): Remove always-true predicates.

From-SVN: r154823
parent 36e76408
2009-11-30 Thomas Quinot <quinot@adacore.com> 2009-11-30 Thomas Quinot <quinot@adacore.com>
* g-sechas.adb: Minor reformatting
2009-11-30 Matthew Heaney <heaney@adacore.com>
* a-crbtgo.adb (Delete_Fixup): Add comments explaining why predicates
were removed.
* a-cdlili.adb (Vet): Remove always-true predicates.
2009-11-30 Thomas Quinot <quinot@adacore.com>
* s-sechas.adb, s-sechas.ads, s-shshco.adb, s-shshco.ads, s-shsh64.adb, * s-sechas.adb, s-sechas.ads, s-shshco.adb, s-shshco.ads, s-shsh64.adb,
s-shsh64.ads, s-sehamd.adb, s-sehamd.ads, s-shsh32.adb, s-shsh32.ads, s-shsh64.ads, s-sehamd.adb, s-sehamd.ads, s-shsh32.adb, s-shsh32.ads,
s-sehash.adb, s-sehash.ads, g-sechas.adb, g-sechas.ads, g-shshco.adb, s-sehash.adb, s-sehash.ads, g-sechas.adb, g-sechas.ads, g-shshco.adb,
......
...@@ -1711,12 +1711,18 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1711,12 +1711,18 @@ package body Ada.Containers.Doubly_Linked_Lists is
return False; return False;
end if; end if;
-- If we get here, we know that this disjunction is true:
-- Position.Node.Prev /= null or else Position.Node = L.First
if Position.Node.Next = null if Position.Node.Next = null
and then Position.Node /= L.Last and then Position.Node /= L.Last
then then
return False; return False;
end if; end if;
-- If we get here, we know that this disjunction is true:
-- Position.Node.Next /= null or else Position.Node = L.Last
if L.Length = 1 then if L.Length = 1 then
return L.First = L.Last; return L.First = L.Last;
end if; end if;
...@@ -1761,21 +1767,21 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1761,21 +1767,21 @@ package body Ada.Containers.Doubly_Linked_Lists is
return False; return False;
end if; end if;
if Position.Node = L.First then if Position.Node = L.First then -- eliminates ealier disjunct
return True; return True;
end if; end if;
if Position.Node = L.Last then -- If we get here, we know, per disjunctive syllogism (modus
return True; -- tollendo ponens), that this predicate is true:
end if; -- Position.Node.Prev /= null
if Position.Node.Next = null then if Position.Node = L.Last then -- eliminates earlier disjunct
return False; return True;
end if; end if;
if Position.Node.Prev = null then -- If we get here, we know, per disjunctive syllogism (modus
return False; -- tollendo ponens), that this predicate is true:
end if; -- Position.Node.Next /= null
if Position.Node.Next.Prev /= Position.Node then if Position.Node.Next.Prev /= Position.Node then
return False; return False;
......
...@@ -49,6 +49,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is ...@@ -49,6 +49,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
procedure Left_Rotate (Tree : in out Tree_Type; X : Node_Access); procedure Left_Rotate (Tree : in out Tree_Type; X : Node_Access);
procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access); procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access);
-- Why is all the following code commented out ???
-- --------------------- -- ---------------------
-- -- Check_Invariant -- -- -- Check_Invariant --
-- --------------------- -- ---------------------
...@@ -171,8 +173,15 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is ...@@ -171,8 +173,15 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
if Right (W) = null if Right (W) = null
or else Color (Right (W)) = Black or else Color (Right (W)) = Black
then then
-- As a condition for setting the color of the left child to
-- black, the left child access value must be non-null. A
-- truth table analysis shows that if we arrive here, that
-- condition holds, so there's no need for an explicit test.
-- The assertion is here to document what we know is true.
pragma Assert (Left (W) /= null); pragma Assert (Left (W) /= null);
Set_Color (Left (W), Black); Set_Color (Left (W), Black);
Set_Color (W, Red); Set_Color (W, Red);
Right_Rotate (Tree, W); Right_Rotate (Tree, W);
W := Right (Parent (X)); W := Right (Parent (X));
...@@ -206,8 +215,16 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is ...@@ -206,8 +215,16 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
else else
if Left (W) = null or else Color (Left (W)) = Black then if Left (W) = null or else Color (Left (W)) = Black then
-- As a condition for setting the color of the right child
-- to black, the right child access value must be non-null.
-- A truth table analysis shows that if we arrive here, that
-- condition holds, so there's no need for an explicit test.
-- The assertion is here to document what we know is true.
pragma Assert (Right (W) /= null); pragma Assert (Right (W) /= null);
Set_Color (Right (W), Black); Set_Color (Right (W), Black);
Set_Color (W, Red); Set_Color (W, Red);
Left_Rotate (Tree, W); Left_Rotate (Tree, W);
W := Left (Parent (X)); W := Left (Parent (X));
...@@ -246,6 +263,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is ...@@ -246,6 +263,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
"attempt to tamper with cursors (container is busy)"; "attempt to tamper with cursors (container is busy)";
end if; end if;
-- Why are these all commented out ???
-- pragma Assert (Tree.Length > 0); -- pragma Assert (Tree.Length > 0);
-- pragma Assert (Tree.Root /= null); -- pragma Assert (Tree.Root /= null);
-- pragma Assert (Tree.First /= null); -- pragma Assert (Tree.First /= null);
......
...@@ -37,8 +37,7 @@ package body GNAT.Secure_Hashes is ...@@ -37,8 +37,7 @@ package body GNAT.Secure_Hashes is
use Ada.Streams; use Ada.Streams;
Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character := Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character :=
('0', '1', '2', '3', '4', '5', '6', '7', "0123456789abcdef";
'8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
type Fill_Buffer_Access is type Fill_Buffer_Access is
access procedure access procedure
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment