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

[multiple changes] 

2014-10-20  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (List_Inlining_Info): Minor tweaks.
	(Add_Inlined_Body): Inline the enclosing package
	if it is not internally generated, even if it doesn't come
	from source.

2014-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Process_Function_Call): If the first actual
	denotes a discrete type, the mode must be interpreted as a slice
	of an array returned by a parameterless call.

2014-10-20  Vasiliy Fofanov  <fofanov@adacore.com>

	* prj-env.ads, prj-env.adb (Get_Runtime_Path): No longer inhibit
	searching for runtime referenced by a simple name on a project path.

2014-10-20  Olivier Hainque  <hainque@adacore.com>

	* vxworks-x86-link.spec: New file.
	* system-vxworks-x86.ads: Add pragma Linker_Options to link with
	vxworks-x86-link.spec.

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

	* opt.ads (Origin_Of_Target): New type.
	(Target_Origin): New variable.
	* prj-conf.adb (Parse_Project_And_Apply_Config): Record
	Target_Value and Target_Origin.  If target was not specified
	on the command line with --target=, check if attribute Target
	is declared in the main project. If it is and it is not the
	native target, parse again the projects so that 'Target get
	the new value. Fail if the target has changed again.  Invoke
	Process_Project_And_Apply_Config with Do_Phase_1 set to False
	is Process_Project_Tree_Phase_1 has already been invoked.
	* prj-conf.ads (Process_Project_And_Apply_Config): New Boolean
	parameter Do_Phase_1, defaulted to True.
	* prj-proc.adb (Expression): Check the special values and
	defaults for attribute Target.

2014-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Handle_Late_Controlled_Primitive): Do not analyze
	the subprogram spec of the body in full, because it will be
	reanalyzed when the declaration itself is analyzed;  otherwise. a
	formal may end up duplicated in the list of formals leading to
	spurious conformance errors with an existing declaration.

From-SVN: r216473
This commit is contained in:
Arnaud Charlet 2014-10-20 16:17:37 +02:00
parent 3e1862b1fd
commit 1725676d08
12 changed files with 264 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
gcc/ada/ChangeLog
View File

@ -1,3 +1,52 @@
2014-10-20 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (List_Inlining_Info): Minor tweaks.
(Add_Inlined_Body): Inline the enclosing package
if it is not internally generated, even if it doesn't come
from source.
2014-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Process_Function_Call): If the first actual
denotes a discrete type, the mode must be interpreted as a slice
of an array returned by a parameterless call.
2014-10-20 Vasiliy Fofanov <fofanov@adacore.com>
* prj-env.ads, prj-env.adb (Get_Runtime_Path): No longer inhibit
searching for runtime referenced by a simple name on a project path.
2014-10-20 Olivier Hainque <hainque@adacore.com>
* vxworks-x86-link.spec: New file.
* system-vxworks-x86.ads: Add pragma Linker_Options to link with
vxworks-x86-link.spec.
2014-10-20 Vincent Celier <celier@adacore.com>
* opt.ads (Origin_Of_Target): New type.
(Target_Origin): New variable.
* prj-conf.adb (Parse_Project_And_Apply_Config): Record
Target_Value and Target_Origin. If target was not specified
on the command line with --target=, check if attribute Target
is declared in the main project. If it is and it is not the
native target, parse again the projects so that 'Target get
the new value. Fail if the target has changed again. Invoke
Process_Project_And_Apply_Config with Do_Phase_1 set to False
is Process_Project_Tree_Phase_1 has already been invoked.
* prj-conf.ads (Process_Project_And_Apply_Config): New Boolean
parameter Do_Phase_1, defaulted to True.
* prj-proc.adb (Expression): Check the special values and
defaults for attribute Target.
2014-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Handle_Late_Controlled_Primitive): Do not analyze
the subprogram spec of the body in full, because it will be
reanalyzed when the declaration itself is analyzed; otherwise. a
formal may end up duplicated in the list of formals leading to
spurious conformance errors with an existing declaration.
2014-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb: Improve error recovery on illegal aspect.

12
gcc/ada/inline.adb
View File

@ -414,7 +414,7 @@ package body Inline is
elsif Level = Inline_Package
and then not Is_Inlined (Pack)
and then Comes_From_Source (E)
and then not Is_Internal (E)
and then not In_Main_Unit_Or_Subunit (Pack)
then
Set_Is_Inlined (Pack);
@ -3888,7 +3888,7 @@ package body Inline is
Count := Count + 1;
if Count = 1 then
Write_Str ("Listing of frontend inlined calls");
Write_Str ("List of calls inlined by the frontend");
Write_Eol;
end if;
@ -3917,7 +3917,7 @@ package body Inline is
Count := Count + 1;
if Count = 1 then
Write_Str ("Listing of inlined calls passed to the backend");
Write_Str ("List of inlined calls passed to the backend");
Write_Eol;
end if;
@ -3947,7 +3947,7 @@ package body Inline is
if Count = 1 then
Write_Str
("Listing of inlined subprograms passed to the backend");
("List of inlined subprograms passed to the backend");
Write_Eol;
end if;
@ -3964,7 +3964,7 @@ package body Inline is
end loop;
end if;
-- Generate listing of subprogram that cannot be inlined by the backend
-- Generate listing of subprograms that cannot be inlined by the backend
if Present (Backend_Not_Inlined_Subps)
and then Back_End_Inlining
@ -3979,7 +3979,7 @@ package body Inline is
if Count = 1 then
Write_Str
("Listing of subprograms that cannot inline the backend");
("List of subprograms that cannot be inlined by the backend");
Write_Eol;
end if;

10
gcc/ada/opt.ads
View File

@ -1418,6 +1418,16 @@ package Opt is
-- Get_Targ and Set_Targ for full details) using the name given by
-- this switch. Set to non-null file name by use of the -gnatet switch.
type Origin_Of_Target is (Unknown, Default, Specified);
Target_Origin : Origin_Of_Target := Unknown;
-- GPRBUILD
-- Indicates the origin of attribute Target in project files
Target_Value : String_Access := null;
-- GPRBUILD
-- Indicates the value of attribute Target in project files
Task_Dispatching_Policy : Character := ' ';
-- GNAT, GNATBIND
-- Set to ' ' for the default case (no task dispatching policy specified).

100
gcc/ada/prj-conf.adb
View File

@ -1584,9 +1584,24 @@ package body Prj.Conf is
Implicit_Project : Boolean := False;
On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
is
Success : Boolean := False;
Try_Again : Boolean := True;
begin
pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
-- Record Target_Value and Target_Origin.
if Target_Name = "" then
Opt.Target_Value := new String'(Normalized_Hostname);
Opt.Target_Origin := Default;
else
Opt.Target_Value := new String'(Target_Name);
Opt.Target_Origin := Specified;
end if;
<<Parse_Again>>
-- Parse the user project tree
Prj.Initialize (Project_Tree);
@ -1609,6 +1624,55 @@ package body Prj.Conf is
return;
end if;
-- If --target was not specified on the command line, then do Phase 1 to
-- check if attribute Target is declared in the main project.
if Opt.Target_Origin /= Specified then
Main_Project := No_Project;
Process_Project_Tree_Phase_1
(In_Tree => Project_Tree,
Project => Main_Project,
Packages_To_Check => Packages_To_Check,
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Env => Env,
Reset_Tree => True,
On_New_Tree_Loaded => On_New_Tree_Loaded);
if not Success then
Main_Project := No_Project;
return;
end if;
declare
Variable : constant Variable_Value :=
Value_Of
(Name_Target,
Main_Project.Decl.Attributes,
Project_Tree.Shared);
begin
if Variable /= Nil_Variable_Value
and then not Variable.Default
and then
Get_Name_String (Variable.Value) /= Opt.Target_Value.all
then
if Try_Again then
Opt.Target_Value :=
new String'(Get_Name_String (Variable.Value));
Try_Again := False;
goto Parse_Again;
else
Fail_Program
(Project_Tree,
"inconsistent value of attribute Target");
end if;
end if;
end;
end if;
Process_Project_And_Apply_Config
(Main_Project => Main_Project,
User_Project_Node => User_Project_Node,
@ -1624,7 +1688,8 @@ package body Prj.Conf is
Target_Name => Target_Name,
Normalized_Hostname => Normalized_Hostname,
On_Load_Config => On_Load_Config,
On_New_Tree_Loaded => On_New_Tree_Loaded);
On_New_Tree_Loaded => On_New_Tree_Loaded,
Do_Phase_1 => Opt.Target_Origin = Specified);
end Parse_Project_And_Apply_Config;
--------------------------------------
@ -1647,7 +1712,8 @@ package body Prj.Conf is
Normalized_Hostname : String;
On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True;
On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null;
Do_Phase_1 : Boolean := True)
is
Shared : constant Shared_Project_Tree_Data_Access :=
Project_Tree.Shared;
@ -1692,23 +1758,25 @@ package body Prj.Conf is
-- Start of processing for Process_Project_And_Apply_Config
begin
Main_Project := No_Project;
Automatically_Generated := False;
Process_Project_Tree_Phase_1
(In_Tree => Project_Tree,
Project => Main_Project,
Packages_To_Check => Packages_To_Check,
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Env => Env,
Reset_Tree => Reset_Tree,
On_New_Tree_Loaded => On_New_Tree_Loaded);
if not Success then
if Do_Phase_1 then
Main_Project := No_Project;
return;
Process_Project_Tree_Phase_1
(In_Tree => Project_Tree,
Project => Main_Project,
Packages_To_Check => Packages_To_Check,
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Env => Env,
Reset_Tree => Reset_Tree,
On_New_Tree_Loaded => On_New_Tree_Loaded);
if not Success then
Main_Project := No_Project;
return;
end if;
end if;
if Project_Tree.Source_Info_File_Name /= null then

16
gcc/ada/prj-conf.ads
View File

@ -112,20 +112,21 @@ package Prj.Conf is
procedure Process_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;
User_Project_Node : Prj.Tree.Project_Node_Id;
Config_File_Name : String := "";
Config_File_Name : String := "";
Autoconf_Specified : Boolean;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True;
Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Config_File_Path : out String_Access;
Target_Name : String := "";
Target_Name : String := "";
Normalized_Hostname : String;
On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True;
On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null);
On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True;
On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null;
Do_Phase_1 : Boolean := True);
-- Same as above, except the project must already have been parsed through
-- Prj.Part.Parse, and only the processing of the project and the
-- configuration is done at this level.
@ -138,6 +139,9 @@ package Prj.Conf is
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project).
--
-- If Do_Phase_1 is False, then Prj.Proc.Process_Project_Tree_Phase_1
-- should not be called, as it has already been invoked successfully.
Invalid_Config : exception;

25
gcc/ada/prj-env.adb
View File

@ -1425,35 +1425,12 @@ package body Prj.Env is
(Self : Project_Search_Path;
Name : String) return String_Access
is
function Is_Base_Name (Path : String) return Boolean;
-- Returns True if Path has no directory separator
------------------
-- Is_Base_Name --
------------------
function Is_Base_Name (Path : String) return Boolean is
begin
for J in Path'Range loop
if Is_Directory_Separator (Path (J)) then
return False;
end if;
end loop;
return True;
end Is_Base_Name;
function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
(Check_Filename => Is_Directory);
-- Start of processing for Get_Runtime_Path
begin
if not Is_Base_Name (Name) then
return Find_Rts_In_Path (Self, Name);
else
return null;
end if;
return Find_Rts_In_Path (Self, Name);
end Get_Runtime_Path;
----------------

6
gcc/ada/prj-env.ads
View File

@ -243,10 +243,8 @@ package Prj.Env is
function Get_Runtime_Path
(Self : Project_Search_Path;
Name : String) return String_Access;
-- Compute the full path for the project-based runtime name. It first
-- checks that Name is not a simple file name (must have a path separator
-- in it), and returns null in case of failure. This check might be removed
-- in the future. Name is simply searched on the project path.
-- Compute the full path for the project-based runtime name.
-- Name is simply searched on the project path.
private
package Projects_Paths is new GNAT.Dynamic_HTables.Simple_HTable

31
gcc/ada/prj-proc.adb
View File

@ -889,16 +889,26 @@ package body Prj.Proc is
-- Check the defaults
if Current_Term_Kind = N_Attribute_Reference
and then The_Variable.Default
then
if Current_Term_Kind = N_Attribute_Reference then
declare
The_Default : constant Attribute_Default_Value :=
Default_Of
(The_Current_Term, From_Project_Node_Tree);
begin
case The_Variable.Kind is
-- Check the special value for 'Target when specified
if The_Default = Target_Value
and then Opt.Target_Origin = Specified
then
Name_Len := 0;
Add_Str_To_Name_Buffer (Opt.Target_Value.all);
The_Variable.Value := Name_Find;
-- Check the defaults
elsif The_Variable.Default then
case The_Variable.Kind is
when Undefined =>
null;
@ -923,7 +933,15 @@ package body Prj.Proc is
goto Object_Dir_Restart;
when Target_Value =>
null;
if Opt.Target_Value = null then
The_Variable.Value := Empty_String;
else
Name_Len := 0;
Add_Str_To_Name_Buffer
(Opt.Target_Value.all);
The_Variable.Value := Name_Find;
end if;
end case;
when List =>
@ -941,7 +959,8 @@ package body Prj.Proc is
when Object_Dir_Value | Target_Value =>
null;
end case;
end case;
end case;
end if;
end;
end if;

60
gcc/ada/sem_ch3.adb
View File

@ -2167,10 +2167,7 @@ package body Sem_Ch3 is
Parameter_Specifications (Body_Spec);
Spec : Node_Id;
Spec_Id : Entity_Id;
Dummy : Entity_Id;
-- A dummy variable used to capture the unused result of subprogram
-- spec analysis.
Typ : Node_Id;
begin
-- Consider only procedure bodies whose name matches one of the three
@ -2183,28 +2180,49 @@ package body Sem_Ch3 is
then
return;
-- A controlled primitive must have exactly one formal
-- A controlled primitive must have exactly one formal which is not
-- an anonymous access type.
elsif List_Length (Params) /= 1 then
return;
end if;
Dummy := Analyze_Subprogram_Specification (Body_Spec);
Typ := Parameter_Type (First (Params));
if Nkind (Typ) = N_Access_Definition then
return;
end if;
Find_Type (Typ);
-- The type of the formal must be derived from [Limited_]Controlled
if not Is_Controlled (Etype (Defining_Entity (First (Params)))) then
if not Is_Controlled (Entity (Typ)) then
return;
end if;
Spec_Id := Find_Corresponding_Spec (Body_Decl, Post_Error => False);
-- Check whether a specification exists for this body. We do not
-- analyze the spec of the body in full, because it will be analyzed
-- again when the body is properly analyzed, and we cannot create
-- duplicate entries in the formals chain. We look for an explicit
-- specification because the body may be an overriding operation and
-- an inherited spec may be present.
-- The body has a matching spec, therefore it cannot be a late
-- primitive.
Spec_Id := Current_Entity (Body_Id);
if Present (Spec_Id) then
return;
end if;
while Present (Spec_Id) loop
if Ekind_In (Spec_Id, E_Procedure, E_Generic_Procedure)
and then Scope (Spec_Id) = Current_Scope
and then Present (First_Formal (Spec_Id))
and then No (Next_Formal (First_Formal (Spec_Id)))
and then Etype (First_Formal (Spec_Id)) = Entity (Typ)
and then Comes_From_Source (Spec_Id)
then
return;
end if;
Spec_Id := Homonym (Spec_Id);
end loop;
-- At this point the body is known to be a late controlled primitive.
-- Generate a matching spec and insert it before the body. Note the
@ -2777,18 +2795,22 @@ package body Sem_Ch3 is
-- them to the entity for the type which is currently the partial
-- view, but which is the one that will be frozen.
-- In most cases the partial view is a private type, and both views
-- appear in different declarative parts. In the unusual case where the
-- partial view is incomplete, perform the analysis on the full view,
-- to prevent freezing anomalies with the corresponding class-wide type,
-- which otherwise might be frozen before the dispatch table is built.
if Has_Aspects (N) then
-- In most cases the partial view is a private type, and both views
-- appear in different declarative parts. In the unusual case where
-- the partial view is incomplete, perform the analysis on the
-- full view, to prevent freezing anomalies with the corresponding
-- class-wide type, which otherwise might be frozen before the
-- dispatch table is built.
if Prev /= Def_Id
and then Ekind (Prev) /= E_Incomplete_Type
then
Analyze_Aspect_Specifications (N, Prev);
-- Normal case
else
Analyze_Aspect_Specifications (N, Def_Id);
end if;

22
gcc/ada/sem_ch4.adb
View File

@ -2156,6 +2156,7 @@ package body Sem_Ch4 is
---------------------------
procedure Process_Function_Call is
Loc : constant Source_Ptr := Sloc (N);
Actual : Node_Id;
begin
@ -2187,7 +2188,26 @@ package body Sem_Ch4 is
-- subsequent crashes or loops if there is an attempt to continue
-- analysis of the program.
Next (Actual);
-- IF there is a single actual and it is a type name, the node
-- can only be interpreted as a slice of a parameterless call.
-- Rebuild the node as such and analyze.
if No (Next (Actual))
and then Is_Entity_Name (Actual)
and then Is_Type (Entity (Actual))
and then Is_Discrete_Type (Entity (Actual))
then
Replace (N,
Make_Slice (Loc,
Prefix => P,
Discrete_Range =>
New_Occurrence_Of (Entity (Actual), Loc)));
Analyze (N);
return;
else
Next (Actual);
end if;
end loop;
Analyze_Call (N);

5
gcc/ada/system-vxworks-x86.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- (VxWorks 5 Version x86) --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -115,6 +115,9 @@ package System is
private
pragma Linker_Options ("--specs=vxworks-x86-link.spec");
-- Setup proper set of -L's for this configuration
type Address is mod Memory_Size;
Null_Address : constant Address := 0;

11
gcc/ada/vxworks-x86-link.spec Normal file
View File

@ -0,0 +1,11 @@
*lib:
+ %{mrtp:%{!shared: \
%{vxsim: \
-L%:getenv(WIND_BASE /target/usr/lib/simpentium/SIMPENTIUM/common) \
-L%:getenv(WIND_BASE /target/lib/usr/lib/simpentium/SIMPENTIUM/common) \
} \
%{!vxsim: \
-L%:getenv(WIND_BASE /target/usr/lib/pentium/PENTIUM/common) \
-L%:getenv(WIND_BASE /target/lib/usr/lib/pentium/PENTIUM/common) \
} \
}}