a-cohase.ads, [...]: Update to latest RM version.

2011-12-22  Ed Schonberg  <schonberg@adacore.com>

	* a-cohase.ads, a-cohase.adb: Update to latest RM version. Add
	aspect Constant_Reference to set type, and corresponding
	functions.
	* a-cihama.ads, a-cihama.adb: Update to latest RM version. Add
	function Reference to provide a proper element iterator construct
	over indefinite maps.

2011-12-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_attr.adb (Expand_N_Attribute, case 'Access): Do not insert
	implicit conversion on prefix of Unrestricted_Access when prefix
	is an explicit dereference.

From-SVN: r182617
This commit is contained in:
Ed Schonberg 2011-12-22 08:54:26 +00:00 committed by Arnaud Charlet
parent 9a7e930fb2
commit 3b59004a6d
6 changed files with 125 additions and 7 deletions

View File

@ -1,3 +1,18 @@
2011-12-22 Ed Schonberg <schonberg@adacore.com>
* a-cohase.ads, a-cohase.adb: Update to latest RM version. Add
aspect Constant_Reference to set type, and corresponding
functions.
* a-cihama.ads, a-cihama.adb: Update to latest RM version. Add
function Reference to provide a proper element iterator construct
over indefinite maps.
2011-12-22 Ed Schonberg <schonberg@adacore.com>
* exp_attr.adb (Expand_N_Attribute, case 'Access): Do not insert
implicit conversion on prefix of Unrestricted_Access when prefix
is an explicit dereference.
2011-12-22 Vincent Pucci <pucci@adacore.com>
* sem_dim.adb: Addressed all ??? comments. Replacement of warnings by

View File

@ -973,6 +973,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
Container.Find (Key).Node.Element.all'Unrestricted_Access);
end Reference;
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Element (Position)'Unrestricted_Access);
end Reference;
-------------
-- Replace --
-------------

View File

@ -293,8 +293,13 @@ package Ada.Containers.Indefinite_Hashed_Maps is
Key : Key_Type) -- SHOULD BE ALIASED ???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type)
return 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;

View File

@ -1100,6 +1100,14 @@ package body Ada.Containers.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 --
---------------
@ -1118,6 +1126,19 @@ 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 --
-------------
@ -1655,6 +1676,14 @@ package body Ada.Containers.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 --
----------------
@ -1923,6 +1952,27 @@ package body Ada.Containers.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'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
return (Element => Position.Node.Element'Unrestricted_Access);
end Reference_Preserving_Key;
end Generic_Keys;
end Ada.Containers.Hashed_Sets;

View File

@ -31,10 +31,10 @@
-- 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;
with Ada.Iterator_Interfaces;
generic
type Element_Type is private;
@ -52,6 +52,7 @@ package Ada.Containers.Hashed_Sets is
type Set is tagged private
with
constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@ -148,6 +149,14 @@ package Ada.Containers.Hashed_Sets is
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;
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
-- buckets array and nodes from Source to Target.
@ -403,13 +412,27 @@ package Ada.Containers.Hashed_Sets is
-- Equivalent_Keys to compare the saved key-value to the value returned
-- by applying generic formal operation Key to the post-Process value of
-- element. If the key values compare equal then the operation
-- completes. Otherwise, the node is removed from the map and
-- completes. Otherwise, the node is removed from the set 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
pragma Inline (Next);
type Node_Type;
@ -469,6 +492,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.Hashed_Sets;

View File

@ -971,11 +971,12 @@ package body Exp_Attr is
(Etype (Prefix (Ref_Object))));
begin
-- No implicit conversion required if designated types
-- match.
-- match, or if we have an unrestricted access.
if Obj_DDT /= Btyp_DDT
and then Id /= Attribute_Unrestricted_Access
and then not (Is_Class_Wide_Type (Obj_DDT)
and then Etype (Obj_DDT) = Btyp_DDT)
and then Etype (Obj_DDT) = Btyp_DDT)
then
Rewrite (N,
Convert_To (Typ,