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:
parent
6891bd6c71
commit
a523b302d0
@ -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
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user