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

	* prj-proc.adb, make.adb, makeutl.adb: Minor reformatting.

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

	* exp_ch5.adb (Expand_Iterator_Loop): Code cleanup and reorganization.
	Set the associated loop as the related expression of internally
	generated cursors.
	* exp_ch7.adb (Is_Container_Cursor): New routine.
	(Wrap_Transient_Declaration): Supress the finalization of the list
	controller when the declaration denotes a container cursor.

2011-08-02  Yannick Moy  <moy@adacore.com>

	* opt.ads (SPARK_Mode): update comment, SPARK_Mode only set through
	command line now.
	* par-ch3.adb (P_Delta_Constraint): remove check in SPARK mode that the
	expression is a simple expression. This check cannot be performed in
	the semantics, so just drop it.
	(P_Index_Or_Discriminant_Constraint): move check that the index or
	discriminant is a subtype mark to Analyze_Subtype_Declaration in the
	semantics. Other cases were previously checked in the semantics.
	* par-ch4.adb (P_Name): move checks that a selector name is not
	character literal or an operator symbol to Find_Selected_Component in
	the semantics
	* par-ch5.adb (Parse_Decls_Begin_End): move check that basic
	declarations are not placed after later declarations in a separate
	procedure in Sem_Util (possibly not the best choice?), to be used both
	during parsing, for Ada 83 mode, and during semantic analysis, for
	SPARK mode.
	* par-endh.adb (Check_End): move check that end label is not missing
	to Process_End_Label in the semantics
	* par-prag.adb (Process_Restrictions_Or_Restriction_Warnings): remove
	the special case for SPARK restriction
	* par.adb: use and with Sem_Util, for use in Parse_Decls_Begin_End
	* restrict.adb, restrict.ads (Check_Formal_Restriction): add a
	parameter Force to issue the error message even on internal node (used
	for generated end label). Call Check_Restriction to check when an error
	must be issued. In SPARK mode, issue an error message even if the
	restriction is not set.
	(Check_Restriction): new procedure with an additional out parameter to
	inform the caller that a message has been issued
	* sem_aggr.adb: Minor modification of message
	* sem_attr.adb (Analyze_Attribute): call Check_Formal_Restriction
	instead of issuing an error message directly
	* sem_ch3.adb (Analyze_Declarations): move here the check that basic
	declarations are not placed after later declarations, by calling
	Check_Later_Vs_Basic_Declarations
	(Analyze_Subtype_Declaration): move here the check that an index or
	discriminant constraint must be a subtype mark. Change the check that
	a subtype of String must start at one so that it works on subtype marks.
	* sem_ch4.adb (Analyze_Call): move here the check that a named
	association cannot follow a positional one in a call
	* sem_ch5.adb (Check_Unreachable_Code): call Check_Formal_Restriction
	instead of issuing an error message directly
	* sem_ch8.adb (Find_Selected_Component): move here the check that a
	selector name is not a character literal or an operator symbol. Move
	here the check that the prefix of an expanded name cannot be a
	subprogram or a loop statement.
	* sem_util.adb, sem_util.ads (Check_Later_Vs_Basic_Declarations): new
	procedure called from parsing and semantics to check that basic
	declarations are not placed after later declarations
	(Process_End_Label): move here the check that end label is not missing

2011-08-02  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch13.adb (Analyze_Enumeration_Representation_Clause): Ignore enum
	representation clause in codepeer mode, since it confuses CodePeer and
	does not bring useful info.

2011-08-02  Ed Falis  <falis@adacore.com>

	* init.c: initialize fp hw on MILS.

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

	* errout.adb (First_Node): for bodies, return the node itself (small
	optimization). For other nodes, do not check source_unit if the node
	comes from Standard.



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

1 files changed, 59 insertions, 51 deletions

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 854b1a0ca89..de277662978 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2859,13 +2859,10 @@ package body Exp_Ch5 is
          --  with the obvious replacements if "reverse" is specified.
 
          declare
-            Element_Type  : constant Entity_Id := Etype (Id);
-            Pack          : constant Entity_Id := Scope (Base_Type (Typ));
-            Name_Init     : Name_Id;
-            Name_Step     : Name_Id;
-            Cond          : Node_Id;
-            Cursor_Decl   : Node_Id;
-            Renaming_Decl : Node_Id;
+            Element_Type : constant Entity_Id := Etype (Id);
+            Pack         : constant Entity_Id := Scope (Base_Type (Typ));
+            Name_Init    : Name_Id;
+            Name_Step    : Name_Id;
 
          begin
             Stats := Statements (N);
@@ -2876,52 +2873,24 @@ package body Exp_Ch5 is
                Cursor := Id;
             end if;
 
-            if Reverse_Present (I_Spec) then
-
-               --  Must verify that the container has a reverse iterator ???
+            --  Must verify that the container has a reverse iterator ???
 
+            if Reverse_Present (I_Spec) then
                Name_Init := Name_Last;
                Name_Step := Name_Previous;
-
             else
                Name_Init := Name_First;
                Name_Step := Name_Next;
             end if;
 
-            --  C : Cursor_Type := Container.First;
-
-            Cursor_Decl :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Cursor,
-                Object_Definition   =>
-                  Make_Selected_Component (Loc,
-                    Prefix        => New_Occurrence_Of (Pack, Loc),
-                    Selector_Name => Make_Identifier (Loc, Name_Cursor)),
-                Expression =>
-                  Make_Selected_Component (Loc,
-                    Prefix        => Relocate_Node (Container),
-                    Selector_Name => Make_Identifier (Loc, Name_Init)));
-
-            Insert_Action (N, Cursor_Decl);
-
-            --  while C /= No_Element loop
-
-            Cond := Make_Op_Ne (Loc,
-                      Left_Opnd  => New_Occurrence_Of (Cursor, Loc),
-                      Right_Opnd => Make_Selected_Component (Loc,
-                         Prefix        => New_Occurrence_Of (Pack, Loc),
-                         Selector_Name =>
-                           Make_Identifier (Loc, Name_No_Element)));
+            --  The code below only handles containers where Element is not a
+            --  primitive operation of the container. This excludes for now the
+            --  Hi-Lite formal containers. Generate:
+            --
+            --    Id : Element_Type renames Container.Element (Cursor);
 
             if Of_Present (I_Spec) then
-
-               --  Id : Element_Type renames Container.Element (Cursor);
-
-               --  The code below only handles containers where Element is not
-               --  a primitive operation of the container. This excludes
-               --  for now the Hi-Lite formal containers.
-
-               Renaming_Decl :=
+               Prepend_To (Stats,
                  Make_Object_Renaming_Declaration (Loc,
                    Defining_Identifier => Id,
                    Subtype_Mark        =>
@@ -2934,9 +2903,7 @@ package body Exp_Ch5 is
                            Selector_Name =>
                              Make_Identifier (Loc, Chars => Name_Element)),
                        Expressions =>
-                         New_List (New_Occurrence_Of (Cursor, Loc))));
-
-               Prepend (Renaming_Decl, Stats);
+                         New_List (New_Occurrence_Of (Cursor, Loc)))));
             end if;
 
             --  For both iterator forms, add call to step operation (Next or
@@ -2951,11 +2918,52 @@ package body Exp_Ch5 is
                 Parameter_Associations =>
                   New_List (New_Occurrence_Of (Cursor, Loc))));
 
-            New_Loop := Make_Loop_Statement (Loc,
-              Iteration_Scheme =>
-                Make_Iteration_Scheme (Loc, Condition => Cond),
-              Statements       => Stats,
-              End_Label        => Empty);
+            --  Generate:
+            --    while Cursor /= No_Element loop
+            --       <Stats>
+            --    end loop;
+
+            New_Loop :=
+              Make_Loop_Statement (Loc,
+                Iteration_Scheme =>
+                  Make_Iteration_Scheme (Loc,
+                    Condition =>
+                      Make_Op_Ne (Loc,
+                        Left_Opnd =>
+                          New_Occurrence_Of (Cursor, Loc),
+                        Right_Opnd =>
+                          Make_Selected_Component (Loc,
+                            Prefix =>
+                              New_Occurrence_Of (Pack, Loc),
+                            Selector_Name =>
+                              Make_Identifier (Loc, Name_No_Element)))),
+                Statements => Stats,
+                End_Label  => Empty);
+
+            --  When the cursor is internally generated, associate it with the
+            --  loop statement.
+
+            if Of_Present (I_Spec) then
+               Set_Ekind (Cursor, E_Variable);
+               Set_Related_Expression (Cursor, New_Loop);
+            end if;
+
+            --  Create the declaration of the cursor and insert it before the
+            --  source loop. Generate:
+            --
+            --    C : Cursor_Type := Container.First;
+
+            Insert_Action (N,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Cursor,
+                Object_Definition   =>
+                  Make_Selected_Component (Loc,
+                    Prefix        => New_Occurrence_Of (Pack, Loc),
+                    Selector_Name => Make_Identifier (Loc, Name_Cursor)),
+                Expression =>
+                  Make_Selected_Component (Loc,
+                    Prefix        => Relocate_Node (Container),
+                    Selector_Name => Make_Identifier (Loc, Name_Init))));
 
             --  If the range of iteration is given by a function call that
             --  returns a container, the finalization actions have been saved