exp_ch9.adb (Build_Protected_Entry): Propagate the original source location to allow the correct generation of...

2007-08-14  Javier Miranda  <miranda@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch9.adb (Build_Protected_Entry): Propagate the original source
	location to allow the correct generation of errors in case of
	restrictions applied to the expanded code.
	(Expand_Entry_Barrier): Remove all generated renamings for a barrier
	function if the condition does not reference them.
	(Expand_Entry_Body_Declarations): Mark the index constant as having a
	valid value.

From-SVN: r127448

1 files changed, 43 insertions, 15 deletions

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 79286d55..764d643 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -1002,7 +1002,7 @@ package body Exp_Ch9 is
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc,
               Statements => New_List (
-                Make_Return_Statement (Loc,
+                Make_Simple_Return_Statement (Loc,
                   Expression => Condition (Ent_Formals)))));
       Set_Is_Entry_Barrier_Function (EBF);
       return EBF;
@@ -1370,7 +1370,7 @@ package body Exp_Ch9 is
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements =>
                    New_List (
-                     Make_Return_Statement (Loc,
+                     Make_Simple_Return_Statement (Loc,
                         Make_Function_Call (Loc,
                           Name =>
                             Make_Selected_Component (Loc,
@@ -1787,7 +1787,7 @@ package body Exp_Ch9 is
          Cond  : Node_Id;
          Stats : constant List_Id :=
                    New_List (
-                     Make_Return_Statement (Loc,
+                     Make_Simple_Return_Statement (Loc,
                        Expression => Make_Integer_Literal (Loc, Index + 1)));
 
       begin
@@ -1879,7 +1879,7 @@ package body Exp_Ch9 is
          --  correspondence between entry queue and entry body.
 
          Ret :=
-           Make_Return_Statement (Loc,
+           Make_Simple_Return_Statement (Loc,
              Expression => Make_Identifier (Loc, Name_uE));
 
       else
@@ -1915,7 +1915,7 @@ package body Exp_Ch9 is
          if Index = 1 then
             Decls := New_List;
             Ret :=
-              Make_Return_Statement (Loc,
+              Make_Simple_Return_Statement (Loc,
                 Expression => Make_Integer_Literal (Loc, 1));
 
          elsif Nkind (Ret) = N_If_Statement then
@@ -2083,8 +2083,13 @@ package body Exp_Ch9 is
 
       if Debug_Generated_Code then
          Han_Loc := End_Loc;
+
+      --  Otherwise we propagate the original source location to allow the
+      --  correct generation of errors in case of restrictions applied to
+      --  the expanded code.
+
       else
-         Han_Loc := No_Location;
+         Han_Loc := Sloc (N);
       end if;
 
       Edef :=
@@ -2521,11 +2526,11 @@ package body Exp_Ch9 is
                     Name => Make_Identifier (Loc,
                       Chars (Defining_Unit_Name (N_Op_Spec))),
                     Parameter_Associations => Uactuals));
-            Return_Stmt := Make_Return_Statement (Loc,
+            Return_Stmt := Make_Simple_Return_Statement (Loc,
               Expression => New_Reference_To (R, Loc));
 
          else
-            Unprot_Call := Make_Return_Statement (Loc,
+            Unprot_Call := Make_Simple_Return_Statement (Loc,
               Expression => Make_Function_Call (Loc,
                 Name =>
                   Make_Identifier (Loc,
@@ -4352,6 +4357,18 @@ package body Exp_Ch9 is
       --  scope.
 
       if Is_Entity_Name (Cond) then
+
+         --  A small optimization of useless renamings. If the scope of the
+         --  entity of the condition is not the barrier function, then the
+         --  condition does not reference any of the generated renamings
+         --  within the function.
+
+         if Expander_Active
+           and then Scope (Entity (Cond)) /= Func
+         then
+            Set_Declarations (B_F, Empty_List);
+         end if;
+
          if Entity (Cond) = Standard_False
               or else
             Entity (Cond) = Standard_True
@@ -4402,9 +4419,20 @@ package body Exp_Ch9 is
            Entry_Index_Specification (Entry_Body_Formal_Part (N));
 
          if Present (Index_Spec) then
-            Set_Entry_Index_Constant (
-              Defining_Identifier (Index_Spec),
-              Make_Defining_Identifier (Loc, New_Internal_Name ('J')));
+            declare
+               Index_Con : constant Entity_Id :=
+                             Make_Defining_Identifier (Loc,
+                               Chars => New_Internal_Name ('J'));
+            begin
+               --  Mark the index constant as having a valid value since it
+               --  will act as a renaming of the original entry index which
+               --  is known to be valid.
+
+               Set_Is_Known_Valid (Index_Con);
+
+               Set_Entry_Index_Constant
+                 (Defining_Identifier (Index_Spec), Index_Con);
+            end;
          end if;
       end if;
    end Expand_Entry_Body_Declarations;
@@ -6724,7 +6752,7 @@ package body Exp_Ch9 is
 
             Stmts :=
               New_List (
-                Make_Return_Statement (Loc,
+                Make_Simple_Return_Statement (Loc,
                   Expression =>
                     Make_Function_Call (Loc,
                       Name =>
@@ -7911,7 +7939,7 @@ package body Exp_Ch9 is
 
          --  Build the return statement to skip the rest of the entry body
 
-         Skip_Stat := Make_Return_Statement (Loc);
+         Skip_Stat := Make_Simple_Return_Statement (Loc);
 
       else
          --  If the requeue is within a task, find the end label of the
@@ -8474,7 +8502,7 @@ package body Exp_Ch9 is
             Add_Accept (Alt);
 
          elsif Nkind (Alt) = N_Delay_Alternative then
-            Delay_Count   := Delay_Count + 1;
+            Delay_Count := Delay_Count + 1;
 
             --  If the delays are relative delays, the delay expressions have
             --  type Standard_Duration. Otherwise they must have some time type
@@ -8491,7 +8519,7 @@ package body Exp_Ch9 is
                   null;
                else
                   Error_Msg_NE (
-                    "& is not a time type ('R'M 9.6(6))",
+                    "& is not a time type (RM 9.6(6))",
                        Expression (Delay_Statement (Alt)), Time_Type);
                   Time_Type := Standard_Duration;
                   Set_Etype (Expression (Delay_Statement (Alt)), Any_Type);