From: Ed Schonberg Date: Thu, 22 Dec 2011 08:54:26 +0000 (+0000) Subject: a-cohase.ads, [...]: Update to latest RM version. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3b59004a6dccaa88c178edde7e497debe098ef6e;p=gcc.git a-cohase.ads, [...]: Update to latest RM version. 2011-12-22 Ed Schonberg * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5780f4c6db8..f50b44ed257 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2011-12-22 Ed Schonberg + + * 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 + + * 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 * sem_dim.adb: Addressed all ??? comments. Replacement of warnings by diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index ebfaf27d2ff..51e8c0c2424 100644 --- a/gcc/ada/a-cihama.adb +++ b/gcc/ada/a-cihama.adb @@ -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 -- ------------- diff --git a/gcc/ada/a-cihama.ads b/gcc/ada/a-cihama.ads index 3b639f4cff7..567fe4ed6f6 100644 --- a/gcc/ada/a-cihama.ads +++ b/gcc/ada/a-cihama.ads @@ -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; diff --git a/gcc/ada/a-cohase.adb b/gcc/ada/a-cohase.adb index fadff195ff5..cf3354270d7 100644 --- a/gcc/ada/a-cohase.adb +++ b/gcc/ada/a-cohase.adb @@ -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; diff --git a/gcc/ada/a-cohase.ads b/gcc/ada/a-cohase.ads index 96944cd2b2f..b31001c90f3 100644 --- a/gcc/ada/a-cohase.ads +++ b/gcc/ada/a-cohase.ads @@ -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; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index ef0e70b59b7..14d9da1609a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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,