+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
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
-- 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
-- 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;
procedure Check_Anonymous_Return is
Decl : Node_Id;
+ Par : Node_Id;
Scop : Entity_Id;
begin
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 :=
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;
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;
projects / gcc.git / commitdiff