[multiple changes]

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_Loop_Entry_Attribute): Clarify the
	extraction of the declarative part of the conditional block. Move
	the processing of simple infinite loops to the start of the
	expansion logic. Correct the check which determines whether the
	proper scope is installed in visibility.
	* sem_attr.adb (Analyze_Attribute): Add local variable Attr
	to keep track of the attribute in case the enclosing indexed
	component has to be rewritten. When searching for the enclosing
	loop, start from the proper attribute reference in case of a
	rewriting. Do not allow for 'Loop_Entry to appear in pragma
	Assert. Replace loop variable J with Index. Set the type of the
	proper attribute.
	* sem_ch5.adb (Check_Unreachable_Code): Detect a specialized
	block that services a loop statement subject to at least one
	'Loop_Entry attribute.

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb (Disambiguate): In Ada 2012 mode, when trying to
	resolve a fixed point operation, use first subtype to determine
	whether type and operator are declared in the same list of
	declarations.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* par-ch6.adb (P_Subprogram): Detect an illegal
	placement of the aspect specification list in the context of
	expression functions.

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Allocator):  If the designated object
	has tasks, and the pointer type is an itype that has no master
	id, create a master renaming in the current context, which can
	only be an init_proc.

From-SVN: r198242

7 files changed, 132 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5cbe4b1..3a1a5f6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,41 @@
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_attr.adb (Expand_Loop_Entry_Attribute): Clarify the
+	extraction of the declarative part of the conditional block. Move
+	the processing of simple infinite loops to the start of the
+	expansion logic. Correct the check which determines whether the
+	proper scope is installed in visibility.
+	* sem_attr.adb (Analyze_Attribute): Add local variable Attr
+	to keep track of the attribute in case the enclosing indexed
+	component has to be rewritten. When searching for the enclosing
+	loop, start from the proper attribute reference in case of a
+	rewriting. Do not allow for 'Loop_Entry to appear in pragma
+	Assert. Replace loop variable J with Index. Set the type of the
+	proper attribute.
+	* sem_ch5.adb (Check_Unreachable_Code): Detect a specialized
+	block that services a loop statement subject to at least one
+	'Loop_Entry attribute.
+
+2013-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_type.adb (Disambiguate): In Ada 2012 mode, when trying to
+	resolve a fixed point operation, use first subtype to determine
+	whether type and operator are declared in the same list of
+	declarations.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* par-ch6.adb (P_Subprogram): Detect an illegal
+	placement of the aspect specification list in the context of
+	expression functions.
+
+2013-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Allocator):  If the designated object
+	has tasks, and the pointer type is an itype that has no master
+	id, create a master renaming in the current context, which can
+	only be an init_proc.
+
 2013-04-24  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch3.adb, sem_ch7.adb: Minor reformatting.
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index f904707..c009222 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -782,11 +782,23 @@ package body Exp_Attr is
       --  'Loop_Entry attribute. Retrieve the declarative list of the block.
 
       if Has_Loop_Entry_Attributes (Loop_Id) then
+
+         --  When the related loop name appears as the argument of attribute
+         --  Loop_Entry, the corresponding label construct is the generated
+         --  block statement. This happens because the expander reuses the
+         --  label.
+
          if Nkind (Loop_Stmt) = N_Block_Statement then
             Decls := Declarations (Loop_Stmt);
+
+         --  In all other cases, the loop must appear in the handled sequence
+         --  of statements of the generated block.
+
          else
-            --  What is going on here??? comments/assertions needed to explain
-            --  the assumption being made about the tree???
+            pragma Assert
+              (Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
+                 and then Nkind (Parent (Parent (Loop_Stmt))) =
+                            N_Block_Statement);
 
             Decls := Declarations (Parent (Parent (Loop_Stmt)));
          end if;
@@ -799,6 +811,27 @@ package body Exp_Attr is
          Set_Has_Loop_Entry_Attributes (Loop_Id);
          Scheme := Iteration_Scheme (Loop_Stmt);
 
+         --  Infinite loops are transformed into:
+
+         --    declare
+         --       Temp1 : constant <type of Pref1> := <Pref1>;
+         --       . . .
+         --       TempN : constant <type of PrefN> := <PrefN>;
+         --    begin
+         --       loop
+         --          <original source statements with attribute rewrites>
+         --       end loop;
+         --    end;
+
+         if No (Scheme) then
+            Build_Conditional_Block (Loc,
+              Cond      => Empty,
+              Loop_Stmt => Relocate_Node (Loop_Stmt),
+              If_Stmt   => Result,
+              Blk_Stmt  => Blk);
+
+            Result := Blk;
+
          --  While loops are transformed into:
 
          --    if <Condition> then
@@ -817,7 +850,7 @@ package body Exp_Attr is
          --  Note that loops over iterators and containers are already
          --  converted into while loops.
 
-         if Present (Condition (Scheme)) then
+         elsif Present (Condition (Scheme)) then
             declare
                Cond : constant Node_Id := Condition (Scheme);
 
@@ -947,27 +980,6 @@ package body Exp_Attr is
                  If_Stmt   => Result,
                  Blk_Stmt  => Blk);
             end;
-
-         --  Infinite loops are transformed into:
-
-         --    declare
-         --       Temp1 : constant <type of Pref1> := <Pref1>;
-         --       . . .
-         --       TempN : constant <type of PrefN> := <PrefN>;
-         --    begin
-         --       loop
-         --          <original source statements with attribute rewrites>
-         --       end loop;
-         --    end;
-
-         else
-            Build_Conditional_Block (Loc,
-              Cond      => Empty,
-              Loop_Stmt => Relocate_Node (Loop_Stmt),
-              If_Stmt   => Result,
-              Blk_Stmt  => Blk);
-
-            Result := Blk;
          end if;
 
          Decls := Declarations (Blk);
@@ -993,7 +1005,7 @@ package body Exp_Attr is
 
       Rewrite (Attr, New_Reference_To (Temp_Id, Loc));
 
-      Installed := Current_Scope = Loop_Id;
+      Installed := Current_Scope = Scope (Loop_Id);
 
       --  Depending on the pracement of attribute 'Loop_Entry relative to the
       --  associated loop, ensure the proper visibility for analysis.
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e1b6cf0..85a6496 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4577,9 +4577,19 @@ package body Exp_Ch4 is
                      --  access type did not get expanded. Salvage it now.
 
                      if not Restriction_Active (No_Task_Hierarchy) then
-                        pragma Assert (Present (Parent (Base_Type (PtrT))));
-                        Expand_N_Full_Type_Declaration
-                          (Parent (Base_Type (PtrT)));
+                        if Present (Parent (Base_Type (PtrT))) then
+                           Expand_N_Full_Type_Declaration
+                             (Parent (Base_Type (PtrT)));
+
+                        else
+                           --  If the type of the allocator is an itype,
+                           --  the master must exist in the context. This
+                           --  is the case when the allocator initializes
+                           --  an access component in an init-proc.
+
+                           pragma Assert (Is_Itype (PtrT));
+                           Build_Master_Renaming (PtrT, N);
+                        end if;
                      end if;
                   end if;
 
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 1e96cb2..7531f40 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -838,6 +838,22 @@ package body Ch6 is
                        ("\unit must be compiled with -gnat2012 switch!");
                   end if;
 
+                  --  Catch an illegal placement of the aspect specification
+                  --  list:
+
+                  --    function_specification
+                  --      [aspect_specification] is (expression);
+
+                  --  This case is correctly processed by the parser because
+                  --  the expression function first appears as a subprogram
+                  --  declaration to the parser.
+
+                  if Is_Non_Empty_List (Aspects) then
+                     Error_Msg
+                       ("aspect specifications must come after parenthesized "
+                        & "expression", Sloc (First (Aspects)));
+                  end if;
+
                   --  Parse out expression and build expression function
 
                   Body_Node :=
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index f3845f6..762015f 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3698,6 +3698,7 @@ package body Sem_Attr is
          --  Local variables
 
          Context           : constant Node_Id := Parent (N);
+         Attr              : Node_Id;
          Enclosing_Loop    : Node_Id;
          In_Loop_Assertion : Boolean   := False;
          Loop_Id           : Entity_Id := Empty;
@@ -3707,6 +3708,13 @@ package body Sem_Attr is
       --  Start of processing for Loop_Entry
 
       begin
+         Attr := N;
+
+         --  Set the type of the attribute now to ensure the successfull
+         --  continuation of analysis even if the attribute is misplaced.
+
+         Set_Etype (Attr, P_Type);
+
          --  Attribute 'Loop_Entry may appear in several flavors:
 
          --    * Prefix'Loop_Entry - in this form, the attribute applies to the
@@ -3775,6 +3783,8 @@ package body Sem_Attr is
                   Set_Expressions (N, Expressions (Context));
                   Rewrite   (Context, N);
                   Set_Etype (Context, P_Type);
+
+                  Attr := Context;
                end if;
             end if;
          end if;
@@ -3796,17 +3806,14 @@ package body Sem_Attr is
          --  Climb the parent chain to verify the location of the attribute and
          --  find the enclosing loop.
 
-         Stmt := N;
+         Stmt := Attr;
          while Present (Stmt) loop
 
-            --  Locate the enclosing Loop_Invariant / Loop_Variant pragma (if
-            --  any). Note that when these two are expanded, we must look for
-            --  an Assertion pragma.
+            --  Locate the enclosing Loop_Invariant / Loop_Variant pragma
 
             if Nkind (Original_Node (Stmt)) = N_Pragma
               and then
                 Nam_In (Pragma_Name (Original_Node (Stmt)),
-                        Name_Assert,
                         Name_Loop_Invariant,
                         Name_Loop_Variant)
             then
@@ -3852,8 +3859,8 @@ package body Sem_Attr is
          --  appear within a body of accept statement, if this construct is
          --  itself enclosed by the given loop statement.
 
-         for J in reverse 0 .. Scope_Stack.Last loop
-            Scop := Scope_Stack.Table (J).Entity;
+         for Index in reverse 0 .. Scope_Stack.Last loop
+            Scop := Scope_Stack.Table (Index).Entity;
 
             if Ekind (Scop) = E_Loop and then Scop = Loop_Id then
                exit;
@@ -3883,8 +3890,6 @@ package body Sem_Attr is
          then
             Error_Attr_P ("prefix of attribute % must denote an entity");
          end if;
-
-         Set_Etype (N, P_Type);
       end Loop_Entry;
 
       -------------
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index c2023cd..2e48721 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2958,7 +2958,16 @@ package body Sem_Ch5 is
                elsif Nkind (P) = N_Handled_Sequence_Of_Statements
                  and then Nkind (Parent (P)) = N_Block_Statement
                then
-                  null;
+                  --  The original loop is now placed inside a block statement
+                  --  due to the expansion of attribute 'Loop_Entry. Return as
+                  --  this is not a "real" block for the purposes of exit
+                  --  counting.
+
+                  if Nkind (N) = N_Loop_Statement
+                    and then Subject_To_Loop_Entry_Attributes (N)
+                  then
+                     return;
+                  end if;
 
                --  Statements in exception handler in a block
 
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index fa5c085..c6ad391 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2048,8 +2048,8 @@ package body Sem_Type is
       --  Ditto in Ada 2012, where an ambiguity may arise for an operation
       --  on a partial view that is completed with a fixed point type. See
       --  AI05-0020 and AI05-0209. The ambiguity is resolved in favor of the
-      --  user-defined subprogram so that a client of the package has the
-      --  same resulution as the body of the package.
+      --  user-defined type and subprogram, so that a client of the package
+      --  has the same resolution as the body of the package.
 
       else
          if (In_Open_Scopes (Scope (User_Subp))
@@ -2064,7 +2064,8 @@ package body Sem_Type is
                    (Ada_Version >= Ada_2012
                      and then
                        In_Same_Declaration_List
-                         (Typ, Unit_Declaration_Node (User_Subp))))
+                         (First_Subtype (Typ),
+                            Unit_Declaration_Node (User_Subp))))
             then
                if It2.Nam = Predef_Subp then
                   return It1;