diff options
Diffstat (limited to 'gcc/ada/a-cohase.adb')
| -rw-r--r-- | gcc/ada/a-cohase.adb | 140 |
1 files changed, 110 insertions, 30 deletions
diff --git a/gcc/ada/a-cohase.adb b/gcc/ada/a-cohase.adb index cf3354270d7..dd09da5a17c 100644 --- a/gcc/ada/a-cohase.adb +++ b/gcc/ada/a-cohase.adb @@ -198,6 +198,29 @@ package body Ada.Containers.Hashed_Sets is HT_Ops.Clear (Container.HT); end Clear; + ------------------------ + -- Constant_Reference -- + ------------------------ + + function Constant_Reference + (Container : aliased Set; + Position : Cursor) return Constant_Reference_Type + is + begin + if Position.Container = null then + raise Constraint_Error with "Position cursor has no element"; + end if; + + if Position.Container /= Container'Unrestricted_Access then + raise Program_Error with + "Position cursor designates wrong container"; + end if; + + pragma Assert (Vet (Position), "bad cursor in Constant_Reference"); + + return (Element => Position.Node.Element'Access); + end Constant_Reference; + -------------- -- Contains -- -------------- @@ -1126,19 +1149,6 @@ package body Ada.Containers.Hashed_Sets is raise; end Read_Node; - --------------- - -- Reference -- - --------------- - - function Constant_Reference - (Container : aliased Set; - Position : Cursor) return Constant_Reference_Type - is - pragma Unreferenced (Container); - begin - return (Element => Position.Node.Element'Unrestricted_Access); - end Constant_Reference; - ------------- -- Replace -- ------------- @@ -1720,6 +1730,25 @@ package body Ada.Containers.Hashed_Sets is Hash => Hash, Equivalent_Keys => Equivalent_Key_Node); + ------------------------ + -- Constant_Reference -- + ------------------------ + + function Constant_Reference + (Container : aliased Set; + Key : Key_Type) return Constant_Reference_Type + is + Node : constant Node_Access := + Key_Keys.Find (Container.HT, Key); + + begin + if Node = null then + raise Constraint_Error with "Key not in set"; + end if; + + return (Element => Node.Element'Access); + end Constant_Reference; + -------------- -- Contains -- -------------- @@ -1831,6 +1860,66 @@ package body Ada.Containers.Hashed_Sets is return Key (Position.Node.Element); end Key; + ---------- + -- Read -- + ---------- + + procedure Read + (Stream : not null access Root_Stream_Type'Class; + Item : out Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Read; + + ------------------------------ + -- Reference_Preserving_Key -- + ------------------------------ + + function Reference_Preserving_Key + (Container : aliased in out Set; + Position : Cursor) return Reference_Type + is + begin + if Position.Container = null then + raise Constraint_Error with "Position cursor has no element"; + end if; + + if Position.Container /= Container'Unrestricted_Access then + raise Program_Error with + "Position cursor designates wrong container"; + end if; + + pragma Assert + (Vet (Position), + "bad cursor in function Reference_Preserving_Key"); + + -- Some form of finalization will be required in order to actually + -- check that the key-part of the element designated by Position has + -- not changed. ??? + + return (Element => Position.Node.Element'Access); + end Reference_Preserving_Key; + + function Reference_Preserving_Key + (Container : aliased in out Set; + Key : Key_Type) return Reference_Type + is + Node : constant Node_Access := + Key_Keys.Find (Container.HT, Key); + + begin + if Node = null then + raise Constraint_Error with "Key not in set"; + end if; + + -- Some form of finalization will be required in order to actually + -- check that the key-part of the element designated by Key has not + -- changed. ??? + + return (Element => Node.Element'Access); + end Reference_Preserving_Key; + ------------- -- Replace -- ------------- @@ -1952,27 +2041,18 @@ package body Ada.Containers.Hashed_Sets is raise Program_Error with "key was modified"; end Update_Element_Preserving_Key; - ------------------------------ - -- Reference_Preserving_Key -- - ------------------------------ + ----------- + -- Write -- + ----------- - function Reference_Preserving_Key - (Container : aliased in out Set; - Position : Cursor) return Reference_Type + procedure Write + (Stream : not null access Root_Stream_Type'Class; + Item : Reference_Type) is - pragma Unreferenced (Container); begin - return (Element => Position.Node.Element'Unrestricted_Access); - end Reference_Preserving_Key; + raise Program_Error with "attempt to stream reference"; + end Write; - function Reference_Preserving_Key - (Container : aliased in out Set; - Key : Key_Type) return Reference_Type - is - Position : constant Cursor := Find (Container, Key); - begin - return (Element => Position.Node.Element'Unrestricted_Access); - end Reference_Preserving_Key; end Generic_Keys; end Ada.Containers.Hashed_Sets; |