diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 89a8830b4a597404dfbdcb82ea511db07028813e..076707496904599b4216564acd25469621bed166 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb
index 25113d00c2881e05fdfd09be309ee883dce4ad6b..40f5d8f2ead26e098188dd9b67536fade4275e43 100644
--- a/gcc/ada/a-cbdlli.adb
+++ b/gcc/ada/a-cbdlli.adb
@@ -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;
---------------------
diff --git a/gcc/ada/a-cbdlli.ads b/gcc/ada/a-cbdlli.ads
index df0633f4c69beaecbe6054a063b627d44c24b57b..6612ea1e533727d30d81012665308fb82e57f65a 100644
--- a/gcc/ada/a-cbdlli.ads
+++ b/gcc/ada/a-cbdlli.ads
@@ -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;
diff --git a/gcc/ada/a-cbhama.adb b/gcc/ada/a-cbhama.adb
index d52aea053767321ca134c62c7bb5f00d3eeba042..b14383e321cacec0e5838cd276c04a93c9482eec 100644
--- a/gcc/ada/a-cbhama.adb
+++ b/gcc/ada/a-cbhama.adb
@@ -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;
-------------
diff --git a/gcc/ada/a-cbhama.ads b/gcc/ada/a-cbhama.ads
index 4d7cfa2225bff27eccbc9d200b04290e861c8c5b..78347c5473d5660fbc3139bb47fe1a47d776041a 100644
--- a/gcc/ada/a-cbhama.ads
+++ b/gcc/ada/a-cbhama.ads
@@ -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;
diff --git a/gcc/ada/a-cbhase.adb b/gcc/ada/a-cbhase.adb
index b52d7fffa7e394517a7f26b8733f67ce38fd14d0..7e294d3fb7573f1fc0e33d75c8426107aaee7c3e 100644
--- a/gcc/ada/a-cbhase.adb
+++ b/gcc/ada/a-cbhase.adb
@@ -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 --
- ------------------------------
-
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Position : Cursor) return Reference_Type
- is
- N : Node_Type renames Container.Nodes (Position.Node);
- begin
- return (Element => N.Element'Unrestricted_Access);
- end Reference_Preserving_Key;
+ -----------
+ -- Write --
+ -----------
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : 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;
diff --git a/gcc/ada/a-cbhase.ads b/gcc/ada/a-cbhase.ads
index 3f6b6696871cc5d2f5ea548bc80cc25da5993867..ceb358204bb27cdb6c0e57446056c97e5c21d65b 100644
--- a/gcc/ada/a-cbhase.ads
+++ b/gcc/ada/a-cbhase.ads
@@ -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;
diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb
index 0e05e8b5f74572616bf35c59e66f7cd1c8c634d0..e40c7bfc82d645174eaadc34ec0291240216368e 100644
--- a/gcc/ada/a-cbmutr.adb
+++ b/gcc/ada/a-cbmutr.adb
@@ -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;
--------------------
diff --git a/gcc/ada/a-cbmutr.ads b/gcc/ada/a-cbmutr.ads
index b114ffc3db8f24b9bc29bced6678e4001354c608..46263088cd376eaf9a028c4e9e46ccae2d485fba 100644
--- a/gcc/ada/a-cbmutr.ads
+++ b/gcc/ada/a-cbmutr.ads
@@ -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 => <>);
diff --git a/gcc/ada/a-cborma.adb b/gcc/ada/a-cborma.adb
index b39d9ae3a55ca76ddf2e6424a24b6a6e027ba1fb..9dec108219b00b3d2599e2907a93bd3b410acdd1 100644
--- a/gcc/ada/a-cborma.adb
+++ b/gcc/ada/a-cborma.adb
@@ -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;
-------------
diff --git a/gcc/ada/a-cborma.ads b/gcc/ada/a-cborma.ads
index 05c55730f101d5aefe83e60f1598c7616c6b95ec..bfb6f016028cafc66804b86ce65717b039e6f3ea 100644
--- a/gcc/ada/a-cborma.ads
+++ b/gcc/ada/a-cborma.ads
@@ -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
diff --git a/gcc/ada/a-cborse.adb b/gcc/ada/a-cborse.adb
index 557983d04c2d1d6f0b6ae98152c9e4cea3209e27..62417f36b1170bef54cf41bb5b34f987c4656594 100644
--- a/gcc/ada/a-cborse.adb
+++ b/gcc/ada/a-cborse.adb
@@ -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 --
-------------
diff --git a/gcc/ada/a-cborse.ads b/gcc/ada/a-cborse.ads
index 9c4fdb4f31df7834860cc18e6c5109417f44d68e..6a8bff96a0d33de6c22153f3c6c0445dcb784201 100644
--- a/gcc/ada/a-cborse.ads
+++ b/gcc/ada/a-cborse.ads
@@ -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
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb
index f56578c03649306613ed4c4f1740177b68785cd7..55defaec254c2ff7368f184bc8a76d165571b2a3 100644
--- a/gcc/ada/a-cdlili.adb
+++ b/gcc/ada/a-cdlili.adb
@@ -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;
diff --git a/gcc/ada/a-cdlili.ads b/gcc/ada/a-cdlili.ads
index 6662ff161e6b57165970741d15cbd23718445140..4799198a39a95e506b3b259fc4a35f824400212c 100644
--- a/gcc/ada/a-cdlili.ads
+++ b/gcc/ada/a-cdlili.ads
@@ -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);
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb
index bad5a896455e3e538d20f7b932a370240fa7d2ef..183f6a8614a5bc8aa97be56e4b50786af3ea208c 100644
--- a/gcc/ada/a-cidlli.adb
+++ b/gcc/ada/a-cidlli.adb
@@ -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 /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
+ 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;
diff --git a/gcc/ada/a-cidlli.ads b/gcc/ada/a-cidlli.ads
index be1b4344a8a6a3937bf71c855487fbc6c88dc1bb..762693c7b9dd68da45a2b6b17ffc71b1cfb0aef2 100644
--- a/gcc/ada/a-cidlli.ads
+++ b/gcc/ada/a-cidlli.ads
@@ -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
diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb
index 51e8c0c2424961c98808e9e8b065c073effafead..35419020c1097d099b9dee45feaf2c9980f5e49d 100644
--- a/gcc/ada/a-cihama.adb
+++ b/gcc/ada/a-cihama.adb
@@ -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
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type
is
begin
- return (Element =>
- Container.Find (Key).Node.Element.all'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;
- Position : Cursor) return Reference_Type
+ Key : Key_Type) return Reference_Type
is
- pragma Unreferenced (Container);
+ Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
+
begin
- return (Element => Element (Position)'Unrestricted_Access);
+ 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;
-------------
diff --git a/gcc/ada/a-cihama.ads b/gcc/ada/a-cihama.ads
index 567fe4ed6f63d3d43e5bd262a78a8cf2b30c02c3..2cd41eb0b469b8601aaee892e935dfff36785533 100644
--- a/gcc/ada/a-cihama.ads
+++ b/gcc/ada/a-cihama.ads
@@ -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));
diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb
index e6899e8622e2d78a645a5f2514dd5d9672a4a466..6255675550e36415c66784fdac3144724a24bab0 100644
--- a/gcc/ada/a-cihase.adb
+++ b/gcc/ada/a-cihase.adb
@@ -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 --
- ------------------------------
-
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Position : Cursor) return Reference_Type
- is
- pragma Unreferenced (Container);
- begin
- return (Element => Position.Node.Element.all'Access);
- end Reference_Preserving_Key;
+ -----------
+ -- Write --
+ -----------
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : 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;
diff --git a/gcc/ada/a-cihase.ads b/gcc/ada/a-cihase.ads
index 33994cdeffa67d2b278a05ec513363b08c70ca78..db59bdb7a002f4cd0654b4a59cab6ccf93de97a0 100644
--- a/gcc/ada/a-cihase.ads
+++ b/gcc/ada/a-cihase.ads
@@ -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
diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb
index daac18feb04e88974bdc3e90fcf3fd044b6143ae..c3887a57769b2a30c274a410c2f348b0c5111bca 100644
--- a/gcc/ada/a-cimutr.adb
+++ b/gcc/ada/a-cimutr.adb
@@ -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;
+
+ 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'Unchecked_Access);
+ return (Element => Position.Node.Element.all'Access);
end Reference;
--------------------
diff --git a/gcc/ada/a-cimutr.ads b/gcc/ada/a-cimutr.ads
index 6d5684d1b351337687dc1f7a5372e57f5a03ba8e..87c0e41f1d54622745fe50af7bef019501afe882 100644
--- a/gcc/ada/a-cimutr.ads
+++ b/gcc/ada/a-cimutr.ads
@@ -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 => <>);
diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb
index d775b27fc1f96dcfa2d844a0a384cd033a6c9b8d..15efbc7243df4ad92e5a64ce28fa970fc4519d00 100644
--- a/gcc/ada/a-ciorma.adb
+++ b/gcc/ada/a-ciorma.adb
@@ -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;
-------------
diff --git a/gcc/ada/a-ciorma.ads b/gcc/ada/a-ciorma.ads
index f4c1321835efb790979a7efb29dd8ed6cb8990a5..814f062537e76a093d1fcce0c11b897b3b6629b2 100644
--- a/gcc/ada/a-ciorma.ads
+++ b/gcc/ada/a-ciorma.ads
@@ -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));
diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb
index 0a99a82a7a9fd1f9784a94085933fdce66a05a8e..ff929067237002c739c22f12f3cde7886ec71eaf 100644
--- a/gcc/ada/a-ciorse.adb
+++ b/gcc/ada/a-ciorse.adb
@@ -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 --
-------------
diff --git a/gcc/ada/a-ciorse.ads b/gcc/ada/a-ciorse.ads
index ac711246542826516d3e95683dda45c819d492e6..5e2f84d2490a79678d32d85656fe9d1c9a01271c 100644
--- a/gcc/ada/a-ciorse.ads
+++ b/gcc/ada/a-ciorse.ads
@@ -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
diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index 71f65dfea6b3d1169a9683ee6da4cf195bf93e00..99659abc79535ecbeed14727d120aa86cd42ea08 100644
--- a/gcc/ada/a-cobove.adb
+++ b/gcc/ada/a-cobove.adb
@@ -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
+ 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.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
- 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 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;
---------------------
diff --git a/gcc/ada/a-cobove.ads b/gcc/ada/a-cobove.ads
index 7c009c0352c15c90ea873f9515171863be9e1a5d..6bcb0a407156edba955c3e75e4de905ea5fb6262 100644
--- a/gcc/ada/a-cobove.ads
+++ b/gcc/ada/a-cobove.ads
@@ -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
diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb
index 2bc2ca956f9c67aca81ffb20b22b0c3c3f6ed48a..8adcb1af35ad1f97f853b3681852ab3608248c07 100644
--- a/gcc/ada/a-cohama.adb
+++ b/gcc/ada/a-cohama.adb
@@ -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;
---------------
diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads
index 93c3504e8d570929d2e5756b26202b4cdc714619..a5b2ff3e1d7d4bb92ba0d7a81d6ead467324595a 100644
--- a/gcc/ada/a-cohama.ads
+++ b/gcc/ada/a-cohama.ads
@@ -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;
diff --git a/gcc/ada/a-cohase.adb b/gcc/ada/a-cohase.adb
index cf3354270d7fa758407f7848047e44fa4d0b264a..dd09da5a17c2fafc6c1d83f1d56a6d5eb8c645f0 100644
--- a/gcc/ada/a-cohase.adb
+++ b/gcc/ada/a-cohase.adb
@@ -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;
diff --git a/gcc/ada/a-cohase.ads b/gcc/ada/a-cohase.ads
index b31001c90f34932ba4c2775f50f04a27dffe1c43..97b209d280d4dd421c8c6befbf6dae564a968887 100644
--- a/gcc/ada/a-cohase.ads
+++ b/gcc/ada/a-cohase.ads
@@ -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;
diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb
index b845e6fc7ffb019ff145f5c32328f6bd818b3e0c..92c08749d9a05f9d23aaf6abc997399452462208 100644
--- a/gcc/ada/a-coinve.adb
+++ b/gcc/ada/a-coinve.adb
@@ -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;
---------------------
diff --git a/gcc/ada/a-coinve.ads b/gcc/ada/a-coinve.ads
index 85d68ebf7ee585b4d0353fd62913986eee1ab5de..8f55d81ed65428c5c1aad82d1fd5ad2183671ea3 100644
--- a/gcc/ada/a-coinve.ads
+++ b/gcc/ada/a-coinve.ads
@@ -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 Constant_Reference
- (Container : Vector; Position : Index_Type)
- return Constant_Reference_Type;
+ function Reference
+ (Container : aliased in out Vector;
+ Position : Cursor) return Reference_Type;
- function Reference (Container : Vector; Position : Cursor)
- return Reference_Type;
+ function Constant_Reference
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_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;
diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb
index 3d6794a74f5847ce228f49c95961702aadfa52d1..a923871b148992ad0e8aacdbcf6e6519586d6f5d 100644
--- a/gcc/ada/a-comutr.adb
+++ b/gcc/ada/a-comutr.adb
@@ -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;
+
+ 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'Unrestricted_Access);
+ return (Element => Position.Node.Element'Access);
end Reference;
--------------------
diff --git a/gcc/ada/a-comutr.ads b/gcc/ada/a-comutr.ads
index 37e2eda0c2c71d9b061aee02acf43eef893ceb0b..20a91bb9a13a1dbf46ab5395b6cc299ec3f1f238 100644
--- a/gcc/ada/a-comutr.ads
+++ b/gcc/ada/a-comutr.ads
@@ -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 => <>);
diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb
index f80dd3b29c05865e362bc20c5996f850d4d73ef1..2e3523514e4660fe8464bd6b5c31a3a270bd3e84 100644
--- a/gcc/ada/a-convec.adb
+++ b/gcc/ada/a-convec.adb
@@ -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.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";
+ 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);
+ 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;
diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads
index 00f9b2abbaccb080d40e409129241f788032a457..babf94e9c452d48c4e709714c508b1edfe1a9c49 100644
--- a/gcc/ada/a-convec.ads
+++ b/gcc/ada/a-convec.ads
@@ -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 Constant_Reference
- (Container : Vector; Position : Index_Type)
- return Constant_Reference_Type;
+ function Reference
+ (Container : aliased in out Vector;
+ Position : Cursor) return Reference_Type;
- function Reference (Container : Vector; Position : Cursor)
- return Reference_Type;
+ function Constant_Reference
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_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);
diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb
index 41df493812db4ac11a0ccf0d8224423d964ee101..c7153c5fcbb54e7a5edf6bfa2c6f255a8d4c075c 100644
--- a/gcc/ada/a-coorma.adb
+++ b/gcc/ada/a-coorma.adb
@@ -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;
-------------
diff --git a/gcc/ada/a-coorma.ads b/gcc/ada/a-coorma.ads
index 9d2737a5efb644ab56d5fa1781be974b2d7bd510..a58a4f5a2a2960bdb1796638ddab127386f2d2f6 100644
--- a/gcc/ada/a-coorma.ads
+++ b/gcc/ada/a-coorma.ads
@@ -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
diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb
index c8bf665ee17e9fc39175a248dfca32aba8c4ecc2..41ebb5c0d71142eba88c4c68c67acd414048d147 100644
--- a/gcc/ada/a-coorse.adb
+++ b/gcc/ada/a-coorse.adb
@@ -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 --
-------------
diff --git a/gcc/ada/a-coorse.ads b/gcc/ada/a-coorse.ads
index 39f69f5eff0da21af57577245e02108615371c0f..cf28a7ccd1c5253a8c8c7c5349d4e83e1e12d493 100644
--- a/gcc/ada/a-coorse.ads
+++ b/gcc/ada/a-coorse.ads
@@ -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
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 21dc91634aa951b4d5623bdd9c77cdedbac24e2c..dac30475e49f7f473206d050e8b212d75baaf81b 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -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
diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb
index a359f14dc286c54437a5c15e5444bbdd5b22d907..db18a7ebec0b308c6f95eeb3832db49769d54f64 100644
--- a/gcc/ada/s-gearop.adb
+++ b/gcc/ada/s-gearop.adb
@@ -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);
diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads
index 3599261498c06cce5974243fe407e1d238616576..d0b83ae05f4066a71b3ebb261d251f0c6e486d2b 100755
--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -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,