OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Bob Duff 2007-08-14 10:45:48 +02:00 committed by Arnaud Charlet
parent b11e8d6fc0
commit f97ccb3a84
21 changed files with 560 additions and 406 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/a-cdlili.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -44,6 +44,7 @@ generic
package Ada.Containers.Doubly_Linked_Lists is
pragma Preelaborate;
pragma Remote_Types;
type List is tagged private;
pragma Preelaborable_Initialization (List);
@ -204,6 +205,10 @@ package Ada.Containers.Doubly_Linked_Lists is
end Generic_Sorting;
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;

65
gcc/ada/a-chtgop.adb
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -37,8 +37,10 @@ with System; use type System.Address;
package body Ada.Containers.Hash_Tables.Generic_Operations is
procedure Free is
new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);
type Buckets_Allocation is access all Buckets_Type;
-- Used for allocation and deallocation (see New_Buckets and
-- Free_Buckets). This is necessary because Buckets_Access has an empty
-- storage pool.
------------
-- Adjust --
@ -66,7 +68,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
-- source table. This has the benefit that when iterating, elements of
-- 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
Src_Node := Src_Buckets (Src_Index);
@ -220,7 +222,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
procedure Finalize (HT : in out Hash_Table_Type) is
begin
Clear (HT);
Free (HT.Buckets);
Free_Buckets (HT.Buckets);
end Finalize;
-----------
@ -245,6 +247,21 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end loop;
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 --
---------------------
@ -265,7 +282,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end loop;
end loop;
Free (Buckets);
Free_Buckets (Buckets);
end Free_Hash_Table;
-------------------
@ -273,8 +290,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
-------------------
function Generic_Equal
(L, R : Hash_Table_Type) return Boolean is
(L, R : Hash_Table_Type) return Boolean
is
L_Index : Hash_Type;
L_Node : Node_Access;
@ -386,9 +403,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
if HT.Buckets = null
or else HT.Buckets'Length < N
then
Free (HT.Buckets);
Free_Buckets (HT.Buckets);
NN := Prime_Numbers.To_Prime (N);
HT.Buckets := new Buckets_Type (0 .. NN - 1);
HT.Buckets := New_Buckets (Length => NN);
end if;
for J in 1 .. N loop
@ -481,6 +498,20 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
Source.Length := 0;
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 --
----------
@ -521,7 +552,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
if HT.Buckets = null then
if N > 0 then
NN := Prime_Numbers.To_Prime (N);
HT.Buckets := new Buckets_Type (0 .. NN - 1);
HT.Buckets := New_Buckets (Length => NN);
end if;
return;
@ -536,7 +567,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
-- length that corresponds to a prime number.)
if N = 0 then
Free (HT.Buckets);
Free_Buckets (HT.Buckets);
return;
end if;
@ -553,8 +584,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
declare
X : Buckets_Access := HT.Buckets;
begin
HT.Buckets := new Buckets_Type (0 .. NN - 1);
Free (X);
HT.Buckets := New_Buckets (Length => NN);
Free_Buckets (X);
end;
return;
@ -595,7 +626,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if;
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;
L : Count_Type renames HT.Length;
@ -656,7 +687,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end;
end loop;
Free (Dst_Buckets);
Free_Buckets (Dst_Buckets);
raise Program_Error with
"hash function raised exception during rehash";
end;
@ -667,7 +698,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
HT.Buckets := Dst_Buckets;
HT.Length := LL;
Free (Src_Buckets);
Free_Buckets (Src_Buckets);
end Rehash;
end Reserve_Capacity;

13
gcc/ada/a-chtgop.ads
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- 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
-- first clears hash table HT, then populates the hash table by calling
-- 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;

7
gcc/ada/a-cidlli.ads
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -45,6 +45,7 @@ generic
package Ada.Containers.Indefinite_Doubly_Linked_Lists is
pragma Preelaborate;
pragma Remote_Types;
type List is tagged private;
pragma Preelaborable_Initialization (List);
@ -195,6 +196,10 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
end Generic_Sorting;
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;

4
gcc/ada/a-cihama.ads
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -48,6 +48,7 @@ generic
package Ada.Containers.Indefinite_Hashed_Maps is
pragma Preelaborate;
pragma Remote_Types;
type Map is tagged private;
pragma Preelaborable_Initialization (Map);
@ -159,6 +160,7 @@ private
pragma Inline (Reserve_Capacity);
pragma Inline (Has_Element);
pragma Inline (Equivalent_Keys);
pragma Inline (Next);
type Node_Type;
type Node_Access is access Node_Type;

10
gcc/ada/a-cihase.adb
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- 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
declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Length := 0;
@ -817,7 +817,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Length := 0;
@ -1372,7 +1372,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Length := 0;
@ -1574,7 +1574,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Iterate_Left : declare

6
gcc/ada/a-cihase.ads
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -50,6 +50,7 @@ generic
package Ada.Containers.Indefinite_Hashed_Sets is
pragma Preelaborate;
pragma Remote_Types;
type Set is tagged private;
pragma Preelaborable_Initialization (Set);
@ -204,6 +205,9 @@ package Ada.Containers.Indefinite_Hashed_Sets is
end Generic_Keys;
private
pragma Inline (Next);
type Node_Type;
type Node_Access is access Node_Type;

6
gcc/ada/a-ciorma.ads
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -47,6 +47,7 @@ generic
package Ada.Containers.Indefinite_Ordered_Maps is
pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
@ -176,6 +177,9 @@ package Ada.Containers.Indefinite_Ordered_Maps is
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;

6
gcc/ada/a-ciormu.ads
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -46,6 +46,7 @@ generic
package Ada.Containers.Indefinite_Ordered_Multisets is
pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
@ -238,6 +239,9 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;

6
gcc/ada/a-ciorse.ads
View File

@ -7,7 +7,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -46,6 +46,7 @@ generic
package Ada.Containers.Indefinite_Ordered_Sets is
pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
@ -242,6 +243,9 @@ package Ada.Containers.Indefinite_Ordered_Sets is
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;

4
gcc/ada/a-cohama.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -47,6 +47,7 @@ generic
package Ada.Containers.Hashed_Maps is
pragma Preelaborate;
pragma Remote_Types;
type Map is tagged private;
pragma Preelaborable_Initialization (Map);
@ -164,6 +165,7 @@ private
pragma Inline (Reserve_Capacity);
pragma Inline (Has_Element);
pragma Inline (Equivalent_Keys);
pragma Inline (Next);
type Node_Type;
type Node_Access is access Node_Type;

10
gcc/ada/a-cohase.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -327,7 +327,7 @@ package body Ada.Containers.Hashed_Sets is
declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Length := 0;
@ -753,7 +753,7 @@ package body Ada.Containers.Hashed_Sets is
declare
Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Length := 0;
@ -1248,7 +1248,7 @@ package body Ada.Containers.Hashed_Sets is
Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Length := 0;
@ -1426,7 +1426,7 @@ package body Ada.Containers.Hashed_Sets is
Size : constant Hash_Type :=
Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := new Buckets_Type (0 .. Size - 1);
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Iterate_Left : declare

6
gcc/ada/a-cohase.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -49,6 +49,7 @@ generic
package Ada.Containers.Hashed_Sets is
pragma Preelaborate;
pragma Remote_Types;
type Set is tagged private;
pragma Preelaborable_Initialization (Set);
@ -203,6 +204,9 @@ package Ada.Containers.Hashed_Sets is
end Generic_Keys;
private
pragma Inline (Next);
type Node_Type;
type Node_Access is access Node_Type;

7
gcc/ada/a-cohata.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -33,7 +33,7 @@
-- containers.
package Ada.Containers.Hash_Tables is
pragma Preelaborate;
pragma Pure; -- so this can be imported by Remote_Types packages
generic
type Node_Type (<>) is limited private;
@ -43,7 +43,8 @@ package Ada.Containers.Hash_Tables is
package Generic_Hash_Table_Types is
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
Buckets : Buckets_Access;

408
gcc/ada/a-coinve.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -59,22 +59,23 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
RE : Elements_Type renames
Right.Elements (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : Elements_Access :=
new Elements_Type (RE'Range);
new Elements_Type (Right.Last);
begin
for I in Elements'Range loop
for I in Elements.EA'Range loop
begin
if RE (I) /= null then
Elements (I) := new Element_Type'(RE (I).all);
Elements.EA (I) := new Element_Type'(RE (I).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements (J));
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -89,22 +90,23 @@ package body Ada.Containers.Indefinite_Vectors is
if RN = 0 then
declare
LE : Elements_Type renames
Left.Elements (Index_Type'First .. Left.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : Elements_Access :=
new Elements_Type (LE'Range);
new Elements_Type (Left.Last);
begin
for I in Elements'Range loop
for I in Elements.EA'Range loop
begin
if LE (I) /= null then
Elements (I) := new Element_Type'(LE (I).all);
Elements.EA (I) := new Element_Type'(LE (I).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements (J));
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -134,14 +136,13 @@ package body Ada.Containers.Indefinite_Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames
Left.Elements (Index_Type'First .. Left.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
RE : Elements_Type renames
Right.Elements (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : Elements_Access :=
new Elements_Type (Index_Type'First .. Last);
Elements : Elements_Access := new Elements_Type (Last);
I : Index_Type'Base := No_Index;
@ -151,12 +152,13 @@ package body Ada.Containers.Indefinite_Vectors is
begin
if LE (LI) /= null then
Elements (I) := new Element_Type'(LE (LI).all);
Elements.EA (I) := new Element_Type'(LE (LI).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements (J));
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -169,12 +171,13 @@ package body Ada.Containers.Indefinite_Vectors is
begin
if RE (RI) /= null then
Elements (I) := new Element_Type'(RE (RI).all);
Elements.EA (I) := new Element_Type'(RE (RI).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements (J));
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -193,14 +196,11 @@ package body Ada.Containers.Indefinite_Vectors is
begin
if LN = 0 then
declare
subtype Elements_Subtype is
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : Elements_Access := new Elements_Subtype;
Elements : Elements_Access := new Elements_Type (Index_Type'First);
begin
begin
Elements (Elements'First) := new Element_Type'(Right);
Elements.EA (Index_Type'First) := new Element_Type'(Right);
exception
when others =>
Free (Elements);
@ -228,22 +228,23 @@ package body Ada.Containers.Indefinite_Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames
Left.Elements (Index_Type'First .. Left.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : Elements_Access :=
new Elements_Type (Index_Type'First .. Last);
new Elements_Type (Last);
begin
for I in LE'Range loop
begin
if LE (I) /= null then
Elements (I) := new Element_Type'(LE (I).all);
Elements.EA (I) := new Element_Type'(LE (I).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements (J));
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -252,11 +253,12 @@ package body Ada.Containers.Indefinite_Vectors is
end loop;
begin
Elements (Elements'Last) := new Element_Type'(Right);
Elements.EA (Last) := new Element_Type'(Right);
exception
when others =>
for J in Index_Type'First .. Elements'Last - 1 loop
Free (Elements (J));
for J in Index_Type'First .. Last - 1 loop
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -274,14 +276,11 @@ package body Ada.Containers.Indefinite_Vectors is
begin
if RN = 0 then
declare
subtype Elements_Subtype is
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : Elements_Access := new Elements_Subtype;
Elements : Elements_Access := new Elements_Type (Index_Type'First);
begin
begin
Elements (Elements'First) := new Element_Type'(Left);
Elements.EA (Index_Type'First) := new Element_Type'(Left);
exception
when others =>
Free (Elements);
@ -309,17 +308,17 @@ package body Ada.Containers.Indefinite_Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
RE : Elements_Type renames
Right.Elements (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : Elements_Access :=
new Elements_Type (Index_Type'First .. Last);
new Elements_Type (Last);
I : Index_Type'Base := Index_Type'First;
begin
begin
Elements (I) := new Element_Type'(Left);
Elements.EA (I) := new Element_Type'(Left);
exception
when others =>
Free (Elements);
@ -331,12 +330,13 @@ package body Ada.Containers.Indefinite_Vectors is
begin
if RE (RI) /= null then
Elements (I) := new Element_Type'(RE (RI).all);
Elements.EA (I) := new Element_Type'(RE (RI).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements (J));
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -356,15 +356,12 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
Last : constant Index_Type := Index_Type'First + 1;
subtype ET is Elements_Type (Index_Type'First .. Last);
Elements : Elements_Access := new ET;
Last : constant Index_Type := Index_Type'First + 1;
Elements : Elements_Access := new Elements_Type (Last);
begin
begin
Elements (Elements'First) := new Element_Type'(Left);
Elements.EA (Index_Type'First) := new Element_Type'(Left);
exception
when others =>
Free (Elements);
@ -372,15 +369,15 @@ package body Ada.Containers.Indefinite_Vectors is
end;
begin
Elements (Elements'Last) := new Element_Type'(Right);
Elements.EA (Last) := new Element_Type'(Right);
exception
when others =>
Free (Elements (Elements'First));
Free (Elements.EA (Index_Type'First));
Free (Elements);
raise;
end;
return (Controlled with Elements, Elements'Last, 0, 0);
return (Controlled with Elements, Last, 0, 0);
end;
end "&";
@ -399,15 +396,15 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
for J in Index_Type'First .. Left.Last loop
if Left.Elements (J) = null then
if Right.Elements (J) /= null then
if Left.Elements.EA (J) = null then
if Right.Elements.EA (J) /= null then
return False;
end if;
elsif Right.Elements (J) = null then
elsif Right.Elements.EA (J) = null then
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;
end if;
end loop;
@ -427,8 +424,9 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
E : Elements_Type renames Container.Elements.all;
L : constant Index_Type := Container.Last;
E : Elements_Array renames
Container.Elements.EA (Index_Type'First .. L);
begin
Container.Elements := null;
@ -436,11 +434,11 @@ package body Ada.Containers.Indefinite_Vectors is
Container.Busy := 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
Container.Elements (I) := new Element_Type'(E (I).all);
Container.Elements.EA (I) := new Element_Type'(E (I).all);
end if;
Container.Last := I;
@ -499,7 +497,7 @@ package body Ada.Containers.Indefinite_Vectors is
return 0;
end if;
return Container.Elements'Length;
return Container.Elements.EA'Length;
end Capacity;
-----------
@ -515,9 +513,9 @@ package body Ada.Containers.Indefinite_Vectors is
while Container.Last >= Index_Type'First loop
declare
X : Element_Access := Container.Elements (Container.Last);
X : Element_Access := Container.Elements.EA (Container.Last);
begin
Container.Elements (Container.Last) := null;
Container.Elements.EA (Container.Last) := null;
Container.Last := Container.Last - 1;
Free (X);
end;
@ -576,7 +574,7 @@ package body Ada.Containers.Indefinite_Vectors is
N : constant Int'Base := Int'Min (Count1, Count2);
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
if J_As_Int > Old_Last_As_Int then
@ -637,7 +635,7 @@ package body Ada.Containers.Indefinite_Vectors is
Delete (Container, Position.Index, Count);
Position := No_Element; -- See comment in a-convec.adb
Position := No_Element;
end Delete;
------------------
@ -684,7 +682,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
E : Elements_Type renames Container.Elements.all;
E : Elements_Array renames Container.Elements.EA;
begin
for Indx in 1 .. Count_Type'Min (Count, N) loop
@ -715,7 +713,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
EA : constant Element_Access := Container.Elements (Index);
EA : constant Element_Access := Container.Elements.EA (Index);
begin
if EA = null then
@ -732,7 +730,21 @@ package body Ada.Containers.Indefinite_Vectors is
raise Constraint_Error with "Position cursor has no element";
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;
--------------
@ -772,8 +784,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
for J in Position.Index .. Container.Last loop
if Container.Elements (J) /= null
and then Container.Elements (J).all = Item
if Container.Elements.EA (J) /= null
and then Container.Elements.EA (J).all = Item
then
return (Container'Unchecked_Access, J);
end if;
@ -793,8 +805,8 @@ package body Ada.Containers.Indefinite_Vectors is
is
begin
for Indx in Index .. Container.Last loop
if Container.Elements (Indx) /= null
and then Container.Elements (Indx).all = Item
if Container.Elements.EA (Indx) /= null
and then Container.Elements.EA (Indx).all = Item
then
return Indx;
end if;
@ -822,7 +834,21 @@ package body Ada.Containers.Indefinite_Vectors is
function First_Element (Container : Vector) return Element_Type is
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;
-----------------
@ -874,7 +900,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
E : Elements_Type renames Container.Elements.all;
E : Elements_Array renames Container.Elements.EA;
begin
for I in Index_Type'First .. Container.Last - 1 loop
if Is_Less (E (I + 1), E (I)) then
@ -891,8 +917,7 @@ package body Ada.Containers.Indefinite_Vectors is
-----------
procedure Merge (Target, Source : in out Vector) is
I : Index_Type'Base := Target.Last;
J : Index_Type'Base;
I, J : Index_Type'Base;
begin
if Target.Last < Index_Type'First then
@ -913,23 +938,24 @@ package body Ada.Containers.Indefinite_Vectors is
"attempt to tamper with elements (vector is busy)";
end if;
I := Target.Last; -- original value (before Set_Length)
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
pragma Assert
(Source.Last <= Index_Type'First
or else not (Is_Less
(Source.Elements (Source.Last),
Source.Elements (Source.Last - 1))));
(Source.Elements.EA (Source.Last),
Source.Elements.EA (Source.Last - 1))));
if I < Index_Type'First then
declare
Src : Elements_Type renames
Source.Elements (Index_Type'First .. Source.Last);
Src : Elements_Array renames
Source.Elements.EA (Index_Type'First .. Source.Last);
begin
Target.Elements (Index_Type'First .. J) := Src;
Target.Elements.EA (Index_Type'First .. J) := Src;
Src := (others => null);
end;
@ -940,21 +966,21 @@ package body Ada.Containers.Indefinite_Vectors is
pragma Assert
(I <= Index_Type'First
or else not (Is_Less
(Target.Elements (I),
Target.Elements (I - 1))));
(Target.Elements.EA (I),
Target.Elements.EA (I - 1))));
declare
Src : Element_Access renames Source.Elements (Source.Last);
Tgt : Element_Access renames Target.Elements (I);
Src : Element_Access renames Source.Elements.EA (Source.Last);
Tgt : Element_Access renames Target.Elements.EA (I);
begin
if Is_Less (Src, Tgt) then
Target.Elements (J) := Tgt;
Target.Elements.EA (J) := Tgt;
Tgt := null;
I := I - 1;
else
Target.Elements (J) := Src;
Target.Elements.EA (J) := Src;
Src := null;
Source.Last := Source.Last - 1;
end if;
@ -974,7 +1000,7 @@ package body Ada.Containers.Indefinite_Vectors is
new Generic_Array_Sort
(Index_Type => Index_Type,
Element_Type => Element_Access,
Array_Type => Elements_Type,
Array_Type => Elements_Array,
"<" => Is_Less);
-- Start of processing for Sort
@ -989,7 +1015,7 @@ package body Ada.Containers.Indefinite_Vectors is
"attempt to tamper with cursors (vector is locked)";
end if;
Sort (Container.Elements (Index_Type'First .. Container.Last));
Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
end Sort;
end Generic_Sorting;
@ -1073,22 +1099,20 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
if Container.Elements = null then
Container.Elements :=
new Elements_Type (Index_Type'First .. New_Last);
Container.Elements := new Elements_Type (New_Last);
Container.Last := No_Index;
for J in Container.Elements'Range loop
Container.Elements (J) := new Element_Type'(New_Item);
for J in Container.Elements.EA'Range loop
Container.Elements.EA (J) := new Element_Type'(New_Item);
Container.Last := J;
end loop;
return;
end if;
if New_Last <= Container.Elements'Last then
if New_Last <= Container.Elements.Last then
declare
E : Elements_Type renames Container.Elements.all;
E : Elements_Array renames Container.Elements.EA;
begin
if Before <= Container.Last then
@ -1131,7 +1155,7 @@ package body Ada.Containers.Indefinite_Vectors is
C, CC : UInt;
begin
C := UInt'Max (1, Container.Elements'Length);
C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop
if C > UInt'Last / 2 then
C := UInt'Last;
@ -1163,7 +1187,7 @@ package body Ada.Containers.Indefinite_Vectors is
Index_Type (First + UInt'Pos (C) - Int'(1));
begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last);
Dst := new Elements_Type (Dst_Last);
end;
end;
@ -1177,17 +1201,17 @@ package body Ada.Containers.Indefinite_Vectors is
Src : Elements_Access := Container.Elements;
begin
Dst (Index_Type'First .. Before - 1) :=
Src (Index_Type'First .. Before - 1);
Dst.EA (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.Last := New_Last;
Free (Src);
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;
@ -1196,14 +1220,14 @@ package body Ada.Containers.Indefinite_Vectors is
Src : Elements_Access := Container.Elements;
begin
Dst (Index_Type'First .. Container.Last) :=
Src (Index_Type'First .. Container.Last);
Dst.EA (Index_Type'First .. Container.Last) :=
Src.EA (Index_Type'First .. Container.Last);
Container.Elements := Dst;
Free (Src);
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;
end loop;
end;
@ -1242,16 +1266,19 @@ package body Ada.Containers.Indefinite_Vectors is
Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
Dst : Elements_Type renames
Container.Elements (Before .. Dst_Last);
Dst : Elements_Array renames
Container.Elements.EA (Before .. Dst_Last);
Dst_Index : Index_Type'Base := Before - 1;
begin
if Container'Address /= New_Item'Address then
declare
Src : Elements_Type renames
New_Item.Elements (Index_Type'First .. New_Item.Last);
subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. New_Item.Last;
Src : Elements_Array renames
New_Item.Elements.EA (Src_Index_Subtype);
begin
for Src_Index in Src'Range loop
@ -1270,8 +1297,8 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Before - 1;
Src : Elements_Type renames
Container.Elements (Src_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
begin
for Src_Index in Src'Range loop
@ -1291,8 +1318,8 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Src_Index_Subtype is Index_Type'Base range
Dst_Last + 1 .. Container.Last;
Src : Elements_Type renames
Container.Elements (Src_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
begin
for Src_Index in Src'Range loop
@ -1535,16 +1562,14 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
if Container.Elements = null then
Container.Elements :=
new Elements_Type (Index_Type'First .. New_Last);
Container.Elements := new Elements_Type (New_Last);
Container.Last := New_Last;
return;
end if;
if New_Last <= Container.Elements'Last then
if New_Last <= Container.Elements.Last then
declare
E : Elements_Type renames Container.Elements.all;
E : Elements_Array renames Container.Elements.EA;
begin
if Before <= Container.Last then
@ -1569,7 +1594,7 @@ package body Ada.Containers.Indefinite_Vectors is
C, CC : UInt;
begin
C := UInt'Max (1, Container.Elements'Length);
C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop
if C > UInt'Last / 2 then
C := UInt'Last;
@ -1601,7 +1626,7 @@ package body Ada.Containers.Indefinite_Vectors is
Index_Type (First + UInt'Pos (C) - 1);
begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last);
Dst := new Elements_Type (Dst_Last);
end;
end;
@ -1617,15 +1642,15 @@ package body Ada.Containers.Indefinite_Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int);
begin
Dst (Index_Type'First .. Before - 1) :=
Src (Index_Type'First .. Before - 1);
Dst.EA (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;
else
Dst (Index_Type'First .. Container.Last) :=
Src (Index_Type'First .. Container.Last);
Dst.EA (Index_Type'First .. Container.Last) :=
Src.EA (Index_Type'First .. Container.Last);
end if;
Container.Elements := Dst;
@ -1735,7 +1760,21 @@ package body Ada.Containers.Indefinite_Vectors is
function Last_Element (Container : Vector) return Element_Type is
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;
----------------
@ -1894,7 +1933,7 @@ package body Ada.Containers.Indefinite_Vectors is
raise Constraint_Error with "Index is out of range";
end if;
if V.Elements (Index) = null then
if V.Elements.EA (Index) = null then
raise Constraint_Error with "element is null";
end if;
@ -1902,7 +1941,7 @@ package body Ada.Containers.Indefinite_Vectors is
L := L + 1;
begin
Process (V.Elements (Index).all);
Process (V.Elements.EA (Index).all);
exception
when others =>
L := L - 1;
@ -1954,7 +1993,7 @@ package body Ada.Containers.Indefinite_Vectors is
Boolean'Read (Stream, B);
if B then
Container.Elements (Last) :=
Container.Elements.EA (Last) :=
new Element_Type'(Element_Type'Input (Stream));
end if;
@ -1990,9 +2029,9 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
X : Element_Access := Container.Elements (Index);
X : Element_Access := Container.Elements.EA (Index);
begin
Container.Elements (Index) := new Element_Type'(New_Item);
Container.Elements.EA (Index) := new Element_Type'(New_Item);
Free (X);
end;
end Replace_Element;
@ -2011,7 +2050,21 @@ package body Ada.Containers.Indefinite_Vectors is
raise Program_Error with "Position cursor denotes wrong container";
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;
----------------------
@ -2034,7 +2087,7 @@ package body Ada.Containers.Indefinite_Vectors is
Free (X);
end;
elsif N < Container.Elements'Length then
elsif N < Container.Elements.EA'Length then
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
@ -2044,16 +2097,13 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Array_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last;
Src : Elements_Type renames
Container.Elements (Array_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Array_Index_Subtype);
X : Elements_Access := Container.Elements;
begin
Container.Elements := new Array_Subtype'(Src);
Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X);
end;
end if;
@ -2074,11 +2124,8 @@ package body Ada.Containers.Indefinite_Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is
Elements_Type (Index_Type'First .. Last);
begin
Container.Elements := new Array_Subtype;
Container.Elements := new Elements_Type (Last);
end;
end;
@ -2086,7 +2133,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
if Capacity <= N then
if N < Container.Elements'Length then
if N < Container.Elements.EA'Length then
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
@ -2096,16 +2143,13 @@ package body Ada.Containers.Indefinite_Vectors is
subtype Array_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last;
Src : Elements_Type renames
Container.Elements (Array_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Array_Index_Subtype);
X : Elements_Access := Container.Elements;
begin
Container.Elements := new Array_Subtype'(Src);
Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X);
end;
end if;
@ -2113,7 +2157,7 @@ package body Ada.Containers.Indefinite_Vectors is
return;
end if;
if Capacity = Container.Elements'Length then
if Capacity = Container.Elements.EA'Length then
return;
end if;
@ -2133,21 +2177,20 @@ package body Ada.Containers.Indefinite_Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
X : Elements_Access := Container.Elements;
subtype Array_Subtype is
Elements_Type (Index_Type'First .. Last);
X : Elements_Access := Container.Elements;
subtype Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last;
begin
Container.Elements := new Array_Subtype;
Container.Elements := new Elements_Type (Last);
declare
Src : Elements_Type renames
X (Index_Type'First .. Container.Last);
Src : Elements_Array renames
X.EA (Index_Subtype);
Tgt : Elements_Type renames
Container.Elements (Index_Type'First .. Container.Last);
Tgt : Elements_Array renames
Container.Elements.EA (Index_Subtype);
begin
Tgt := Src;
@ -2176,7 +2219,7 @@ package body Ada.Containers.Indefinite_Vectors is
declare
I : Index_Type;
J : Index_Type;
E : Elements_Type renames Container.Elements.all;
E : Elements_Array renames Container.Elements.EA;
begin
I := Index_Type'First;
@ -2223,8 +2266,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (Indx) /= null
and then Container.Elements (Indx).all = Item
if Container.Elements.EA (Indx) /= null
and then Container.Elements.EA (Indx).all = Item
then
return (Container'Unchecked_Access, Indx);
end if;
@ -2252,8 +2295,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (Indx) /= null
and then Container.Elements (Indx).all = Item
if Container.Elements.EA (Indx) /= null
and then Container.Elements.EA (Indx).all = Item
then
return Indx;
end if;
@ -2313,10 +2356,10 @@ package body Ada.Containers.Indefinite_Vectors is
for Index in 1 .. N - Length loop
declare
J : constant Index_Type := Container.Last;
X : Element_Access := Container.Elements (J);
X : Element_Access := Container.Elements.EA (J);
begin
Container.Elements (J) := null;
Container.Elements.EA (J) := null;
Container.Last := J - 1;
Free (X);
end;
@ -2365,8 +2408,8 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
EI : Element_Access renames Container.Elements (I);
EJ : Element_Access renames Container.Elements (J);
EI : Element_Access renames Container.Elements.EA (I);
EJ : Element_Access renames Container.Elements.EA (J);
EI_Copy : constant Element_Access := EI;
@ -2455,7 +2498,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
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);
end;
@ -2482,20 +2525,21 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Index_Type'First .. Last);
Elements := new Elements_Type (Last);
Last := Index_Type'First;
begin
loop
Elements (Last) := new Element_Type'(New_Item);
exit when Last = Elements'Last;
Elements.EA (Last) := new Element_Type'(New_Item);
exit when Last = Elements.Last;
Last := Last + 1;
end loop;
exception
when others =>
for J in Index_Type'First .. Last - 1 loop
Free (Elements (J));
Free (Elements.EA (J));
end loop;
Free (Elements);
@ -2523,7 +2567,7 @@ package body Ada.Containers.Indefinite_Vectors is
raise Constraint_Error with "Index is out of range";
end if;
if Container.Elements (Index) = null then
if Container.Elements.EA (Index) = null then
raise Constraint_Error with "element is null";
end if;
@ -2531,7 +2575,7 @@ package body Ada.Containers.Indefinite_Vectors is
L := L + 1;
begin
Process (Container.Elements (Index).all);
Process (Container.Elements.EA (Index).all);
exception
when others =>
L := L - 1;
@ -2578,7 +2622,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
E : Elements_Type renames Container.Elements.all;
E : Elements_Array renames Container.Elements.EA;
begin
for Indx in Index_Type'First .. Container.Last loop

18
gcc/ada/a-coinve.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -33,8 +33,8 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Finalization;
with Ada.Streams;
private with Ada.Finalization;
private with Ada.Streams;
generic
type Index_Type is range <>;
@ -44,6 +44,7 @@ generic
package Ada.Containers.Indefinite_Vectors is
pragma Preelaborate;
pragma Remote_Types;
subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 ..
@ -301,12 +302,17 @@ private
pragma Inline (Update_Element);
pragma Inline (Replace_Element);
pragma Inline (Contains);
pragma Inline (Next);
pragma Inline (Previous);
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;
@ -319,8 +325,10 @@ private
Lock : Natural := 0;
end record;
overriding
procedure Adjust (Container : in out Vector);
overriding
procedure Finalize (Container : in out Vector);
use Ada.Streams;

346
gcc/ada/a-convec.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -57,11 +57,11 @@ package body Ada.Containers.Vectors is
end if;
declare
RE : Elements_Type renames
Right.Elements (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
new Elements_Type'(RE);
new Elements_Type'(Right.Last, RE);
begin
return (Controlled with Elements, Right.Last, 0, 0);
@ -70,11 +70,11 @@ package body Ada.Containers.Vectors is
if RN = 0 then
declare
LE : Elements_Type renames
Left.Elements (Index_Type'First .. Left.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : constant Elements_Access :=
new Elements_Type'(LE);
new Elements_Type'(Left.Last, LE);
begin
return (Controlled with Elements, Left.Last, 0, 0);
@ -100,14 +100,14 @@ package body Ada.Containers.Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames
Left.Elements (Index_Type'First .. Left.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
RE : Elements_Type renames
Right.Elements (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
new Elements_Type'(LE & RE);
new Elements_Type'(Last, LE & RE);
begin
return (Controlled with Elements, Last, 0, 0);
@ -121,11 +121,10 @@ package body Ada.Containers.Vectors is
begin
if LN = 0 then
declare
subtype Elements_Subtype is
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : constant Elements_Access :=
new Elements_Subtype'(others => Right);
new Elements_Type'
(Last => Index_Type'First,
EA => (others => Right));
begin
return (Controlled with Elements, Index_Type'First, 0, 0);
@ -149,12 +148,13 @@ package body Ada.Containers.Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames
Left.Elements (Index_Type'First .. Left.Last);
LE : Elements_Array renames
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
return (Controlled with Elements, Last, 0, 0);
@ -168,11 +168,10 @@ package body Ada.Containers.Vectors is
begin
if RN = 0 then
declare
subtype Elements_Subtype is
Elements_Type (Index_Type'First .. Index_Type'First);
Elements : constant Elements_Access :=
new Elements_Subtype'(others => Left);
new Elements_Type'
(Last => Index_Type'First,
EA => (others => Left));
begin
return (Controlled with Elements, Index_Type'First, 0, 0);
@ -196,12 +195,13 @@ package body Ada.Containers.Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
RE : Elements_Type renames
Right.Elements (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
subtype ET is Elements_Type (Index_Type'First .. Last);
Elements : constant Elements_Access := new ET'(Left & RE);
Elements : constant Elements_Access :=
new Elements_Type'
(Last => Last,
EA => Left & RE);
begin
return (Controlled with Elements, Last, 0, 0);
@ -218,9 +218,10 @@ package body Ada.Containers.Vectors is
declare
Last : constant Index_Type := Index_Type'First + 1;
subtype ET is Elements_Type (Index_Type'First .. Last);
Elements : constant Elements_Access := new ET'(Left, Right);
Elements : constant Elements_Access :=
new Elements_Type'
(Last => Last,
EA => (Left, Right));
begin
return (Controlled with Elements, Last, 0, 0);
@ -242,7 +243,7 @@ package body Ada.Containers.Vectors is
end if;
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;
end if;
end loop;
@ -262,15 +263,17 @@ package body Ada.Containers.Vectors is
end if;
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
Container.Elements := null;
Container.Last := No_Index;
Container.Busy := 0;
Container.Lock := 0;
Container.Elements := new Elements_Type'(E (Index_Type'First .. L));
Container.Elements := new Elements_Type'(L, EA);
Container.Last := L;
end;
end Adjust;
@ -326,7 +329,7 @@ package body Ada.Containers.Vectors is
return 0;
end if;
return Container.Elements'Length;
return Container.Elements.EA'Length;
end Capacity;
-----------
@ -402,15 +405,15 @@ package body Ada.Containers.Vectors is
else
declare
J : constant Index_Type := Index_Type (J_As_Int);
E : Elements_Type renames Container.Elements.all;
J : constant Index_Type := Index_Type (J_As_Int);
EA : Elements_Array renames Container.Elements.EA;
New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
New_Last : constant Index_Type :=
Index_Type (New_Last_As_Int);
begin
E (Index .. New_Last) := E (J .. Container.Last);
EA (Index .. New_Last) := EA (J .. Container.Last);
Container.Last := New_Last;
end;
end if;
@ -436,17 +439,6 @@ package body Ada.Containers.Vectors is
end if;
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;
end Delete;
@ -513,7 +505,7 @@ package body Ada.Containers.Vectors is
raise Constraint_Error with "Index is out of range";
end if;
return Container.Elements (Index);
return Container.Elements.EA (Index);
end Element;
function Element (Position : Cursor) return Element_Type is
@ -522,7 +514,11 @@ package body Ada.Containers.Vectors is
raise Constraint_Error with "Position cursor has no element";
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;
--------------
@ -564,7 +560,7 @@ package body Ada.Containers.Vectors is
end if;
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);
end if;
end loop;
@ -583,7 +579,7 @@ package body Ada.Containers.Vectors is
is
begin
for Indx in Index .. Container.Last loop
if Container.Elements (Indx) = Item then
if Container.Elements.EA (Indx) = Item then
return Indx;
end if;
end loop;
@ -610,7 +606,11 @@ package body Ada.Containers.Vectors is
function First_Element (Container : Vector) return Element_Type is
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;
-----------------
@ -640,10 +640,10 @@ package body Ada.Containers.Vectors is
end if;
declare
E : Elements_Type renames Container.Elements.all;
EA : Elements_Array renames Container.Elements.EA;
begin
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;
end if;
end loop;
@ -681,35 +681,40 @@ package body Ada.Containers.Vectors is
Target.Set_Length (Length (Target) + Length (Source));
J := Target.Last;
while Source.Last >= Index_Type'First loop
pragma Assert (Source.Last <= Index_Type'First
or else not (Source.Elements (Source.Last) <
Source.Elements (Source.Last - 1)));
declare
TA : Elements_Array renames Target.Elements.EA;
SA : Elements_Array renames Source.Elements.EA;
if I < Index_Type'First then
Target.Elements (Index_Type'First .. J) :=
Source.Elements (Index_Type'First .. Source.Last);
begin
J := Target.Last;
while Source.Last >= Index_Type'First loop
pragma Assert (Source.Last <= Index_Type'First
or else not (SA (Source.Last) <
SA (Source.Last - 1)));
Source.Last := No_Index;
return;
end if;
if I < Index_Type'First then
TA (Index_Type'First .. J) :=
SA (Index_Type'First .. Source.Last);
pragma Assert (I <= Index_Type'First
or else not (Target.Elements (I) <
Target.Elements (I - 1)));
Source.Last := No_Index;
return;
end if;
if Source.Elements (Source.Last) < Target.Elements (I) then
Target.Elements (J) := Target.Elements (I);
I := I - 1;
pragma Assert (I <= Index_Type'First
or else not (TA (I) < TA (I - 1)));
else
Target.Elements (J) := Source.Elements (Source.Last);
Source.Last := Source.Last - 1;
end if;
if SA (Source.Last) < TA (I) then
TA (J) := TA (I);
I := I - 1;
J := J - 1;
end loop;
else
TA (J) := SA (Source.Last);
Source.Last := Source.Last - 1;
end if;
J := J - 1;
end loop;
end;
end Merge;
----------
@ -722,7 +727,7 @@ package body Ada.Containers.Vectors is
new Generic_Array_Sort
(Index_Type => Index_Type,
Element_Type => Element_Type,
Array_Type => Elements_Type,
Array_Type => Elements_Array,
"<" => "<");
begin
@ -735,7 +740,7 @@ package body Ada.Containers.Vectors is
"attempt to tamper with cursors (vector is locked)";
end if;
Sort (Container.Elements (Index_Type'First .. Container.Last));
Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
end Sort;
end Generic_Sorting;
@ -819,20 +824,16 @@ package body Ada.Containers.Vectors is
end if;
if Container.Elements = null then
declare
subtype Elements_Subtype is
Elements_Type (Index_Type'First .. New_Last);
begin
Container.Elements := new Elements_Subtype'(others => New_Item);
end;
Container.Elements := new Elements_Type'
(Last => New_Last,
EA => (others => New_Item));
Container.Last := New_Last;
return;
end if;
if New_Last <= Container.Elements'Last then
if New_Last <= Container.Elements.Last then
declare
E : Elements_Type renames Container.Elements.all;
EA : Elements_Array renames Container.Elements.EA;
begin
if Before <= Container.Last then
@ -843,14 +844,14 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int);
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);
end;
else
E (Before .. New_Last) := (others => New_Item);
EA (Before .. New_Last) := (others => New_Item);
end if;
end;
@ -862,7 +863,7 @@ package body Ada.Containers.Vectors is
C, CC : UInt;
begin
C := UInt'Max (1, Container.Elements'Length);
C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop
if C > UInt'Last / 2 then
C := UInt'Last;
@ -894,16 +895,17 @@ package body Ada.Containers.Vectors is
Index_Type (First + UInt'Pos (C) - 1);
begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last);
Dst := new Elements_Type (Dst_Last);
end;
end;
declare
Src : Elements_Type renames Container.Elements.all;
SA : Elements_Array renames Container.Elements.EA;
DA : Elements_Array renames Dst.EA;
begin
Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
Src (Index_Type'First .. Index_Type'Pred (Before));
DA (Index_Type'First .. Index_Type'Pred (Before)) :=
SA (Index_Type'First .. Index_Type'Pred (Before));
if Before <= Container.Last then
declare
@ -913,12 +915,12 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int);
begin
Dst (Before .. Index_Type'Pred (Index)) := (others => New_Item);
Dst (Index .. New_Last) := Src (Before .. Container.Last);
DA (Before .. Index_Type'Pred (Index)) := (others => New_Item);
DA (Index .. New_Last) := SA (Before .. Container.Last);
end;
else
Dst (Before .. New_Last) := (others => New_Item);
DA (Before .. New_Last) := (others => New_Item);
end if;
exception
when others =>
@ -969,8 +971,8 @@ package body Ada.Containers.Vectors is
begin
if Container'Address /= New_Item'Address then
Container.Elements (Before .. Dst_Last) :=
New_Item.Elements (Index_Type'First .. New_Item.Last);
Container.Elements.EA (Before .. Dst_Last) :=
New_Item.Elements.EA (Index_Type'First .. New_Item.Last);
return;
end if;
@ -979,8 +981,8 @@ package body Ada.Containers.Vectors is
subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Before - 1;
Src : Elements_Type renames
Container.Elements (Src_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
Index_As_Int : constant Int'Base :=
Int (Before) + Src'Length - 1;
@ -988,8 +990,8 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type'Base :=
Index_Type'Base (Index_As_Int);
Dst : Elements_Type renames
Container.Elements (Before .. Index);
Dst : Elements_Array renames
Container.Elements.EA (Before .. Index);
begin
Dst := Src;
@ -1003,8 +1005,8 @@ package body Ada.Containers.Vectors is
subtype Src_Index_Subtype is Index_Type'Base range
Dst_Last + 1 .. Container.Last;
Src : Elements_Type renames
Container.Elements (Src_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
Index_As_Int : constant Int'Base :=
Dst_Last_As_Int - Src'Length + 1;
@ -1012,8 +1014,8 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type :=
Index_Type (Index_As_Int);
Dst : Elements_Type renames
Container.Elements (Index .. Dst_Last);
Dst : Elements_Array renames
Container.Elements.EA (Index .. Dst_Last);
begin
Dst := Src;
@ -1275,16 +1277,14 @@ package body Ada.Containers.Vectors is
end if;
if Container.Elements = null then
Container.Elements :=
new Elements_Type (Index_Type'First .. New_Last);
Container.Elements := new Elements_Type (New_Last);
Container.Last := New_Last;
return;
end if;
if New_Last <= Container.Elements'Last then
if New_Last <= Container.Elements.Last then
declare
E : Elements_Type renames Container.Elements.all;
EA : Elements_Array renames Container.Elements.EA;
begin
if Before <= Container.Last then
declare
@ -1294,7 +1294,7 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int);
begin
E (Index .. New_Last) := E (Before .. Container.Last);
EA (Index .. New_Last) := EA (Before .. Container.Last);
end;
end if;
end;
@ -1307,7 +1307,7 @@ package body Ada.Containers.Vectors is
C, CC : UInt;
begin
C := UInt'Max (1, Container.Elements'Length);
C := UInt'Max (1, Container.Elements.EA'Length); -- ???
while C < New_Length loop
if C > UInt'Last / 2 then
C := UInt'Last;
@ -1339,16 +1339,17 @@ package body Ada.Containers.Vectors is
Index_Type (First + UInt'Pos (C) - 1);
begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last);
Dst := new Elements_Type (Dst_Last);
end;
end;
declare
Src : Elements_Type renames Container.Elements.all;
SA : Elements_Array renames Container.Elements.EA;
DA : Elements_Array renames Dst.EA;
begin
Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
Src (Index_Type'First .. Index_Type'Pred (Before));
DA (Index_Type'First .. Index_Type'Pred (Before)) :=
SA (Index_Type'First .. Index_Type'Pred (Before));
if Before <= Container.Last then
declare
@ -1358,7 +1359,7 @@ package body Ada.Containers.Vectors is
Index : constant Index_Type := Index_Type (Index_As_Int);
begin
Dst (Index .. New_Last) := Src (Before .. Container.Last);
DA (Index .. New_Last) := SA (Before .. Container.Last);
end;
end if;
exception
@ -1477,7 +1478,11 @@ package body Ada.Containers.Vectors is
function Last_Element (Container : Vector) return Element_Type is
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;
----------------
@ -1643,7 +1648,7 @@ package body Ada.Containers.Vectors is
L := L + 1;
begin
Process (V.Elements (Index));
Process (V.Elements.EA (Index));
exception
when others =>
L := L - 1;
@ -1689,7 +1694,7 @@ package body Ada.Containers.Vectors is
for J in Count_Type range 1 .. Length loop
Last := Last + 1;
Element_Type'Read (Stream, Container.Elements (Last));
Element_Type'Read (Stream, Container.Elements.EA (Last));
Container.Last := Last;
end loop;
end Read;
@ -1721,7 +1726,7 @@ package body Ada.Containers.Vectors is
"attempt to tamper with cursors (vector is locked)";
end if;
Container.Elements (Index) := New_Item;
Container.Elements.EA (Index) := New_Item;
end Replace_Element;
procedure Replace_Element
@ -1738,7 +1743,16 @@ package body Ada.Containers.Vectors is
raise Program_Error with "Position cursor denotes wrong container";
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;
----------------------
@ -1761,26 +1775,23 @@ package body Ada.Containers.Vectors is
Free (X);
end;
elsif N < Container.Elements'Length then
elsif N < Container.Elements.EA'Length then
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
declare
subtype Array_Index_Subtype is Index_Type'Base range
subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last;
Src : Elements_Type renames
Container.Elements (Array_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
X : Elements_Access := Container.Elements;
begin
Container.Elements := new Array_Subtype'(Src);
Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X);
end;
end if;
@ -1801,11 +1812,8 @@ package body Ada.Containers.Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is
Elements_Type (Index_Type'First .. Last);
begin
Container.Elements := new Array_Subtype;
Container.Elements := new Elements_Type (Last);
end;
end;
@ -1813,26 +1821,23 @@ package body Ada.Containers.Vectors is
end if;
if Capacity <= N then
if N < Container.Elements'Length then
if N < Container.Elements.EA'Length then
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
declare
subtype Array_Index_Subtype is Index_Type'Base range
subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last;
Src : Elements_Type renames
Container.Elements (Array_Index_Subtype);
subtype Array_Subtype is
Elements_Type (Array_Index_Subtype);
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
X : Elements_Access := Container.Elements;
begin
Container.Elements := new Array_Subtype'(Src);
Container.Elements := new Elements_Type'(Container.Last, Src);
Free (X);
end;
@ -1841,7 +1846,7 @@ package body Ada.Containers.Vectors is
return;
end if;
if Capacity = Container.Elements'Length then
if Capacity = Container.Elements.EA'Length then
return;
end if;
@ -1862,18 +1867,17 @@ package body Ada.Containers.Vectors is
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is
Elements_Type (Index_Type'First .. Last);
E : Elements_Access := new Array_Subtype;
E : Elements_Access := new Elements_Type (Last);
begin
declare
Src : Elements_Type renames
Container.Elements (Index_Type'First .. Container.Last);
subtype Index_Subtype is Index_Type'Base range
Index_Type'First .. Container.Last;
Tgt : Elements_Type renames
E (Index_Type'First .. Container.Last);
Src : Elements_Array renames
Container.Elements.EA (Index_Subtype);
Tgt : Elements_Array renames E.EA (Index_Subtype);
begin
Tgt := Src;
@ -1918,11 +1922,11 @@ package body Ada.Containers.Vectors is
J := Container.Last;
while I < J loop
declare
EI : constant Element_Type := E (I);
EI : constant Element_Type := E.EA (I);
begin
E (I) := E (J);
E (J) := EI;
E.EA (I) := E.EA (J);
E.EA (J) := EI;
end;
I := I + 1;
@ -1958,7 +1962,7 @@ package body Ada.Containers.Vectors is
end if;
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);
end if;
end loop;
@ -1985,7 +1989,7 @@ package body Ada.Containers.Vectors is
end if;
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (Indx) = Item then
if Container.Elements.EA (Indx) = Item then
return Indx;
end if;
end loop;
@ -2071,8 +2075,8 @@ package body Ada.Containers.Vectors is
end if;
declare
EI : Element_Type renames Container.Elements (I);
EJ : Element_Type renames Container.Elements (J);
EI : Element_Type renames Container.Elements.EA (I);
EJ : Element_Type renames Container.Elements.EA (J);
EI_Copy : constant Element_Type := EI;
@ -2158,7 +2162,7 @@ package body Ada.Containers.Vectors is
end if;
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);
end;
@ -2185,7 +2189,7 @@ package body Ada.Containers.Vectors is
end if;
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);
end;
@ -2212,7 +2216,7 @@ package body Ada.Containers.Vectors is
L := L + 1;
begin
Process (Container.Elements (Index));
Process (Container.Elements.EA (Index));
exception
when others =>
L := L - 1;
@ -2253,7 +2257,7 @@ package body Ada.Containers.Vectors is
Count_Type'Base'Write (Stream, Length (Container));
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 Write;

19
gcc/ada/a-convec.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -32,8 +32,9 @@
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Finalization;
with Ada.Streams;
private with Ada.Finalization;
private with Ada.Streams;
generic
type Index_Type is range <>;
@ -43,6 +44,7 @@ generic
package Ada.Containers.Vectors is
pragma Preelaborate;
pragma Remote_Types;
subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 ..
@ -311,10 +313,15 @@ private
pragma Inline (Update_Element);
pragma Inline (Replace_Element);
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;
@ -327,8 +334,10 @@ private
Lock : Natural := 0;
end record;
overriding
procedure Adjust (Container : in out Vector);
overriding
procedure Finalize (Container : in out Vector);
use Ada.Streams;

6
gcc/ada/a-coorma.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -46,6 +46,7 @@ generic
package Ada.Containers.Ordered_Maps is
pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
@ -181,6 +182,9 @@ package Ada.Containers.Ordered_Maps is
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;

6
gcc/ada/a-coormu.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -45,6 +45,7 @@ generic
package Ada.Containers.Ordered_Multisets is
pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
@ -245,6 +246,9 @@ package Ada.Containers.Ordered_Multisets is
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;

6
gcc/ada/a-coorse.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -45,6 +45,7 @@ generic
package Ada.Containers.Ordered_Sets is
pragma Preelaborate;
pragma Remote_Types;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
@ -233,6 +234,9 @@ package Ada.Containers.Ordered_Sets is
private
pragma Inline (Next);
pragma Inline (Previous);
type Node_Type;
type Node_Access is access Node_Type;