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-convec.adb | 89 ++++++++++++++++++++++++++++------------------------ 1 file changed, 48 insertions(+), 41 deletions(-) (limited to 'gcc/ada/a-convec.adb') diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index f80dd3b..2e35235 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -478,6 +478,42 @@ package body Ada.Containers.Vectors is end if; end Clear; + ------------------------ + -- Constant_Reference -- + ------------------------ + + function Constant_Reference + (Container : aliased Vector; + 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 denotes wrong container"; + end if; + + if Position.Index > Position.Container.Last then + raise Constraint_Error with "Position cursor is out of range"; + end if; + + return (Element => Container.Elements.EA (Position.Index)'Access); + end Constant_Reference; + + function Constant_Reference + (Container : aliased Vector; + Index : Index_Type) return Constant_Reference_Type + is + begin + if Index > Container.Last then + raise Constraint_Error with "Index is out of range"; + else + return (Element => Container.Elements.EA (Index)'Access); + end if; + end Constant_Reference; + -------------- -- Contains -- -------------- @@ -2538,64 +2574,35 @@ package body Ada.Containers.Vectors is -- Reference -- --------------- - function Constant_Reference - (Container : Vector; - Position : Cursor) -- SHOULD BE ALIASED - return Constant_Reference_Type + function Reference + (Container : aliased in out Vector; + 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.Index > Position.Container.Last then - raise Constraint_Error with "Position cursor is out of range"; - end if; - - return - (Element => - Position.Container.Elements.EA (Position.Index)'Access); - end Constant_Reference; - - function Constant_Reference - (Container : Vector; - Position : Index_Type) - return Constant_Reference_Type - is - begin - if Position > Container.Last then - raise Constraint_Error with "Index is out of range"; - else - return (Element => Container.Elements.EA (Position)'Access); - end if; - end Constant_Reference; - - function Reference (Container : Vector; Position : Cursor) - return Reference_Type is - begin - pragma Unreferenced (Container); - - if Position.Container = null then - raise Constraint_Error with "Position cursor has no element"; + if Position.Container /= Container'Unrestricted_Access then + raise Program_Error with "Position cursor denotes wrong container"; end if; if Position.Index > Position.Container.Last then raise Constraint_Error with "Position cursor is out of range"; end if; - return - (Element => Position.Container.Elements.EA (Position.Index)'Access); + return (Element => Container.Elements.EA (Position.Index)'Access); end Reference; - function Reference (Container : Vector; Position : Index_Type) - return Reference_Type is + function Reference + (Container : aliased in out Vector; + Index : Index_Type) return Reference_Type + is begin - if Position > Container.Last then + if Index > Container.Last then raise Constraint_Error with "Index is out of range"; else - return (Element => Container.Elements.EA (Position)'Access); + return (Element => Container.Elements.EA (Index)'Access); end if; end Reference; -- cgit v1.1