Commit 13a0b1e8 by Arnaud Charlet

[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
parent 20428725
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> 2011-09-05 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Replace_Type): If the target of the assignment is * exp_aggr.adb (Replace_Type): If the target of the assignment is
......
...@@ -1006,9 +1006,8 @@ package body Exp_Intr is ...@@ -1006,9 +1006,8 @@ package body Exp_Intr is
Nam2 : Node_Id; Nam2 : Node_Id;
begin begin
-- An Abort followed by a Free will not do what the user -- An Abort followed by a Free will not do what the user expects,
-- expects, because the abort is not immediate. This is -- because the abort is not immediate. This is worth a warning.
-- worth a friendly warning.
while Present (Stat) while Present (Stat)
and then not Comes_From_Source (Original_Node (Stat)) and then not Comes_From_Source (Original_Node (Stat))
...@@ -1101,9 +1100,9 @@ package body Exp_Intr is ...@@ -1101,9 +1100,9 @@ package body Exp_Intr is
if Present (Procedure_To_Call (Free_Node)) then if Present (Procedure_To_Call (Free_Node)) then
-- For all cases of a Deallocate call, the back-end needs to be -- For all cases of a Deallocate call, the back-end needs to be able
-- able to compute the size of the object being freed. This may -- to compute the size of the object being freed. This may require
-- require some adjustments for objects of dynamic size. -- some adjustments for objects of dynamic size.
-- --
-- If the type is class wide, we generate an implicit type with the -- If the type is class wide, we generate an implicit type with the
-- right dynamic size, so that the deallocate call gets the right -- right dynamic size, so that the deallocate call gets the right
...@@ -1175,8 +1174,8 @@ package body Exp_Intr is ...@@ -1175,8 +1174,8 @@ package body Exp_Intr is
Set_Expression (Free_Node, Free_Arg); Set_Expression (Free_Node, Free_Arg);
end if; end if;
-- Only remaining step is to set result to null, or generate a -- Only remaining step is to set result to null, or generate a raise of
-- raise of constraint error if the target object is "not null". -- Constraint_Error if the target object is "not null".
if Can_Never_Be_Null (Etype (Arg)) then if Can_Never_Be_Null (Etype (Arg)) then
Append_To (Stmts, Append_To (Stmts,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -682,9 +682,7 @@ package body System.Tasking.Initialization is ...@@ -682,9 +682,7 @@ package body System.Tasking.Initialization is
-- between the expander and the run time, we may end up with -- between the expander and the run time, we may end up with
-- Self_ID.Deferral_Level being equal to zero, when called from -- Self_ID.Deferral_Level being equal to zero, when called from
-- the procedure created by the expander that corresponds to a -- the procedure created by the expander that corresponds to a
-- task body. -- task body. In this case, there's nothing to be done.
-- In this case, there's nothing to be done
-- See related code in System.Tasking.Stages.Create_Task resetting -- See related code in System.Tasking.Stages.Create_Task resetting
-- Deferral_Level when System.Restrictions.Abort_Allowed is False. -- Deferral_Level when System.Restrictions.Abort_Allowed is False.
......
...@@ -772,10 +772,16 @@ package body Sem_Ch3 is ...@@ -772,10 +772,16 @@ package body Sem_Ch3 is
Anon_Scope := Scope (Defining_Entity (Related_Nod)); Anon_Scope := Scope (Defining_Entity (Related_Nod));
end if; end if;
else -- For an access type definition, if the current scope is a child
-- For access formals, access components, and access discriminants, -- unit it is the scope of the type.
-- the scope is that of the enclosing declaration,
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); Anon_Scope := Scope (Current_Scope);
end if; end if;
......
...@@ -298,12 +298,6 @@ package body Sem_Ch6 is ...@@ -298,12 +298,6 @@ package body Sem_Ch6 is
Make_Simple_Return_Statement (LocX, Make_Simple_Return_Statement (LocX,
Expression => Expression (N))))); 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) if Present (Prev)
and then Ekind (Prev) = E_Generic_Function and then Ekind (Prev) = E_Generic_Function
then then
...@@ -2719,9 +2713,11 @@ package body Sem_Ch6 is ...@@ -2719,9 +2713,11 @@ package body Sem_Ch6 is
-- family index (if applicable). This form of early expansion is done -- family index (if applicable). This form of early expansion is done
-- when the Expander is active because Install_Private_Data_Declarations -- when the Expander is active because Install_Private_Data_Declarations
-- references entities which were created during regular expansion. -- 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 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 (Prot_Typ)
and then Present (Spec_Id) and then Present (Spec_Id)
and then not Is_Eliminated (Spec_Id) and then not Is_Eliminated (Spec_Id)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment