diff options
Diffstat (limited to 'gcc/ada/a-cohase.adb')
| -rw-r--r-- | gcc/ada/a-cohase.adb | 88 |
1 files changed, 65 insertions, 23 deletions
diff --git a/gcc/ada/a-cohase.adb b/gcc/ada/a-cohase.adb index 05a2416c7b5..afb219055d5 100644 --- a/gcc/ada/a-cohase.adb +++ b/gcc/ada/a-cohase.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -72,6 +72,12 @@ package body Ada.Containers.Hashed_Sets is function Hash_Node (Node : Node_Access) return Hash_Type; pragma Inline (Hash_Node); + procedure Insert + (HT : in out Hash_Table_Type; + New_Item : Element_Type; + Node : out Node_Access; + Inserted : out Boolean); + function Is_In (HT : Hash_Table_Type; Key : Node_Access) return Boolean; @@ -595,6 +601,32 @@ package body Ada.Containers.Hashed_Sets is Position : out Cursor; Inserted : out Boolean) is + begin + Insert (Container.HT, New_Item, Position.Node, Inserted); + Position.Container := Container'Unchecked_Access; + end Insert; + + procedure Insert + (Container : in out Set; + New_Item : Element_Type) + is + Position : Cursor; + Inserted : Boolean; + + begin + Insert (Container, New_Item, Position, Inserted); + + if not Inserted then + raise Constraint_Error; + end if; + end Insert; + + procedure Insert + (HT : in out Hash_Table_Type; + New_Item : Element_Type; + Node : out Node_Access; + Inserted : out Boolean) + is function New_Node (Next : Node_Access) return Node_Access; pragma Inline (New_Node); @@ -606,13 +638,10 @@ package body Ada.Containers.Hashed_Sets is -------------- function New_Node (Next : Node_Access) return Node_Access is - Node : constant Node_Access := new Node_Type'(New_Item, Next); begin - return Node; + return new Node_Type'(New_Item, Next); end New_Node; - HT : Hash_Table_Type renames Container.HT; - -- Start of processing for Insert begin @@ -620,30 +649,13 @@ package body Ada.Containers.Hashed_Sets is HT_Ops.Reserve_Capacity (HT, 1); end if; - Local_Insert (HT, New_Item, Position.Node, Inserted); + Local_Insert (HT, New_Item, Node, Inserted); if Inserted and then HT.Length > HT_Ops.Capacity (HT) then HT_Ops.Reserve_Capacity (HT, HT.Length); end if; - - Position.Container := Container'Unchecked_Access; - end Insert; - - procedure Insert - (Container : in out Set; - New_Item : Element_Type) - is - Position : Cursor; - Inserted : Boolean; - - begin - Insert (Container, New_Item, Position, Inserted); - - if not Inserted then - raise Constraint_Error; - end if; end Insert; ------------------ @@ -970,6 +982,14 @@ package body Ada.Containers.Hashed_Sets is Read_Nodes (Stream, Container.HT); end Read; + procedure Read + (Stream : access Root_Stream_Type'Class; + Item : out Cursor) + is + begin + raise Program_Error; + end Read; + --------------- -- Read_Node -- --------------- @@ -1366,6 +1386,20 @@ package body Ada.Containers.Hashed_Sets is return (Controlled with HT => (Buckets, Length, 0, 0)); end Symmetric_Difference; + ------------ + -- To_Set -- + ------------ + + function To_Set (New_Item : Element_Type) return Set is + HT : Hash_Table_Type; + Node : Node_Access; + Inserted : Boolean; + + begin + Insert (HT, New_Item, Node, Inserted); + return Set'(Controlled with HT); + end To_Set; + ----------- -- Union -- ----------- @@ -1595,6 +1629,14 @@ package body Ada.Containers.Hashed_Sets is Write_Nodes (Stream, Container.HT); end Write; + procedure Write + (Stream : access Root_Stream_Type'Class; + Item : Cursor) + is + begin + raise Program_Error; + end Write; + ---------------- -- Write_Node -- ---------------- |