Skip to content

R
riscv-gcc-1
Commit f97ccb3a by Bob Duff Committed by Arnaud Charlet
Options

a-cihama.ads, [...] (Next): Applied pragma Inline. 

2007-08-14  Bob Duff  <duff@adacore.com>

	* a-cihama.ads, a-cidlli.ads, a-chtgop.ads, a-chtgop.adb, a-cdlili.ads, 
	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-ciorse.ads, a-cohama.ads, 
	a-cohata.ads, a-convec.adb, a-coinve.ads, a-coinve.adb, a-convec.ads,
	a-coorse.ads (Next): Applied pragma Inline.
	Make all Containers packages Remote_Types (unless they are already
	Pure).
	(Previous): applied pragma Inline
	(Elements_Type): is now a record instead of an array

From-SVN: r127441
parent b11e8d6f
Showing with 561 additions and 407 deletions
gcc/ada/a-cdlili.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -44,6 +44,7 @@ generic ...@@ -44,6 +44,7 @@ generic
package Ada.Containers.Doubly_Linked_Lists is package Ada.Containers.Doubly_Linked_Lists is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
type List is tagged private; type List is tagged private;
pragma Preelaborable_Initialization (List); pragma Preelaborable_Initialization (List);
...@@ -204,6 +205,10 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -204,6 +205,10 @@ package Ada.Containers.Doubly_Linked_Lists is
end Generic_Sorting; end Generic_Sorting;
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-chtgop.adb
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,8 +37,10 @@ with System; use type System.Address; ...@@ -37,8 +37,10 @@ with System; use type System.Address;
package body Ada.Containers.Hash_Tables.Generic_Operations is package body Ada.Containers.Hash_Tables.Generic_Operations is
procedure Free is type Buckets_Allocation is access all Buckets_Type;
new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access); -- Used for allocation and deallocation (see New_Buckets and
-- Free_Buckets). This is necessary because Buckets_Access has an empty
-- storage pool.
------------ ------------
-- Adjust -- -- Adjust --
...@@ -66,7 +68,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -66,7 +68,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
-- source table. This has the benefit that when iterating, elements of -- source table. This has the benefit that when iterating, elements of
-- the target are delivered in the exact same order as for the source. -- the target are delivered in the exact same order as for the source.
HT.Buckets := new Buckets_Type (Src_Buckets'Range); HT.Buckets := New_Buckets (Length => Src_Buckets'Length);
for Src_Index in Src_Buckets'Range loop for Src_Index in Src_Buckets'Range loop
Src_Node := Src_Buckets (Src_Index); Src_Node := Src_Buckets (Src_Index);
...@@ -220,7 +222,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -220,7 +222,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
procedure Finalize (HT : in out Hash_Table_Type) is procedure Finalize (HT : in out Hash_Table_Type) is
begin begin
Clear (HT); Clear (HT);
Free (HT.Buckets); Free_Buckets (HT.Buckets);
end Finalize; end Finalize;
----------- -----------
...@@ -245,6 +247,21 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -245,6 +247,21 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end loop; end loop;
end First; end First;
------------------
-- Free_Buckets --
------------------
procedure Free_Buckets (Buckets : in out Buckets_Access) is
procedure Free is
new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Allocation);
begin
-- Buckets must have been created by New_Buckets. Here, we convert back
-- to the Buckets_Allocation type, and do the free on that.
Free (Buckets_Allocation (Buckets));
end Free_Buckets;
--------------------- ---------------------
-- Free_Hash_Table -- -- Free_Hash_Table --
--------------------- ---------------------
...@@ -265,7 +282,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -265,7 +282,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end loop; end loop;
end loop; end loop;
Free (Buckets); Free_Buckets (Buckets);
end Free_Hash_Table; end Free_Hash_Table;
------------------- -------------------
...@@ -273,8 +290,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -273,8 +290,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
------------------- -------------------
function Generic_Equal function Generic_Equal
(L, R : Hash_Table_Type) return Boolean is (L, R : Hash_Table_Type) return Boolean
is
L_Index : Hash_Type; L_Index : Hash_Type;
L_Node : Node_Access; L_Node : Node_Access;
...@@ -386,9 +403,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -386,9 +403,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
if HT.Buckets = null if HT.Buckets = null
or else HT.Buckets'Length < N or else HT.Buckets'Length < N
then then
Free (HT.Buckets); Free_Buckets (HT.Buckets);
NN := Prime_Numbers.To_Prime (N); NN := Prime_Numbers.To_Prime (N);
HT.Buckets := new Buckets_Type (0 .. NN - 1); HT.Buckets := New_Buckets (Length => NN);
end if; end if;
for J in 1 .. N loop for J in 1 .. N loop
...@@ -481,6 +498,20 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -481,6 +498,20 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
Source.Length := 0; Source.Length := 0;
end Move; end Move;
-----------------
-- New_Buckets --
-----------------
function New_Buckets (Length : Hash_Type) return Buckets_Access is
subtype Rng is Hash_Type range 0 .. Length - 1;
begin
-- Allocate in Buckets_Allocation'Storage_Pool, then convert to
-- Buckets_Access.
return Buckets_Access (Buckets_Allocation'(new Buckets_Type (Rng)));
end New_Buckets;
---------- ----------
-- Next -- -- Next --
---------- ----------
...@@ -521,7 +552,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -521,7 +552,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
if HT.Buckets = null then if HT.Buckets = null then
if N > 0 then if N > 0 then
NN := Prime_Numbers.To_Prime (N); NN := Prime_Numbers.To_Prime (N);
HT.Buckets := new Buckets_Type (0 .. NN - 1); HT.Buckets := New_Buckets (Length => NN);
end if; end if;
return; return;
...@@ -536,7 +567,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -536,7 +567,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
-- length that corresponds to a prime number.) -- length that corresponds to a prime number.)
if N = 0 then if N = 0 then
Free (HT.Buckets); Free_Buckets (HT.Buckets);
return; return;
end if; end if;
...@@ -553,8 +584,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -553,8 +584,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
declare declare
X : Buckets_Access := HT.Buckets; X : Buckets_Access := HT.Buckets;
begin begin
HT.Buckets := new Buckets_Type (0 .. NN - 1); HT.Buckets := New_Buckets (Length => NN);
Free (X); Free_Buckets (X);
end; end;
return; return;
...@@ -595,7 +626,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -595,7 +626,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if; end if;
Rehash : declare Rehash : declare
Dst_Buckets : Buckets_Access := new Buckets_Type (0 .. NN - 1); Dst_Buckets : Buckets_Access := New_Buckets (Length => NN);
Src_Buckets : Buckets_Access := HT.Buckets; Src_Buckets : Buckets_Access := HT.Buckets;
L : Count_Type renames HT.Length; L : Count_Type renames HT.Length;
...@@ -656,7 +687,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -656,7 +687,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end; end;
end loop; end loop;
Free (Dst_Buckets); Free_Buckets (Dst_Buckets);
raise Program_Error with raise Program_Error with
"hash function raised exception during rehash"; "hash function raised exception during rehash";
end; end;
...@@ -667,7 +698,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -667,7 +698,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
HT.Buckets := Dst_Buckets; HT.Buckets := Dst_Buckets;
HT.Length := LL; HT.Length := LL;
Free (Src_Buckets); Free_Buckets (Src_Buckets);
end Rehash; end Rehash;
end Reserve_Capacity; end Reserve_Capacity;
......
gcc/ada/a-chtgop.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -163,4 +163,15 @@ package Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -163,4 +163,15 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
-- first clears hash table HT, then populates the hash table by calling -- first clears hash table HT, then populates the hash table by calling
-- New_Node for each item in Stream. -- New_Node for each item in Stream.
function New_Buckets (Length : Hash_Type) return Buckets_Access;
pragma Inline (New_Buckets);
-- Allocate a new Buckets_Type array with bounds 0..Length-1.
procedure Free_Buckets (Buckets : in out Buckets_Access);
pragma Inline (Free_Buckets);
-- Unchecked_Deallocate Buckets.
-- Note: New_Buckets and Free_Buckets are needed because Buckets_Access has
-- an empty pool.
end Ada.Containers.Hash_Tables.Generic_Operations; end Ada.Containers.Hash_Tables.Generic_Operations;
gcc/ada/a-cidlli.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -45,6 +45,7 @@ generic ...@@ -45,6 +45,7 @@ generic
package Ada.Containers.Indefinite_Doubly_Linked_Lists is package Ada.Containers.Indefinite_Doubly_Linked_Lists is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
type List is tagged private; type List is tagged private;
pragma Preelaborable_Initialization (List); pragma Preelaborable_Initialization (List);
...@@ -195,6 +196,10 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -195,6 +196,10 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
end Generic_Sorting; end Generic_Sorting;
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-cihama.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -48,6 +48,7 @@ generic ...@@ -48,6 +48,7 @@ generic
package Ada.Containers.Indefinite_Hashed_Maps is package Ada.Containers.Indefinite_Hashed_Maps is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
type Map is tagged private; type Map is tagged private;
pragma Preelaborable_Initialization (Map); pragma Preelaborable_Initialization (Map);
...@@ -159,6 +160,7 @@ private ...@@ -159,6 +160,7 @@ private
pragma Inline (Reserve_Capacity); pragma Inline (Reserve_Capacity);
pragma Inline (Has_Element); pragma Inline (Has_Element);
pragma Inline (Equivalent_Keys); pragma Inline (Equivalent_Keys);
pragma Inline (Next);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-cihase.adb
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -340,7 +340,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -340,7 +340,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
declare declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length); Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Length := 0; Length := 0;
...@@ -817,7 +817,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -817,7 +817,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
declare declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Length); Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Length := 0; Length := 0;
...@@ -1372,7 +1372,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1372,7 +1372,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Size : constant Hash_Type := Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length); Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Length := 0; Length := 0;
...@@ -1574,7 +1574,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1574,7 +1574,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Size : constant Hash_Type := Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length); Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Iterate_Left : declare Iterate_Left : declare
......
gcc/ada/a-cihase.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -50,6 +50,7 @@ generic ...@@ -50,6 +50,7 @@ generic
package Ada.Containers.Indefinite_Hashed_Sets is package Ada.Containers.Indefinite_Hashed_Sets is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
type Set is tagged private; type Set is tagged private;
pragma Preelaborable_Initialization (Set); pragma Preelaborable_Initialization (Set);
...@@ -204,6 +205,9 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -204,6 +205,9 @@ package Ada.Containers.Indefinite_Hashed_Sets is
end Generic_Keys; end Generic_Keys;
private private
pragma Inline (Next);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-ciorma.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -47,6 +47,7 @@ generic ...@@ -47,6 +47,7 @@ generic
package Ada.Containers.Indefinite_Ordered_Maps is package Ada.Containers.Indefinite_Ordered_Maps is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
...@@ -176,6 +177,9 @@ package Ada.Containers.Indefinite_Ordered_Maps is ...@@ -176,6 +177,9 @@ package Ada.Containers.Indefinite_Ordered_Maps is
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-ciormu.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -46,6 +46,7 @@ generic ...@@ -46,6 +46,7 @@ generic
package Ada.Containers.Indefinite_Ordered_Multisets is package Ada.Containers.Indefinite_Ordered_Multisets is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean; function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
...@@ -238,6 +239,9 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -238,6 +239,9 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-ciorse.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -46,6 +46,7 @@ generic ...@@ -46,6 +46,7 @@ generic
package Ada.Containers.Indefinite_Ordered_Sets is package Ada.Containers.Indefinite_Ordered_Sets is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean; function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
...@@ -242,6 +243,9 @@ package Ada.Containers.Indefinite_Ordered_Sets is ...@@ -242,6 +243,9 @@ package Ada.Containers.Indefinite_Ordered_Sets is
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-cohama.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -47,6 +47,7 @@ generic ...@@ -47,6 +47,7 @@ generic
package Ada.Containers.Hashed_Maps is package Ada.Containers.Hashed_Maps is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
type Map is tagged private; type Map is tagged private;
pragma Preelaborable_Initialization (Map); pragma Preelaborable_Initialization (Map);
...@@ -164,6 +165,7 @@ private ...@@ -164,6 +165,7 @@ private
pragma Inline (Reserve_Capacity); pragma Inline (Reserve_Capacity);
pragma Inline (Has_Element); pragma Inline (Has_Element);
pragma Inline (Equivalent_Keys); pragma Inline (Equivalent_Keys);
pragma Inline (Next);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-cohase.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -327,7 +327,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -327,7 +327,7 @@ package body Ada.Containers.Hashed_Sets is
declare declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length); Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Length := 0; Length := 0;
...@@ -753,7 +753,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -753,7 +753,7 @@ package body Ada.Containers.Hashed_Sets is
declare declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Length); Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Length := 0; Length := 0;
...@@ -1248,7 +1248,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1248,7 +1248,7 @@ package body Ada.Containers.Hashed_Sets is
Size : constant Hash_Type := Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length); Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Length := 0; Length := 0;
...@@ -1426,7 +1426,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1426,7 +1426,7 @@ package body Ada.Containers.Hashed_Sets is
Size : constant Hash_Type := Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length); Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin begin
Buckets := new Buckets_Type (0 .. Size - 1); Buckets := HT_Ops.New_Buckets (Length => Size);
end; end;
Iterate_Left : declare Iterate_Left : declare
......
gcc/ada/a-cohase.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -49,6 +49,7 @@ generic ...@@ -49,6 +49,7 @@ generic
package Ada.Containers.Hashed_Sets is package Ada.Containers.Hashed_Sets is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
type Set is tagged private; type Set is tagged private;
pragma Preelaborable_Initialization (Set); pragma Preelaborable_Initialization (Set);
...@@ -203,6 +204,9 @@ package Ada.Containers.Hashed_Sets is ...@@ -203,6 +204,9 @@ package Ada.Containers.Hashed_Sets is
end Generic_Keys; end Generic_Keys;
private private
pragma Inline (Next);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-cohata.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
-- containers. -- containers.
package Ada.Containers.Hash_Tables is package Ada.Containers.Hash_Tables is
pragma Preelaborate; pragma Pure; -- so this can be imported by Remote_Types packages
generic generic
type Node_Type (<>) is limited private; type Node_Type (<>) is limited private;
...@@ -43,7 +43,8 @@ package Ada.Containers.Hash_Tables is ...@@ -43,7 +43,8 @@ package Ada.Containers.Hash_Tables is
package Generic_Hash_Table_Types is package Generic_Hash_Table_Types is
type Buckets_Type is array (Hash_Type range <>) of Node_Access; type Buckets_Type is array (Hash_Type range <>) of Node_Access;
type Buckets_Access is access Buckets_Type; type Buckets_Access is access all Buckets_Type;
for Buckets_Access'Storage_Size use 0; -- so this package can be Pure
type Hash_Table_Type is tagged record type Hash_Table_Type is tagged record
Buckets : Buckets_Access; Buckets : Buckets_Access;
......
gcc/ada/a-coinve.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -59,22 +59,23 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -59,22 +59,23 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
RE : Elements_Type renames RE : Elements_Array renames
Right.Elements (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : Elements_Access := Elements : Elements_Access :=
new Elements_Type (RE'Range); new Elements_Type (Right.Last);
begin begin
for I in Elements'Range loop for I in Elements.EA'Range loop
begin begin
if RE (I) /= null then if RE (I) /= null then
Elements (I) := new Element_Type'(RE (I).all); Elements.EA (I) := new Element_Type'(RE (I).all);
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. I - 1 loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -89,22 +90,23 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -89,22 +90,23 @@ package body Ada.Containers.Indefinite_Vectors is
if RN = 0 then if RN = 0 then
declare declare
LE : Elements_Type renames LE : Elements_Array renames
Left.Elements (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : Elements_Access := Elements : Elements_Access :=
new Elements_Type (LE'Range); new Elements_Type (Left.Last);
begin begin
for I in Elements'Range loop for I in Elements.EA'Range loop
begin begin
if LE (I) /= null then if LE (I) /= null then
Elements (I) := new Element_Type'(LE (I).all); Elements.EA (I) := new Element_Type'(LE (I).all);
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. I - 1 loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -134,14 +136,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -134,14 +136,13 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames LE : Elements_Array renames
Left.Elements (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
RE : Elements_Type renames RE : Elements_Array renames
Right.Elements (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : Elements_Access := Elements : Elements_Access := new Elements_Type (Last);
new Elements_Type (Index_Type'First .. Last);
I : Index_Type'Base := No_Index; I : Index_Type'Base := No_Index;
...@@ -151,12 +152,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -151,12 +152,13 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
if LE (LI) /= null then if LE (LI) /= null then
Elements (I) := new Element_Type'(LE (LI).all); Elements.EA (I) := new Element_Type'(LE (LI).all);
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. I - 1 loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -169,12 +171,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -169,12 +171,13 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
if RE (RI) /= null then if RE (RI) /= null then
Elements (I) := new Element_Type'(RE (RI).all); Elements.EA (I) := new Element_Type'(RE (RI).all);
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. I - 1 loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -193,14 +196,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -193,14 +196,11 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
if LN = 0 then if LN = 0 then
declare declare
subtype Elements_Subtype is Elements : Elements_Access := new Elements_Type (Index_Type'First);
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : Elements_Access := new Elements_Subtype;
begin begin
begin begin
Elements (Elements'First) := new Element_Type'(Right); Elements.EA (Index_Type'First) := new Element_Type'(Right);
exception exception
when others => when others =>
Free (Elements); Free (Elements);
...@@ -228,22 +228,23 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -228,22 +228,23 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames LE : Elements_Array renames
Left.Elements (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : Elements_Access := Elements : Elements_Access :=
new Elements_Type (Index_Type'First .. Last); new Elements_Type (Last);
begin begin
for I in LE'Range loop for I in LE'Range loop
begin begin
if LE (I) /= null then if LE (I) /= null then
Elements (I) := new Element_Type'(LE (I).all); Elements.EA (I) := new Element_Type'(LE (I).all);
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. I - 1 loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -252,11 +253,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -252,11 +253,12 @@ package body Ada.Containers.Indefinite_Vectors is
end loop; end loop;
begin begin
Elements (Elements'Last) := new Element_Type'(Right); Elements.EA (Last) := new Element_Type'(Right);
exception exception
when others => when others =>
for J in Index_Type'First .. Elements'Last - 1 loop for J in Index_Type'First .. Last - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -274,14 +276,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -274,14 +276,11 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
if RN = 0 then if RN = 0 then
declare declare
subtype Elements_Subtype is Elements : Elements_Access := new Elements_Type (Index_Type'First);
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : Elements_Access := new Elements_Subtype;
begin begin
begin begin
Elements (Elements'First) := new Element_Type'(Left); Elements.EA (Index_Type'First) := new Element_Type'(Left);
exception exception
when others => when others =>
Free (Elements); Free (Elements);
...@@ -309,17 +308,17 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -309,17 +308,17 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
RE : Elements_Type renames RE : Elements_Array renames
Right.Elements (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : Elements_Access := Elements : Elements_Access :=
new Elements_Type (Index_Type'First .. Last); new Elements_Type (Last);
I : Index_Type'Base := Index_Type'First; I : Index_Type'Base := Index_Type'First;
begin begin
begin begin
Elements (I) := new Element_Type'(Left); Elements.EA (I) := new Element_Type'(Left);
exception exception
when others => when others =>
Free (Elements); Free (Elements);
...@@ -331,12 +330,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -331,12 +330,13 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
if RE (RI) /= null then if RE (RI) /= null then
Elements (I) := new Element_Type'(RE (RI).all); Elements.EA (I) := new Element_Type'(RE (RI).all);
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. I - 1 loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -356,15 +356,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -356,15 +356,12 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
Last : constant Index_Type := Index_Type'First + 1; Last : constant Index_Type := Index_Type'First + 1;
Elements : Elements_Access := new Elements_Type (Last);
subtype ET is Elements_Type (Index_Type'First .. Last);
Elements : Elements_Access := new ET;
begin begin
begin begin
Elements (Elements'First) := new Element_Type'(Left); Elements.EA (Index_Type'First) := new Element_Type'(Left);
exception exception
when others => when others =>
Free (Elements); Free (Elements);
...@@ -372,15 +369,15 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -372,15 +369,15 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
begin begin
Elements (Elements'Last) := new Element_Type'(Right); Elements.EA (Last) := new Element_Type'(Right);
exception exception
when others => when others =>
Free (Elements (Elements'First)); Free (Elements.EA (Index_Type'First));
Free (Elements); Free (Elements);
raise; raise;
end; end;
return (Controlled with Elements, Elements'Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end "&"; end "&";
...@@ -399,15 +396,15 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -399,15 +396,15 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
for J in Index_Type'First .. Left.Last loop for J in Index_Type'First .. Left.Last loop
if Left.Elements (J) = null then if Left.Elements.EA (J) = null then
if Right.Elements (J) /= null then if Right.Elements.EA (J) /= null then
return False; return False;
end if; end if;
elsif Right.Elements (J) = null then elsif Right.Elements.EA (J) = null then
return False; return False;
elsif Left.Elements (J).all /= Right.Elements (J).all then elsif Left.Elements.EA (J).all /= Right.Elements.EA (J).all then
return False; return False;
end if; end if;
end loop; end loop;
...@@ -427,8 +424,9 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -427,8 +424,9 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
E : Elements_Type renames Container.Elements.all;
L : constant Index_Type := Container.Last; L : constant Index_Type := Container.Last;
E : Elements_Array renames
Container.Elements.EA (Index_Type'First .. L);
begin begin
Container.Elements := null; Container.Elements := null;
...@@ -436,11 +434,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -436,11 +434,11 @@ package body Ada.Containers.Indefinite_Vectors is
Container.Busy := 0; Container.Busy := 0;
Container.Lock := 0; Container.Lock := 0;
Container.Elements := new Elements_Type (Index_Type'First .. L); Container.Elements := new Elements_Type (L);
for I in Container.Elements'Range loop for I in E'Range loop
if E (I) /= null then if E (I) /= null then
Container.Elements (I) := new Element_Type'(E (I).all); Container.Elements.EA (I) := new Element_Type'(E (I).all);
end if; end if;
Container.Last := I; Container.Last := I;
...@@ -499,7 +497,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -499,7 +497,7 @@ package body Ada.Containers.Indefinite_Vectors is
return 0; return 0;
end if; end if;
return Container.Elements'Length; return Container.Elements.EA'Length;
end Capacity; end Capacity;
----------- -----------
...@@ -515,9 +513,9 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -515,9 +513,9 @@ package body Ada.Containers.Indefinite_Vectors is
while Container.Last >= Index_Type'First loop while Container.Last >= Index_Type'First loop
declare declare
X : Element_Access := Container.Elements (Container.Last); X : Element_Access := Container.Elements.EA (Container.Last);
begin begin
Container.Elements (Container.Last) := null; Container.Elements.EA (Container.Last) := null;
Container.Last := Container.Last - 1; Container.Last := Container.Last - 1;
Free (X); Free (X);
end; end;
...@@ -576,7 +574,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -576,7 +574,7 @@ package body Ada.Containers.Indefinite_Vectors is
N : constant Int'Base := Int'Min (Count1, Count2); N : constant Int'Base := Int'Min (Count1, Count2);
J_As_Int : constant Int'Base := Index_As_Int + N; J_As_Int : constant Int'Base := Index_As_Int + N;
E : Elements_Type renames Container.Elements.all; E : Elements_Array renames Container.Elements.EA;
begin begin
if J_As_Int > Old_Last_As_Int then if J_As_Int > Old_Last_As_Int then
...@@ -637,7 +635,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -637,7 +635,7 @@ package body Ada.Containers.Indefinite_Vectors is
Delete (Container, Position.Index, Count); Delete (Container, Position.Index, Count);
Position := No_Element; -- See comment in a-convec.adb Position := No_Element;
end Delete; end Delete;
------------------ ------------------
...@@ -684,7 +682,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -684,7 +682,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Array renames Container.Elements.EA;
begin begin
for Indx in 1 .. Count_Type'Min (Count, N) loop for Indx in 1 .. Count_Type'Min (Count, N) loop
...@@ -715,7 +713,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -715,7 +713,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
EA : constant Element_Access := Container.Elements (Index); EA : constant Element_Access := Container.Elements.EA (Index);
begin begin
if EA = null then if EA = null then
...@@ -732,7 +730,21 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -732,7 +730,21 @@ package body Ada.Containers.Indefinite_Vectors is
raise Constraint_Error with "Position cursor has no element"; raise Constraint_Error with "Position cursor has no element";
end if; end if;
return Element (Position.Container.all, Position.Index); if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
declare
EA : constant Element_Access :=
Position.Container.Elements.EA (Position.Index);
begin
if EA = null then
raise Constraint_Error with "element is empty";
end if;
return EA.all;
end;
end Element; end Element;
-------------- --------------
...@@ -772,8 +784,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -772,8 +784,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
for J in Position.Index .. Container.Last loop for J in Position.Index .. Container.Last loop
if Container.Elements (J) /= null if Container.Elements.EA (J) /= null
and then Container.Elements (J).all = Item and then Container.Elements.EA (J).all = Item
then then
return (Container'Unchecked_Access, J); return (Container'Unchecked_Access, J);
end if; end if;
...@@ -793,8 +805,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -793,8 +805,8 @@ package body Ada.Containers.Indefinite_Vectors is
is is
begin begin
for Indx in Index .. Container.Last loop for Indx in Index .. Container.Last loop
if Container.Elements (Indx) /= null if Container.Elements.EA (Indx) /= null
and then Container.Elements (Indx).all = Item and then Container.Elements.EA (Indx).all = Item
then then
return Indx; return Indx;
end if; end if;
...@@ -822,7 +834,21 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -822,7 +834,21 @@ package body Ada.Containers.Indefinite_Vectors is
function First_Element (Container : Vector) return Element_Type is function First_Element (Container : Vector) return Element_Type is
begin begin
return Element (Container, Index_Type'First); if Container.Last = No_Index then
raise Constraint_Error with "Container is empty";
end if;
declare
EA : constant Element_Access :=
Container.Elements.EA (Index_Type'First);
begin
if EA = null then
raise Constraint_Error with "first element is empty";
end if;
return EA.all;
end;
end First_Element; end First_Element;
----------------- -----------------
...@@ -874,7 +900,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -874,7 +900,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Array renames Container.Elements.EA;
begin begin
for I in Index_Type'First .. Container.Last - 1 loop for I in Index_Type'First .. Container.Last - 1 loop
if Is_Less (E (I + 1), E (I)) then if Is_Less (E (I + 1), E (I)) then
...@@ -891,8 +917,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -891,8 +917,7 @@ package body Ada.Containers.Indefinite_Vectors is
----------- -----------
procedure Merge (Target, Source : in out Vector) is procedure Merge (Target, Source : in out Vector) is
I : Index_Type'Base := Target.Last; I, J : Index_Type'Base;
J : Index_Type'Base;
begin begin
if Target.Last < Index_Type'First then if Target.Last < Index_Type'First then
...@@ -913,23 +938,24 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -913,23 +938,24 @@ package body Ada.Containers.Indefinite_Vectors is
"attempt to tamper with elements (vector is busy)"; "attempt to tamper with elements (vector is busy)";
end if; end if;
I := Target.Last; -- original value (before Set_Length)
Target.Set_Length (Length (Target) + Length (Source)); Target.Set_Length (Length (Target) + Length (Source));
J := Target.Last; J := Target.Last; -- new value (after Set_Length)
while Source.Last >= Index_Type'First loop while Source.Last >= Index_Type'First loop
pragma Assert pragma Assert
(Source.Last <= Index_Type'First (Source.Last <= Index_Type'First
or else not (Is_Less or else not (Is_Less
(Source.Elements (Source.Last), (Source.Elements.EA (Source.Last),
Source.Elements (Source.Last - 1)))); Source.Elements.EA (Source.Last - 1))));
if I < Index_Type'First then if I < Index_Type'First then
declare declare
Src : Elements_Type renames Src : Elements_Array renames
Source.Elements (Index_Type'First .. Source.Last); Source.Elements.EA (Index_Type'First .. Source.Last);
begin begin
Target.Elements (Index_Type'First .. J) := Src; Target.Elements.EA (Index_Type'First .. J) := Src;
Src := (others => null); Src := (others => null);
end; end;
...@@ -940,21 +966,21 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -940,21 +966,21 @@ package body Ada.Containers.Indefinite_Vectors is
pragma Assert pragma Assert
(I <= Index_Type'First (I <= Index_Type'First
or else not (Is_Less or else not (Is_Less
(Target.Elements (I), (Target.Elements.EA (I),
Target.Elements (I - 1)))); Target.Elements.EA (I - 1))));
declare declare
Src : Element_Access renames Source.Elements (Source.Last); Src : Element_Access renames Source.Elements.EA (Source.Last);
Tgt : Element_Access renames Target.Elements (I); Tgt : Element_Access renames Target.Elements.EA (I);
begin begin
if Is_Less (Src, Tgt) then if Is_Less (Src, Tgt) then
Target.Elements (J) := Tgt; Target.Elements.EA (J) := Tgt;
Tgt := null; Tgt := null;
I := I - 1; I := I - 1;
else else
Target.Elements (J) := Src; Target.Elements.EA (J) := Src;
Src := null; Src := null;
Source.Last := Source.Last - 1; Source.Last := Source.Last - 1;
end if; end if;
...@@ -974,7 +1000,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -974,7 +1000,7 @@ package body Ada.Containers.Indefinite_Vectors is
new Generic_Array_Sort new Generic_Array_Sort
(Index_Type => Index_Type, (Index_Type => Index_Type,
Element_Type => Element_Access, Element_Type => Element_Access,
Array_Type => Elements_Type, Array_Type => Elements_Array,
"<" => Is_Less); "<" => Is_Less);
-- Start of processing for Sort -- Start of processing for Sort
...@@ -989,7 +1015,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -989,7 +1015,7 @@ package body Ada.Containers.Indefinite_Vectors is
"attempt to tamper with cursors (vector is locked)"; "attempt to tamper with cursors (vector is locked)";
end if; end if;
Sort (Container.Elements (Index_Type'First .. Container.Last)); Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
end Sort; end Sort;
end Generic_Sorting; end Generic_Sorting;
...@@ -1073,22 +1099,20 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1073,22 +1099,20 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Container.Elements = null then if Container.Elements = null then
Container.Elements := Container.Elements := new Elements_Type (New_Last);
new Elements_Type (Index_Type'First .. New_Last);
Container.Last := No_Index; Container.Last := No_Index;
for J in Container.Elements'Range loop for J in Container.Elements.EA'Range loop
Container.Elements (J) := new Element_Type'(New_Item); Container.Elements.EA (J) := new Element_Type'(New_Item);
Container.Last := J; Container.Last := J;
end loop; end loop;
return; return;
end if; end if;
if New_Last <= Container.Elements'Last then if New_Last <= Container.Elements.Last then
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Array renames Container.Elements.EA;
begin begin
if Before <= Container.Last then if Before <= Container.Last then
...@@ -1131,7 +1155,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1131,7 +1155,7 @@ package body Ada.Containers.Indefinite_Vectors is
C, CC : UInt; C, CC : UInt;
begin begin
C := UInt'Max (1, Container.Elements'Length); C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop while C < New_Length loop
if C > UInt'Last / 2 then if C > UInt'Last / 2 then
C := UInt'Last; C := UInt'Last;
...@@ -1163,7 +1187,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1163,7 +1187,7 @@ package body Ada.Containers.Indefinite_Vectors is
Index_Type (First + UInt'Pos (C) - Int'(1)); Index_Type (First + UInt'Pos (C) - Int'(1));
begin begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last); Dst := new Elements_Type (Dst_Last);
end; end;
end; end;
...@@ -1177,17 +1201,17 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1177,17 +1201,17 @@ package body Ada.Containers.Indefinite_Vectors is
Src : Elements_Access := Container.Elements; Src : Elements_Access := Container.Elements;
begin begin
Dst (Index_Type'First .. Before - 1) := Dst.EA (Index_Type'First .. Before - 1) :=
Src (Index_Type'First .. Before - 1); Src.EA (Index_Type'First .. Before - 1);
Dst (Index .. New_Last) := Src (Before .. Container.Last); Dst.EA (Index .. New_Last) := Src.EA (Before .. Container.Last);
Container.Elements := Dst; Container.Elements := Dst;
Container.Last := New_Last; Container.Last := New_Last;
Free (Src); Free (Src);
for J in Before .. Index - 1 loop for J in Before .. Index - 1 loop
Dst (J) := new Element_Type'(New_Item); Dst.EA (J) := new Element_Type'(New_Item);
end loop; end loop;
end; end;
...@@ -1196,14 +1220,14 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1196,14 +1220,14 @@ package body Ada.Containers.Indefinite_Vectors is
Src : Elements_Access := Container.Elements; Src : Elements_Access := Container.Elements;
begin begin
Dst (Index_Type'First .. Container.Last) := Dst.EA (Index_Type'First .. Container.Last) :=
Src (Index_Type'First .. Container.Last); Src.EA (Index_Type'First .. Container.Last);
Container.Elements := Dst; Container.Elements := Dst;
Free (Src); Free (Src);
for J in Before .. New_Last loop for J in Before .. New_Last loop
Dst (J) := new Element_Type'(New_Item); Dst.EA (J) := new Element_Type'(New_Item);
Container.Last := J; Container.Last := J;
end loop; end loop;
end; end;
...@@ -1242,16 +1266,19 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1242,16 +1266,19 @@ package body Ada.Containers.Indefinite_Vectors is
Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int); Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
Dst : Elements_Type renames Dst : Elements_Array renames
Container.Elements (Before .. Dst_Last); Container.Elements.EA (Before .. Dst_Last);
Dst_Index : Index_Type'Base := Before - 1; Dst_Index : Index_Type'Base := Before - 1;
begin begin
if Container'Address /= New_Item'Address then if Container'Address /= New_Item'Address then
declare declare
Src : Elements_Type renames subtype Src_Index_Subtype is Index_Type'Base range
New_Item.Elements (Index_Type'First .. New_Item.Last); Index_Type'First .. New_Item.Last;
Src : Elements_Array renames
New_Item.Elements.EA (Src_Index_Subtype);
begin begin
for Src_Index in Src'Range loop for Src_Index in Src'Range loop
...@@ -1270,8 +1297,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1270,8 +1297,8 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Src_Index_Subtype is Index_Type'Base range subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Before - 1; Index_Type'First .. Before - 1;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Src_Index_Subtype); Container.Elements.EA (Src_Index_Subtype);
begin begin
for Src_Index in Src'Range loop for Src_Index in Src'Range loop
...@@ -1291,8 +1318,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1291,8 +1318,8 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Src_Index_Subtype is Index_Type'Base range subtype Src_Index_Subtype is Index_Type'Base range
Dst_Last + 1 .. Container.Last; Dst_Last + 1 .. Container.Last;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Src_Index_Subtype); Container.Elements.EA (Src_Index_Subtype);
begin begin
for Src_Index in Src'Range loop for Src_Index in Src'Range loop
...@@ -1535,16 +1562,14 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1535,16 +1562,14 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Container.Elements = null then if Container.Elements = null then
Container.Elements := Container.Elements := new Elements_Type (New_Last);
new Elements_Type (Index_Type'First .. New_Last);
Container.Last := New_Last; Container.Last := New_Last;
return; return;
end if; end if;
if New_Last <= Container.Elements'Last then if New_Last <= Container.Elements.Last then
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Array renames Container.Elements.EA;
begin begin
if Before <= Container.Last then if Before <= Container.Last then
...@@ -1569,7 +1594,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1569,7 +1594,7 @@ package body Ada.Containers.Indefinite_Vectors is
C, CC : UInt; C, CC : UInt;
begin begin
C := UInt'Max (1, Container.Elements'Length); C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop while C < New_Length loop
if C > UInt'Last / 2 then if C > UInt'Last / 2 then
C := UInt'Last; C := UInt'Last;
...@@ -1601,7 +1626,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1601,7 +1626,7 @@ package body Ada.Containers.Indefinite_Vectors is
Index_Type (First + UInt'Pos (C) - 1); Index_Type (First + UInt'Pos (C) - 1);
begin begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last); Dst := new Elements_Type (Dst_Last);
end; end;
end; end;
...@@ -1617,15 +1642,15 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1617,15 +1642,15 @@ package body Ada.Containers.Indefinite_Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int); Index : constant Index_Type := Index_Type (Index_As_Int);
begin begin
Dst (Index_Type'First .. Before - 1) := Dst.EA (Index_Type'First .. Before - 1) :=
Src (Index_Type'First .. Before - 1); Src.EA (Index_Type'First .. Before - 1);
Dst (Index .. New_Last) := Src (Before .. Container.Last); Dst.EA (Index .. New_Last) := Src.EA (Before .. Container.Last);
end; end;
else else
Dst (Index_Type'First .. Container.Last) := Dst.EA (Index_Type'First .. Container.Last) :=
Src (Index_Type'First .. Container.Last); Src.EA (Index_Type'First .. Container.Last);
end if; end if;
Container.Elements := Dst; Container.Elements := Dst;
...@@ -1735,7 +1760,21 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1735,7 +1760,21 @@ package body Ada.Containers.Indefinite_Vectors is
function Last_Element (Container : Vector) return Element_Type is function Last_Element (Container : Vector) return Element_Type is
begin begin
return Element (Container, Container.Last); if Container.Last = No_Index then
raise Constraint_Error with "Container is empty";
end if;
declare
EA : constant Element_Access :=
Container.Elements.EA (Container.Last);
begin
if EA = null then
raise Constraint_Error with "last element is empty";
end if;
return EA.all;
end;
end Last_Element; end Last_Element;
---------------- ----------------
...@@ -1894,7 +1933,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1894,7 +1933,7 @@ package body Ada.Containers.Indefinite_Vectors is
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
end if; end if;
if V.Elements (Index) = null then if V.Elements.EA (Index) = null then
raise Constraint_Error with "element is null"; raise Constraint_Error with "element is null";
end if; end if;
...@@ -1902,7 +1941,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1902,7 +1941,7 @@ package body Ada.Containers.Indefinite_Vectors is
L := L + 1; L := L + 1;
begin begin
Process (V.Elements (Index).all); Process (V.Elements.EA (Index).all);
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -1954,7 +1993,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1954,7 +1993,7 @@ package body Ada.Containers.Indefinite_Vectors is
Boolean'Read (Stream, B); Boolean'Read (Stream, B);
if B then if B then
Container.Elements (Last) := Container.Elements.EA (Last) :=
new Element_Type'(Element_Type'Input (Stream)); new Element_Type'(Element_Type'Input (Stream));
end if; end if;
...@@ -1990,9 +2029,9 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1990,9 +2029,9 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
X : Element_Access := Container.Elements (Index); X : Element_Access := Container.Elements.EA (Index);
begin begin
Container.Elements (Index) := new Element_Type'(New_Item); Container.Elements.EA (Index) := new Element_Type'(New_Item);
Free (X); Free (X);
end; end;
end Replace_Element; end Replace_Element;
...@@ -2011,7 +2050,21 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2011,7 +2050,21 @@ package body Ada.Containers.Indefinite_Vectors is
raise Program_Error with "Position cursor denotes wrong container"; raise Program_Error with "Position cursor denotes wrong container";
end if; end if;
Replace_Element (Container, Position.Index, New_Item); if Position.Index > Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is locked)";
end if;
declare
X : Element_Access := Container.Elements.EA (Position.Index);
begin
Container.Elements.EA (Position.Index) := new Element_Type'(New_Item);
Free (X);
end;
end Replace_Element; end Replace_Element;
---------------------- ----------------------
...@@ -2034,7 +2087,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2034,7 +2087,7 @@ package body Ada.Containers.Indefinite_Vectors is
Free (X); Free (X);
end; end;
elsif N < Container.Elements'Length then elsif N < Container.Elements.EA'Length then
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error with raise Program_Error with
"attempt to tamper with elements (vector is busy)"; "attempt to tamper with elements (vector is busy)";
...@@ -2044,16 +2097,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2044,16 +2097,13 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Array_Index_Subtype is Index_Type'Base range subtype Array_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last; Index_Type'First .. Container.Last;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Array_Index_Subtype); Container.Elements.EA (Array_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
Container.Elements := new Array_Subtype'(Src); Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X); Free (X);
end; end;
end if; end if;
...@@ -2074,11 +2124,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2074,11 +2124,8 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is
Elements_Type (Index_Type'First .. Last);
begin begin
Container.Elements := new Array_Subtype; Container.Elements := new Elements_Type (Last);
end; end;
end; end;
...@@ -2086,7 +2133,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2086,7 +2133,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Capacity <= N then if Capacity <= N then
if N < Container.Elements'Length then if N < Container.Elements.EA'Length then
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error with raise Program_Error with
"attempt to tamper with elements (vector is busy)"; "attempt to tamper with elements (vector is busy)";
...@@ -2096,16 +2143,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2096,16 +2143,13 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Array_Index_Subtype is Index_Type'Base range subtype Array_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last; Index_Type'First .. Container.Last;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Array_Index_Subtype); Container.Elements.EA (Array_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
Container.Elements := new Array_Subtype'(Src); Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X); Free (X);
end; end;
end if; end if;
...@@ -2113,7 +2157,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2113,7 +2157,7 @@ package body Ada.Containers.Indefinite_Vectors is
return; return;
end if; end if;
if Capacity = Container.Elements'Length then if Capacity = Container.Elements.EA'Length then
return; return;
end if; end if;
...@@ -2133,21 +2177,20 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2133,21 +2177,20 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
X : Elements_Access := Container.Elements;
subtype Array_Subtype is subtype Index_Subtype is Index_Type'Base range
Elements_Type (Index_Type'First .. Last); Index_Type'First .. Container.Last;
X : Elements_Access := Container.Elements;
begin begin
Container.Elements := new Array_Subtype; Container.Elements := new Elements_Type (Last);
declare declare
Src : Elements_Type renames Src : Elements_Array renames
X (Index_Type'First .. Container.Last); X.EA (Index_Subtype);
Tgt : Elements_Type renames Tgt : Elements_Array renames
Container.Elements (Index_Type'First .. Container.Last); Container.Elements.EA (Index_Subtype);
begin begin
Tgt := Src; Tgt := Src;
...@@ -2176,7 +2219,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2176,7 +2219,7 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
I : Index_Type; I : Index_Type;
J : Index_Type; J : Index_Type;
E : Elements_Type renames Container.Elements.all; E : Elements_Array renames Container.Elements.EA;
begin begin
I := Index_Type'First; I := Index_Type'First;
...@@ -2223,8 +2266,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2223,8 +2266,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
for Indx in reverse Index_Type'First .. Last loop for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (Indx) /= null if Container.Elements.EA (Indx) /= null
and then Container.Elements (Indx).all = Item and then Container.Elements.EA (Indx).all = Item
then then
return (Container'Unchecked_Access, Indx); return (Container'Unchecked_Access, Indx);
end if; end if;
...@@ -2252,8 +2295,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2252,8 +2295,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
for Indx in reverse Index_Type'First .. Last loop for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (Indx) /= null if Container.Elements.EA (Indx) /= null
and then Container.Elements (Indx).all = Item and then Container.Elements.EA (Indx).all = Item
then then
return Indx; return Indx;
end if; end if;
...@@ -2313,10 +2356,10 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2313,10 +2356,10 @@ package body Ada.Containers.Indefinite_Vectors is
for Index in 1 .. N - Length loop for Index in 1 .. N - Length loop
declare declare
J : constant Index_Type := Container.Last; J : constant Index_Type := Container.Last;
X : Element_Access := Container.Elements (J); X : Element_Access := Container.Elements.EA (J);
begin begin
Container.Elements (J) := null; Container.Elements.EA (J) := null;
Container.Last := J - 1; Container.Last := J - 1;
Free (X); Free (X);
end; end;
...@@ -2365,8 +2408,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2365,8 +2408,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
EI : Element_Access renames Container.Elements (I); EI : Element_Access renames Container.Elements.EA (I);
EJ : Element_Access renames Container.Elements (J); EJ : Element_Access renames Container.Elements.EA (J);
EI_Copy : constant Element_Access := EI; EI_Copy : constant Element_Access := EI;
...@@ -2455,7 +2498,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2455,7 +2498,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
Last := Index_Type (Last_As_Int); Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Index_Type'First .. Last); Elements := new Elements_Type (Last);
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
...@@ -2482,20 +2525,21 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2482,20 +2525,21 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
Last := Index_Type (Last_As_Int); Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Index_Type'First .. Last); Elements := new Elements_Type (Last);
Last := Index_Type'First; Last := Index_Type'First;
begin begin
loop loop
Elements (Last) := new Element_Type'(New_Item); Elements.EA (Last) := new Element_Type'(New_Item);
exit when Last = Elements'Last; exit when Last = Elements.Last;
Last := Last + 1; Last := Last + 1;
end loop; end loop;
exception exception
when others => when others =>
for J in Index_Type'First .. Last - 1 loop for J in Index_Type'First .. Last - 1 loop
Free (Elements (J)); Free (Elements.EA (J));
end loop; end loop;
Free (Elements); Free (Elements);
...@@ -2523,7 +2567,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2523,7 +2567,7 @@ package body Ada.Containers.Indefinite_Vectors is
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
end if; end if;
if Container.Elements (Index) = null then if Container.Elements.EA (Index) = null then
raise Constraint_Error with "element is null"; raise Constraint_Error with "element is null";
end if; end if;
...@@ -2531,7 +2575,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2531,7 +2575,7 @@ package body Ada.Containers.Indefinite_Vectors is
L := L + 1; L := L + 1;
begin begin
Process (Container.Elements (Index).all); Process (Container.Elements.EA (Index).all);
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -2578,7 +2622,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2578,7 +2622,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Array renames Container.Elements.EA;
begin begin
for Indx in Index_Type'First .. Container.Last loop for Indx in Index_Type'First .. Container.Last loop
......
gcc/ada/a-coinve.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -33,8 +33,8 @@ ...@@ -33,8 +33,8 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Finalization; private with Ada.Finalization;
with Ada.Streams; private with Ada.Streams;
generic generic
type Index_Type is range <>; type Index_Type is range <>;
...@@ -44,6 +44,7 @@ generic ...@@ -44,6 +44,7 @@ generic
package Ada.Containers.Indefinite_Vectors is package Ada.Containers.Indefinite_Vectors is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
subtype Extended_Index is Index_Type'Base subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 .. range Index_Type'First - 1 ..
...@@ -301,12 +302,17 @@ private ...@@ -301,12 +302,17 @@ private
pragma Inline (Update_Element); pragma Inline (Update_Element);
pragma Inline (Replace_Element); pragma Inline (Replace_Element);
pragma Inline (Contains); pragma Inline (Contains);
pragma Inline (Next);
pragma Inline (Previous);
type Element_Access is access Element_Type; type Element_Access is access Element_Type;
type Elements_Type is array (Index_Type range <>) of Element_Access; type Elements_Array is array (Index_Type range <>) of Element_Access;
function "=" (L, R : Elements_Array) return Boolean is abstract;
function "=" (L, R : Elements_Type) return Boolean is abstract; type Elements_Type (Last : Index_Type) is limited record
EA : Elements_Array (Index_Type'First .. Last);
end record;
type Elements_Access is access Elements_Type; type Elements_Access is access Elements_Type;
...@@ -319,8 +325,10 @@ private ...@@ -319,8 +325,10 @@ private
Lock : Natural := 0; Lock : Natural := 0;
end record; end record;
overriding
procedure Adjust (Container : in out Vector); procedure Adjust (Container : in out Vector);
overriding
procedure Finalize (Container : in out Vector); procedure Finalize (Container : in out Vector);
use Ada.Streams; use Ada.Streams;
......
gcc/ada/a-convec.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2006 Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -57,11 +57,11 @@ package body Ada.Containers.Vectors is ...@@ -57,11 +57,11 @@ package body Ada.Containers.Vectors is
end if; end if;
declare declare
RE : Elements_Type renames RE : Elements_Array renames
Right.Elements (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type'(RE); new Elements_Type'(Right.Last, RE);
begin begin
return (Controlled with Elements, Right.Last, 0, 0); return (Controlled with Elements, Right.Last, 0, 0);
...@@ -70,11 +70,11 @@ package body Ada.Containers.Vectors is ...@@ -70,11 +70,11 @@ package body Ada.Containers.Vectors is
if RN = 0 then if RN = 0 then
declare declare
LE : Elements_Type renames LE : Elements_Array renames
Left.Elements (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type'(LE); new Elements_Type'(Left.Last, LE);
begin begin
return (Controlled with Elements, Left.Last, 0, 0); return (Controlled with Elements, Left.Last, 0, 0);
...@@ -100,14 +100,14 @@ package body Ada.Containers.Vectors is ...@@ -100,14 +100,14 @@ package body Ada.Containers.Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames LE : Elements_Array renames
Left.Elements (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
RE : Elements_Type renames RE : Elements_Array renames
Right.Elements (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type'(LE & RE); new Elements_Type'(Last, LE & RE);
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
...@@ -121,11 +121,10 @@ package body Ada.Containers.Vectors is ...@@ -121,11 +121,10 @@ package body Ada.Containers.Vectors is
begin begin
if LN = 0 then if LN = 0 then
declare declare
subtype Elements_Subtype is
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Subtype'(others => Right); new Elements_Type'
(Last => Index_Type'First,
EA => (others => Right));
begin begin
return (Controlled with Elements, Index_Type'First, 0, 0); return (Controlled with Elements, Index_Type'First, 0, 0);
...@@ -149,12 +148,13 @@ package body Ada.Containers.Vectors is ...@@ -149,12 +148,13 @@ package body Ada.Containers.Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames LE : Elements_Array renames
Left.Elements (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
subtype ET is Elements_Type (Index_Type'First .. Last);
Elements : constant Elements_Access := new ET'(LE & Right); Elements : constant Elements_Access :=
new Elements_Type'
(Last => Last,
EA => LE & Right);
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
...@@ -168,11 +168,10 @@ package body Ada.Containers.Vectors is ...@@ -168,11 +168,10 @@ package body Ada.Containers.Vectors is
begin begin
if RN = 0 then if RN = 0 then
declare declare
subtype Elements_Subtype is
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Subtype'(others => Left); new Elements_Type'
(Last => Index_Type'First,
EA => (others => Left));
begin begin
return (Controlled with Elements, Index_Type'First, 0, 0); return (Controlled with Elements, Index_Type'First, 0, 0);
...@@ -196,12 +195,13 @@ package body Ada.Containers.Vectors is ...@@ -196,12 +195,13 @@ package body Ada.Containers.Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
RE : Elements_Type renames RE : Elements_Array renames
Right.Elements (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
subtype ET is Elements_Type (Index_Type'First .. Last); Elements : constant Elements_Access :=
new Elements_Type'
Elements : constant Elements_Access := new ET'(Left & RE); (Last => Last,
EA => Left & RE);
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
...@@ -218,9 +218,10 @@ package body Ada.Containers.Vectors is ...@@ -218,9 +218,10 @@ package body Ada.Containers.Vectors is
declare declare
Last : constant Index_Type := Index_Type'First + 1; Last : constant Index_Type := Index_Type'First + 1;
subtype ET is Elements_Type (Index_Type'First .. Last); Elements : constant Elements_Access :=
new Elements_Type'
Elements : constant Elements_Access := new ET'(Left, Right); (Last => Last,
EA => (Left, Right));
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
...@@ -242,7 +243,7 @@ package body Ada.Containers.Vectors is ...@@ -242,7 +243,7 @@ package body Ada.Containers.Vectors is
end if; end if;
for J in Index_Type range Index_Type'First .. Left.Last loop for J in Index_Type range Index_Type'First .. Left.Last loop
if Left.Elements (J) /= Right.Elements (J) then if Left.Elements.EA (J) /= Right.Elements.EA (J) then
return False; return False;
end if; end if;
end loop; end loop;
...@@ -262,15 +263,17 @@ package body Ada.Containers.Vectors is ...@@ -262,15 +263,17 @@ package body Ada.Containers.Vectors is
end if; end if;
declare declare
E : constant Elements_Access := Container.Elements; L : constant Index_Type := Container.Last;
L : constant Index_Type := Container.Last; EA : Elements_Array renames
Container.Elements.EA (Index_Type'First .. L);
begin begin
Container.Elements := null; Container.Elements := null;
Container.Last := No_Index; Container.Last := No_Index;
Container.Busy := 0; Container.Busy := 0;
Container.Lock := 0; Container.Lock := 0;
Container.Elements := new Elements_Type'(E (Index_Type'First .. L));
Container.Elements := new Elements_Type'(L, EA);
Container.Last := L; Container.Last := L;
end; end;
end Adjust; end Adjust;
...@@ -326,7 +329,7 @@ package body Ada.Containers.Vectors is ...@@ -326,7 +329,7 @@ package body Ada.Containers.Vectors is
return 0; return 0;
end if; end if;
return Container.Elements'Length; return Container.Elements.EA'Length;
end Capacity; end Capacity;
----------- -----------
...@@ -402,15 +405,15 @@ package body Ada.Containers.Vectors is ...@@ -402,15 +405,15 @@ package body Ada.Containers.Vectors is
else else
declare declare
J : constant Index_Type := Index_Type (J_As_Int); J : constant Index_Type := Index_Type (J_As_Int);
E : Elements_Type renames Container.Elements.all; EA : Elements_Array renames Container.Elements.EA;
New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N; New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
New_Last : constant Index_Type := New_Last : constant Index_Type :=
Index_Type (New_Last_As_Int); Index_Type (New_Last_As_Int);
begin begin
E (Index .. New_Last) := E (J .. Container.Last); EA (Index .. New_Last) := EA (J .. Container.Last);
Container.Last := New_Last; Container.Last := New_Last;
end; end;
end if; end if;
...@@ -436,17 +439,6 @@ package body Ada.Containers.Vectors is ...@@ -436,17 +439,6 @@ package body Ada.Containers.Vectors is
end if; end if;
Delete (Container, Position.Index, Count); Delete (Container, Position.Index, Count);
-- This is the old behavior, prior to the York API (2005/06):
-- if Position.Index <= Container.Last then
-- Position := (Container'Unchecked_Access, Position.Index);
-- else
-- Position := No_Element;
-- end if;
-- This is the behavior specified by the York API:
Position := No_Element; Position := No_Element;
end Delete; end Delete;
...@@ -513,7 +505,7 @@ package body Ada.Containers.Vectors is ...@@ -513,7 +505,7 @@ package body Ada.Containers.Vectors is
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
end if; end if;
return Container.Elements (Index); return Container.Elements.EA (Index);
end Element; end Element;
function Element (Position : Cursor) return Element_Type is function Element (Position : Cursor) return Element_Type is
...@@ -522,7 +514,11 @@ package body Ada.Containers.Vectors is ...@@ -522,7 +514,11 @@ package body Ada.Containers.Vectors is
raise Constraint_Error with "Position cursor has no element"; raise Constraint_Error with "Position cursor has no element";
end if; end if;
return Element (Position.Container.all, Position.Index); if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return Position.Container.Elements.EA (Position.Index);
end Element; end Element;
-------------- --------------
...@@ -564,7 +560,7 @@ package body Ada.Containers.Vectors is ...@@ -564,7 +560,7 @@ package body Ada.Containers.Vectors is
end if; end if;
for J in Position.Index .. Container.Last loop for J in Position.Index .. Container.Last loop
if Container.Elements (J) = Item then if Container.Elements.EA (J) = Item then
return (Container'Unchecked_Access, J); return (Container'Unchecked_Access, J);
end if; end if;
end loop; end loop;
...@@ -583,7 +579,7 @@ package body Ada.Containers.Vectors is ...@@ -583,7 +579,7 @@ package body Ada.Containers.Vectors is
is is
begin begin
for Indx in Index .. Container.Last loop for Indx in Index .. Container.Last loop
if Container.Elements (Indx) = Item then if Container.Elements.EA (Indx) = Item then
return Indx; return Indx;
end if; end if;
end loop; end loop;
...@@ -610,7 +606,11 @@ package body Ada.Containers.Vectors is ...@@ -610,7 +606,11 @@ package body Ada.Containers.Vectors is
function First_Element (Container : Vector) return Element_Type is function First_Element (Container : Vector) return Element_Type is
begin begin
return Element (Container, Index_Type'First); if Container.Last = No_Index then
raise Constraint_Error with "Container is empty";
end if;
return Container.Elements.EA (Index_Type'First);
end First_Element; end First_Element;
----------------- -----------------
...@@ -640,10 +640,10 @@ package body Ada.Containers.Vectors is ...@@ -640,10 +640,10 @@ package body Ada.Containers.Vectors is
end if; end if;
declare declare
E : Elements_Type renames Container.Elements.all; EA : Elements_Array renames Container.Elements.EA;
begin begin
for I in Index_Type'First .. Container.Last - 1 loop for I in Index_Type'First .. Container.Last - 1 loop
if E (I + 1) < E (I) then if EA (I + 1) < EA (I) then
return False; return False;
end if; end if;
end loop; end loop;
...@@ -681,35 +681,40 @@ package body Ada.Containers.Vectors is ...@@ -681,35 +681,40 @@ package body Ada.Containers.Vectors is
Target.Set_Length (Length (Target) + Length (Source)); Target.Set_Length (Length (Target) + Length (Source));
J := Target.Last; declare
while Source.Last >= Index_Type'First loop TA : Elements_Array renames Target.Elements.EA;
pragma Assert (Source.Last <= Index_Type'First SA : Elements_Array renames Source.Elements.EA;
or else not (Source.Elements (Source.Last) <
Source.Elements (Source.Last - 1)));
if I < Index_Type'First then
Target.Elements (Index_Type'First .. J) :=
Source.Elements (Index_Type'First .. Source.Last);
Source.Last := No_Index; begin
return; J := Target.Last;
end if; while Source.Last >= Index_Type'First loop
pragma Assert (Source.Last <= Index_Type'First
or else not (SA (Source.Last) <
SA (Source.Last - 1)));
if I < Index_Type'First then
TA (Index_Type'First .. J) :=
SA (Index_Type'First .. Source.Last);
Source.Last := No_Index;
return;
end if;
pragma Assert (I <= Index_Type'First pragma Assert (I <= Index_Type'First
or else not (Target.Elements (I) < or else not (TA (I) < TA (I - 1)));
Target.Elements (I - 1)));
if Source.Elements (Source.Last) < Target.Elements (I) then if SA (Source.Last) < TA (I) then
Target.Elements (J) := Target.Elements (I); TA (J) := TA (I);
I := I - 1; I := I - 1;
else else
Target.Elements (J) := Source.Elements (Source.Last); TA (J) := SA (Source.Last);
Source.Last := Source.Last - 1; Source.Last := Source.Last - 1;
end if; end if;
J := J - 1; J := J - 1;
end loop; end loop;
end;
end Merge; end Merge;
---------- ----------
...@@ -722,7 +727,7 @@ package body Ada.Containers.Vectors is ...@@ -722,7 +727,7 @@ package body Ada.Containers.Vectors is
new Generic_Array_Sort new Generic_Array_Sort
(Index_Type => Index_Type, (Index_Type => Index_Type,
Element_Type => Element_Type, Element_Type => Element_Type,
Array_Type => Elements_Type, Array_Type => Elements_Array,
"<" => "<"); "<" => "<");
begin begin
...@@ -735,7 +740,7 @@ package body Ada.Containers.Vectors is ...@@ -735,7 +740,7 @@ package body Ada.Containers.Vectors is
"attempt to tamper with cursors (vector is locked)"; "attempt to tamper with cursors (vector is locked)";
end if; end if;
Sort (Container.Elements (Index_Type'First .. Container.Last)); Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
end Sort; end Sort;
end Generic_Sorting; end Generic_Sorting;
...@@ -819,20 +824,16 @@ package body Ada.Containers.Vectors is ...@@ -819,20 +824,16 @@ package body Ada.Containers.Vectors is
end if; end if;
if Container.Elements = null then if Container.Elements = null then
declare Container.Elements := new Elements_Type'
subtype Elements_Subtype is (Last => New_Last,
Elements_Type (Index_Type'First .. New_Last); EA => (others => New_Item));
begin
Container.Elements := new Elements_Subtype'(others => New_Item);
end;
Container.Last := New_Last; Container.Last := New_Last;
return; return;
end if; end if;
if New_Last <= Container.Elements'Last then if New_Last <= Container.Elements.Last then
declare declare
E : Elements_Type renames Container.Elements.all; EA : Elements_Array renames Container.Elements.EA;
begin begin
if Before <= Container.Last then if Before <= Container.Last then
...@@ -843,14 +844,14 @@ package body Ada.Containers.Vectors is ...@@ -843,14 +844,14 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int); Index : constant Index_Type := Index_Type (Index_As_Int);
begin begin
E (Index .. New_Last) := E (Before .. Container.Last); EA (Index .. New_Last) := EA (Before .. Container.Last);
E (Before .. Index_Type'Pred (Index)) := EA (Before .. Index_Type'Pred (Index)) :=
(others => New_Item); (others => New_Item);
end; end;
else else
E (Before .. New_Last) := (others => New_Item); EA (Before .. New_Last) := (others => New_Item);
end if; end if;
end; end;
...@@ -862,7 +863,7 @@ package body Ada.Containers.Vectors is ...@@ -862,7 +863,7 @@ package body Ada.Containers.Vectors is
C, CC : UInt; C, CC : UInt;
begin begin
C := UInt'Max (1, Container.Elements'Length); C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop while C < New_Length loop
if C > UInt'Last / 2 then if C > UInt'Last / 2 then
C := UInt'Last; C := UInt'Last;
...@@ -894,16 +895,17 @@ package body Ada.Containers.Vectors is ...@@ -894,16 +895,17 @@ package body Ada.Containers.Vectors is
Index_Type (First + UInt'Pos (C) - 1); Index_Type (First + UInt'Pos (C) - 1);
begin begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last); Dst := new Elements_Type (Dst_Last);
end; end;
end; end;
declare declare
Src : Elements_Type renames Container.Elements.all; SA : Elements_Array renames Container.Elements.EA;
DA : Elements_Array renames Dst.EA;
begin begin
Dst (Index_Type'First .. Index_Type'Pred (Before)) := DA (Index_Type'First .. Index_Type'Pred (Before)) :=
Src (Index_Type'First .. Index_Type'Pred (Before)); SA (Index_Type'First .. Index_Type'Pred (Before));
if Before <= Container.Last then if Before <= Container.Last then
declare declare
...@@ -913,12 +915,12 @@ package body Ada.Containers.Vectors is ...@@ -913,12 +915,12 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int); Index : constant Index_Type := Index_Type (Index_As_Int);
begin begin
Dst (Before .. Index_Type'Pred (Index)) := (others => New_Item); DA (Before .. Index_Type'Pred (Index)) := (others => New_Item);
Dst (Index .. New_Last) := Src (Before .. Container.Last); DA (Index .. New_Last) := SA (Before .. Container.Last);
end; end;
else else
Dst (Before .. New_Last) := (others => New_Item); DA (Before .. New_Last) := (others => New_Item);
end if; end if;
exception exception
when others => when others =>
...@@ -969,8 +971,8 @@ package body Ada.Containers.Vectors is ...@@ -969,8 +971,8 @@ package body Ada.Containers.Vectors is
begin begin
if Container'Address /= New_Item'Address then if Container'Address /= New_Item'Address then
Container.Elements (Before .. Dst_Last) := Container.Elements.EA (Before .. Dst_Last) :=
New_Item.Elements (Index_Type'First .. New_Item.Last); New_Item.Elements.EA (Index_Type'First .. New_Item.Last);
return; return;
end if; end if;
...@@ -979,8 +981,8 @@ package body Ada.Containers.Vectors is ...@@ -979,8 +981,8 @@ package body Ada.Containers.Vectors is
subtype Src_Index_Subtype is Index_Type'Base range subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Before - 1; Index_Type'First .. Before - 1;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Src_Index_Subtype); Container.Elements.EA (Src_Index_Subtype);
Index_As_Int : constant Int'Base := Index_As_Int : constant Int'Base :=
Int (Before) + Src'Length - 1; Int (Before) + Src'Length - 1;
...@@ -988,8 +990,8 @@ package body Ada.Containers.Vectors is ...@@ -988,8 +990,8 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type'Base := Index : constant Index_Type'Base :=
Index_Type'Base (Index_As_Int); Index_Type'Base (Index_As_Int);
Dst : Elements_Type renames Dst : Elements_Array renames
Container.Elements (Before .. Index); Container.Elements.EA (Before .. Index);
begin begin
Dst := Src; Dst := Src;
...@@ -1003,8 +1005,8 @@ package body Ada.Containers.Vectors is ...@@ -1003,8 +1005,8 @@ package body Ada.Containers.Vectors is
subtype Src_Index_Subtype is Index_Type'Base range subtype Src_Index_Subtype is Index_Type'Base range
Dst_Last + 1 .. Container.Last; Dst_Last + 1 .. Container.Last;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Src_Index_Subtype); Container.Elements.EA (Src_Index_Subtype);
Index_As_Int : constant Int'Base := Index_As_Int : constant Int'Base :=
Dst_Last_As_Int - Src'Length + 1; Dst_Last_As_Int - Src'Length + 1;
...@@ -1012,8 +1014,8 @@ package body Ada.Containers.Vectors is ...@@ -1012,8 +1014,8 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index : constant Index_Type :=
Index_Type (Index_As_Int); Index_Type (Index_As_Int);
Dst : Elements_Type renames Dst : Elements_Array renames
Container.Elements (Index .. Dst_Last); Container.Elements.EA (Index .. Dst_Last);
begin begin
Dst := Src; Dst := Src;
...@@ -1275,16 +1277,14 @@ package body Ada.Containers.Vectors is ...@@ -1275,16 +1277,14 @@ package body Ada.Containers.Vectors is
end if; end if;
if Container.Elements = null then if Container.Elements = null then
Container.Elements := Container.Elements := new Elements_Type (New_Last);
new Elements_Type (Index_Type'First .. New_Last);
Container.Last := New_Last; Container.Last := New_Last;
return; return;
end if; end if;
if New_Last <= Container.Elements'Last then if New_Last <= Container.Elements.Last then
declare declare
E : Elements_Type renames Container.Elements.all; EA : Elements_Array renames Container.Elements.EA;
begin begin
if Before <= Container.Last then if Before <= Container.Last then
declare declare
...@@ -1294,7 +1294,7 @@ package body Ada.Containers.Vectors is ...@@ -1294,7 +1294,7 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int); Index : constant Index_Type := Index_Type (Index_As_Int);
begin begin
E (Index .. New_Last) := E (Before .. Container.Last); EA (Index .. New_Last) := EA (Before .. Container.Last);
end; end;
end if; end if;
end; end;
...@@ -1307,7 +1307,7 @@ package body Ada.Containers.Vectors is ...@@ -1307,7 +1307,7 @@ package body Ada.Containers.Vectors is
C, CC : UInt; C, CC : UInt;
begin begin
C := UInt'Max (1, Container.Elements'Length); C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop while C < New_Length loop
if C > UInt'Last / 2 then if C > UInt'Last / 2 then
C := UInt'Last; C := UInt'Last;
...@@ -1339,16 +1339,17 @@ package body Ada.Containers.Vectors is ...@@ -1339,16 +1339,17 @@ package body Ada.Containers.Vectors is
Index_Type (First + UInt'Pos (C) - 1); Index_Type (First + UInt'Pos (C) - 1);
begin begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last); Dst := new Elements_Type (Dst_Last);
end; end;
end; end;
declare declare
Src : Elements_Type renames Container.Elements.all; SA : Elements_Array renames Container.Elements.EA;
DA : Elements_Array renames Dst.EA;
begin begin
Dst (Index_Type'First .. Index_Type'Pred (Before)) := DA (Index_Type'First .. Index_Type'Pred (Before)) :=
Src (Index_Type'First .. Index_Type'Pred (Before)); SA (Index_Type'First .. Index_Type'Pred (Before));
if Before <= Container.Last then if Before <= Container.Last then
declare declare
...@@ -1358,7 +1359,7 @@ package body Ada.Containers.Vectors is ...@@ -1358,7 +1359,7 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int); Index : constant Index_Type := Index_Type (Index_As_Int);
begin begin
Dst (Index .. New_Last) := Src (Before .. Container.Last); DA (Index .. New_Last) := SA (Before .. Container.Last);
end; end;
end if; end if;
exception exception
...@@ -1477,7 +1478,11 @@ package body Ada.Containers.Vectors is ...@@ -1477,7 +1478,11 @@ package body Ada.Containers.Vectors is
function Last_Element (Container : Vector) return Element_Type is function Last_Element (Container : Vector) return Element_Type is
begin begin
return Element (Container, Container.Last); if Container.Last = No_Index then
raise Constraint_Error with "Container is empty";
end if;
return Container.Elements.EA (Container.Last);
end Last_Element; end Last_Element;
---------------- ----------------
...@@ -1643,7 +1648,7 @@ package body Ada.Containers.Vectors is ...@@ -1643,7 +1648,7 @@ package body Ada.Containers.Vectors is
L := L + 1; L := L + 1;
begin begin
Process (V.Elements (Index)); Process (V.Elements.EA (Index));
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -1689,7 +1694,7 @@ package body Ada.Containers.Vectors is ...@@ -1689,7 +1694,7 @@ package body Ada.Containers.Vectors is
for J in Count_Type range 1 .. Length loop for J in Count_Type range 1 .. Length loop
Last := Last + 1; Last := Last + 1;
Element_Type'Read (Stream, Container.Elements (Last)); Element_Type'Read (Stream, Container.Elements.EA (Last));
Container.Last := Last; Container.Last := Last;
end loop; end loop;
end Read; end Read;
...@@ -1721,7 +1726,7 @@ package body Ada.Containers.Vectors is ...@@ -1721,7 +1726,7 @@ package body Ada.Containers.Vectors is
"attempt to tamper with cursors (vector is locked)"; "attempt to tamper with cursors (vector is locked)";
end if; end if;
Container.Elements (Index) := New_Item; Container.Elements.EA (Index) := New_Item;
end Replace_Element; end Replace_Element;
procedure Replace_Element procedure Replace_Element
...@@ -1738,7 +1743,16 @@ package body Ada.Containers.Vectors is ...@@ -1738,7 +1743,16 @@ package body Ada.Containers.Vectors is
raise Program_Error with "Position cursor denotes wrong container"; raise Program_Error with "Position cursor denotes wrong container";
end if; end if;
Replace_Element (Container, Position.Index, New_Item); if Position.Index > Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is locked)";
end if;
Container.Elements.EA (Position.Index) := New_Item;
end Replace_Element; end Replace_Element;
---------------------- ----------------------
...@@ -1761,26 +1775,23 @@ package body Ada.Containers.Vectors is ...@@ -1761,26 +1775,23 @@ package body Ada.Containers.Vectors is
Free (X); Free (X);
end; end;
elsif N < Container.Elements'Length then elsif N < Container.Elements.EA'Length then
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error with raise Program_Error with
"attempt to tamper with elements (vector is busy)"; "attempt to tamper with elements (vector is busy)";
end if; end if;
declare declare
subtype Array_Index_Subtype is Index_Type'Base range subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last; Index_Type'First .. Container.Last;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Array_Index_Subtype); Container.Elements.EA (Src_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
Container.Elements := new Array_Subtype'(Src); Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X); Free (X);
end; end;
end if; end if;
...@@ -1801,11 +1812,8 @@ package body Ada.Containers.Vectors is ...@@ -1801,11 +1812,8 @@ package body Ada.Containers.Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is
Elements_Type (Index_Type'First .. Last);
begin begin
Container.Elements := new Array_Subtype; Container.Elements := new Elements_Type (Last);
end; end;
end; end;
...@@ -1813,26 +1821,23 @@ package body Ada.Containers.Vectors is ...@@ -1813,26 +1821,23 @@ package body Ada.Containers.Vectors is
end if; end if;
if Capacity <= N then if Capacity <= N then
if N < Container.Elements'Length then if N < Container.Elements.EA'Length then
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error with raise Program_Error with
"attempt to tamper with elements (vector is busy)"; "attempt to tamper with elements (vector is busy)";
end if; end if;
declare declare
subtype Array_Index_Subtype is Index_Type'Base range subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last; Index_Type'First .. Container.Last;
Src : Elements_Type renames Src : Elements_Array renames
Container.Elements (Array_Index_Subtype); Container.Elements.EA (Src_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
Container.Elements := new Array_Subtype'(Src); Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X); Free (X);
end; end;
...@@ -1841,7 +1846,7 @@ package body Ada.Containers.Vectors is ...@@ -1841,7 +1846,7 @@ package body Ada.Containers.Vectors is
return; return;
end if; end if;
if Capacity = Container.Elements'Length then if Capacity = Container.Elements.EA'Length then
return; return;
end if; end if;
...@@ -1862,18 +1867,17 @@ package body Ada.Containers.Vectors is ...@@ -1862,18 +1867,17 @@ package body Ada.Containers.Vectors is
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is E : Elements_Access := new Elements_Type (Last);
Elements_Type (Index_Type'First .. Last);
E : Elements_Access := new Array_Subtype;
begin begin
declare declare
Src : Elements_Type renames subtype Index_Subtype is Index_Type'Base range
Container.Elements (Index_Type'First .. Container.Last); Index_Type'First .. Container.Last;
Src : Elements_Array renames
Container.Elements.EA (Index_Subtype);
Tgt : Elements_Type renames Tgt : Elements_Array renames E.EA (Index_Subtype);
E (Index_Type'First .. Container.Last);
begin begin
Tgt := Src; Tgt := Src;
...@@ -1918,11 +1922,11 @@ package body Ada.Containers.Vectors is ...@@ -1918,11 +1922,11 @@ package body Ada.Containers.Vectors is
J := Container.Last; J := Container.Last;
while I < J loop while I < J loop
declare declare
EI : constant Element_Type := E (I); EI : constant Element_Type := E.EA (I);
begin begin
E (I) := E (J); E.EA (I) := E.EA (J);
E (J) := EI; E.EA (J) := EI;
end; end;
I := I + 1; I := I + 1;
...@@ -1958,7 +1962,7 @@ package body Ada.Containers.Vectors is ...@@ -1958,7 +1962,7 @@ package body Ada.Containers.Vectors is
end if; end if;
for Indx in reverse Index_Type'First .. Last loop for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (Indx) = Item then if Container.Elements.EA (Indx) = Item then
return (Container'Unchecked_Access, Indx); return (Container'Unchecked_Access, Indx);
end if; end if;
end loop; end loop;
...@@ -1985,7 +1989,7 @@ package body Ada.Containers.Vectors is ...@@ -1985,7 +1989,7 @@ package body Ada.Containers.Vectors is
end if; end if;
for Indx in reverse Index_Type'First .. Last loop for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (Indx) = Item then if Container.Elements.EA (Indx) = Item then
return Indx; return Indx;
end if; end if;
end loop; end loop;
...@@ -2071,8 +2075,8 @@ package body Ada.Containers.Vectors is ...@@ -2071,8 +2075,8 @@ package body Ada.Containers.Vectors is
end if; end if;
declare declare
EI : Element_Type renames Container.Elements (I); EI : Element_Type renames Container.Elements.EA (I);
EJ : Element_Type renames Container.Elements (J); EJ : Element_Type renames Container.Elements.EA (J);
EI_Copy : constant Element_Type := EI; EI_Copy : constant Element_Type := EI;
...@@ -2158,7 +2162,7 @@ package body Ada.Containers.Vectors is ...@@ -2158,7 +2162,7 @@ package body Ada.Containers.Vectors is
end if; end if;
Last := Index_Type (Last_As_Int); Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Index_Type'First .. Last); Elements := new Elements_Type (Last);
return Vector'(Controlled with Elements, Last, 0, 0); return Vector'(Controlled with Elements, Last, 0, 0);
end; end;
...@@ -2185,7 +2189,7 @@ package body Ada.Containers.Vectors is ...@@ -2185,7 +2189,7 @@ package body Ada.Containers.Vectors is
end if; end if;
Last := Index_Type (Last_As_Int); Last := Index_Type (Last_As_Int);
Elements := new Elements_Type'(Index_Type'First .. Last => New_Item); Elements := new Elements_Type'(Last, EA => (others => New_Item));
return Vector'(Controlled with Elements, Last, 0, 0); return Vector'(Controlled with Elements, Last, 0, 0);
end; end;
...@@ -2212,7 +2216,7 @@ package body Ada.Containers.Vectors is ...@@ -2212,7 +2216,7 @@ package body Ada.Containers.Vectors is
L := L + 1; L := L + 1;
begin begin
Process (Container.Elements (Index)); Process (Container.Elements.EA (Index));
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -2253,7 +2257,7 @@ package body Ada.Containers.Vectors is ...@@ -2253,7 +2257,7 @@ package body Ada.Containers.Vectors is
Count_Type'Base'Write (Stream, Length (Container)); Count_Type'Base'Write (Stream, Length (Container));
for J in Index_Type'First .. Container.Last loop for J in Index_Type'First .. Container.Last loop
Element_Type'Write (Stream, Container.Elements (J)); Element_Type'Write (Stream, Container.Elements.EA (J));
end loop; end loop;
end Write; end Write;
......
gcc/ada/a-convec.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -32,8 +32,9 @@ ...@@ -32,8 +32,9 @@
-- -- -- --
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Finalization;
with Ada.Streams; private with Ada.Finalization;
private with Ada.Streams;
generic generic
type Index_Type is range <>; type Index_Type is range <>;
...@@ -43,6 +44,7 @@ generic ...@@ -43,6 +44,7 @@ generic
package Ada.Containers.Vectors is package Ada.Containers.Vectors is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
subtype Extended_Index is Index_Type'Base subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 .. range Index_Type'First - 1 ..
...@@ -311,10 +313,15 @@ private ...@@ -311,10 +313,15 @@ private
pragma Inline (Update_Element); pragma Inline (Update_Element);
pragma Inline (Replace_Element); pragma Inline (Replace_Element);
pragma Inline (Contains); pragma Inline (Contains);
pragma Inline (Next);
pragma Inline (Previous);
type Elements_Type is array (Index_Type range <>) of Element_Type; type Elements_Array is array (Index_Type range <>) of Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract;
function "=" (L, R : Elements_Type) return Boolean is abstract; type Elements_Type (Last : Index_Type) is limited record
EA : Elements_Array (Index_Type'First .. Last);
end record;
type Elements_Access is access Elements_Type; type Elements_Access is access Elements_Type;
...@@ -327,8 +334,10 @@ private ...@@ -327,8 +334,10 @@ private
Lock : Natural := 0; Lock : Natural := 0;
end record; end record;
overriding
procedure Adjust (Container : in out Vector); procedure Adjust (Container : in out Vector);
overriding
procedure Finalize (Container : in out Vector); procedure Finalize (Container : in out Vector);
use Ada.Streams; use Ada.Streams;
......
gcc/ada/a-coorma.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -46,6 +46,7 @@ generic ...@@ -46,6 +46,7 @@ generic
package Ada.Containers.Ordered_Maps is package Ada.Containers.Ordered_Maps is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
...@@ -181,6 +182,9 @@ package Ada.Containers.Ordered_Maps is ...@@ -181,6 +182,9 @@ package Ada.Containers.Ordered_Maps is
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-coormu.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -45,6 +45,7 @@ generic ...@@ -45,6 +45,7 @@ generic
package Ada.Containers.Ordered_Multisets is package Ada.Containers.Ordered_Multisets is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean; function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
...@@ -245,6 +246,9 @@ package Ada.Containers.Ordered_Multisets is ...@@ -245,6 +246,9 @@ package Ada.Containers.Ordered_Multisets is
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-coorse.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -45,6 +45,7 @@ generic ...@@ -45,6 +45,7 @@ generic
package Ada.Containers.Ordered_Sets is package Ada.Containers.Ordered_Sets is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean; function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
...@@ -233,6 +234,9 @@ package Ada.Containers.Ordered_Sets is ...@@ -233,6 +234,9 @@ package Ada.Containers.Ordered_Sets is
private private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment