From c9423ca3fa65282b0ca58d33976c150f78e24f23 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 10 Jan 2012 12:06:44 +0100 Subject: [multiple changes] 2012-01-10 Pascal Obry * prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source directories for aggregate libraries. 2012-01-10 Matthew Heaney * a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb, a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads, a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb, a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads, a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb, a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb, a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb, a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads, a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare container parameter as aliased in/in out. Code clean ups. 2012-01-10 Bob Duff * s-os_lib.ads: Improve comment. 2012-01-10 Geert Bosch * s-gearop.adb (Forward_Eliminate): Avoid improper aliasing for complex Scalar. From-SVN: r183060 --- gcc/ada/a-cborse.adb | 172 +++++++++++++++++++++++++++++++++++---------------- 1 file changed, 117 insertions(+), 55 deletions(-) (limited to 'gcc/ada/a-cborse.adb') diff --git a/gcc/ada/a-cborse.adb b/gcc/ada/a-cborse.adb index 557983d..62417f3 100644 --- a/gcc/ada/a-cborse.adb +++ b/gcc/ada/a-cborse.adb @@ -402,6 +402,35 @@ package body Ada.Containers.Bounded_Ordered_Sets is return Node.Color; end Color; + ------------------------ + -- 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 (Container, Position.Node), + "bad cursor in Constant_Reference"); + + declare + N : Node_Type renames Container.Nodes (Position.Node); + begin + return (Element => N.Element'Access); + end; + end Constant_Reference; + -------------- -- Contains -- -------------- @@ -697,6 +726,28 @@ package body Ada.Containers.Bounded_Ordered_Sets is else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; + ------------------------ + -- Constant_Reference -- + ------------------------ + + function Constant_Reference + (Container : aliased Set; + Key : Key_Type) return Constant_Reference_Type + is + Node : constant Count_Type := Key_Keys.Find (Container, Key); + + begin + if Node = 0 then + raise Constraint_Error with "key not in set"; + end if; + + declare + N : Node_Type renames Container.Nodes (Node); + begin + return (Element => N.Element'Access); + end; + end Constant_Reference; + -------------- -- Contains -- -------------- @@ -822,6 +873,69 @@ package body Ada.Containers.Bounded_Ordered_Sets is return Key (Position.Container.Nodes (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 (Container, Position.Node), + "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. ??? + + declare + N : Node_Type renames Container.Nodes (Position.Node); + begin + return (Element => N.Element'Access); + end; + end Reference_Preserving_Key; + + function Reference_Preserving_Key + (Container : aliased in out Set; + Key : Key_Type) return Reference_Type + is + Node : constant Count_Type := Key_Keys.Find (Container, Key); + + begin + if Node = 0 then + raise Constraint_Error with "key not in set"; + end if; + + declare + N : Node_Type renames Container.Nodes (Node); + begin + return (Element => N.Element'Access); + end; + end Reference_Preserving_Key; + ------------- -- Replace -- ------------- @@ -900,45 +1014,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is raise Program_Error with "key was modified"; end Update_Element_Preserving_Key; - function Reference_Preserving_Key - (Container : aliased in out Set; - Key : Key_Type) return Constant_Reference_Type - is - Position : constant Cursor := Find (Container, Key); - - begin - if Position.Node = 0 then - raise Constraint_Error with "Position cursor has no element"; - end if; - - return - (Element => - Container.Nodes (Position.Node).Element'Unrestricted_Access); - end Reference_Preserving_Key; - - function Reference_Preserving_Key - (Container : aliased in out Set; - Key : Key_Type) return Reference_Type - is - Position : constant Cursor := Find (Container, Key); - - begin - if Position.Node = 0 then - raise Constraint_Error with "Position cursor has no element"; - end if; - - return - (Element => - Container.Nodes (Position.Node).Element'Unrestricted_Access); - end Reference_Preserving_Key; - - 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; + ----------- + -- Write -- + ----------- procedure Write (Stream : not null access Root_Stream_Type'Class; @@ -1585,22 +1663,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is raise Program_Error with "attempt to stream reference"; end Read; - --------------- - -- Reference -- - --------------- - - function Constant_Reference (Container : 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; - - return (Element => - Container.Nodes (Position.Node).Element'Unrestricted_Access); - end Constant_Reference; - ------------- -- Replace -- ------------- -- cgit v1.1