[multiple changes]
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
parent
14258928a3
commit
527f5eb67a
@ -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.
|
||||
|
||||
@ -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;
|
||||
|
||||
-------------------------------
|
||||
|
||||
@ -254,7 +254,7 @@ 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
|
||||
-- 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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 --
|
||||
-------------------------
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user