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, 101 insertions, 69 deletions

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 21b14d725fc..29399d790f8 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -2920,12 +2921,21 @@ package body Exp_Ch5 is
 
          declare
             Element_Type : constant Entity_Id := Etype (Id);
+            Iter_Type    : Entity_Id;
             Pack         : Entity_Id;
             Decl         : Node_Id;
             Name_Init    : Name_Id;
             Name_Step    : Name_Id;
 
          begin
+
+            --  The type of the iterator is the return type of the Iterate
+            --  function used. For the "of" form this is the default iterator
+            --  for the type, otherwise it is the type of the explicit
+            --  function used in the loop.
+
+            Iter_Type := Etype (Name (I_Spec));
+
             if Is_Entity_Name (Container) then
                Pack := Scope (Etype (Container));
 
@@ -2934,14 +2944,43 @@ package body Exp_Ch5 is
             end if;
 
             --  The "of" case uses an internally generated cursor whose type
-            --  is found in the container package.
+            --  is found in the container package. The domain of iteration
+            --  is expanded into a call to the default Iterator function, but
+            --  this expansion does not take place in a quantifier expressions
+            --  that are analyzed with expansion disabled, and in that case the
+            --  type of the iterator must be obtained from the aspect.
 
             if Of_Present (I_Spec) then
-               Cursor := Make_Temporary (Loc, 'I');
-
                declare
+                  Default_Iter : constant Entity_Id :=
+                    Find_Aspect (Etype (Container), Aspect_Default_Iterator);
                   Ent : Entity_Id;
+
                begin
+                  Cursor := Make_Temporary (Loc, 'I');
+
+                  if Is_Iterator (Iter_Type) then
+                     null;
+
+                  else
+                     Iter_Type :=
+                        Etype
+                         (Find_Aspect
+                              (Etype (Container), Aspect_Default_Iterator));
+
+                     --  Rewrite domain of iteration as a call to the default
+                     --  iterator for the container type.
+
+                     Rewrite (Name (I_Spec),
+                       Make_Function_Call (Loc,
+                         Name => Default_Iter,
+                         Parameter_Associations =>
+                           New_List (Relocate_Node (Name (I_Spec)))));
+                     Analyze_And_Resolve (Name (I_Spec));
+                  end if;
+
+                  --  Find cursor type in container package.
+
                   Ent := First_Entity (Pack);
                   while Present (Ent) loop
                      if Chars (Ent) = Name_Cursor then
@@ -2950,60 +2989,61 @@ package body Exp_Ch5 is
                      end if;
                      Next_Entity (Ent);
                   end loop;
+
+                  --  Generate:
+                  --    Id : Element_Type renames Pack.Element (Cursor);
+
+                  Decl :=
+                    Make_Object_Renaming_Declaration (Loc,
+                      Defining_Identifier => Id,
+                         Subtype_Mark =>
+                        New_Reference_To (Element_Type, Loc),
+                      Name =>
+                        Make_Indexed_Component (Loc,
+                          Prefix => Make_Selected_Component (Loc,
+                              Prefix        => New_Reference_To (Pack, Loc),
+                              Selector_Name =>
+                                Make_Identifier (Loc, Chars => Name_Element)),
+                          Expressions =>
+                            New_List (New_Occurrence_Of (Cursor, Loc))));
+
+                  --  If the container holds controlled objects, wrap the loop
+                  --  statements and element renaming declaration with a block.
+                  --  This ensures that the result of Element (Iterator) is
+                  --  cleaned up after each iteration of the loop.
+
+                  if Needs_Finalization (Element_Type) then
+
+                     --  Generate:
+                     --    declare
+                     --       Id : Element_Type := Pack.Element (Iterator);
+                     --    begin
+                     --       <original loop statements>
+                     --    end;
+
+                     Stats := New_List (
+                       Make_Block_Statement (Loc,
+                         Declarations => New_List (Decl),
+                         Handled_Statement_Sequence =>
+                           Make_Handled_Sequence_Of_Statements (Loc,
+                              Statements => Stats)));
+
+                  --  Elements do not need finalization
+
+                  else
+                     Prepend_To (Stats, Decl);
+                  end if;
                end;
 
+            --  X in Iterate (S) : type of iterator is type of explicitly
+            --  given Iterate function.
+
             else
                Cursor := Id;
             end if;
 
             Iterator := Make_Temporary (Loc, 'I');
 
-            if Of_Present (I_Spec) then
-
-               --  Generate:
-               --    Id : Element_Type renames Pack.Element (Cursor);
-
-               Decl :=
-                 Make_Object_Renaming_Declaration (Loc,
-                   Defining_Identifier => Id,
-                   Subtype_Mark =>
-                     New_Reference_To (Element_Type, Loc),
-                   Name =>
-                     Make_Indexed_Component (Loc,
-                       Prefix =>
-                         Make_Selected_Component (Loc,
-                           Prefix =>
-                             New_Reference_To (Pack, Loc),
-                           Selector_Name =>
-                             Make_Identifier (Loc, Chars => Name_Element)),
-                       Expressions => New_List (
-                          New_Occurrence_Of (Cursor, Loc))));
-
-               --  When the container holds controlled objects, wrap the loop
-               --  statements and element renaming declaration with a block.
-               --  This ensures that the transient result of Element (Iterator)
-               --  is cleaned up after each iteration of the loop.
-
-               if Needs_Finalization (Element_Type) then
-
-                  --  Generate:
-                  --    declare
-                  --       Id : Element_Type := Pack.Element (Iterator);
-                  --    begin
-                  --       <original loop statements>
-                  --    end;
-
-                  Stats := New_List (
-                    Make_Block_Statement (Loc,
-                      Declarations => New_List (Decl),
-                      Handled_Statement_Sequence =>
-                        Make_Handled_Sequence_Of_Statements (Loc,
-                          Statements => Stats)));
-               else
-                  Prepend_To (Stats, Decl);
-               end if;
-            end if;
-
             --  Determine the advancement and initialization steps for the
             --  cursor.
 
@@ -3026,23 +3066,16 @@ package body Exp_Ch5 is
 
             declare
                Rhs : Node_Id;
+
             begin
-               if Of_Present (I_Spec) then
-                  Rhs :=
-                    Make_Function_Call (Loc,
-                      Name => Make_Identifier (Loc, Name_Step),
-                      Parameter_Associations =>
-                        New_List (New_Reference_To (Cursor, Loc)));
-               else
-                  Rhs :=
-                    Make_Function_Call (Loc,
-                      Name =>
-                        Make_Selected_Component (Loc,
-                          Prefix => New_Reference_To (Iterator, Loc),
-                          Selector_Name => Make_Identifier (Loc, Name_Step)),
-                      Parameter_Associations => New_List (
-                         New_Reference_To (Cursor, Loc)));
-               end if;
+               Rhs :=
+                 Make_Function_Call (Loc,
+                   Name =>
+                     Make_Selected_Component (Loc,
+                       Prefix => New_Reference_To (Iterator, Loc),
+                       Selector_Name => Make_Identifier (Loc, Name_Step)),
+                   Parameter_Associations => New_List (
+                      New_Reference_To (Cursor, Loc)));
 
                Append_To (Stats,
                  Make_Assignment_Statement (Loc,
@@ -3082,14 +3115,13 @@ package body Exp_Ch5 is
             declare
                Decl1 : Node_Id;
                Decl2 : Node_Id;
+
             begin
                Decl1 :=
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Iterator,
-                 Object_Definition =>
-                   New_Occurrence_Of (Etype (Name (I_Spec)), Loc),
-
-                 Expression => Relocate_Node (Name (I_Spec)));
+                   Object_Definition   => New_Occurrence_Of (Iter_Type, Loc),
+                   Expression          => Relocate_Node (Name (I_Spec)));
                Set_Assignment_OK (Decl1);
 
                Decl2 :=