[multiple changes]

2011-09-05  Thomas Quinot  <quinot@adacore.com>

	* exp_intr.adb, s-tasini.adb: Minor reformatting.

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Definition): If an access type declaration
	appears in a child unit, the scope of whatever anonymous type
	may be generated is the child unit itself.

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): Do not set
	Comes_From_Source on rewritten body.
	(Analyze_Subprogram_Body_Helper): Check that the original node for
	the body comes from source, when determining whether expansion
	of a protected operation is needed.

From-SVN: r178543

5 files changed, 39 insertions, 22 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fc96642..e77ffbb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2011-09-05  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_intr.adb, s-tasini.adb: Minor reformatting.
+
+2011-09-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Access_Definition): If an access type declaration
+	appears in a child unit, the scope of whatever anonymous type
+	may be generated is the child unit itself.
+
+2011-09-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Expression_Function): Do not set
+	Comes_From_Source on rewritten body.
+	(Analyze_Subprogram_Body_Helper): Check that the original node for
+	the body comes from source, when determining whether expansion
+	of a protected operation is needed.
+
 2011-09-05  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_aggr.adb (Replace_Type): If the target of the assignment is
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 2d47846..ce7c0dc 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -1006,9 +1006,8 @@ package body Exp_Intr is
             Nam2 : Node_Id;
 
          begin
-            --  An Abort followed by a Free will not do what the user
-            --  expects, because the abort is not immediate. This is
-            --  worth a friendly warning.
+            --  An Abort followed by a Free will not do what the user expects,
+            --  because the abort is not immediate. This is worth a warning.
 
             while Present (Stat)
               and then not Comes_From_Source (Original_Node (Stat))
@@ -1101,9 +1100,9 @@ package body Exp_Intr is
 
       if Present (Procedure_To_Call (Free_Node)) then
 
-         --  For all cases of a Deallocate call, the back-end needs to be
-         --  able to compute the size of the object being freed. This may
-         --  require some adjustments for objects of dynamic size.
+         --  For all cases of a Deallocate call, the back-end needs to be able
+         --  to compute the size of the object being freed. This may require
+         --  some adjustments for objects of dynamic size.
          --
          --  If the type is class wide, we generate an implicit type with the
          --  right dynamic size, so that the deallocate call gets the right
@@ -1175,8 +1174,8 @@ package body Exp_Intr is
          Set_Expression (Free_Node, Free_Arg);
       end if;
 
-      --  Only remaining step is to set result to null, or generate a
-      --  raise of constraint error if the target object is "not null".
+      --  Only remaining step is to set result to null, or generate a raise of
+      --  Constraint_Error if the target object is "not null".
 
       if Can_Never_Be_Null (Etype (Arg)) then
          Append_To (Stmts,
diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb
index cacd86c..7203c1c 100644
--- a/gcc/ada/s-tasini.adb
+++ b/gcc/ada/s-tasini.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -682,9 +682,7 @@ package body System.Tasking.Initialization is
          --  between the expander and the run time, we may end up with
          --  Self_ID.Deferral_Level being equal to zero, when called from
          --  the procedure created by the expander that corresponds to a
-         --  task body.
-
-         --  In this case, there's nothing to be done
+         --  task body. In this case, there's nothing to be done.
 
          --  See related code in System.Tasking.Stages.Create_Task resetting
          --  Deferral_Level when System.Restrictions.Abort_Allowed is False.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 8a36be7..ba3bbb7 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -772,10 +772,16 @@ package body Sem_Ch3 is
             Anon_Scope := Scope (Defining_Entity (Related_Nod));
          end if;
 
-      else
-         --  For access formals, access components, and access discriminants,
-         --  the scope is that of the enclosing declaration,
+         --  For an access type definition, if the current scope is a child
+         --  unit it is the scope of the type.
+
+      elsif Is_Compilation_Unit (Current_Scope) then
+         Anon_Scope := Current_Scope;
 
+      --  For access formals, access components, and access discriminants, the
+      --  scope is that of the enclosing declaration,
+
+      else
          Anon_Scope := Scope (Current_Scope);
       end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index b701bda..04a2889 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -298,12 +298,6 @@ package body Sem_Ch6 is
                 Make_Simple_Return_Statement (LocX,
                   Expression => Expression (N)))));
 
-      --  If the expression function comes from source, indicate that so does
-      --  its rewriting, so it is compatible with any subsequent expansion of
-      --  the subprogram body (e.g. when it is a protected operation).
-
-      Set_Comes_From_Source (New_Body, Comes_From_Source (N));
-
       if Present (Prev)
         and then Ekind (Prev) = E_Generic_Function
       then
@@ -2719,9 +2713,11 @@ package body Sem_Ch6 is
       --  family index (if applicable). This form of early expansion is done
       --  when the Expander is active because Install_Private_Data_Declarations
       --  references entities which were created during regular expansion.
+      --  The body may be the rewritting of an expression function, and we need
+      --  to verify that the original node is in the source.
 
       if Full_Expander_Active
-        and then Comes_From_Source (N)
+        and then Comes_From_Source (Original_Node (N))
         and then Present (Prot_Typ)
         and then Present (Spec_Id)
         and then not Is_Eliminated (Spec_Id)