From: Javier Miranda Date: Wed, 15 Apr 2009 09:10:11 +0000 (+0000) Subject: exp_ch4.adb (Expand_N_Allocator): Code cleanup. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a523b302d07a67d993c1bf24dd979616749abe7d;p=gcc.git exp_ch4.adb (Expand_N_Allocator): Code cleanup. 2009-04-15 Javier Miranda * exp_ch4.adb (Expand_N_Allocator): Code cleanup. * sem_ch6.adb (Check_Anonymous_Return): Add missing support for functions returning anonymous access to class-wide limited types. Mark also the containing scope as a task master. * sem_ch8.adb (Restore_Scope_Stack): Add missing management for limited-withed packages. Required to restore their visibility after processing packages associated with implicit with-clauses. * exp_ch3.adb (Build_Class_Wide_Master): Avoid marking masters associated with return statements because this work is now done by Check_Anonymous_Return. (Build_Master): Code cleanup. From-SVN: r146089 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index de31fabf53a..5b405551915 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2009-04-15 Javier Miranda + + * exp_ch4.adb (Expand_N_Allocator): Code cleanup. + + * sem_ch6.adb (Check_Anonymous_Return): Add missing support for + functions returning anonymous access to class-wide limited types. Mark + also the containing scope as a task master. + + * sem_ch8.adb (Restore_Scope_Stack): Add missing management for + limited-withed packages. Required to restore their visibility after + processing packages associated with implicit with-clauses. + + * exp_ch3.adb (Build_Class_Wide_Master): Avoid marking masters + associated with return statements because this work is now done by + Check_Anonymous_Return. + (Build_Master): Code cleanup. + 2009-04-15 Thomas Quinot * sem_warn.ads: Minor reformatting diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 39ac9c95af3..7f30178432c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -814,22 +814,26 @@ package body Exp_Ch3 is Analyze (Decl); Set_Has_Master_Entity (Scope (T)); - -- Now mark the containing scope as a task master + -- Now mark the containing scope as a task master. Masters + -- associated with return statements are already marked at + -- this stage (see Analyze_Subprogram_Body). - Par := P; - while Nkind (Par) /= N_Compilation_Unit loop - Par := Parent (Par); + if Ekind (Current_Scope) /= E_Return_Statement then + Par := P; + while Nkind (Par) /= N_Compilation_Unit loop + Par := Parent (Par); -- If we fall off the top, we are at the outer level, and the -- environment task is our effective master, so nothing to mark. - if Nkind_In - (Par, N_Task_Body, N_Block_Statement, N_Subprogram_Body) - then - Set_Is_Task_Master (Par, True); - exit; - end if; - end loop; + if Nkind_In + (Par, N_Task_Body, N_Block_Statement, N_Subprogram_Body) + then + Set_Is_Task_Master (Par, True); + exit; + end if; + end loop; + end if; end if; -- Now define the renaming of the master_id @@ -3949,15 +3953,13 @@ package body Exp_Ch3 is -- Create a class-wide master because a Master_Id must be generated -- for access-to-limited-class-wide types whose root may be extended - -- with task components, and for access-to-limited-interfaces because - -- they can be used to reference tasks implementing such interface. + -- with task components. + + -- Note: This code covers access-to-limited-interfaces because they + -- can be used to reference tasks implementing them. elsif Is_Class_Wide_Type (Designated_Type (Def_Id)) - and then (Is_Limited_Type (Designated_Type (Def_Id)) - or else - (Is_Interface (Designated_Type (Def_Id)) - and then - Is_Limited_Interface (Designated_Type (Def_Id)))) + and then Is_Limited_Type (Designated_Type (Def_Id)) and then Tasking_Allowed -- Do not create a class-wide master for types whose convention is diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6b2794b4073..27bc6c6e7e0 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3609,11 +3609,7 @@ package body Exp_Ch4 is -- on the global final list which is singly-linked. -- Work needed for access discriminants in Ada 2005 ??? - if Ekind (PtrT) = E_Anonymous_Access_Type - and then - Nkind (Associated_Node_For_Itype (PtrT)) - not in N_Subprogram_Specification - then + if Ekind (PtrT) = E_Anonymous_Access_Type then Attach_Level := Uint_1; else Attach_Level := Uint_2; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 15e42f16b88..2663fabb698 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1426,6 +1426,7 @@ package body Sem_Ch6 is procedure Check_Anonymous_Return is Decl : Node_Id; + Par : Node_Id; Scop : Entity_Id; begin @@ -1437,7 +1438,12 @@ package body Sem_Ch6 is if Ekind (Scop) = E_Function and then Ekind (Etype (Scop)) = E_Anonymous_Access_Type - and then Has_Task (Designated_Type (Etype (Scop))) + and then not Is_Thunk (Scop) + and then (Has_Task (Designated_Type (Etype (Scop))) + or else + (Is_Class_Wide_Type (Designated_Type (Etype (Scop))) + and then + Is_Limited_Record (Designated_Type (Etype (Scop))))) and then Expander_Active then Decl := @@ -1459,6 +1465,25 @@ package body Sem_Ch6 is Set_Master_Id (Etype (Scop), Defining_Identifier (Decl)); Set_Has_Master_Entity (Scop); + + -- Now mark the containing scope as a task master + + Par := N; + while Nkind (Par) /= N_Compilation_Unit loop + Par := Parent (Par); + pragma Assert (Present (Par)); + + -- If we fall off the top, we are at the outer level, and + -- the environment task is our effective master, so nothing + -- to mark. + + if Nkind_In + (Par, N_Task_Body, N_Block_Statement, N_Subprogram_Body) + then + Set_Is_Task_Master (Par, True); + exit; + end if; + end loop; end if; end Check_Anonymous_Return; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index a912fef80b1..64f2081953f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6708,8 +6708,17 @@ package body Sem_Ch8 is E := First_Entity (S); while Present (E) loop if Is_Child_Unit (E) then - Set_Is_Immediately_Visible (E, - Is_Visible_Child_Unit (E) or else In_Open_Scopes (E)); + if not From_With_Type (E) then + Set_Is_Immediately_Visible (E, + Is_Visible_Child_Unit (E) or else In_Open_Scopes (E)); + else + pragma Assert + (Nkind (Parent (E)) = N_Defining_Program_Unit_Name + and then + Nkind (Parent (Parent (E))) = N_Package_Specification); + Set_Is_Immediately_Visible (E, + Limited_View_Installed (Parent (Parent (E)))); + end if; else Set_Is_Immediately_Visible (E, True); end if;