From ffb35bbf33cbdac32aa3147cccbbc73076eba66d Mon Sep 17 00:00:00 2001
From: Ed Schonberg <schonberg@adacore.com>
Date: Tue, 27 Sep 2011 10:11:01 +0000
Subject: [PATCH] a-cbhase.adb, [...]: Add iterator machinery to bounded sets
and indefinite sets.
2011-09-27 Ed Schonberg <schonberg@adacore.com>
* a-cbhase.adb, a-cbhase.ads, a-cborse.adb, a-cborse.ads,
a-cihase.adb, a-cihase.ads, a-ciorse.adb, a-ciorse.ads,
a-coorse.adb, a-coorse.ads: Add iterator machinery to bounded sets and
indefinite sets.
* a-coorma.ads: Minor reformmating.
* einfo.ads: Improve the comment describing the
Directly_Designated_Type function.
* a-ciorma.adb, a-ciorma.ads: Add iterator machinery to indefinite
ordered maps.
* gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update
dependencies.
From-SVN: r179260
---
gcc/ada/ChangeLog | 14 +++
gcc/ada/a-cbhase.adb | 100 +++++++++++++++++++
gcc/ada/a-cbhase.ads | 62 +++++++++++-
gcc/ada/a-cborse.adb | 152 +++++++++++++++++++++++++++++
gcc/ada/a-cborse.ads | 78 ++++++++++++++-
gcc/ada/a-cihase.adb | 98 ++++++++++++++++++-
gcc/ada/a-cihase.ads | 63 ++++++++++--
gcc/ada/a-ciorma.adb | 140 +++++++++++++++++++++++++-
gcc/ada/a-ciorma.ads | 72 +++++++++++++-
gcc/ada/a-ciorse.adb | 72 ++++++++------
gcc/ada/a-ciorse.ads | 76 ++++++++-------
gcc/ada/a-coorma.ads | 48 ++++-----
gcc/ada/a-coorse.adb | 72 ++++++++------
gcc/ada/a-coorse.ads | 82 ++++++++--------
gcc/ada/einfo.ads | 9 +-
gcc/ada/gcc-interface/Make-lang.in | 15 ++-
gcc/ada/gcc-interface/Makefile.in | 75 +++++---------
17 files changed, 989 insertions(+), 239 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8346b6b96eba..cab378da07f8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2011-09-27 Ed Schonberg <schonberg@adacore.com>
+
+ * a-cbhase.adb, a-cbhase.ads, a-cborse.adb, a-cborse.ads,
+ a-cihase.adb, a-cihase.ads, a-ciorse.adb, a-ciorse.ads,
+ a-coorse.adb, a-coorse.ads: Add iterator machinery to bounded sets and
+ indefinite sets.
+ * a-coorma.ads: Minor reformmating.
+ * einfo.ads: Improve the comment describing the
+ Directly_Designated_Type function.
+ * a-ciorma.adb, a-ciorma.ads: Add iterator machinery to indefinite
+ ordered maps.
+ * gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update
+ dependencies.
+
2011-09-27 Robert Dewar <dewar@adacore.com>
* a-comutr.ads: Minor reformatting.
diff --git a/gcc/ada/a-cbhase.adb b/gcc/ada/a-cbhase.adb
index d2d5b6c53b56..7dcd074995d5 100644
--- a/gcc/ada/a-cbhase.adb
+++ b/gcc/ada/a-cbhase.adb
@@ -39,6 +39,17 @@ with System; use type System.Address;
package body Ada.Containers.Bounded_Hashed_Sets is
+ type Iterator is new Set_Iterator_Interfaces.Forward_Iterator with record
+ Container : Set_Access;
+ Position : Cursor;
+ end record;
+
+ overriding function First (Object : Iterator) return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -593,6 +604,16 @@ package body Ada.Containers.Bounded_Hashed_Sets is
return Cursor'(Container'Unrestricted_Access, Node);
end First;
+ overriding function First (Object : Iterator) return Cursor is
+ Node : constant Count_Type := HT_Ops.First (Object.Container.all);
+ begin
+ if Node = 0 then
+ return No_Element;
+ end if;
+
+ return Cursor'(Object.Container, Node);
+ end First;
+
-----------------
-- Has_Element --
-----------------
@@ -899,6 +920,12 @@ package body Ada.Containers.Bounded_Hashed_Sets is
B := B - 1;
end Iterate;
+ function Iterate (Container : Set)
+ return Set_Iterator_Interfaces.Forward_Iterator'Class is
+ begin
+ return Iterator'(Container'Unrestricted_Access, First (Container));
+ end Iterate;
+
------------
-- Length --
------------
@@ -962,6 +989,23 @@ package body Ada.Containers.Bounded_Hashed_Sets is
Position := Next (Position);
end Next;
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor designates wrong set";
+ end if;
+
+ if Position.Node = 0 then
+ return No_Element;
+ end if;
+
+ return Next (Position);
+ end Next;
+
-------------
-- Overlap --
-------------
@@ -1083,6 +1127,31 @@ package body Ada.Containers.Bounded_Hashed_Sets is
raise Program_Error with "attempt to stream set cursor";
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ S : Set renames Position.Container.all;
+ N : Node_Type renames S.Nodes (Position.Node);
+
+ begin
+ pragma Unreferenced (Container);
+
+ return (Element => N.Element'Unrestricted_Access);
+ end Constant_Reference;
+
-------------
-- Replace --
-------------
@@ -1476,6 +1545,14 @@ package body Ada.Containers.Bounded_Hashed_Sets is
raise Program_Error with "attempt to stream set cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
package body Generic_Keys is
-----------------------
@@ -1731,6 +1808,29 @@ 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;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Position : constant Cursor := Find (Container, Key);
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Unrestricted_Access);
+ end Reference_Preserving_Key;
+
end Generic_Keys;
end Ada.Containers.Bounded_Hashed_Sets;
diff --git a/gcc/ada/a-cbhase.ads b/gcc/ada/a-cbhase.ads
index 711c01169634..c72b8ab85972 100644
--- a/gcc/ada/a-cbhase.ads
+++ b/gcc/ada/a-cbhase.ads
@@ -31,6 +31,7 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
+with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
@@ -48,7 +49,11 @@ package Ada.Containers.Bounded_Hashed_Sets is
pragma Pure;
pragma Remote_Types;
- type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
+ type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private
+ with Constant_Indexing => Constant_Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
+
pragma Preelaborable_Initialization (Set);
type Cursor is private;
@@ -62,6 +67,12 @@ package Ada.Containers.Bounded_Hashed_Sets is
-- Cursor objects declared without an initialization expression are
-- initialized to the value No_Element.
+ function Has_Element (Position : Cursor) return Boolean;
+ -- Equivalent to Position /= No_Element
+
+ package Set_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
+
function "=" (Left, Right : Set) return Boolean;
-- For each element in Left, set equality attempts to find the equal
-- element in Right; if a search fails, then set equality immediately
@@ -129,7 +140,16 @@ package Ada.Containers.Bounded_Hashed_Sets is
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
-- Calls Process with the element (having only a constant view) of the node
- -- designed by the cursor.
+ -- designated by the cursor.
+
+ 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);
-- If Target denotes the same object as Source, then the operation has no
@@ -314,9 +334,6 @@ package Ada.Containers.Bounded_Hashed_Sets is
function Contains (Container : Set; Item : Element_Type) return Boolean;
-- Equivalent to Find (Container, Item) /= No_Element
- function Has_Element (Position : Cursor) return Boolean;
- -- Equivalent to Position /= No_Element
-
function Equivalent_Elements (Left, Right : Cursor) return Boolean;
-- Returns the result of calling Equivalent_Elements with the elements of
-- the nodes designated by cursors Left and Right.
@@ -338,6 +355,9 @@ package Ada.Containers.Bounded_Hashed_Sets is
Process : not null access procedure (Position : Cursor));
-- Calls Process for each node in the set
+ function Iterate (Container : Set)
+ return Set_Iterator_Interfaces.Forward_Iterator'Class;
+
generic
type Key_Type (<>) is private;
@@ -406,6 +426,23 @@ package Ada.Containers.Bounded_Hashed_Sets is
-- completes. Otherwise, the node is removed from the map and
-- Program_Error is raised.
+ type Reference_Type (Element : not null access Element_Type) is private
+ with Implicit_Dereference => Element;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor)
+ return Reference_Type;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type)
+ return Reference_Type;
+
+ private
+ type Reference_Type (Element : not null access Element_Type)
+ is null record;
+
end Generic_Keys;
private
@@ -466,6 +503,21 @@ private
for Set'Read use Read;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ 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;
+
Empty_Set : constant Set :=
(Hash_Table_Type with Capacity => 0, Modulus => 0);
diff --git a/gcc/ada/a-cborse.adb b/gcc/ada/a-cborse.adb
index 4a4bc71d416d..1974c6cccef0 100644
--- a/gcc/ada/a-cborse.adb
+++ b/gcc/ada/a-cborse.adb
@@ -42,6 +42,24 @@ with System; use type System.Address;
package body Ada.Containers.Bounded_Ordered_Sets is
+ type Iterator is new
+ Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record
+ Container : access constant Set;
+ Node : Count_Type;
+ end record;
+
+ overriding function First (Object : Iterator) return Cursor;
+
+ overriding function Last (Object : Iterator) return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
+ overriding function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
------------------------------
-- Access to Fields of Node --
------------------------------
@@ -598,6 +616,18 @@ package body Ada.Containers.Bounded_Ordered_Sets is
return Cursor'(Container'Unrestricted_Access, Container.First);
end First;
+ function First (Object : Iterator) return Cursor is
+ begin
+ if Object.Container.First = 0 then
+ return No_Element;
+ else
+ return
+ Cursor'(
+ Object.Container.all'Unrestricted_Access,
+ Object.Container.First);
+ end if;
+ end First;
+
-------------------
-- First_Element --
-------------------
@@ -891,6 +921,53 @@ 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;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
end Generic_Keys;
-----------------
@@ -1185,6 +1262,25 @@ package body Ada.Containers.Bounded_Ordered_Sets is
B := B - 1;
end Iterate;
+ function Iterate (Container : Set)
+ return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
+ is
+ begin
+ if Container.Length = 0 then
+ return Iterator'(null, 0);
+ else
+ return Iterator'(Container'Unchecked_Access, Container.First);
+ end if;
+ end Iterate;
+
+ function Iterate (Container : Set; Start : Cursor)
+ return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
+ is
+ It : constant Iterator := (Container'Unchecked_Access, Start.Node);
+ begin
+ return It;
+ end Iterate;
+
----------
-- Last --
----------
@@ -1198,6 +1294,17 @@ package body Ada.Containers.Bounded_Ordered_Sets is
return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last;
+ function Last (Object : Iterator) return Cursor is
+ begin
+ if Object.Container.Last = 0 then
+ return No_Element;
+ else
+ return Cursor'(
+ Object.Container.all'Unrestricted_Access,
+ Object.Container.Last);
+ end if;
+ end Last;
+
------------------
-- Last_Element --
------------------
@@ -1279,6 +1386,13 @@ package body Ada.Containers.Bounded_Ordered_Sets is
Position := Next (Position);
end Next;
+ function Next (Object : Iterator; Position : Cursor) return Cursor is
+ pragma Unreferenced (Object);
+
+ begin
+ return Next (Position);
+ end Next;
+
-------------
-- Overlap --
-------------
@@ -1328,6 +1442,12 @@ package body Ada.Containers.Bounded_Ordered_Sets is
Position := Previous (Position);
end Previous;
+ function Previous (Object : Iterator; Position : Cursor) return Cursor is
+ pragma Unreferenced (Object);
+ begin
+ return Previous (Position);
+ end Previous;
+
-------------------
-- Query_Element --
-------------------
@@ -1408,6 +1528,30 @@ package body Ada.Containers.Bounded_Ordered_Sets is
raise Program_Error with "attempt to stream set cursor";
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ 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 --
-------------
@@ -1716,4 +1860,12 @@ package body Ada.Containers.Bounded_Ordered_Sets is
raise Program_Error with "attempt to stream set cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Ada.Containers.Bounded_Ordered_Sets;
diff --git a/gcc/ada/a-cborse.ads b/gcc/ada/a-cborse.ads
index e56b71b4c61e..0c8ae6b17038 100644
--- a/gcc/ada/a-cborse.ads
+++ b/gcc/ada/a-cborse.ads
@@ -31,8 +31,9 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
+with Ada.Iterator_Interfaces;
private with Ada.Containers.Red_Black_Trees;
-private with Ada.Streams;
+with Ada.Streams; use Ada.Streams;
generic
type Element_Type is private;
@@ -46,7 +47,11 @@ package Ada.Containers.Bounded_Ordered_Sets is
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
- type Set (Capacity : Count_Type) is tagged private;
+ type Set (Capacity : Count_Type) is tagged private
+ with Constant_Indexing => Constant_Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
+
pragma Preelaborable_Initialization (Set);
type Cursor is private;
@@ -55,6 +60,20 @@ package Ada.Containers.Bounded_Ordered_Sets is
Empty_Set : constant Set;
No_Element : constant Cursor;
+ function Has_Element (Position : Cursor) return Boolean;
+
+ package Ordered_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;
@@ -171,8 +190,6 @@ package Ada.Containers.Bounded_Ordered_Sets is
function Contains (Container : Set; Item : Element_Type) return Boolean;
- function Has_Element (Position : Cursor) return Boolean;
-
function "<" (Left, Right : Cursor) return Boolean;
function ">" (Left, Right : Cursor) return Boolean;
@@ -193,6 +210,15 @@ package Ada.Containers.Bounded_Ordered_Sets is
(Container : Set;
Process : not null access procedure (Position : Cursor));
+ function Iterate
+ (Container : Set)
+ return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
+
+ function Iterate
+ (Container : Set;
+ Start : Cursor)
+ return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
+
generic
type Key_Type (<>) is private;
@@ -231,6 +257,34 @@ package Ada.Containers.Bounded_Ordered_Sets is
Process : not null access
procedure (Element : in out Element_Type));
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type;
+
+ private
+ type Reference_Type
+ (Element : not null access Element_Type) is null record;
+
+ 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
@@ -267,7 +321,6 @@ private
end record;
use Tree_Types;
- use Ada.Streams;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
@@ -295,6 +348,21 @@ private
for Set'Read use Read;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ 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;
+
Empty_Set : constant Set := Set'(Tree_Type with Capacity => 0);
end Ada.Containers.Bounded_Ordered_Sets;
diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb
index 0a42fb239b3f..dd43229b5e21 100644
--- a/gcc/ada/a-cihase.adb
+++ b/gcc/ada/a-cihase.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2011, 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- --
@@ -41,6 +41,17 @@ with System; use type System.Address;
package body Ada.Containers.Indefinite_Hashed_Sets is
+ type Iterator is new Set_Iterator_Interfaces.Forward_Iterator with record
+ Container : Set_Access;
+ Position : Cursor;
+ end record;
+
+ overriding function First (Object : Iterator) return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -602,6 +613,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
return Cursor'(Container'Unrestricted_Access, Node);
end First;
+ function First (Object : Iterator) return Cursor is
+ Node : constant Node_Access := HT_Ops.First (Object.Container.HT);
+ begin
+ if Node = null then
+ return No_Element;
+ end if;
+
+ return Cursor'(Object.Container, Node);
+ end First;
+
----------
-- Free --
----------
@@ -956,6 +977,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
B := B - 1;
end Iterate;
+ function Iterate (Container : Set)
+ return Set_Iterator_Interfaces.Forward_Iterator'Class is
+ begin
+ return Iterator'(Container'Unrestricted_Access, First (Container));
+ end Iterate;
+
------------
-- Length --
------------
@@ -1013,6 +1040,23 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Position := Next (Position);
end Next;
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor designates wrong set";
+ end if;
+
+ if Position.Node = null then
+ return No_Element;
+ end if;
+
+ return Next (Position);
+ end Next;
+
-------------
-- Overlap --
-------------
@@ -1106,6 +1150,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
raise Program_Error with "attempt to stream set cursor";
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
---------------
-- Read_Node --
---------------
@@ -1123,6 +1175,20 @@ 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
+ begin
+ pragma Unreferenced (Container);
+
+ return (Element => Position.Node.Element);
+ end Constant_Reference;
+
-------------
-- Replace --
-------------
@@ -1746,6 +1812,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
raise Program_Error with "attempt to stream set cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
----------------
-- Write_Node --
----------------
@@ -2017,6 +2091,28 @@ 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);
+ end Reference_Preserving_Key;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Position : constant Cursor := Find (Container, Key);
+ begin
+ return (Element => Position.Node.Element);
+ end Reference_Preserving_Key;
+
end Generic_Keys;
end Ada.Containers.Indefinite_Hashed_Sets;
diff --git a/gcc/ada/a-cihase.ads b/gcc/ada/a-cihase.ads
index df091031bc52..b055c1be1534 100644
--- a/gcc/ada/a-cihase.ads
+++ b/gcc/ada/a-cihase.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@@ -31,6 +31,7 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
+with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
private with Ada.Finalization;
@@ -49,7 +50,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is
pragma Preelaborate;
pragma Remote_Types;
- type Set is tagged private;
+ type Set is tagged private
+ with Constant_Indexing => Constant_Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
+
pragma Preelaborable_Initialization (Set);
type Cursor is private;
@@ -63,6 +68,12 @@ package Ada.Containers.Indefinite_Hashed_Sets is
-- Cursor objects declared without an initialization expression are
-- initialized to the value No_Element.
+ function Has_Element (Position : Cursor) return Boolean;
+ -- Equivalent to Position /= No_Element
+
+ package Set_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
+
function "=" (Left, Right : Set) return Boolean;
-- For each element in Left, set equality attempts to find the equal
-- element in Right; if a search fails, then set equality immediately
@@ -131,7 +142,16 @@ package Ada.Containers.Indefinite_Hashed_Sets is
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
-- Calls Process with the element (having only a constant view) of the node
- -- designed by the cursor.
+ -- designated by the cursor.
+
+ 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 Move (Target : in out Set; Source : in out Set);
-- Clears Target (if it's not empty), and then moves (not copies) the
@@ -297,9 +317,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is
function Contains (Container : Set; Item : Element_Type) return Boolean;
-- Equivalent to Find (Container, Item) /= No_Element
- function Has_Element (Position : Cursor) return Boolean;
- -- Equivalent to Position /= No_Element
-
function Equivalent_Elements (Left, Right : Cursor) return Boolean;
-- Returns the result of calling Equivalent_Elements with the elements of
-- the nodes designated by cursors Left and Right.
@@ -321,6 +338,9 @@ package Ada.Containers.Indefinite_Hashed_Sets is
Process : not null access procedure (Position : Cursor));
-- Calls Process for each node in the set
+ function Iterate (Container : Set)
+ return Set_Iterator_Interfaces.Forward_Iterator'Class;
+
generic
type Key_Type (<>) is private;
@@ -389,6 +409,22 @@ package Ada.Containers.Indefinite_Hashed_Sets is
-- completes. Otherwise, the node is removed from the map and
-- Program_Error is raised.
+ type Reference_Type (Element : not null access Element_Type) is private
+ with Implicit_Dereference => Element;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor)
+ return Reference_Type;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type)
+ return Reference_Type;
+
+ private
+ type Reference_Type (Element : not null access Element_Type)
+ is null record;
end Generic_Keys;
private
@@ -454,6 +490,21 @@ private
for Set'Read use Read;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ 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;
+
Empty_Set : constant Set := (Controlled with HT => (null, 0, 0, 0));
end Ada.Containers.Indefinite_Hashed_Sets;
diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb
index 9cfcd3f5a809..c30abd08046f 100644
--- a/gcc/ada/a-ciorma.adb
+++ b/gcc/ada/a-ciorma.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -37,6 +37,24 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
package body Ada.Containers.Indefinite_Ordered_Maps is
+ type Iterator is new
+ Map_Iterator_Interfaces.Reversible_Iterator with record
+ Container : Map_Access;
+ Node : Node_Access;
+ end record;
+
+ overriding function First (Object : Iterator) return Cursor;
+
+ overriding function Last (Object : Iterator) return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
+ overriding function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------------
-- Node Access Subprograms --
-----------------------------
@@ -305,6 +323,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
return Node.Color;
end Color;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : Map;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ begin return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -503,6 +532,18 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
return Cursor'(Container'Unrestricted_Access, T.First);
end First;
+ function First (Object : Iterator) return Cursor is
+ M : constant Map_Access := Object.Container;
+ N : constant Node_Access := M.Tree.First;
+
+ begin
+ if N = null then
+ return No_Element;
+ else
+ return Cursor'(Object.Container.all'Unchecked_Access, N);
+ end if;
+ end First;
+
-------------------
-- First_Element --
-------------------
@@ -810,6 +851,24 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
B := B - 1;
end Iterate;
+ function Iterate
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+ is
+ Node : constant Node_Access := Container.Tree.First;
+ It : constant Iterator := (Container'Unrestricted_Access, Node);
+
+ begin
+ return It;
+ end Iterate;
+
+ function Iterate (Container : Map; Start : Cursor)
+ return Map_Iterator_Interfaces.Reversible_Iterator'class
+ is
+ It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
+ begin
+ return It;
+ end Iterate;
+
---------
-- Key --
---------
@@ -847,6 +906,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
return Cursor'(Container'Unrestricted_Access, T.Last);
end Last;
+ function Last (Object : Iterator) return Cursor is
+ M : constant Map_Access := Object.Container;
+ N : constant Node_Access := M.Tree.Last;
+ begin
+ if N = null then
+ return No_Element;
+ else
+ return Cursor'(Object.Container.all'Unchecked_Access, N);
+ end if;
+ end Last;
+
------------------
-- Last_Element --
------------------
@@ -941,6 +1011,18 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Position := Next (Position);
end Next;
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+ if Position.Node = null then
+ return No_Element;
+ else
+ return (Object.Container, Tree_Operations.Next (Position.Node));
+ end if;
+ end Next;
+
------------
-- Parent --
------------
@@ -984,6 +1066,18 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Position := Previous (Position);
end Previous;
+ function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+ if Position.Node = null then
+ return No_Element;
+ else
+ return (Object.Container, Tree_Operations.Previous (Position.Node));
+ end if;
+ end Previous;
+
-------------------
-- Query_Element --
-------------------
@@ -1084,6 +1178,35 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
raise Program_Error with "attempt to stream map cursor";
end 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;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Reference
+ (Container : Map;
+ Key : Key_Type)
+ return Reference_Type
+ is
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Reference;
+
-------------
-- Replace --
-------------
@@ -1359,4 +1482,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
raise Program_Error with "attempt to stream map cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
end Ada.Containers.Indefinite_Ordered_Maps;
diff --git a/gcc/ada/a-ciorma.ads b/gcc/ada/a-ciorma.ads
index 56e40d9bf329..b31dc0d2e256 100644
--- a/gcc/ada/a-ciorma.ads
+++ b/gcc/ada/a-ciorma.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@@ -31,6 +31,7 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
+with Ada.Iterator_Interfaces;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
@@ -48,7 +49,12 @@ package Ada.Containers.Indefinite_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
- type Map is tagged private;
+ type Map is tagged private
+ with constant_Indexing => Constant_Reference,
+ Variable_Indexing => Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
+
pragma Preelaborable_Initialization (Map);
type Cursor is private;
@@ -57,6 +63,10 @@ package Ada.Containers.Indefinite_Ordered_Maps is
Empty_Map : constant Map;
No_Element : constant Cursor;
+ function Has_Element (Position : Cursor) return Boolean;
+
+ package Map_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
function "=" (Left, Right : Map) return Boolean;
@@ -150,8 +160,6 @@ package Ada.Containers.Indefinite_Ordered_Maps is
function Contains (Container : Map; Key : Key_Type) return Boolean;
- function Has_Element (Position : Cursor) return Boolean;
-
function "<" (Left, Right : Cursor) return Boolean;
function ">" (Left, Right : Cursor) return Boolean;
@@ -164,6 +172,23 @@ 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));
@@ -172,6 +197,15 @@ package Ada.Containers.Indefinite_Ordered_Maps is
(Container : Map;
Process : not null access procedure (Position : Cursor));
+ function Iterate
+ (Container : Map)
+ return Map_Iterator_Interfaces.Forward_Iterator'class;
+
+ function Iterate
+ (Container : Map;
+ Start : Cursor)
+ return Map_Iterator_Interfaces.Reversible_Iterator'class;
+
private
pragma Inline (Next);
@@ -243,6 +277,36 @@ private
for Map'Read use Read;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ 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 null record;
+
+ 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;
+
Empty_Map : constant Map :=
(Controlled with Tree => (First => null,
Last => null,
diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb
index 673cd510a3c6..a330ed8b6c5f 100644
--- a/gcc/ada/a-ciorse.adb
+++ b/gcc/ada/a-ciorse.adb
@@ -926,6 +926,50 @@ 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;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Generic_Keys;
-----------------
@@ -1498,14 +1542,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
raise Program_Error with "attempt to stream set cursor";
end 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;
-
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type)
@@ -1530,18 +1566,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
- function Reference (Container : Set; Position : Cursor)
- return 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 Reference;
-
-------------
-- Replace --
-------------
@@ -1874,14 +1898,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
raise Program_Error with "attempt to stream set cursor";
end Write;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Reference_Type)
- is
- begin
- raise Program_Error with "attempt to stream reference";
- end Write;
-
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type)
diff --git a/gcc/ada/a-ciorse.ads b/gcc/ada/a-ciorse.ads
index 78b5d764b061..f397f1d464e6 100644
--- a/gcc/ada/a-ciorse.ads
+++ b/gcc/ada/a-ciorse.ads
@@ -50,7 +50,6 @@ package Ada.Containers.Indefinite_Ordered_Sets is
type Set is tagged private with
Constant_Indexing => Constant_Reference,
- Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@@ -73,6 +72,10 @@ package Ada.Containers.Indefinite_Ordered_Sets 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);
@@ -85,30 +88,6 @@ package Ada.Containers.Indefinite_Ordered_Sets is
for Constant_Reference_Type'Write use Write;
- function Constant_Reference
- (Container : Set;
- Position : Cursor) return Constant_Reference_Type;
-
- 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 Reference
- (Container : Set; Position : Cursor)
- return Reference_Type;
-
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@@ -212,13 +191,21 @@ package Ada.Containers.Indefinite_Ordered_Sets is
procedure Previous (Position : in out Cursor);
- function Find (Container : Set; Item : Element_Type) return Cursor;
+ function Find
+ (Container : Set;
+ Item : Element_Type) return Cursor;
- function Floor (Container : Set; Item : Element_Type) return Cursor;
+ function Floor
+ (Container : Set;
+ Item : Element_Type) return Cursor;
- function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+ function Ceiling
+ (Container : Set;
+ Item : Element_Type) return Cursor;
- function Contains (Container : Set; Item : Element_Type) return Boolean;
+ function Contains
+ (Container : Set;
+ Item : Element_Type) return Boolean;
function "<" (Left, Right : Cursor) return Boolean;
@@ -295,10 +282,36 @@ package Ada.Containers.Indefinite_Ordered_Sets is
Process : not null access
procedure (Element : in out Element_Type));
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type;
+
+ 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);
+
+ 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;
end Generic_Keys;
private
-
pragma Inline (Next);
pragma Inline (Previous);
@@ -368,9 +381,6 @@ private
type Constant_Reference_Type
(Element : not null access constant Element_Type) is null record;
- type Reference_Type
- (Element : not null access Element_Type) is null record;
-
Empty_Set : constant Set :=
(Controlled with Tree => (First => null,
Last => null,
diff --git a/gcc/ada/a-coorma.ads b/gcc/ada/a-coorma.ads
index 1beea7bbff51..6fd45b78253d 100644
--- a/gcc/ada/a-coorma.ads
+++ b/gcc/ada/a-coorma.ads
@@ -183,34 +183,10 @@ package Ada.Containers.Ordered_Maps is
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???
@@ -308,6 +284,30 @@ private
type Reference_Type
(Element : not null access Element_Type) is null record;
+ 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;
+
+ 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;
+
Empty_Map : constant Map :=
(Controlled with Tree => (First => null,
Last => null,
diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb
index 7465f930b1fc..d52ed67c9a0f 100644
--- a/gcc/ada/a-coorse.adb
+++ b/gcc/ada/a-coorse.adb
@@ -860,6 +860,50 @@ 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;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Generic_Keys;
-----------------
@@ -1410,14 +1454,6 @@ package body Ada.Containers.Ordered_Sets is
raise Program_Error with "attempt to stream set cursor";
end 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;
-
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type)
@@ -1442,18 +1478,6 @@ package body Ada.Containers.Ordered_Sets is
return (Element => Position.Node.Element'Access);
end Constant_Reference;
- function Reference (Container : Set; Position : Cursor)
- return 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 Reference;
-
-------------
-- Replace --
-------------
@@ -1769,14 +1793,6 @@ package body Ada.Containers.Ordered_Sets is
raise Program_Error with "attempt to stream set cursor";
end Write;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Reference_Type)
- is
- begin
- raise Program_Error with "attempt to stream reference";
- end Write;
-
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type)
diff --git a/gcc/ada/a-coorse.ads b/gcc/ada/a-coorse.ads
index 21eb71977790..8349ef85fb4b 100644
--- a/gcc/ada/a-coorse.ads
+++ b/gcc/ada/a-coorse.ads
@@ -50,11 +50,9 @@ package Ada.Containers.Ordered_Sets is
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
type Set is tagged private
- with
- Constant_Indexing => Constant_Reference,
- Variable_Indexing => Reference,
- Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ with Constant_Indexing => Constant_Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
pragma Preelaborable_Initialization (Set);
@@ -67,18 +65,6 @@ package Ada.Containers.Ordered_Sets is
No_Element : constant Cursor;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor);
-
- for Cursor'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor);
-
- for Cursor'Read use Read;
-
package Ordered_Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
@@ -104,26 +90,6 @@ package Ada.Containers.Ordered_Sets is
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 Reference
- (Container : Set; Position : Cursor)
- return Reference_Type;
-
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@@ -302,6 +268,33 @@ package Ada.Containers.Ordered_Sets is
Process : not null access
procedure (Element : in out Element_Type));
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type;
+
+ 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);
+
+ 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;
end Generic_Keys;
private
@@ -343,6 +336,18 @@ private
Node : Node_Access;
end record;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Cursor);
+
+ for Cursor'Write use Write;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Cursor);
+
+ for Cursor'Read use Read;
+
No_Element : constant Cursor := Cursor'(null, null);
procedure Write
@@ -360,9 +365,6 @@ private
type Constant_Reference_Type
(Element : not null access constant Element_Type) is null record;
- type Reference_Type
- (Element : not null access Element_Type) is null record;
-
Empty_Set : constant Set :=
(Controlled with Tree => (First => null,
Last => null,
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index c366e0274b31..93d914fd855e 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -817,10 +817,11 @@ package Einfo is
-- Present in access types. This field points to the type that is
-- directly designated by the access type. In the case of an access
-- type to an incomplete type, this field references the incomplete
--- type. Note that in the semantic processing, what is useful in
--- nearly all cases is the full type designated by the access type.
--- The function Designated_Type obtains this full type in the case of
--- access to an incomplete type.
+-- type. Directly_Designated_Type is typically used in implementing the
+-- static semantics of the language; in implementing dynamic semantics,
+-- we typically want the full view of the designated type. The function
+-- Designated_Type obtains this full type in the case of access to an
+-- incomplete type.
-- Discard_Names (Flag88)
-- Present in types and exception entities. Set if pragma Discard_Names
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index 50dd0b751ab8..9f25fc26d92b 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -1811,20 +1811,19 @@ ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/exp_alfa.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
- ada/exp_alfa.ads ada/exp_alfa.adb ada/exp_attr.ads ada/exp_ch6.ads \
- ada/exp_dbug.ads ada/gnat.ads ada/g-htable.ads ada/hostparm.ads \
- ada/interfac.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
- ada/nlists.adb ada/opt.ads ada/output.ads ada/rtsfind.ads \
- ada/sem_aux.ads ada/sem_aux.adb ada/sem_res.ads ada/sinfo.ads \
- ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
+ ada/exp_alfa.ads ada/exp_alfa.adb ada/exp_attr.ads ada/exp_ch4.ads \
+ ada/exp_ch6.ads ada/exp_dbug.ads ada/gnat.ads ada/g-htable.ads \
+ ada/hostparm.ads ada/interfac.ads ada/namet.ads ada/namet.adb \
+ ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
+ ada/rtsfind.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_res.ads \
+ ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
- ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads \
- ada/exp_ch4.ads
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/exp_atag.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index db7f563e13d7..c463cd674362 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -597,7 +597,6 @@ ifeq ($(strip $(filter-out powerpc% e500v2 wrs vxworksae,$(targ))),)
a-intnam.ads<a-intnam-vxworks.ads \
a-numaux.ads<a-numaux-vxworks.ads \
g-io.adb<g-io-vxworks-ppc-cert.adb \
- g-io.ads<g-io-vxworks-ppc-cert.ads \
s-inmaop.adb<s-inmaop-vxworks.adb \
s-interr.adb<s-interr-hwint.adb \
s-intman.ads<s-intman-vxworks.ads \
@@ -660,7 +659,6 @@ ifeq ($(strip $(filter-out e500% powerpc% wrs vxworksmils,$(targ))),)
a-intnam.ads<a-intnam-vxworks.ads \
a-numaux.ads<a-numaux-vxworks.ads \
g-io.adb<g-io-vxworks-ppc-cert.adb \
- g-io.ads<g-io-vxworks-ppc-cert.ads \
s-inmaop.adb<s-inmaop-vxworks.adb \
s-interr.adb<s-interr-hwint.adb \
s-intman.ads<s-intman-vxworks.ads \
@@ -715,7 +713,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
a-sytaco.ads<1asytaco.ads \
a-sytaco.adb<1asytaco.adb \
g-io.adb<g-io-vxworks-ppc-cert.adb \
- g-io.ads<g-io-vxworks-ppc-cert.ads \
s-inmaop.adb<s-inmaop-vxworks.adb \
s-interr.adb<s-interr-hwint.adb \
s-intman.ads<s-intman-vxworks.ads \
@@ -1115,62 +1112,36 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
s-intman.adb<s-intman-posix.adb \
s-tpopsp.adb<s-tpopsp-tls.adb \
g-sercom.adb<g-sercom-linux.adb \
+ a-exetim.adb<a-exetim-posix.adb \
+ a-exetim.ads<a-exetim-default.ads \
+ s-linux.ads<s-linux.ads \
+ s-osinte.adb<s-osinte-posix.adb \
+ system.ads<system-linux-x86.ads \
$(ATOMICS_TARGET_PAIRS) \
$(X86_TARGET_PAIRS)
- ifeq ($(strip $(filter-out marte,$(THREAD_KIND))),)
+ ifeq ($(strip $(filter-out xenomai,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
- a-exetim.adb<a-exetim-linux-marte.adb \
- a-exetim.ads<a-exetim-linux-marte.ads \
- a-extiti.adb<a-extiti-linux-marte.adb \
- a-extiti.ads<a-extiti-linux-marte.ads \
- a-rttiev.adb<a-rttiev-linux-marte.adb \
- a-rttiev.ads<a-rttiev-linux-marte.ads \
- s-osinte.adb<s-osinte-linux-marte.adb \
- s-osinte.ads<s-osinte-linux-marte.ads \
- s-osprim.adb<s-osprim-posix.adb \
- s-taprop.adb<s-taprop-linux-marte.adb \
- s-taspri.ads<s-taspri-posix.ads \
- system.ads<system-linux-x86.ads
-
- EXTRA_GNATRTL_TASKING_OBJS=a-exetim.o a-extiti.o
-
- EH_MECHANISM=
- THREADSLIB = -lmarte
+ s-osinte.ads<s-osinte-linux-xenomai.ads \
+ s-osprim.adb<s-osprim-linux-xenomai.adb \
+ s-taprop.adb<s-taprop-linux-xenomai.adb \
+ s-taspri.ads<s-taspri-linux-xenomai.ads
else
LIBGNAT_TARGET_PAIRS += \
- a-exetim.adb<a-exetim-posix.adb \
- a-exetim.ads<a-exetim-default.ads \
- s-linux.ads<s-linux.ads \
- s-osinte.adb<s-osinte-posix.adb \
- system.ads<system-linux-x86.ads
-
- ifeq ($(strip $(filter-out xenomai,$(THREAD_KIND))),)
- LIBGNAT_TARGET_PAIRS += \
- s-osinte.ads<s-osinte-linux-xenomai.ads \
- s-osprim.adb<s-osprim-linux-xenomai.adb \
- s-taprop.adb<s-taprop-linux-xenomai.adb \
- s-taspri.ads<s-taspri-linux-xenomai.ads
-
- EH_MECHANISM=-gcc
- else
- LIBGNAT_TARGET_PAIRS += \
- s-mudido.adb<s-mudido-affinity.adb \
- s-osinte.ads<s-osinte-linux.ads \
- s-osprim.adb<s-osprim-posix.adb \
- s-taprop.adb<s-taprop-linux.adb \
- s-tasinf.ads<s-tasinf-linux.ads \
- s-tasinf.adb<s-tasinf-linux.adb \
- s-taspri.ads<s-taspri-posix.ads
-
- EH_MECHANISM=-gcc
- endif
-
- THREADSLIB = -lpthread -lrt
- EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
- EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
+ s-mudido.adb<s-mudido-affinity.adb \
+ s-osinte.ads<s-osinte-linux.ads \
+ s-osprim.adb<s-osprim-posix.adb \
+ s-taprop.adb<s-taprop-linux.adb \
+ s-tasinf.ads<s-tasinf-linux.ads \
+ s-tasinf.adb<s-tasinf-linux.adb \
+ s-taspri.ads<s-taspri-posix.ads
endif
+ EH_MECHANISM=-gcc
+ THREADSLIB = -lpthread -lrt
+ EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
+ EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
+
TOOLS_TARGET_PAIRS = \
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
indepsw.adb<indepsw-gnu.adb
@@ -2019,7 +1990,7 @@ ifeq ($(strip $(filter-out sh4% linux%,$(arch) $(osys))),)
TOOLS_TARGET_PAIRS = \
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
indepsw.adb<indepsw-linux.adb
-
+
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
EH_MECHANISM=-gcc
MISCLIB=
--
GitLab