exp_ch4.adb (Expand_N_Allocator): Code cleanup.

2009-04-15  Javier Miranda  <miranda@adacore.com>

	* 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
This commit is contained in:
Javier Miranda 2009-04-15 09:10:11 +00:00 committed by Arnaud Charlet
parent 6891bd6c71
commit a523b302d0
5 changed files with 75 additions and 26 deletions

View File

@ -1,3 +1,20 @@
2009-04-15 Javier Miranda <miranda@adacore.com>
* 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 <quinot@adacore.com>
* sem_warn.ads: Minor reformatting

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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;