[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
This commit is contained in:
parent
2042872573
commit
13a0b1e8dd
@ -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
|
||||
|
@ -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,
|
||||
|
@ -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.
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user