diff options
Diffstat (limited to 'gcc/ada/a-cimutr.adb')
-rw-r--r-- | gcc/ada/a-cimutr.adb | 70 |
1 files changed, 57 insertions, 13 deletions
diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb index daac18feb04..c3887a57769 100644 --- a/gcc/ada/a-cimutr.adb +++ b/gcc/ada/a-cimutr.adb @@ -441,6 +441,40 @@ package body Ada.Containers.Indefinite_Multiway_Trees is pragma Assert (Children_Count = Container_Count); end Clear; + ------------------------ + -- Constant_Reference -- + ------------------------ + + function Constant_Reference + (Container : aliased Tree; + 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; + + if Position.Node = Root_Node (Container) then + raise Program_Error with "Position cursor designates root"; + end if; + + if Position.Node.Element = null then + raise Program_Error with "Node has no element"; + end if; + + -- Implement Vet for multiway tree??? + -- pragma Assert (Vet (Position), + -- "Position cursor in Constant_Reference is bad"); + + return (Element => Position.Node.Element.all'Access); + end Constant_Reference; + -------------- -- Contains -- -------------- @@ -1980,24 +2014,34 @@ package body Ada.Containers.Indefinite_Multiway_Trees is -- Reference -- --------------- - function Constant_Reference - (Container : aliased Tree; - Position : Cursor) return Constant_Reference_Type - is - begin - pragma Unreferenced (Container); - - return (Element => Position.Node.Element.all'Unchecked_Access); - end Constant_Reference; - function Reference - (Container : aliased Tree; + (Container : aliased in out Tree; Position : Cursor) return Reference_Type is begin - pragma Unreferenced (Container); + 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; + + if Position.Node = Root_Node (Container) then + raise Program_Error with "Position cursor designates root"; + end if; + + if Position.Node.Element = null then + raise Program_Error with "Node has no element"; + end if; + + -- Implement Vet for multiway tree??? + -- pragma Assert (Vet (Position), + -- "Position cursor in Constant_Reference is bad"); - return (Element => Position.Node.Element.all'Unchecked_Access); + return (Element => Position.Node.Element.all'Access); end Reference; -------------------- |