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

[multiple changes]

Browse Source 
2012-01-10  Pascal Obry  <obry@adacore.com>

	* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
	directories for aggregate libraries.

2012-01-10  Matthew Heaney  <heaney@adacore.com>

	* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
	a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
	a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
	a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
	a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
	a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
	a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
	a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
	a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
	container parameter as aliased in/in out.
	Code clean ups.

2012-01-10  Bob Duff  <duff@adacore.com>

	* s-os_lib.ads: Improve comment.

2012-01-10  Geert Bosch  <bosch@adacore.com>

	* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
	for complex Scalar.

From-SVN: r183060
This commit is contained in:
Arnaud Charlet 2012-01-10 12:06:44 +01:00
parent 72348e26a5
commit c9423ca3fa
46 changed files with 2256 additions and 1035 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes):
Kill check for object/source directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
2012-01-10 Bob Duff <duff@adacore.com>
* sem_intr.adb (Check_Shift): Use RM_Size instead of Esize, when

60
gcc/ada/a-cbdlli.adb
View File

@ -296,6 +296,33 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Free (Container, X);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased List;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1537,34 +1564,27 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- Reference --
---------------
function Constant_Reference
(Container : List;
Position : Cursor) return Constant_Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element =>
Position.Container.Nodes (Position.Node).Element'Unrestricted_Access);
end Constant_Reference;
function Reference
(Container : List;
(Container : aliased in out List;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element =>
Position.Container.Nodes (Position.Node).Element'Unrestricted_Access);
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position), "bad cursor in function Reference");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Reference;
---------------------

86
gcc/ada/a-cbdlli.ads
View File

@ -88,6 +88,48 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type
(Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased List;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out List;
Position : Cursor) return Reference_Type;
procedure Assign (Target : in out List; Source : List);
function Copy (Source : List; Capacity : Count_Type := 0) return List;
@ -223,48 +265,6 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
end Generic_Sorting;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : List; -- SHOULD BE ALIASED ???
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : List; -- SHOULD BE ALIASED ???
Position : Cursor) return Reference_Type;
private
pragma Inline (Next);
@ -273,7 +273,7 @@ private
type Node_Type is record
Prev : Count_Type'Base;
Next : Count_Type;
Element : Element_Type;
Element : aliased Element_Type;
end record;
type Node_Array is array (Count_Type range <>) of Node_Type;

92
gcc/ada/a-cbhama.adb
View File

@ -190,6 +190,53 @@ package body Ada.Containers.Bounded_Hashed_Maps is
HT_Ops.Clear (Container);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert (Vet (Position),
"Position cursor in Constant_Reference is bad");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
if Node = 0 then
raise Constraint_Error with "key not in map";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -916,16 +963,47 @@ package body Ada.Containers.Bounded_Hashed_Maps is
-- Reference --
---------------
function Constant_Reference (Container : Map; Key : Key_Type)
return Constant_Reference_Type is
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert (Vet (Position),
"Position cursor in function Reference is bad");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Reference;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
function Reference (Container : Map; Key : Key_Type)
return Reference_Type is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
if Node = 0 then
raise Constraint_Error with "key not in map";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Reference;
-------------

93
gcc/ada/a-cbhama.ads
View File

@ -134,6 +134,56 @@ package Ada.Containers.Bounded_Hashed_Maps is
-- Calls Process with the key (with only a constant view) and element (with
-- a variable view) of the node designed by the cursor.
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type;
procedure Assign (Target : in out Map; Source : Map);
-- If Target denotes the same object as Source, then the operation has no
-- effect. If the Target capacity is less then the Source length, then
@ -286,47 +336,6 @@ package Ada.Containers.Bounded_Hashed_Maps is
function Iterate (Container : Map)
return Map_Iterator_Interfaces.Forward_Iterator'class;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : Map;
Key : Key_Type) -- SHOULD BE ALIASED???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type) return Reference_Type;
private
pragma Inline (Length);
pragma Inline (Is_Empty);
@ -342,7 +351,7 @@ private
type Node_Type is record
Key : Key_Type;
Element : Element_Type;
Element : aliased Element_Type;
Next : Count_Type;
end record;

154
gcc/ada/a-cbhase.adb
View File

@ -210,6 +210,33 @@ package body Ada.Containers.Bounded_Hashed_Sets is
HT_Ops.Clear (Container);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1145,21 +1172,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
raise Program_Error with "attempt to stream reference";
end Read;
---------------
-- Reference --
---------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
pragma Unreferenced (Container);
S : Set renames Position.Container.all;
N : Node_Type renames S.Nodes (Position.Node);
begin
return (Element => N.Element'Unrestricted_Access);
end Constant_Reference;
-------------
-- Replace --
-------------
@ -1581,6 +1593,28 @@ package body Ada.Containers.Bounded_Hashed_Sets is
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
begin
if Node = 0 then
raise Constraint_Error with "key not in set";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1686,6 +1720,69 @@ package body Ada.Containers.Bounded_Hashed_Sets is
return Key (Position.Container.Nodes (Position.Node).Element);
end Key;
----------
-- Read --
----------
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
------------------------------
-- Reference_Preserving_Key --
------------------------------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert
(Vet (Position),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
begin
if Node = 0 then
raise Constraint_Error with "key not in set";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Reference_Preserving_Key;
-------------
-- Replace --
-------------
@ -1806,28 +1903,17 @@ package body Ada.Containers.Bounded_Hashed_Sets is
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
------------------------------
-- Reference_Preserving_Key --
------------------------------
-----------
-- Write --
-----------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type)
is
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Unrestricted_Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Unrestricted_Access);
end Reference_Preserving_Key;
raise Program_Error with "attempt to stream reference";
end Write;
end Generic_Keys;

20
gcc/ada/a-cbhase.ads
View File

@ -433,6 +433,10 @@ package Ada.Containers.Bounded_Hashed_Sets is
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type;
@ -441,13 +445,27 @@ package Ada.Containers.Bounded_Hashed_Sets is
type Reference_Type (Element : not null access Element_Type)
is null record;
use Ada.Streams;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
end Generic_Keys;
private
pragma Inline (Next);
type Node_Type is record
Element : Element_Type;
Element : aliased Element_Type;
Next : Count_Type;
end record;

66
gcc/ada/a-cbmutr.adb
View File

@ -588,6 +588,36 @@ package body Ada.Containers.Bounded_Multiway_Trees is
pragma Assert (Count = Container_Count);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node = Root_Node (Container) then
raise Program_Error with "Position cursor designates root";
end if;
-- Implement Vet for multiway tree???
-- pragma Assert (Vet (Position),
-- "Position cursor in Constant_Reference is bad");
return (Element => Container.Elements (Position.Node)'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -2464,26 +2494,30 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-- Reference --
---------------
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
return
(Element =>
Position.Container.Elements (Position.Node)'Unchecked_Access);
end Constant_Reference;
function Reference
(Container : aliased Tree;
(Container : aliased in out Tree;
Position : Cursor) return Reference_Type
is
pragma Unreferenced (Container);
begin
return
(Element =>
Position.Container.Elements (Position.Node)'Unchecked_Access);
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node = Root_Node (Container) then
raise Program_Error with "Position cursor designates root";
end if;
-- Implement Vet for multiway tree???
-- pragma Assert (Vet (Position),
-- "Position cursor in Constant_Reference is bad");
return (Element => Container.Elements (Position.Node)'Access);
end Reference;
--------------------

17
gcc/ada/a-cbmutr.ads
View File

@ -107,6 +107,14 @@ package Ada.Containers.Bounded_Multiway_Trees is
(Element : not null access Element_Type) is private
with Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Tree;
Position : Cursor) return Reference_Type;
procedure Assign (Target : in out Tree; Source : Tree);
function Copy (Source : Tree; Capacity : Count_Type := 0) return Tree;
@ -375,6 +383,7 @@ private
type Reference_Type
(Element : not null access Element_Type) is null record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
@ -385,14 +394,6 @@ private
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased Tree;
Position : Cursor) return Reference_Type;
Empty_Tree : constant Tree := (Capacity => 0, others => <>);
No_Element : constant Cursor := Cursor'(others => <>);

88
gcc/ada/a-cborma.adb
View File

@ -402,6 +402,53 @@ package body Ada.Containers.Bounded_Ordered_Maps is
return Node.Color;
end Color;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert (Vet (Container, Position.Node),
"Position cursor in Constant_Reference is bad");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
if Node = 0 then
raise Constraint_Error with "key not in map";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1318,20 +1365,47 @@ package body Ada.Containers.Bounded_Ordered_Maps is
-- Reference --
---------------
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert (Vet (Container, Position.Node),
"Position cursor in function Reference is bad");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Reference;
function Reference
(Container : Map;
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
if Node = 0 then
raise Constraint_Error with "key not in map";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Reference;
-------------

93
gcc/ada/a-cborma.ads
View File

@ -50,7 +50,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map (Capacity : Count_Type) is tagged private with
constant_Indexing => Constant_Reference,
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@ -97,6 +97,55 @@ package Ada.Containers.Bounded_Ordered_Maps is
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type;
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
@ -183,46 +232,6 @@ package Ada.Containers.Bounded_Ordered_Maps is
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
function Constant_Reference
(Container : Map;
Key : Key_Type) -- SHOULD BE ALIASED ???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type) return Reference_Type;
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
@ -251,7 +260,7 @@ private
Right : Count_Type;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Key : Key_Type;
Element : Element_Type;
Element : aliased Element_Type;
end record;
package Tree_Types is

172
gcc/ada/a-cborse.adb
View File

@ -402,6 +402,35 @@ package body Ada.Containers.Bounded_Ordered_Sets is
return Node.Color;
end Color;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert
(Vet (Container, Position.Node),
"bad cursor in Constant_Reference");
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -697,6 +726,28 @@ package body Ada.Containers.Bounded_Ordered_Sets is
else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
begin
if Node = 0 then
raise Constraint_Error with "key not in set";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -822,6 +873,69 @@ package body Ada.Containers.Bounded_Ordered_Sets is
return Key (Position.Container.Nodes (Position.Node).Element);
end Key;
----------
-- Read --
----------
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
------------------------------
-- Reference_Preserving_Key --
------------------------------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert
(Vet (Container, Position.Node),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Access);
end;
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
begin
if Node = 0 then
raise Constraint_Error with "key not in set";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return (Element => N.Element'Access);
end;
end Reference_Preserving_Key;
-------------
-- Replace --
-------------
@ -900,45 +1014,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Constant_Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
if Position.Node = 0 then
raise Constraint_Error with "Position cursor has no element";
end if;
return
(Element =>
Container.Nodes (Position.Node).Element'Unrestricted_Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
if Position.Node = 0 then
raise Constraint_Error with "Position cursor has no element";
end if;
return
(Element =>
Container.Nodes (Position.Node).Element'Unrestricted_Access);
end Reference_Preserving_Key;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
-----------
-- Write --
-----------
procedure Write
(Stream : not null access Root_Stream_Type'Class;
@ -1585,22 +1663,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
raise Program_Error with "attempt to stream reference";
end Read;
---------------
-- Reference --
---------------
function Constant_Reference (Container : Set; Position : Cursor)
return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element =>
Container.Nodes (Position.Node).Element'Unrestricted_Access);
end Constant_Reference;
-------------
-- Replace --
-------------

26
gcc/ada/a-cborse.ads
View File

@ -65,16 +65,6 @@ package Ada.Containers.Bounded_Ordered_Sets is
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : Set; Position : Cursor)
return Constant_Reference_Type;
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@ -98,6 +88,16 @@ package Ada.Containers.Bounded_Ordered_Sets is
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type;
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
@ -263,6 +263,10 @@ package Ada.Containers.Bounded_Ordered_Sets is
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key
@ -297,7 +301,7 @@ private
Left : Count_Type;
Right : Count_Type;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Element : Element_Type;
Element : aliased Element_Type;
end record;
package Tree_Types is

48
gcc/ada/a-cdlili.adb
View File

@ -219,6 +219,29 @@ package body Ada.Containers.Doubly_Linked_Lists is
pragma Warnings (On);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased List;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
return (Element => Position.Node.Element'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1277,31 +1300,22 @@ package body Ada.Containers.Doubly_Linked_Lists is
-- Reference --
---------------
function Constant_Reference
(Container : List;
Position : Cursor) return Constant_Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element'Access);
end Constant_Reference;
function Reference
(Container : List;
(Container : aliased in out List;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unchecked_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position), "bad cursor in function Reference");
return (Element => Position.Node.Element'Access);
end Reference;

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

@ -90,6 +90,48 @@ package Ada.Containers.Doubly_Linked_Lists is
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type
(Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased List;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out List;
Position : Cursor) return Reference_Type;
procedure Assign (Target : in out List; Source : List);
function Copy (Source : List) return List;
@ -222,48 +264,6 @@ package Ada.Containers.Doubly_Linked_Lists is
end Generic_Sorting;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : List; Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type;
function Reference
(Container : List; Position : Cursor) -- SHOULD BE ALIASED
return Reference_Type;
private
pragma Inline (Next);

54
gcc/ada/a-cidlli.adb
View File

@ -242,6 +242,33 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
Free (X);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased List;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1303,27 +1330,26 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
-- Reference --
---------------
function Constant_Reference (Container : List; Position : Cursor)
return Constant_Reference_Type is
function Reference
(Container : aliased in out List;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
function Reference (Container : List; Position : Cursor)
return Reference_Type is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert (Vet (Position), "bad cursor in function Reference");
return (Element => Position.Node.Element.all'Access);
end Reference;

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

@ -90,6 +90,48 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type
(Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased List;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out List;
Position : Cursor) return Reference_Type;
procedure Assign (Target : in out List; Source : List);
function Copy (Source : List) return List;
@ -203,50 +245,6 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Start : Cursor)
return List_Iterator_Interfaces.Reversible_Iterator'class;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : List;
Position : Cursor) -- SHOULD BE ALIASED ???
return Constant_Reference_Type;
function Reference
(Container : List;
Position : Cursor) -- SHOULD BE ALIASED ???
return Reference_Type;
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is

107
gcc/ada/a-cihama.adb
View File

@ -189,6 +189,55 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
HT_Ops.Clear (Container.HT);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
if Position.Node.Element = null then
raise Program_Error with
"Position cursor has no element";
end if;
pragma Assert
(Vet (Position),
"Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
begin
if Node = null then
raise Constraint_Error with "key not in map";
end if;
if Node.Element = null then
raise Program_Error with "key has no element";
end if;
return (Element => Node.Element.all'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -955,31 +1004,49 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
-- Reference --
---------------
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
begin
return (Element =>
Container.Find (Key).Node.Element.all'Unrestricted_Access);
end Constant_Reference;
function Reference
(Container : Map;
Key : Key_Type) return Reference_Type
is
begin
return (Element =>
Container.Find (Key).Node.Element.all'Unrestricted_Access);
end Reference;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Element (Position)'Unrestricted_Access);
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
if Position.Node.Element = null then
raise Program_Error with
"Position cursor has no element";
end if;
pragma Assert
(Vet (Position),
"Position cursor in function Reference is bad");
return (Element => Position.Node.Element.all'Access);
end Reference;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
begin
if Node = null then
raise Constraint_Error with "key not in map";
end if;
if Node.Element = null then
raise Program_Error with "key has no element";
end if;
return (Element => Node.Element.all'Access);
end Reference;
-------------

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

@ -134,6 +134,55 @@ package Ada.Containers.Indefinite_Hashed_Maps is
-- Calls Process with the key (with only a constant view) and element (with
-- a variable view) of the node designed by the cursor.
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type;
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
@ -255,52 +304,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is
-- Returns the result of calling Equivalent_Keys with key Left and the node
-- designated by Right.
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : Map;
Key : Key_Type) -- SHOULD BE ALIASED ???
return Constant_Reference_Type;
function Reference
(Container : Map;
Key : Key_Type) return Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));

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

@ -204,6 +204,33 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
HT_Ops.Clear (Container.HT);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1220,19 +1247,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
raise;
end Read_Node;
---------------
-- Reference --
---------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
-------------
-- Replace --
-------------
@ -1892,6 +1906,29 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
raise Constraint_Error with "Key not in set";
end if;
if Node.Element = null then
raise Program_Error with "Node has no element";
end if;
return (Element => Node.Element.all'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -2001,6 +2038,74 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
return Key (Position.Node.Element.all);
end Key;
----------
-- Read --
----------
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
------------------------------
-- Reference_Preserving_Key --
------------------------------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert
(Vet (Position),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
return (Element => Position.Node.Element.all'Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
raise Constraint_Error with "Key not in set";
end if;
if Node.Element = null then
raise Program_Error with "Node has no element";
end if;
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Key has not
-- changed. ???
return (Element => Node.Element.all'Access);
end Reference_Preserving_Key;
-------------
-- Replace --
-------------
@ -2022,6 +2127,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Replace_Element (Container.HT, Node, New_Item);
end Replace;
-----------------------------------
-- Update_Element_Preserving_Key --
-----------------------------------
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
@ -2123,27 +2232,17 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
------------------------------
-- Reference_Preserving_Key --
------------------------------
-----------
-- Write --
-----------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type)
is
pragma Unreferenced (Container);
begin
return (Element => Position.Node.Element.all'Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
return (Element => Position.Node.Element.all'Access);
end Reference_Preserving_Key;
raise Program_Error with "attempt to stream reference";
end Write;
end Generic_Keys;

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

@ -150,8 +150,7 @@ package Ada.Containers.Indefinite_Hashed_Sets is
function Constant_Reference
(Container : aliased Set;
Position : Cursor)
return Constant_Reference_Type;
Position : Cursor) return Constant_Reference_Type;
procedure Assign (Target : in out Set; Source : Set);
@ -420,6 +419,10 @@ package Ada.Containers.Indefinite_Hashed_Sets is
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type;
@ -427,6 +430,20 @@ package Ada.Containers.Indefinite_Hashed_Sets is
private
type Reference_Type (Element : not null access Element_Type)
is null record;
use Ada.Streams;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
end Generic_Keys;
private

70
gcc/ada/a-cimutr.adb
View File

@ -441,6 +441,40 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
pragma Assert (Children_Count = Container_Count);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node = Root_Node (Container) then
raise Program_Error with "Position cursor designates root";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
-- Implement Vet for multiway tree???
-- pragma Assert (Vet (Position),
-- "Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1980,24 +2014,34 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
-- Reference --
---------------
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type
is
begin
pragma Unreferenced (Container);
return (Element => Position.Node.Element.all'Unchecked_Access);
end Constant_Reference;
function Reference
(Container : aliased Tree;
(Container : aliased in out Tree;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
return (Element => Position.Node.Element.all'Unchecked_Access);
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node = Root_Node (Container) then
raise Program_Error with "Position cursor designates root";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
-- Implement Vet for multiway tree???
-- pragma Assert (Vet (Position),
-- "Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element.all'Access);
end Reference;
--------------------

16
gcc/ada/a-cimutr.ads
View File

@ -109,6 +109,14 @@ package Ada.Containers.Indefinite_Multiway_Trees is
(Element : not null access Element_Type) is private
with Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Tree;
Position : Cursor) return Reference_Type;
procedure Assign (Target : in out Tree; Source : Tree);
function Copy (Source : Tree) return Tree;
@ -400,14 +408,6 @@ private
for Reference_Type'Write use Write;
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased Tree;
Position : Cursor) return Reference_Type;
Empty_Tree : constant Tree := (Controlled with others => <>);
No_Element : constant Cursor := (others => <>);

81
gcc/ada/a-ciorma.adb
View File

@ -357,13 +357,47 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
Node : aliased Element_Type := Element (Container, Key);
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
return (Element => Node'Access);
if Node = null then
raise Constraint_Error with "key not in map";
end if;
if Node.Element = null then
raise Program_Error with "Node has no element";
end if;
return (Element => Node.Element.all'Access);
end Constant_Reference;
--------------
@ -1305,13 +1339,46 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
---------------
function Reference
(Container : Map;
Key : Key_Type)
return Reference_Type
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
Node : aliased Element_Type := Element (Container, Key);
begin
return (Element => Node'Access);
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"Position cursor in function Reference is bad");
return (Element => Position.Node.Element.all'Access);
end Reference;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "key not in map";
end if;
if Node.Element = null then
raise Program_Error with "Node has no element";
end if;
return (Element => Node.Element.all'Access);
end Reference;
-------------

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

@ -50,7 +50,7 @@ package Ada.Containers.Indefinite_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private
with constant_Indexing => Constant_Reference,
with Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@ -96,6 +96,31 @@ package Ada.Containers.Indefinite_Ordered_Maps is
Process : not null access procedure (Key : Key_Type;
Element : in out Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type;
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map) return Map;
@ -176,23 +201,6 @@ package Ada.Containers.Indefinite_Ordered_Maps is
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : Map;
Key : Key_Type) return Reference_Type;
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));

174
gcc/ada/a-ciorse.adb
View File

@ -372,6 +372,35 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
return Node.Color;
end Color;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert
(Vet (Container.Tree, Position.Node),
"bad cursor in Constant_Reference");
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -733,6 +762,29 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "Key not in set";
end if;
if Node.Element = null then
raise Program_Error with "Node has no element";
end if;
return (Element => Node.Element.all'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -889,6 +941,74 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
Replace_Element (Container.Tree, Node, New_Item);
end Replace;
----------
-- Read --
----------
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
------------------------------
-- Reference_Preserving_Key --
------------------------------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node.Element = null then
raise Program_Error with "Node has no element";
end if;
pragma Assert
(Vet (Container.Tree, Position.Node),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
return (Element => Position.Node.Element.all'Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "Key not in set";
end if;
if Node.Element = null then
raise Program_Error with "Node has no element";
end if;
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Key has not
-- changed. ???
return (Element => Node.Element.all'Access);
end Reference_Preserving_Key;
-----------------------------------
-- Update_Element_Preserving_Key --
-----------------------------------
@ -955,41 +1075,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Constant_Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element);
end Reference_Preserving_Key;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
-----------
-- Write --
-----------
procedure Write
(Stream : not null access Root_Stream_Type'Class;
@ -1653,22 +1741,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
raise Program_Error with "attempt to stream reference";
end Read;
---------------
-- Reference --
---------------
function Constant_Reference (Container : Set; Position : Cursor)
return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
-------------
-- Replace --
-------------

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

@ -67,27 +67,6 @@ package Ada.Containers.Indefinite_Ordered_Sets is
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private with
Implicit_Dereference => Element;
function Constant_Reference
(Container : Set;
Position : Cursor) return Constant_Reference_Type;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@ -111,6 +90,27 @@ package Ada.Containers.Indefinite_Ordered_Sets is
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private with
Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set) return Set;
@ -292,6 +292,10 @@ package Ada.Containers.Indefinite_Ordered_Sets is
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key

120
gcc/ada/a-cobove.adb
View File

@ -378,6 +378,52 @@ package body Ada.Containers.Bounded_Vectors is
Container.Last := No_Index;
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Vector;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
declare
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Position.Index);
begin
return (Element => A (I)'Access);
end;
end Constant_Reference;
function Constant_Reference
(Container : aliased Vector;
Index : Index_Type) return Constant_Reference_Type
is
begin
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
declare
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Index);
begin
return (Element => A (I)'Access);
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -2071,76 +2117,46 @@ package body Ada.Containers.Bounded_Vectors is
-- Reference --
---------------
function Constant_Reference
(Container : Vector;
Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element =>
Position.Container.Elements
(To_Array_Index (Position.Index))'Access);
end Constant_Reference;
function Constant_Reference
(Container : Vector;
Position : Index_Type)
return Constant_Reference_Type
is
begin
if (Position) > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
return (Element =>
Container.Elements (To_Array_Index (Position))'Access);
end Constant_Reference;
function Reference
(Container : Vector;
Position : Cursor)
return Reference_Type
(Container : aliased in out Vector;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element =>
Position.Container.Elements
(To_Array_Index (Position.Index))'Access);
declare
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Position.Index);
begin
return (Element => A (I)'Access);
end;
end Reference;
function Reference
(Container : Vector;
Position : Index_Type)
return Reference_Type
(Container : aliased in out Vector;
Index : Index_Type) return Reference_Type
is
begin
if Position > Container.Last then
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return (Element =>
Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
end if;
declare
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Index);
begin
return (Element => A (I)'Access);
end;
end Reference;
---------------------

98
gcc/ada/a-cobove.ads
View File

@ -142,6 +142,56 @@ package Ada.Containers.Bounded_Vectors is
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
function Constant_Reference
(Container : aliased Vector;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Vector;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Vector;
Index : Index_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Vector;
Index : Index_Type) return Reference_Type;
procedure Assign (Target : in out Vector; Source : Vector);
function Copy (Source : Vector; Capacity : Count_Type := 0) return Vector;
@ -308,54 +358,6 @@ package Ada.Containers.Bounded_Vectors is
Start : Cursor)
return Vector_Iterator_Interfaces.Reversible_Iterator'class;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
function Constant_Reference
(Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type;
function Constant_Reference
(Container : Vector; Position : Index_Type)
return Constant_Reference_Type;
function Reference (Container : Vector; Position : Cursor)
return Reference_Type;
function Reference (Container : Vector; Position : Index_Type)
return Reference_Type;
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is

82
gcc/ada/a-cohama.adb
View File

@ -188,6 +188,46 @@ package body Ada.Containers.Hashed_Maps is
HT_Ops.Clear (Container.HT);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert
(Vet (Position),
"Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element'Access);
end Constant_Reference;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
begin
if Node = null then
raise Constraint_Error with "key not in map";
end if;
return (Element => Node.Element'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -861,38 +901,40 @@ package body Ada.Containers.Hashed_Maps is
-- Reference --
---------------
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Element (Position)'Unrestricted_Access);
end Constant_Reference;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Element (Position)'Unrestricted_Access);
end Reference;
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert
(Vet (Position),
"Position cursor in function Reference is bad");
return (Element => Position.Node.Element'Access);
end Reference;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
if Node = null then
raise Constraint_Error with "key not in map";
end if;
return (Element => Node.Element'Access);
end Reference;
---------------

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

@ -148,6 +148,55 @@ package Ada.Containers.Hashed_Maps is
-- Calls Process with the key (with only a constant view) and element (with
-- a variable view) of the node designed by the cursor.
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type;
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
@ -277,55 +326,6 @@ package Ada.Containers.Hashed_Maps is
-- Returns the result of calling Equivalent_Keys with key Left and the node
-- designated by Right.
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type;
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
@ -354,7 +354,7 @@ private
type Node_Type is limited record
Key : Key_Type;
Element : Element_Type;
Element : aliased Element_Type;
Next : Node_Access;
end record;

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

@ -198,6 +198,29 @@ package body Ada.Containers.Hashed_Sets is
HT_Ops.Clear (Container.HT);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
return (Element => Position.Node.Element'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1126,19 +1149,6 @@ package body Ada.Containers.Hashed_Sets is
raise;
end Read_Node;
---------------
-- Reference --
---------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Position.Node.Element'Unrestricted_Access);
end Constant_Reference;
-------------
-- Replace --
-------------
@ -1720,6 +1730,25 @@ package body Ada.Containers.Hashed_Sets is
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
raise Constraint_Error with "Key not in set";
end if;
return (Element => Node.Element'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1831,6 +1860,66 @@ package body Ada.Containers.Hashed_Sets is
return Key (Position.Node.Element);
end Key;
----------
-- Read --
----------
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
------------------------------
-- Reference_Preserving_Key --
------------------------------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert
(Vet (Position),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
return (Element => Position.Node.Element'Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
raise Constraint_Error with "Key not in set";
end if;
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Key has not
-- changed. ???
return (Element => Node.Element'Access);
end Reference_Preserving_Key;
-------------
-- Replace --
-------------
@ -1952,27 +2041,18 @@ package body Ada.Containers.Hashed_Sets is
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
------------------------------
-- Reference_Preserving_Key --
------------------------------
-----------
-- Write --
-----------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type)
is
pragma Unreferenced (Container);
begin
return (Element => Position.Node.Element'Unrestricted_Access);
end Reference_Preserving_Key;
raise Program_Error with "attempt to stream reference";
end Write;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
return (Element => Position.Node.Element'Unrestricted_Access);
end Reference_Preserving_Key;
end Generic_Keys;
end Ada.Containers.Hashed_Sets;

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

@ -52,7 +52,7 @@ package Ada.Containers.Hashed_Sets is
type Set is tagged private
with
constant_Indexing => Constant_Reference,
Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@ -145,10 +145,6 @@ package Ada.Containers.Hashed_Sets is
-- Calls Process with the element (having only a constant view) of the node
-- designed by the cursor.
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with Implicit_Dereference => Element;
@ -157,6 +153,10 @@ package Ada.Containers.Hashed_Sets is
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type;
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
procedure Move (Target : in out Set; Source : in out Set);
-- Clears Target (if it's not empty), and then moves (not copies) the
-- buckets array and nodes from Source to Target.
@ -422,14 +422,32 @@ package Ada.Containers.Hashed_Sets is
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type;
Key : Key_Type) return Reference_Type;
private
type Reference_Type (Element : not null access Element_Type)
is null record;
use Ada.Streams;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
end Generic_Keys;
private
@ -439,7 +457,7 @@ private
type Node_Access is access Node_Type;
type Node_Type is limited record
Element : Element_Type;
Element : aliased Element_Type;
Next : Node_Access;
end record;

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

@ -673,34 +673,51 @@ package body Ada.Containers.Indefinite_Vectors is
------------------------
function Constant_Reference
(Container : Vector;
(Container : aliased Vector;
Position : Cursor) return Constant_Reference_Type
is
begin
pragma Unreferenced (Container);
E : Element_Access;
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element => Position.Container.Elements.EA (Position.Index).all'Access);
E := Container.Elements.EA (Position.Index);
if E = null then
raise Constraint_Error with "element at Position is empty";
end if;
return (Element => E.all'Access);
end Constant_Reference;
function Constant_Reference
(Container : Vector;
Position : Index_Type) return Constant_Reference_Type
(Container : aliased Vector;
Index : Index_Type) return Constant_Reference_Type
is
E : Element_Access;
begin
if (Position) > Container.Last then
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
return (Element => Container.Elements.EA (Position).all'Access);
E := Container.Elements.EA (Index);
if E = null then
raise Constraint_Error with "element at Index is empty";
end if;
return (Element => E.all'Access);
end Constant_Reference;
--------------
@ -2998,35 +3015,51 @@ package body Ada.Containers.Indefinite_Vectors is
---------------
function Reference
(Container : Vector;
(Container : aliased in out Vector;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
E : Element_Access;
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element =>
Position.Container.Elements.EA (Position.Index).all'Access);
E := Container.Elements.EA (Position.Index);
if E = null then
raise Constraint_Error with "element at Position is empty";
end if;
return (Element => E.all'Access);
end Reference;
function Reference
(Container : Vector;
Position : Index_Type) return Reference_Type
(Container : aliased in out Vector;
Index : Index_Type) return Reference_Type
is
E : Element_Access;
begin
if Position > Container.Last then
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
return (Element => Container.Elements.EA (Position).all'Access);
E := Container.Elements.EA (Index);
if E = null then
raise Constraint_Error with "element at Index is empty";
end if;
return (Element => E.all'Access);
end Reference;
---------------------

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

@ -150,18 +150,20 @@ package Ada.Containers.Indefinite_Vectors is
for Reference_Type'Read use Read;
function Constant_Reference
(Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type;
(Container : aliased Vector;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Vector;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : Vector; Position : Index_Type)
return Constant_Reference_Type;
(Container : aliased Vector;
Index : Index_Type) return Constant_Reference_Type;
function Reference (Container : Vector; Position : Cursor)
return Reference_Type;
function Reference (Container : Vector; Position : Index_Type)
return Reference_Type;
function Reference
(Container : aliased in out Vector;
Index : Index_Type) return Reference_Type;
function To_Cursor
(Container : Vector;

62
gcc/ada/a-comutr.adb
View File

@ -437,6 +437,36 @@ package body Ada.Containers.Multiway_Trees is
pragma Assert (Children_Count = Container_Count);
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node = Root_Node (Container) then
raise Program_Error with "Position cursor designates root";
end if;
-- Implement Vet for multiway tree???
-- pragma Assert (Vet (Position),
-- "Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -2000,24 +2030,30 @@ package body Ada.Containers.Multiway_Trees is
-- Reference --
---------------
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type
is
begin
pragma Unreferenced (Container);
return (Element => Position.Node.Element'Unrestricted_Access);
end Constant_Reference;
function Reference
(Container : aliased Tree;
(Container : aliased in out Tree;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
return (Element => Position.Node.Element'Unrestricted_Access);
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
if Position.Node = Root_Node (Container) then
raise Program_Error with "Position cursor designates root";
end if;
-- Implement Vet for multiway tree???
-- pragma Assert (Vet (Position),
-- "Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element'Access);
end Reference;
--------------------

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

@ -108,6 +108,14 @@ package Ada.Containers.Multiway_Trees is
(Element : not null access Element_Type) is private
with Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Tree;
Position : Cursor) return Reference_Type;
procedure Assign (Target : in out Tree; Source : Tree);
function Copy (Source : Tree) return Tree;
@ -341,7 +349,7 @@ private
Prev : Tree_Node_Access;
Next : Tree_Node_Access;
Children : Children_Type;
Element : Element_Type;
Element : aliased Element_Type;
end record;
pragma Convention (C, Tree_Node_Type);
@ -445,14 +453,6 @@ private
for Reference_Type'Write use Write;
function Constant_Reference
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased Tree;
Position : Cursor) return Reference_Type;
Empty_Tree : constant Tree := (Controlled with others => <>);
No_Element : constant Cursor := (others => <>);

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

@ -478,6 +478,42 @@ package body Ada.Containers.Vectors is
end if;
end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Vector;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return (Element => Container.Elements.EA (Position.Index)'Access);
end Constant_Reference;
function Constant_Reference
(Container : aliased Vector;
Index : Index_Type) return Constant_Reference_Type
is
begin
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return (Element => Container.Elements.EA (Index)'Access);
end if;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -2538,64 +2574,35 @@ package body Ada.Containers.Vectors is
-- Reference --
---------------
function Constant_Reference
(Container : Vector;
Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type
function Reference
(Container : aliased in out Vector;
Position : Cursor) return Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element =>
Position.Container.Elements.EA (Position.Index)'Access);
end Constant_Reference;
function Constant_Reference
(Container : Vector;
Position : Index_Type)
return Constant_Reference_Type
is
begin
if Position > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return (Element => Container.Elements.EA (Position)'Access);
end if;
end Constant_Reference;
function Reference (Container : Vector; Position : Cursor)
return Reference_Type is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element => Position.Container.Elements.EA (Position.Index)'Access);
return (Element => Container.Elements.EA (Position.Index)'Access);
end Reference;
function Reference (Container : Vector; Position : Index_Type)
return Reference_Type is
function Reference
(Container : aliased in out Vector;
Index : Index_Type) return Reference_Type
is
begin
if Position > Container.Last then
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return (Element => Container.Elements.EA (Position)'Access);
return (Element => Container.Elements.EA (Index)'Access);
end if;
end Reference;

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

@ -189,18 +189,20 @@ package Ada.Containers.Vectors is
for Reference_Type'Read use Read;
function Constant_Reference
(Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type;
(Container : aliased Vector;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Vector;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : Vector; Position : Index_Type)
return Constant_Reference_Type;
(Container : aliased Vector;
Index : Index_Type) return Constant_Reference_Type;
function Reference (Container : Vector; Position : Cursor)
return Reference_Type;
function Reference (Container : Vector; Position : Index_Type)
return Reference_Type;
function Reference
(Container : aliased in out Vector;
Index : Index_Type) return Reference_Type;
procedure Assign (Target : in out Vector; Source : Vector);

63
gcc/ada/a-coorma.adb
View File

@ -322,12 +322,39 @@ package body Ada.Containers.Ordered_Maps is
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"Position cursor in Constant_Reference is bad");
return (Element => Position.Node.Element'Access);
end Constant_Reference;
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
if Node = null then
raise Constraint_Error with "key not in map";
end if;
return (Element => Node.Element'Access);
end Constant_Reference;
--------------
@ -1250,12 +1277,38 @@ package body Ada.Containers.Ordered_Maps is
---------------
function Reference
(Container : Map;
Key : Key_Type)
return Reference_Type
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
if Position.Container = null then
raise Constraint_Error with
"Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong map";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"Position cursor in function Reference is bad");
return (Element => Position.Node.Element'Access);
end Reference;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "key not in map";
end if;
return (Element => Node.Element'Access);
end Reference;
-------------

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

@ -51,7 +51,7 @@ package Ada.Containers.Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private with
constant_Indexing => Constant_Reference,
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@ -96,6 +96,31 @@ package Ada.Containers.Ordered_Maps is
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Map;
Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Map;
Key : Key_Type) return Constant_Reference_Type;
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type;
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map) return Map;
@ -182,23 +207,6 @@ package Ada.Containers.Ordered_Maps is
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : Map;
Key : Key_Type) -- SHOULD BE ALIASED???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type)
return Reference_Type;
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
@ -234,7 +242,7 @@ private
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Key : Key_Type;
Element : Element_Type;
Element : aliased Element_Type;
end record;
package Tree_Types is

158
gcc/ada/a-coorse.adb
View File

@ -331,6 +331,31 @@ package body Ada.Containers.Ordered_Sets is
return Node.Color;
end Color;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert
(Vet (Container.Tree, Position.Node),
"bad cursor in Constant_Reference");
return (Element => Position.Node.Element'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -658,6 +683,25 @@ package body Ada.Containers.Ordered_Sets is
else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "key not in set";
end if;
return (Element => Node.Element'Access);
end Constant_Reference;
--------------
-- Contains --
--------------
@ -784,6 +828,66 @@ package body Ada.Containers.Ordered_Sets is
return Key (Position.Node.Element);
end Key;
----------
-- Read --
----------
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
------------------------------
-- Reference_Preserving_Key --
------------------------------
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert
(Vet (Container.Tree, Position.Node),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
return (Element => Position.Node.Element'Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access :=
Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "key not in set";
end if;
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
return (Element => Node.Element'Access);
end Reference_Preserving_Key;
-------------
-- Replace --
-------------
@ -867,41 +971,9 @@ package body Ada.Containers.Ordered_Sets is
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Constant_Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element'Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element'Access);
end Reference_Preserving_Key;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
-----------
-- Write --
-----------
procedure Write
(Stream : not null access Root_Stream_Type'Class;
@ -1536,22 +1608,6 @@ package body Ada.Containers.Ordered_Sets is
raise Program_Error with "attempt to stream reference";
end Read;
---------------
-- Reference --
---------------
function Constant_Reference (Container : Set; Position : Cursor)
return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Position.Node.Element'Access);
end Constant_Reference;
-------------
-- Replace --
-------------

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

@ -68,28 +68,6 @@ package Ada.Containers.Ordered_Sets is
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
function Constant_Reference
(Container : Set; Position : Cursor)
return Constant_Reference_Type;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@ -113,6 +91,28 @@ package Ada.Containers.Ordered_Sets is
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set) return Set;
@ -278,6 +278,10 @@ package Ada.Containers.Ordered_Sets is
function Reference_Preserving_Key
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
function Constant_Reference
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key

9
gcc/ada/prj-nmsc.adb
View File

@ -2977,8 +2977,15 @@ package body Prj.Nmsc is
"library directory { does not exist",
Lib_Dir.Location, Project);
elsif not Project.Externally_Built then
-- Checks for object/source directories
elsif not Project.Externally_Built
-- An aggregate library does not have sources or objects, so
-- these tests are not required in this case.
and then Project.Qualifier /= Aggregate_Library
then
-- Library directory cannot be the same as Object directory
if Project.Library_Dir.Name = Project.Object_Directory.Name then

20
gcc/ada/s-gearop.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2012, 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- --
@ -311,11 +311,23 @@ package body System.Generic_Array_Operations is
if Max_Abs > 0.0 then
Switch_Row (M, N, Row, Max_Row);
Divide_Row (M, N, Row, M (Row, J));
-- The temporaries below are necessary to force a copy of the
-- value and avoid improper aliasing.
declare
Scale : constant Scalar := M (Row, J);
begin
Divide_Row (M, N, Row, Scale);
end;
for U in Row + 1 .. M'Last (1) loop
Sub_Row (N, U, Row, M (U, J));
Sub_Row (M, U, Row, M (U, J));
declare
Factor : constant Scalar := M (U, J);
begin
Sub_Row (N, U, Row, Factor);
Sub_Row (M, U, Row, Factor);
end;
end loop;
exit when Row >= M'Last (1);

9
gcc/ada/s-os_lib.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2012, 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- --
@ -888,9 +888,10 @@ package System.OS_Lib is
-- If the parent is using tasking, and needs to spawn subprocesses at
-- arbitrary times, one technique is for the parent to spawn (very early)
-- a particular spawn-manager subprocess whose job is to spawn other
-- processes. The spawn-manager avoids tasking. The parent sends messages
-- to the spawn-manager requesting it to spawn processes, using whatever
-- inter-process communication mechanism you like, such as sockets.
-- processes. The spawn-manager must avoid tasking. The parent sends
-- messages to the spawn-manager requesting it to spawn processes, using
-- whatever inter-process communication mechanism you like, such as
-- sockets.
-- In short, mixing spawning of subprocesses with tasking is a tricky
-- business, and should be avoided if possible, but if it is necessary,