OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-11-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Initialization_Call): Reimplement the
	circuitry which extraacts the [underlying] full view of a
	private type to handle a case where the private type acts as a
	generic actual.
	* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Inherit the
	loop label form the original loop regardless of whether it came
	from source.
	* sem_attr.adb (Analyze_Attribute): When taking 'Access of an
	expression function with a generated body that has not been
	analyzed yet, analyze the body to freeze the expression.
	* sem_util.adb (Set_Public_Status_Of): New routine.
	(Transfer_Entities): Handle the case where a private type with
	an internally generated full view is being transfered and update
	its full view.

2014-11-20  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Check_Object): If a unit is in a multi-source
	file, its object file is never the same as any other unit.

2014-11-20  Bob Duff  <duff@adacore.com>

	* s-taskin.adb (Initialize_ATCB): Take into
	account the fact that the domain of the activator can be null
	if we're initializing a foreign task.

From-SVN: r217877
This commit is contained in:
Arnaud Charlet 2014-11-20 16:46:20 +01:00
parent 1e2d79e2b3
commit 8c691dc68e
7 changed files with 166 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2014-11-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Build_Initialization_Call): Reimplement the
circuitry which extraacts the [underlying] full view of a
private type to handle a case where the private type acts as a
generic actual.
* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Inherit the
loop label form the original loop regardless of whether it came
from source.
* sem_attr.adb (Analyze_Attribute): When taking 'Access of an
expression function with a generated body that has not been
analyzed yet, analyze the body to freeze the expression.
* sem_util.adb (Set_Public_Status_Of): New routine.
(Transfer_Entities): Handle the case where a private type with
an internally generated full view is being transfered and update
its full view.
2014-11-20 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Check_Object): If a unit is in a multi-source
file, its object file is never the same as any other unit.
2014-11-20 Bob Duff <duff@adacore.com>
* s-taskin.adb (Initialize_ATCB): Take into
account the fact that the domain of the activator can be null
if we're initializing a foreign task.
2014-11-20 Robert Dewar <dewar@adacore.com>
* sem_ch12.adb: Minor reformatting.

44
gcc/ada/exp_ch3.adb
View File

@ -1459,7 +1459,7 @@ package body Exp_Ch3 is
Discr : Entity_Id;
First_Arg : Node_Id;
Full_Init_Type : Entity_Id;
Full_Type : Entity_Id := Typ;
Full_Type : Entity_Id;
Init_Type : Entity_Id;
Proc : Entity_Id;
@ -1490,20 +1490,38 @@ package body Exp_Ch3 is
return Empty_List;
end if;
-- Go to full view or underlying full view if private type. In the case
-- of successive private derivations, this can require two steps.
Full_Type := Typ;
if Is_Private_Type (Full_Type)
and then Present (Full_View (Full_Type))
then
Full_Type := Full_View (Full_Type);
end if;
-- Use the [underlying] full view when dealing with a private type. This
-- may require several steps depending on derivations.
if Is_Private_Type (Full_Type)
and then Present (Underlying_Full_View (Full_Type))
then
Full_Type := Underlying_Full_View (Full_Type);
end if;
loop
if Is_Private_Type (Full_Type) then
if Present (Full_View (Full_Type)) then
Full_Type := Full_View (Full_Type);
elsif Present (Underlying_Full_View (Full_Type)) then
Full_Type := Underlying_Full_View (Full_Type);
-- When a private type acts as a generic actual and lacks a full
-- view, use the base type.
elsif Is_Generic_Actual_Type (Full_Type) then
Full_Type := Base_Type (Full_Type);
-- The loop has recovered the [underlying] full view, stop the
-- traversal.
else
exit;
end if;
-- The type is not private, nothing to do
else
exit;
end if;
end loop;
-- If Typ is derived, the procedure is the initialization procedure for
-- the root type. Wrap the argument in an conversion to make it type

10
gcc/ada/exp_ch5.adb
View File

@ -3766,14 +3766,10 @@ package body Exp_Ch5 is
end loop;
end if;
-- If original loop has a source name, preserve it so it can be
-- recognized by an exit statement in the body of the rewritten loop.
-- This only concerns source names: the generated name of an anonymous
-- loop will be create again during the subsequent analysis below.
-- Inherit the loop identifier from the original loop. This ensures that
-- the scope stack is consistent after the rewriting.
if Present (Identifier (N))
and then Comes_From_Source (Identifier (N))
then
if Present (Identifier (N)) then
Set_Identifier (Core_Loop, Relocate_Node (Identifier (N)));
end if;

18
gcc/ada/prj-nmsc.adb
View File

@ -2577,7 +2577,7 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Data.Flags,
"?no compiler specified for language %%" &
"?\no compiler specified for language %%" &
", ignoring all its sources",
No_Location, Project);
@ -2604,7 +2604,7 @@ package body Prj.Nmsc is
if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
Error_Msg
(Data.Flags,
"Spec_Suffix not specified for " &
"\Spec_Suffix not specified for " &
Get_Name_String (Lang_Index.Name),
No_Location, Project);
end if;
@ -2612,7 +2612,7 @@ package body Prj.Nmsc is
if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
Error_Msg
(Data.Flags,
"Body_Suffix not specified for " &
"\Body_Suffix not specified for " &
Get_Name_String (Lang_Index.Name),
No_Location, Project);
end if;
@ -2630,7 +2630,7 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Data.Flags,
"no suffixes specified for %%",
"\no suffixes specified for %%",
No_Location, Project);
end if;
end if;
@ -3770,7 +3770,7 @@ package body Prj.Nmsc is
if Switches /= No_Array_Element then
Error_Msg
(Data.Flags,
"?Linker switches not taken into account in library " &
"?\Linker switches not taken into account in library " &
"projects",
No_Location, Project);
end if;
@ -6793,7 +6793,7 @@ package body Prj.Nmsc is
Error_Msg_Name_2 := Source.Unit.Name;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"source file %% for unit %% not found",
"\source file %% for unit %% not found",
No_Location, Project.Project);
end if;
end if;
@ -7789,7 +7789,7 @@ package body Prj.Nmsc is
Error_Msg_File_1 := Source.File;
Error_Msg
(Data.Flags,
"{ cannot be both excluded and an exception file name",
"\{ cannot be both excluded and an exception file name",
No_Location, Project.Project);
end if;
@ -7936,13 +7936,15 @@ package body Prj.Nmsc is
if Source /= No_Source
and then Source.Replaced_By = No_Source
and then Source.Path /= Src.Path
and then Source.Index = 0
and then Src.Index = 0
and then Is_Extending (Src.Project, Source.Project)
then
Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File;
Error_Msg
(Data.Flags,
"{ and { have the same object file name",
"\{ and { have the same object file name",
No_Location, Project.Project);
else

13
gcc/ada/s-taskin.adb
View File

@ -118,10 +118,17 @@ package body System.Tasking is
T.Common.Base_Priority := Base_Priority;
T.Common.Base_CPU := Base_CPU;
-- The Domain defaults to that of the activator
-- The Domain defaults to that of the activator. But that can be null in
-- the case of foreign threads (see Register_Foreign_Thread), in which
-- case we default to the System_Domain.
T.Common.Domain :=
(if Domain = null then Self_ID.Common.Domain else Domain);
if Domain /= null then
T.Common.Domain := Domain;
elsif Self_ID.Common.Domain /= null then
T.Common.Domain := Self_ID.Common.Domain;
else
T.Common.Domain := System_Domain;
end if;
pragma Assert (T.Common.Domain /= null);
T.Common.Current_Priority := 0;

30
gcc/ada/sem_attr.adb
View File

@ -10517,10 +10517,8 @@ package body Sem_Attr is
Scop : constant Entity_Id := Scope (Subp_Id);
Subp_Decl : constant Node_Id :=
Unit_Declaration_Node (Subp_Id);
Flag_Id : Entity_Id;
HSS : Node_Id;
Stmt : Node_Id;
Flag_Id : Entity_Id;
Subp_Body : Node_Id;
-- If the access has been taken and the body of the subprogram
-- has not been see yet, indirect calls must be protected with
@ -10571,24 +10569,20 @@ package body Sem_Attr is
-- generated body is immediately analyzed and the expression
-- is automatically frozen.
if Ekind (Subp_Id) = E_Function
and then Nkind (Subp_Decl) = N_Subprogram_Declaration
and then Nkind (Original_Node (Subp_Decl)) =
N_Expression_Function
if Is_Expression_Function (Subp_Id)
and then Present (Corresponding_Body (Subp_Decl))
and then not Analyzed (Corresponding_Body (Subp_Decl))
then
HSS :=
Handled_Statement_Sequence
(Unit_Declaration_Node
(Corresponding_Body (Subp_Decl)));
Subp_Body :=
Unit_Declaration_Node (Corresponding_Body (Subp_Decl));
if Present (HSS) then
Stmt := First (Statements (HSS));
-- Analyze the body of the expression function to freeze
-- the expression. This takes care of the case where the
-- 'Access is part of dispatch table initialization and
-- the generated body of the expression function has not
-- been analyzed yet.
if Nkind (Stmt) = N_Simple_Return_Statement then
Freeze_Expression (Expression (Stmt));
end if;
if not Analyzed (Subp_Body) then
Analyze (Subp_Body);
end if;
end if;
end;

105
gcc/ada/sem_util.adb
View File

@ -17619,48 +17619,87 @@ package body Sem_Util is
-----------------------
procedure Transfer_Entities (From : Entity_Id; To : Entity_Id) is
Ent : Entity_Id := First_Entity (From);
procedure Set_Public_Status_Of (Id : Entity_Id);
-- Set the Is_Public attribute of arbitrary entity Id by calling routine
-- Set_Public_Status. If successfull and Id denotes a record type, set
-- the Is_Public attribute of its fields.
begin
if No (Ent) then
return;
end if;
--------------------------
-- Set_Public_Status_Of --
--------------------------
if (Last_Entity (To)) = Empty then
Set_First_Entity (To, Ent);
else
Set_Next_Entity (Last_Entity (To), Ent);
end if;
procedure Set_Public_Status_Of (Id : Entity_Id) is
Field : Entity_Id;
Set_Last_Entity (To, Last_Entity (From));
begin
if not Is_Public (Id) then
Set_Public_Status (Id);
while Present (Ent) loop
Set_Scope (Ent, To);
-- When the input entity is a public record type, ensure that all
-- its internal fields are also exposed to the linker. The fields
-- of a class-wide type are never made public.
if not Is_Public (Ent) then
Set_Public_Status (Ent);
if Is_Public (Ent) and then Ekind (Ent) = E_Record_Subtype then
-- The components of the propagated Itype must also be public
declare
Comp : Entity_Id;
begin
Comp := First_Entity (Ent);
while Present (Comp) loop
Set_Is_Public (Comp);
Next_Entity (Comp);
end loop;
end;
if Is_Public (Id)
and then Is_Record_Type (Id)
and then not Is_Class_Wide_Type (Id)
then
Field := First_Entity (Id);
while Present (Field) loop
Set_Is_Public (Field);
Next_Entity (Field);
end loop;
end if;
end if;
end Set_Public_Status_Of;
Next_Entity (Ent);
end loop;
-- Local variables
Set_First_Entity (From, Empty);
Set_Last_Entity (From, Empty);
Full_Id : Entity_Id;
Id : Entity_Id;
-- Start of processing for Transfer_Entities
begin
Id := First_Entity (From);
if Present (Id) then
-- Merge the entity chain of the source scope with that of the
-- destination scope.
if Present (Last_Entity (To)) then
Set_Next_Entity (Last_Entity (To), Id);
else
Set_First_Entity (To, Id);
end if;
Set_Last_Entity (To, Last_Entity (From));
-- Inspect the entities of the source scope and update their Scope
-- attribute.
while Present (Id) loop
Set_Scope (Id, To);
Set_Public_Status_Of (Id);
-- Handle an internally generated full view for a private type
if Is_Private_Type (Id)
and then Present (Full_View (Id))
and then Is_Itype (Full_View (Id))
then
Full_Id := Full_View (Id);
Set_Scope (Full_Id, To);
Set_Public_Status_Of (Full_Id);
end if;
Next_Entity (Id);
end loop;
Set_First_Entity (From, Empty);
Set_Last_Entity (From, Empty);
end if;
end Transfer_Entities;
-----------------------