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

[multiple changes]

Browse Source 
2014-10-31  Vincent Celier  <celier@adacore.com>

	* prj-conf.adb (Look_For_Project_Paths): New procedure
	(Parse_Project_And_Apply_Config): Initially, parse the project
	files ignoring missing withs. If there are missing withs, extend
	the project path with directories rooted at the compiler roots,
	including directories rooted at the runtime roots, if there are
	non default runtimes, in the PATH orser.
	* prj-env.adb (Initialize_Default_Project_Path): Do not add
	any directory from the prefix if the target is "-".
	* prj-part.adb (Parse): Initialize the tables, as Parse may be
	call several times by gprbuild.
	* prj.adb (Update_Ignore_Missing_With): New procedure.

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

	* sem_aux.adb (First_Stored_Discriminant,
	Has_Completely_Hidden_Discriminant): When scanning the list of
	discriminants to locate possibly hidden (inherited) discriminants,
	ignore itypes that may appear in the entity list, when an access
	discriminants is constrained by an access attribute reference.

2014-10-31  Javier Miranda  <miranda@adacore.com>

	* freeze.adb (Freeze_Record_Type): Add missing
	check to verify that all the primitives of an interface type
	are abstract or null procedures.

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

	* s-os_lib.adb, s-os_lib.ads: New function Non_Blocking_Spawn that
	redirects standard output and standard error to two different files.

2014-10-31  Bob Duff  <duff@adacore.com>

	* makeutl.ads: Minor comment fix.

2014-10-31  Arnaud Charlet  <charlet@adacore.com>

	* system-linux-x86_64.ads, system-mingw-x86_64.ads (Word_Size,
	Memory_Size): Use Standard'Word_Size so that the value can be changed
	via a target configuration file.

From-SVN: r216965
This commit is contained in:
Arnaud Charlet 2014-10-31 12:22:19 +01:00
parent 14258928a3
commit 527f5eb67a
14 changed files with 558 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
gcc/ada/ChangeLog
View File

@ -1,3 +1,46 @@
2014-10-31 Vincent Celier <celier@adacore.com>
* prj-conf.adb (Look_For_Project_Paths): New procedure
(Parse_Project_And_Apply_Config): Initially, parse the project
files ignoring missing withs. If there are missing withs, extend
the project path with directories rooted at the compiler roots,
including directories rooted at the runtime roots, if there are
non default runtimes, in the PATH orser.
* prj-env.adb (Initialize_Default_Project_Path): Do not add
any directory from the prefix if the target is "-".
* prj-part.adb (Parse): Initialize the tables, as Parse may be
call several times by gprbuild.
* prj.adb (Update_Ignore_Missing_With): New procedure.
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* sem_aux.adb (First_Stored_Discriminant,
Has_Completely_Hidden_Discriminant): When scanning the list of
discriminants to locate possibly hidden (inherited) discriminants,
ignore itypes that may appear in the entity list, when an access
discriminants is constrained by an access attribute reference.
2014-10-31 Javier Miranda <miranda@adacore.com>
* freeze.adb (Freeze_Record_Type): Add missing
check to verify that all the primitives of an interface type
are abstract or null procedures.
2014-10-31 Vincent Celier <celier@adacore.com>
* s-os_lib.adb, s-os_lib.ads: New function Non_Blocking_Spawn that
redirects standard output and standard error to two different files.
2014-10-31 Bob Duff <duff@adacore.com>
* makeutl.ads: Minor comment fix.
2014-10-31 Arnaud Charlet <charlet@adacore.com>
* system-linux-x86_64.ads, system-mingw-x86_64.ads (Word_Size,
Memory_Size): Use Standard'Word_Size so that the value can be changed
via a target configuration file.
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch4.adb: Minor tweak.

41
gcc/ada/freeze.adb
View File

@ -4004,6 +4004,47 @@ package body Freeze is
-- call to the Analyze_Freeze_Entity for the record type.
end Check_Variant_Part;
-- Check that all the primitives of an interface type are abstract
-- or null procedures.
if Is_Interface (Rec)
and then not Error_Posted (Parent (Rec))
then
declare
Elmt : Elmt_Id;
Subp : Entity_Id;
begin
Elmt := First_Elmt (Primitive_Operations (Rec));
while Present (Elmt) loop
Subp := Node (Elmt);
if not Is_Abstract_Subprogram (Subp)
-- Avoid reporting the error on inherited primitives
and then Comes_From_Source (Subp)
then
Error_Msg_Name_1 := Chars (Subp);
if Ekind (Subp) = E_Procedure then
if not Null_Present (Parent (Subp)) then
Error_Msg_N
("interface procedure % must be abstract or null",
Parent (Subp));
end if;
else
Error_Msg_N
("interface function % must be abstract",
Parent (Subp));
end if;
end if;
Next_Elmt (Elmt);
end loop;
end;
end if;
end Freeze_Record_Type;
-------------------------------

4
gcc/ada/makeutl.ads
View File

@ -254,8 +254,8 @@ package Makeutl is
-- file. This checks various attributes to see if there are file specific
-- switches, or else defaults on the switches for the corresponding
-- language. Is_Default is set to False if there were file-specific
-- switches Source_File can be set to No_File to force retrieval of the
-- default switches. If Test_Without_Suffix is True, and there is no " for
-- switches. Source_File can be set to No_File to force retrieval of the
-- default switches. If Test_Without_Suffix is True, and there is no "for
-- Switches(Source_File) use", then this procedure also tests without the
-- extension of the filename. If Test_Without_Suffix is True and
-- Check_ALI_Suffix is True, then we also replace the file extension with

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

@ -53,6 +53,32 @@ package body Prj.Conf is
Gprconfig_Name : constant String := "gprconfig";
Warn_For_RTS : Boolean := True;
-- Set to False when gprbuild parse again the project files, to avoid
-- an incorrect warning.
type Runtime_Root_Data;
type Runtime_Root_Ptr is access Runtime_Root_Data;
type Runtime_Root_Data is record
Root : String_Access;
Next : Runtime_Root_Ptr;
end record;
-- Data for a runtime root to be used when adding directories to the
-- project path.
type Compiler_Root_Data;
type Compiler_Root_Ptr is access Compiler_Root_Data;
type Compiler_Root_Data is record
Root : String_Access;
Runtimes : Runtime_Root_Ptr;
Next : Compiler_Root_Ptr;
end record;
-- Data for a compiler root to be used when adding directories to the
-- project path.
First_Compiler_Root : Compiler_Root_Ptr := null;
-- Head of the list of compiler roots
package RTS_Languages is new GNAT.HTable.Simple_HTable
(Header_Num => Prj.Header_Num,
Element => Name_Id,
@ -98,6 +124,21 @@ package body Prj.Conf is
-- projects, so that when the second phase of the processing is performed
-- these attributes are automatically taken into account.
type State is (No_State);
procedure Look_For_Project_Paths
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State);
-- Check the compilers in the Project and add record them in the list
-- rooted at First_Compiler_Root, with their runtimes, if they are not
-- already in the list.
procedure Update_Project_Path is new
For_Every_Project_Imported
(State => State,
Action => Look_For_Project_Paths);
------------------------------------
-- Add_Default_GNAT_Naming_Scheme --
------------------------------------
@ -1448,7 +1489,8 @@ package body Prj.Conf is
-- If the config file is not auto-generated, warn if there is any --RTS
-- switch, but not when the config file is generated in memory.
elsif RTS_Languages.Get_First /= No_Name
elsif Warn_For_RTS
and then RTS_Languages.Get_First /= No_Name
and then Opt.Warning_Mode /= Opt.Suppress
and then On_Load_Config = null
then
@ -1558,11 +1600,36 @@ package body Prj.Conf is
On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
is
Success : Boolean := False;
Try_Again : Boolean := True;
Target_Try_Again : Boolean := True;
Config_Try_Again : Boolean;
S : State := No_State;
Conf_File_Name : String_Access := new String'(Config_File_Name);
procedure Add_Directory (Dir : String);
-- Add a directory at the end of the Project Path
-------------------
-- Add_Directory --
-------------------
procedure Add_Directory (Dir : String) is
begin
if Opt.Verbose_Mode then
Write_Line (" Adding directory """ & Dir & """");
end if;
Prj.Env.Add_Directories (Env.Project_Path, Dir);
end Add_Directory;
begin
pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
-- Start with ignoring missing withed projects
Update_Ignore_Missing_With (Env.Flags, True);
-- Record Target_Value and Target_Origin.
if Target_Name = "" then
@ -1630,10 +1697,10 @@ package body Prj.Conf is
and then
Get_Name_String (Variable.Value) /= Opt.Target_Value.all
then
if Try_Again then
if Target_Try_Again then
Opt.Target_Value :=
new String'(Get_Name_String (Variable.Value));
Try_Again := False;
Target_Try_Again := False;
goto Parse_Again;
else
@ -1643,13 +1710,18 @@ package body Prj.Conf is
end if;
end if;
end;
end if;
-- If there are missing withed projects, the projects will be parsed
-- again after the project path is extended with directories rooted
-- at the compiler roots.
Config_Try_Again := Project_Node_Tree.Incomplete_With;
Process_Project_And_Apply_Config
(Main_Project => Main_Project,
User_Project_Node => User_Project_Node,
Config_File_Name => Config_File_Name,
Config_File_Name => Conf_File_Name.all,
Autoconf_Specified => Autoconf_Specified,
Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree,
@ -1663,6 +1735,194 @@ package body Prj.Conf is
On_Load_Config => On_Load_Config,
On_New_Tree_Loaded => On_New_Tree_Loaded,
Do_Phase_1 => Opt.Target_Origin = Specified);
-- Exit if there was an error. Otherwise, if Config_Try_Again is True,
-- update the project path and try again.
if Main_Project /= No_Project and then Config_Try_Again then
Update_Ignore_Missing_With (Env.Flags, False);
if Config_File_Path /= null then
Conf_File_Name := new String'(Simple_Name (Config_File_Path.all));
end if;
-- For the second time the project files are parsed, the warning for
-- --RTS= being only taken into account in auto-configuration are
-- suppressed, as we are no longer in auto-configuration.
Warn_For_RTS := False;
-- Add the default directories corresponding to the compilers
Update_Project_Path
(By => Main_Project,
Tree => Project_Tree,
With_State => S,
Include_Aggregated => True,
Imported_First => False);
declare
Compiler_Root : Compiler_Root_Ptr;
Prefix : String_Access;
Runtime_Root : Runtime_Root_Ptr;
Path_Value : constant String_Access := Getenv ("PATH");
begin
if Opt.Verbose_Mode then
Write_Line ("Setting the default project search directories");
if Prj.Current_Verbosity = High then
if Path_Value = null or else Path_Value'Length = 0 then
Write_Line ("No environment variable PATH");
else
Write_Line ("PATH =");
Write_Line (" " & Path_Value.all);
end if;
end if;
end if;
-- Reorder the compiler roots in the PATH order
if First_Compiler_Root /= null
and then First_Compiler_Root.Next /= null
then
declare
Pred : Compiler_Root_Ptr;
First_New_Comp : Compiler_Root_Ptr := null;
New_Comp : Compiler_Root_Ptr := null;
First : Positive := Path_Value'First;
Last : Positive;
Path_Last : Positive;
begin
while First <= Path_Value'Last loop
Last := First;
if Path_Value (First) /= Path_Separator then
while Last < Path_Value'Last
and then Path_Value (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
Path_Last := Last;
while Path_Last > First
and then
Path_Value (Path_Last) = Directory_Separator
loop
Path_Last := Path_Last - 1;
end loop;
if Path_Last > First + 4
and then
Path_Value (Path_Last - 2 .. Path_Last) = "bin"
and then
Path_Value (Path_Last - 3) = Directory_Separator
then
Path_Last := Path_Last - 4;
Pred := null;
Compiler_Root := First_Compiler_Root;
while Compiler_Root /= null
and then Compiler_Root.Root.all /=
Path_Value (First .. Path_Last)
loop
Pred := Compiler_Root;
Compiler_Root := Compiler_Root.Next;
end loop;
if Compiler_Root /= null then
if Pred = null then
First_Compiler_Root :=
First_Compiler_Root.Next;
else
Pred.Next := Compiler_Root.Next;
end if;
if First_New_Comp = null then
First_New_Comp := Compiler_Root;
else
New_Comp.Next := Compiler_Root;
end if;
New_Comp := Compiler_Root;
New_Comp.Next := null;
end if;
end if;
end if;
First := Last + 1;
end loop;
if First_New_Comp /= null then
New_Comp.Next := First_Compiler_Root;
First_Compiler_Root := First_New_Comp;
end if;
end;
end if;
-- Now that the compiler roots are in a correct order, add the
-- directories corresponding to these compiler roots in the
-- project path.
Compiler_Root := First_Compiler_Root;
while Compiler_Root /= null loop
Prefix := Compiler_Root.Root;
Runtime_Root := Compiler_Root.Runtimes;
while Runtime_Root /= null loop
Add_Directory
(Runtime_Root.Root.all &
Directory_Separator &
"lib" &
Directory_Separator &
"gnat");
Add_Directory
(Runtime_Root.Root.all &
Directory_Separator &
"share" &
Directory_Separator &
"gpr");
Runtime_Root := Runtime_Root.Next;
end loop;
Add_Directory
(Prefix.all &
Directory_Separator &
Opt.Target_Value.all &
Directory_Separator &
"lib" &
Directory_Separator &
"gnat");
Add_Directory
(Prefix.all &
Directory_Separator &
Opt.Target_Value.all &
Directory_Separator &
"share" &
Directory_Separator &
"gpr");
Add_Directory
(Prefix.all &
Directory_Separator &
"share" &
Directory_Separator &
"gpr");
Add_Directory
(Prefix.all &
Directory_Separator &
"lib" &
Directory_Separator &
"gnat");
Compiler_Root := Compiler_Root.Next;
end loop;
end;
-- And parse again the project files. There will be no missing
-- withed projects, as Ignore_Missing_With is set to False in
-- the environment flags, so there is no risk of endless loop here.
goto Parse_Again;
end if;
end Parse_Project_And_Apply_Config;
--------------------------------------
@ -1886,4 +2146,112 @@ package body Prj.Conf is
RTS_Languages.Set (Language, Name_Find);
end Set_Runtime_For;
----------------------------
-- Look_For_Project_Paths --
----------------------------
procedure Look_For_Project_Paths
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State)
is
Lang_Id : Language_Ptr;
Compiler_Root : Compiler_Root_Ptr;
Runtime_Root : Runtime_Root_Ptr;
Comp_Driver : String_Access;
Comp_Dir : String_Access;
Prefix : String_Access;
pragma Unreferenced (Tree);
begin
With_State := No_State;
Lang_Id := Project.Languages;
while Lang_Id /= No_Language_Index loop
if Lang_Id.Config.Compiler_Driver /= No_File then
Comp_Driver :=
new String'
(Get_Name_String (Lang_Id.Config.Compiler_Driver));
-- Get the absolute path of the compiler driver
if not Is_Absolute_Path (Comp_Driver.all) then
Comp_Driver := Locate_Exec_On_Path (Comp_Driver.all);
end if;
if Comp_Driver /= null and then Comp_Driver'Length > 0 then
Comp_Dir :=
new String'
(Containing_Directory (Comp_Driver.all));
-- Consider only the compiler drivers that are in "bin"
-- subdirectories.
if Simple_Name (Comp_Dir.all) = "bin" then
Prefix :=
new String'(Containing_Directory (Comp_Dir.all));
-- Check if the compiler root is already in the list. If it
-- is not, add it to the list.
Compiler_Root := First_Compiler_Root;
while Compiler_Root /= null loop
exit when Prefix.all = Compiler_Root.Root.all;
Compiler_Root := Compiler_Root.Next;
end loop;
if Compiler_Root = null then
First_Compiler_Root :=
new Compiler_Root_Data'
(Root => Prefix,
Runtimes => null,
Next => First_Compiler_Root);
Compiler_Root := First_Compiler_Root;
end if;
-- If there is a runtime for this compiler, check if it is
-- recorded with the compiler root. If it is not, record
-- the runtime.
declare
Runtime : constant String :=
Runtime_Name_For (Lang_Id.Name);
Root : String_Access;
begin
if Runtime'Length > 0 then
if Is_Absolute_Path (Runtime) then
Root := new String'(Runtime);
else
Root :=
new String'
(Prefix.all &
Directory_Separator &
Opt.Target_Value.all &
Directory_Separator &
Runtime);
end if;
Runtime_Root := Compiler_Root.Runtimes;
while Runtime_Root /= null loop
exit when Root.all = Runtime_Root.Root.all;
Runtime_Root := Runtime_Root.Next;
end loop;
if Runtime_Root = null then
Compiler_Root.Runtimes :=
new Runtime_Root_Data'
(Root => Root,
Next => Compiler_Root.Runtimes);
end if;
end if;
end;
end if;
end if;
end if;
Lang_Id := Lang_Id.Next;
end loop;
end Look_For_Project_Paths;
end Prj.Conf;

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

@ -1876,7 +1876,7 @@ package body Prj.Env is
(Self : in out Project_Search_Path;
Target_Name : String)
is
Add_Default_Dir : Boolean := True;
Add_Default_Dir : Boolean := Target_Name /= "-";
First : Positive;
Last : Positive;

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

@ -175,8 +175,10 @@ package Prj.Env is
Target_Name : String);
-- Initialize Self. It will then contain the default project path on the
-- given target (including directories specified by the environment
-- variables ADA_PROJECT_PATH and GPR_PROJECT_PATH). This does nothing if
-- Self has already been initialized.
-- variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and ADA_PROJECT_PATH).
-- If one of the directory or Target_Name is "-", then the path contains
-- only those directories specified by the environment variables (except
-- "-"). This does nothing if Self has already been initialized.
procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
-- Copy From into To

2
gcc/ada/prj-part.adb
View File

@ -553,6 +553,8 @@ package body Prj.Part is
begin
In_Tree.Incomplete_With := False;
Project_Stack.Init;
Tree_Private_Part.Projects_Htable.Reset (In_Tree.Projects_HT);
if not Is_Initialized (Env.Project_Path) then
Prj.Env.Initialize_Default_Project_Path

11
gcc/ada/prj.adb
View File

@ -2147,6 +2147,17 @@ package body Prj is
(Root_Project, Root_Tree, Project_Context'(False, False));
end For_Project_And_Aggregated_Context;
--------------------------------
-- Update_Ignore_Missing_With --
--------------------------------
procedure Update_Ignore_Missing_With
(Flags : in out Processing_Flags; Value : Boolean)
is
begin
Flags.Ignore_Missing_With := Value;
end Update_Ignore_Missing_With;
-- Package initialization for Prj
begin

4
gcc/ada/prj.ads
View File

@ -1893,6 +1893,10 @@ package Prj is
-- * user project also includes a "with" that can only be resolved
-- once we have found the gnatls
procedure Update_Ignore_Missing_With
(Flags : in out Processing_Flags; Value : Boolean);
-- Update the value of component Ignore_Missing_With in Flags with Value
Gprbuild_Flags : constant Processing_Flags;
Gprinstall_Flags : constant Processing_Flags;
Gprclean_Flags : constant Processing_Flags;

48
gcc/ada/s-os_lib.adb
View File

@ -1698,6 +1698,54 @@ package body System.OS_Lib is
end if;
end Non_Blocking_Spawn;
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Stdout_File : String;
Stderr_File : String) return Process_Id
is
Stdout_FD : constant File_Descriptor :=
Create_Output_Text_File (Stdout_File);
Stderr_FD : constant File_Descriptor :=
Create_Output_Text_File (Stderr_File);
Saved_Output : File_Descriptor;
Saved_Error : File_Descriptor;
Result : Process_Id;
begin
-- Do not attempt to spawn if the output files could not be created
if Stdout_FD = Invalid_FD or else Stderr_FD = Invalid_FD then
return Invalid_Pid;
end if;
-- Set standard output and error to the specified files
Saved_Output := Dup (Standout);
Dup2 (Stdout_FD, Standout);
Saved_Error := Dup (Standerr);
Dup2 (Stderr_FD, Standerr);
-- Spawn the program
Result := Non_Blocking_Spawn (Program_Name, Args);
-- Restore the standard output and error
Dup2 (Saved_Output, Standout);
Dup2 (Saved_Error, Standerr);
-- And close the saved standard output and error file descriptors
Close (Saved_Output);
Close (Saved_Error);
return Result;
end Non_Blocking_Spawn;
-------------------------
-- Normalize_Arguments --
-------------------------

9
gcc/ada/s-os_lib.ads
View File

@ -856,6 +856,15 @@ package System.OS_Lib is
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Stdout_File : String;
Stderr_File : String) return Process_Id;
-- Similar to the procedure above, but saves the standard output of the
-- command to a file with the name Stdout_File and the standard output
-- of the command to a file with the name Stderr_File.
procedure Wait_Process (Pid : out Process_Id; Success : out Boolean);
-- Wait for the completion of any of the processes created by previous
-- calls to Non_Blocking_Spawn. The caller will be suspended until one of

18
gcc/ada/sem_aux.adb
View File

@ -282,6 +282,8 @@ package body Sem_Aux is
(Typ : Entity_Id) return Boolean;
-- Scans the Discriminants to see whether any are Completely_Hidden
-- (the mechanism for describing non-specified stored discriminants)
-- Note that the entity list for the type may contain anonymous access
-- types created by expressions that constrain access discriminants.
----------------------------------------
-- Has_Completely_Hidden_Discriminant --
@ -296,8 +298,17 @@ package body Sem_Aux is
pragma Assert (Ekind (Typ) = E_Discriminant);
Ent := Typ;
while Present (Ent) and then Ekind (Ent) = E_Discriminant loop
if Is_Completely_Hidden (Ent) then
while Present (Ent) loop
-- Skip anonymous types that may be created by expressions
-- used as discriminant constraints on inherited discriminants.
if Is_Itype (Ent) then
null;
elsif Ekind (Ent) = E_Discriminant
and then Is_Completely_Hidden (Ent)
then
return True;
end if;
@ -322,7 +333,8 @@ package body Sem_Aux is
if Has_Completely_Hidden_Discriminant (Ent) then
while Present (Ent) loop
exit when Is_Completely_Hidden (Ent);
exit when Ekind (Ent) = E_Discriminant
and then Is_Completely_Hidden (Ent);
Ent := Next_Entity (Ent);
end loop;
end if;

4
gcc/ada/system-linux-x86_64.ads
View File

@ -69,8 +69,8 @@ package System is
Null_Address : constant Address;
Storage_Unit : constant := 8;
Word_Size : constant := 64;
Memory_Size : constant := 2 ** 64;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Word_Size;
-- Address comparison

4
gcc/ada/system-mingw-x86_64.ads
View File

@ -69,8 +69,8 @@ package System is
Null_Address : constant Address;
Storage_Unit : constant := 8;
Word_Size : constant := 64;
Memory_Size : constant := 2 ** 64;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Word_Size;
-- Address comparison