From c78dc054bd4cc6e7ed2a78de4dbbb0f8fd622949 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 5 Sep 2011 13:58:39 +0000 Subject: [PATCH] 2011-09-05 Thomas Quinot * exp_intr.adb, s-tasini.adb: Minor reformatting. 2011-09-05 Ed Schonberg * 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 * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178543 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 18 ++++++++++++++++++ gcc/ada/exp_intr.adb | 15 +++++++-------- gcc/ada/s-tasini.adb | 6 ++---- gcc/ada/sem_ch3.adb | 12 +++++++++--- gcc/ada/sem_ch6.adb | 10 +++------- 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 + + * exp_intr.adb, s-tasini.adb: Minor reformatting. + +2011-09-05 Ed Schonberg + + * 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 + + * 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 * 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) -- 2.7.4