+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
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 --
-------------
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;
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 --
---------------
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 --
-------------
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 --
----------------
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;
-- 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;
type Set is tagged private
with
+ constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
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.
-- 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;
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;
(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,
projects / gcc.git / commitdiff