From: Arnaud Charlet Date: Mon, 5 Sep 2011 13:58:39 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.7.0~3953 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=13a0b1e8dd2794b8c4a100b3e27c884657ec7245;p=thirdparty%2Fgcc.git [multiple changes] 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. From-SVN: r178543 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fc96642975c0..e77ffbbe8205 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 2d4784674746..ce7c0dcc979c 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 cacd86c4c229..7203c1ccec29 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 8a36be79a456..ba3bbb798b52 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 b701bda2cb4b..04a288924ca2 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)