diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/a-cdlili.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/a-chtgop.adb | 65 | ||||
| -rw-r--r-- | gcc/ada/a-chtgop.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/a-cidlli.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/a-cihama.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/a-cihase.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/a-cihase.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-ciorma.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-ciormu.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-ciorse.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-cohama.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/a-cohase.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/a-cohase.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-cohata.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/a-coinve.adb | 408 | ||||
| -rw-r--r-- | gcc/ada/a-coinve.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/a-convec.adb | 348 | ||||
| -rw-r--r-- | gcc/ada/a-convec.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/a-coorma.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-coormu.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-coorse.ads | 6 |
21 files changed, 561 insertions, 407 deletions
diff --git a/gcc/ada/a-cdlili.ads b/gcc/ada/a-cdlili.ads index 06603cb0541..e8a0488b2b4 100644 --- a/gcc/ada/a-cdlili.ads +++ b/gcc/ada/a-cdlili.ads @@ -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; diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb index 93f45fa2315..94a646e3250 100644 --- a/gcc/ada/a-chtgop.adb +++ b/gcc/ada/a-chtgop.adb @@ -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; diff --git a/gcc/ada/a-chtgop.ads b/gcc/ada/a-chtgop.ads index 03154219be6..9e0581093ed 100644 --- a/gcc/ada/a-chtgop.ads +++ b/gcc/ada/a-chtgop.ads @@ -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; diff --git a/gcc/ada/a-cidlli.ads b/gcc/ada/a-cidlli.ads index 178709e2931..4cde43dd860 100644 --- a/gcc/ada/a-cidlli.ads +++ b/gcc/ada/a-cidlli.ads @@ -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; diff --git a/gcc/ada/a-cihama.ads b/gcc/ada/a-cihama.ads index 6d0e883fd1d..45d307b3e56 100644 --- a/gcc/ada/a-cihama.ads +++ b/gcc/ada/a-cihama.ads @@ -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; diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb index 12acb459eb5..8de25a84efc 100644 --- a/gcc/ada/a-cihase.adb +++ b/gcc/ada/a-cihase.adb @@ -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 diff --git a/gcc/ada/a-cihase.ads b/gcc/ada/a-cihase.ads index 6dab3bfdcdb..52d0441ec2a 100644 --- a/gcc/ada/a-cihase.ads +++ b/gcc/ada/a-cihase.ads @@ -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; diff --git a/gcc/ada/a-ciorma.ads b/gcc/ada/a-ciorma.ads index 0d733a17566..25033a9356d 100644 --- a/gcc/ada/a-ciorma.ads +++ b/gcc/ada/a-ciorma.ads @@ -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; diff --git a/gcc/ada/a-ciormu.ads b/gcc/ada/a-ciormu.ads index 518ab351072..fec119b2850 100644 --- a/gcc/ada/a-ciormu.ads +++ b/gcc/ada/a-ciormu.ads @@ -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; diff --git a/gcc/ada/a-ciorse.ads b/gcc/ada/a-ciorse.ads index 895a31796cf..67e383fb9d2 100644 --- a/gcc/ada/a-ciorse.ads +++ b/gcc/ada/a-ciorse.ads @@ -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; diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads index d03d741a74b..487944c2799 100644 --- a/gcc/ada/a-cohama.ads +++ b/gcc/ada/a-cohama.ads @@ -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; diff --git a/gcc/ada/a-cohase.adb b/gcc/ada/a-cohase.adb index 2328e3f3365..e0db89d5b0c 100644 --- a/gcc/ada/a-cohase.adb +++ b/gcc/ada/a-cohase.adb @@ -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 diff --git a/gcc/ada/a-cohase.ads b/gcc/ada/a-cohase.ads index 5c32f51b53e..20e29183aa7 100644 --- a/gcc/ada/a-cohase.ads +++ b/gcc/ada/a-cohase.ads @@ -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; diff --git a/gcc/ada/a-cohata.ads b/gcc/ada/a-cohata.ads index eac81e096e7..983e8c39c26 100644 --- a/gcc/ada/a-cohata.ads +++ b/gcc/ada/a-cohata.ads @@ -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; diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index bccd95145f8..8233a4e9b90 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -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 diff --git a/gcc/ada/a-coinve.ads b/gcc/ada/a-coinve.ads index 0bfbd42dc39..0026272d105 100644 --- a/gcc/ada/a-coinve.ads +++ b/gcc/ada/a-coinve.ads @@ -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; diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index f08b70416a7..64c2a16aa6e 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -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); - - subtype ET is Elements_Type (Index_Type'First .. Last); + LE : Elements_Array renames + Left.Elements.EA (Index_Type'First .. Left.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))); - - if I < Index_Type'First then - Target.Elements (Index_Type'First .. J) := - Source.Elements (Index_Type'First .. Source.Last); + declare + TA : Elements_Array renames Target.Elements.EA; + SA : Elements_Array renames Source.Elements.EA; - Source.Last := No_Index; - return; - end if; + 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))); + + 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 - or else not (Target.Elements (I) < - Target.Elements (I - 1))); + pragma Assert (I <= Index_Type'First + or else not (TA (I) < TA (I - 1))); - if Source.Elements (Source.Last) < Target.Elements (I) then - Target.Elements (J) := Target.Elements (I); - I := I - 1; + if SA (Source.Last) < TA (I) then + TA (J) := TA (I); + I := I - 1; - else - Target.Elements (J) := Source.Elements (Source.Last); - Source.Last := Source.Last - 1; - end if; + else + TA (J) := SA (Source.Last); + Source.Last := Source.Last - 1; + end if; - J := J - 1; - end loop; + 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; + + Src : Elements_Array renames + Container.Elements.EA (Index_Subtype); - Tgt : Elements_Type renames - E (Index_Type'First .. Container.Last); + 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; diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads index dbb3cc4fac1..9dc5c547162 100644 --- a/gcc/ada/a-convec.ads +++ b/gcc/ada/a-convec.ads @@ -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; diff --git a/gcc/ada/a-coorma.ads b/gcc/ada/a-coorma.ads index 18de34dddc3..917c1c7b1e0 100644 --- a/gcc/ada/a-coorma.ads +++ b/gcc/ada/a-coorma.ads @@ -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; diff --git a/gcc/ada/a-coormu.ads b/gcc/ada/a-coormu.ads index df300130e76..bdb2150e014 100644 --- a/gcc/ada/a-coormu.ads +++ b/gcc/ada/a-coormu.ads @@ -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; diff --git a/gcc/ada/a-coorse.ads b/gcc/ada/a-coorse.ads index 47208653ef4..2df6353fa3b 100644 --- a/gcc/ada/a-coorse.ads +++ b/gcc/ada/a-coorse.ads @@ -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; |