From 2c3d0a6d737c0b55769f8e2169bc210b85575f72 Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 15 Nov 2005 13:54:02 +0000 Subject: 2005-11-14 Matthew Heaney * a-crbtgo.ads, a-crbtgo.adb, a-coorse.ads, a-coorse.adb, a-convec.ads, a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohama.ads, a-cohama.adb, a-ciorse.ads, a-ciorse.adb, a-cihama.ads, a-cihama.adb, a-cidlli.ads, a-cidlli.adb, a-cdlili.ads, a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cihase.ads, a-cohase.adb, a-cohase.ads, a-ciorma.ads, a-coorma.ads, a-ciormu.ads, a-coormu.ads, a-ciorma.adb, a-coorma.adb: Compiles against the spec for ordered maps described in sections A.18.6 of the most recent (August 2005) AI-302 draft. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106962 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/a-cohama.adb | 51 +++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 39 insertions(+), 12 deletions(-) (limited to 'gcc/ada/a-cohama.adb') diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb index 1a165499f90..d235d0b0c79 100644 --- a/gcc/ada/a-cohama.adb +++ b/gcc/ada/a-cohama.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 -- @@ -624,6 +624,7 @@ package body Ada.Containers.Hashed_Maps is declare HT : Hash_Table_Type renames Position.Container.HT; Node : constant Node_Access := HT_Ops.Next (HT, Position.Node); + begin if Node = null then return No_Element; @@ -695,6 +696,14 @@ package body Ada.Containers.Hashed_Maps 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 -- --------------- @@ -743,7 +752,11 @@ package body Ada.Containers.Hashed_Maps is -- Replace_Element -- --------------------- - procedure Replace_Element (Position : Cursor; By : Element_Type) is + procedure Replace_Element + (Container : in out Map; + Position : Cursor; + New_Item : Element_Type) + is begin pragma Assert (Vet (Position), "bad cursor in Replace_Element"); @@ -751,11 +764,15 @@ package body Ada.Containers.Hashed_Maps is raise Constraint_Error; end if; + if Position.Container /= Container'Unrestricted_Access then + raise Program_Error; + end if; + if Position.Container.HT.Lock > 0 then raise Program_Error; end if; - Position.Node.Element := By; + Position.Node.Element := New_Item; end Replace_Element; ---------------------- @@ -784,9 +801,10 @@ package body Ada.Containers.Hashed_Maps is -------------------- procedure Update_Element - (Position : Cursor; - Process : not null access procedure (Key : Key_Type; - Element : in out Element_Type)) + (Container : in out Map; + Position : Cursor; + Process : not null access procedure (Key : Key_Type; + Element : in out Element_Type)) is begin pragma Assert (Vet (Position), "bad cursor in Update_Element"); @@ -795,12 +813,14 @@ package body Ada.Containers.Hashed_Maps is raise Constraint_Error; end if; - declare - M : Map renames Position.Container.all; - HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; + if Position.Container /= Container'Unrestricted_Access then + raise Program_Error; + end if; - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; + declare + HT : Hash_Table_Type renames Container.HT; + B : Natural renames HT.Busy; + L : Natural renames HT.Lock; begin B := B + 1; @@ -809,7 +829,6 @@ package body Ada.Containers.Hashed_Maps is declare K : Key_Type renames Position.Node.Key; E : Element_Type renames Position.Node.Element; - begin Process (K, E); exception @@ -891,6 +910,14 @@ package body Ada.Containers.Hashed_Maps 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 -- ---------------- -- cgit v1.2.1