diff options
Diffstat (limited to 'gcc/ada/a-cbhase.adb')
| -rw-r--r-- | gcc/ada/a-cbhase.adb | 59 |
1 files changed, 43 insertions, 16 deletions
diff --git a/gcc/ada/a-cbhase.adb b/gcc/ada/a-cbhase.adb index 99efc1dcf79..640fb8e6136 100644 --- a/gcc/ada/a-cbhase.adb +++ b/gcc/ada/a-cbhase.adb @@ -328,6 +328,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is is Tgt_Node, Src_Node : Count_Type; + Src : Set renames Source'Unrestricted_Access.all; + TN : Nodes_Type renames Target.Nodes; SN : Nodes_Type renames Source.Nodes; @@ -356,7 +358,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is HT_Ops.Free (Target, Tgt_Node); end if; - Src_Node := HT_Ops.Next (Source, Src_Node); + Src_Node := HT_Ops.Next (Src, Src_Node); end loop; else @@ -481,7 +483,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is return True; end if; - R_Node := HT_Ops.Next (R_HT, R_Node); + R_Node := Next (R_HT.Nodes (R_Node)); end loop; end Find_Equivalent_Key; @@ -512,6 +514,20 @@ package body Ada.Containers.Bounded_Hashed_Sets is pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Elements"); pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Elements"); + -- AI05-0022 requires that a container implementation detect element + -- tampering by a generic actual subprogram. However, the following case + -- falls outside the scope of that AI. Randy Brukardt explained on the + -- ARG list on 2013/02/07 that: + + -- (Begin Quote): + -- But for an operation like "<" [the ordered set analog of + -- Equivalent_Elements], there is no need to "dereference" a cursor + -- after the call to the generic formal parameter function, so nothing + -- bad could happen if tampering is undetected. And the operation can + -- safely return a result without a problem even if an element is + -- deleted from the container. + -- (End Quote). + declare LN : Node_Type renames Left.Container.Nodes (Left.Node); RN : Node_Type renames Right.Container.Nodes (Right.Node); @@ -609,7 +625,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Container : Set; Item : Element_Type) return Cursor is - Node : constant Count_Type := Element_Keys.Find (Container, Item); + Node : constant Count_Type := + Element_Keys.Find (Container'Unrestricted_Access.all, Item); begin return (if Node = 0 then No_Element else Cursor'(Container'Unrestricted_Access, Node)); @@ -865,7 +882,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is function Is_In (HT : Set; Key : Node_Type) return Boolean is begin - return Element_Keys.Find (HT, Key.Element) /= 0; + return Element_Keys.Find (HT'Unrestricted_Access.all, Key.Element) /= 0; end Is_In; --------------- @@ -890,7 +907,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is if not Is_In (Of_Set, SN (Subset_Node)) then return False; end if; - Subset_Node := HT_Ops.Next (Subset, Subset_Node); + Subset_Node := HT_Ops.Next + (Subset'Unrestricted_Access.all, Subset_Node); end loop; return True; @@ -1049,7 +1067,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is if Is_In (Right, Left.Nodes (Left_Node)) then return True; end if; - Left_Node := HT_Ops.Next (Left, Left_Node); + Left_Node := HT_Ops.Next (Left'Unrestricted_Access.all, Left_Node); end loop; return False; @@ -1481,7 +1499,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is return False; end if; - X := S.Buckets (Element_Keys.Index (S, N (Position.Node).Element)); + X := S.Buckets (Element_Keys.Checked_Index + (S, N (Position.Node).Element)); for J in 1 .. S.Length loop if X = Position.Node then @@ -1585,7 +1604,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Container : aliased Set; Key : Key_Type) return Constant_Reference_Type is - Node : constant Count_Type := Key_Keys.Find (Container, Key); + Node : constant Count_Type := + Key_Keys.Find (Container'Unrestricted_Access.all, Key); begin if Node = 0 then @@ -1639,11 +1659,12 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Container : Set; Key : Key_Type) return Element_Type is - Node : constant Count_Type := Key_Keys.Find (Container, Key); + Node : constant Count_Type := + Key_Keys.Find (Container'Unrestricted_Access.all, Key); begin if Node = 0 then - raise Constraint_Error with "key not in map"; -- ??? "set" + raise Constraint_Error with "key not in set"; end if; return Container.Nodes (Node).Element; @@ -1683,7 +1704,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Container : Set; Key : Key_Type) return Cursor is - Node : constant Count_Type := Key_Keys.Find (Container, Key); + Node : constant Count_Type := + Key_Keys.Find (Container'Unrestricted_Access.all, Key); begin return (if Node = 0 then No_Element else Cursor'(Container'Unrestricted_Access, Node)); @@ -1825,9 +1847,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Vet (Position), "bad cursor in Update_Element_Preserving_Key"); - -- Record bucket now, in case key is changed - - Indx := HT_Ops.Index (Container.Buckets, N (Position.Node)); + -- Per AI05-0022, the container implementation is required to detect + -- element tampering by a generic actual subprogram. declare E : Element_Type renames N (Position.Node).Element; @@ -1836,12 +1857,19 @@ package body Ada.Containers.Bounded_Hashed_Sets is B : Natural renames Container.Busy; L : Natural renames Container.Lock; + Eq : Boolean; + begin B := B + 1; L := L + 1; begin + -- Record bucket now, in case key is changed + Indx := HT_Ops.Index (Container.Buckets, N (Position.Node)); + Process (E); + + Eq := Equivalent_Keys (K, Key (E)); exception when others => L := L - 1; @@ -1852,8 +1880,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is L := L - 1; B := B - 1; - if Equivalent_Keys (K, Key (E)) then - pragma Assert (Hash (K) = Hash (E)); + if Eq then return; end if; end; |