2011-08-29 Pascal Obry <obry@adacore.com>

	* exp_disp.adb: Minor comment fix.
	(Make_Disp_Asynchronous_Select_Body): Properly initialize out parameters
	to avoid warnings when compiling with -Wall.
	(Make_Disp_Conditional_Select_Body): Likewise.
	(Make_Disp_Timed_Select_Body): Likewise.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Formal_Subprogram_Declaration): If default is
	an entity name, generate reference for it.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Iterator_Loop): Uniform handling of "X of S"
	iterator form.
	* sem_util.adb (Is_Iterator, Is_Reversible_Iterator): Yield True for
	the class-wide type.
	* sem_ch5.adb: Move some rewriting to the expander, where it belongs.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Check_Constrained_Object): Do not create an actual
	subtype for an object whose type is an unconstrained union.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* par-ch3.adb (P_Array_Type_Definiation, P_Component_Items): "aliased"
	is allowed in a component definition, by AI95-406.

2011-08-29  Matthew Heaney  <heaney@adacore.com>

	* a-chtgbo.adb (Generic_Iteration): Use correct overloading of Next.

2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-except-2005.adb: Alphabetize all routines.
	(Triggered_By_Abort): New routine.
	* a-except-2005.ads (Triggered_By_Abort): New routine.
	* a-except.adb Alphabetize all routines.
	(Triggered_By_Abort): New routine.
	* a-except.ads (Triggered_By_Abort): New routine.
	* exp_ch7.adb: Update all comments involving the detection of aborts in
	finalization code.
	(Build_Object_Declarations): Do not generate code to detect the
	presence of an abort at the start of finalization code, use a runtime
	routine istead.
	* rtsfind.ads: Add RE_Triggered_By_Abort to tables RE_Id and
	RE_Unit_Table.
	* sem_res.adb (Resolve_Allocator): Emit a warning when attempting to
	allocate a task on a subpool.
	* s-stposu.adb: Add library-level flag Finalize_Address_Table_In_Use.
	The flag disables all actions related to the maintenance of
	Finalize_Address_Table when subpools are not in use.
	(Allocate_Any_Controlled): Signal the machinery that subpools are in
	use.
	(Deallocate_Any_Controlled): Do not call Delete_Finalize_Address which
	performs costly task locking when subpools are not in use.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178236 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 58 insertions, 35 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 2b40b63baf3..e855da24ef4 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7175,7 +7175,19 @@ package body Sem_Util is
       Iface       : Entity_Id;
 
    begin
-      if not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then
+      if Is_Class_Wide_Type (Typ)
+        and then
+          (Chars (Etype (Typ)) = Name_Forward_Iterator
+            or else Chars (Etype (Typ)) = Name_Reversible_Iterator)
+        and then
+          Is_Predefined_File_Name
+            (Unit_File_Name (Get_Source_Unit (Etype (Typ))))
+      then
+         return True;
+
+      elsif not Is_Tagged_Type (Typ)
+        or else not Is_Derived_Type (Typ)
+      then
          return False;
 
       else
@@ -7198,6 +7210,51 @@ package body Sem_Util is
          return False;
       end if;
    end Is_Iterator;
+
+   ----------------------------
+   -- Is_Reversible_Iterator --
+   ----------------------------
+
+   function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean is
+      Ifaces_List : Elist_Id;
+      Iface_Elmt  : Elmt_Id;
+      Iface       : Entity_Id;
+
+   begin
+      if Is_Class_Wide_Type (Typ)
+        and then  Chars (Etype (Typ)) = Name_Reversible_Iterator
+        and then
+          Is_Predefined_File_Name
+            (Unit_File_Name (Get_Source_Unit (Etype (Typ))))
+      then
+         return True;
+
+      elsif not Is_Tagged_Type (Typ)
+        or else not Is_Derived_Type (Typ)
+      then
+         return False;
+      else
+
+         Collect_Interfaces (Typ, Ifaces_List);
+
+         Iface_Elmt := First_Elmt (Ifaces_List);
+         while Present (Iface_Elmt) loop
+            Iface := Node (Iface_Elmt);
+            if Chars (Iface) = Name_Reversible_Iterator
+              and then
+                Is_Predefined_File_Name
+                  (Unit_File_Name (Get_Source_Unit (Iface)))
+            then
+               return True;
+            end if;
+
+            Next_Elmt (Iface_Elmt);
+         end loop;
+
+      end if;
+      return False;
+   end Is_Reversible_Iterator;
+
    ------------
    -- Is_LHS --
    ------------
@@ -7841,40 +7898,6 @@ package body Sem_Util is
       return False;
    end Is_Renamed_Entry;
 
-   ----------------------------
-   -- Is_Reversible_Iterator --
-   ----------------------------
-
-   function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean is
-      Ifaces_List : Elist_Id;
-      Iface_Elmt  : Elmt_Id;
-      Iface       : Entity_Id;
-
-   begin
-      if not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then
-         return False;
-
-      else
-         Collect_Interfaces (Typ, Ifaces_List);
-
-         Iface_Elmt := First_Elmt (Ifaces_List);
-         while Present (Iface_Elmt) loop
-            Iface := Node (Iface_Elmt);
-            if Chars (Iface) = Name_Reversible_Iterator
-              and then
-                Is_Predefined_File_Name
-                  (Unit_File_Name (Get_Source_Unit (Iface)))
-            then
-               return True;
-            end if;
-
-            Next_Elmt (Iface_Elmt);
-         end loop;
-      end if;
-
-      return False;
-   end Is_Reversible_Iterator;
-
    ----------------------
    -- Is_Selector_Name --
    ----------------------