[multiple changes]
2016-04-20 Vincent Celier <celier@adacore.com> * gnatcmd.adb: Do not invoke gprls when the invocation of "gnat ls" includes the switch -V. * clean.adb: "<target>-gnatclean -P" now calls "gprclean --target=<target>" * make.adb: "<target>-gnatmake -P" now calls "gprbuild --target=<target>" 2016-04-20 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch12.adb (Qualify_Type): Do not perform partial qualification when the immediate scope is a generic unit. From-SVN: r235260
This commit is contained in:
Arnaud Charlet
parent
61d1b085b9
commit
0c61772a12
|
|
@ -1,3 +1,17 @@
|
|||
2016-04-20 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* gnatcmd.adb: Do not invoke gprls when the invocation of "gnat
|
||||
ls" includes the switch -V.
|
||||
* clean.adb: "<target>-gnatclean -P" now calls "gprclean
|
||||
--target=<target>"
|
||||
* make.adb: "<target>-gnatmake -P" now calls "gprbuild
|
||||
--target=<target>"
|
||||
|
||||
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_ch12.adb (Qualify_Type): Do not perform
|
||||
partial qualification when the immediate scope is a generic unit.
|
||||
|
||||
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_unst.adb: Minor reformatting.
|
||||
|
|
|
|||
|
|
@ -1619,8 +1619,8 @@ package body Clean is
|
|||
|
||||
procedure Parse_Cmd_Line is
|
||||
Last : constant Natural := Argument_Count;
|
||||
Source_Index : Int := 0;
|
||||
Index : Positive;
|
||||
Source_Index : Int := 0;
|
||||
|
||||
procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
|
||||
|
||||
|
|
@ -1629,16 +1629,29 @@ package body Clean is
|
|||
|
||||
Check_Version_And_Help ("GNATCLEAN", "2003");
|
||||
|
||||
-- First, for native gnatclean, check for switch -P and, if found and
|
||||
-- gprclean is available, silently invoke gprclean.
|
||||
-- First, check for switch -P and, if found and gprclean is available,
|
||||
-- silently invoke gprclean, with switch --target if not on a native
|
||||
-- platform.
|
||||
|
||||
Find_Program_Name;
|
||||
declare
|
||||
Arg_Len : Positive := Argument_Count;
|
||||
Call_Gprclean : Boolean := False;
|
||||
Gprclean : String_Access := null;
|
||||
Pos : Natural := 0;
|
||||
Success : Boolean;
|
||||
Target : String_Access := null;
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "gnatclean" then
|
||||
declare
|
||||
Call_Gprclean : Boolean := False;
|
||||
begin
|
||||
Find_Program_Name;
|
||||
|
||||
if Name_Len >= 9
|
||||
and then Name_Buffer (Name_Len - 8 .. Name_Len) = "gnatclean"
|
||||
then
|
||||
if Name_Len > 9 then
|
||||
Target := new String'(Name_Buffer (1 .. Name_Len - 10));
|
||||
Arg_Len := Arg_Len + 1;
|
||||
end if;
|
||||
|
||||
begin
|
||||
for J in 1 .. Argument_Count loop
|
||||
declare
|
||||
Arg : constant String := Argument (J);
|
||||
|
|
@ -1653,16 +1666,20 @@ package body Clean is
|
|||
end loop;
|
||||
|
||||
if Call_Gprclean then
|
||||
declare
|
||||
Gprclean : String_Access :=
|
||||
Locate_Exec_On_Path (Exec_Name => "gprclean");
|
||||
Args : Argument_List (1 .. Argument_Count);
|
||||
Success : Boolean;
|
||||
Gprclean := Locate_Exec_On_Path (Exec_Name => "gprclean");
|
||||
|
||||
if Gprclean /= null then
|
||||
declare
|
||||
Args : Argument_List (1 .. Arg_Len);
|
||||
begin
|
||||
if Target /= null then
|
||||
Args (1) := new String'("--target=" & Target.all);
|
||||
Pos := 1;
|
||||
end if;
|
||||
|
||||
begin
|
||||
if Gprclean /= null then
|
||||
for J in 1 .. Argument_Count loop
|
||||
Args (J) := new String'(Argument (J));
|
||||
Pos := Pos + 1;
|
||||
Args (Pos) := new String'(Argument (J));
|
||||
end loop;
|
||||
|
||||
Spawn (Gprclean.all, Args, Success);
|
||||
|
|
@ -1672,11 +1689,11 @@ package body Clean is
|
|||
if Success then
|
||||
Exit_Program (E_Success);
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
||||
Index := 1;
|
||||
while Index <= Last loop
|
||||
|
|
|
|||
|
|
@ -23,19 +23,35 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Csets;
|
||||
with Gnatvsn;
|
||||
with Makeutl; use Makeutl;
|
||||
with Namet; use Namet;
|
||||
with Opt; use Opt;
|
||||
with Osint; use Osint;
|
||||
with Output; use Output;
|
||||
with Prj; use Prj;
|
||||
with Prj.Env;
|
||||
with Prj.Ext; use Prj.Ext;
|
||||
with Prj.Pars;
|
||||
with Prj.Tree; use Prj.Tree;
|
||||
with Prj.Util; use Prj.Util;
|
||||
with Sdefault;
|
||||
with Sinput.P;
|
||||
with Snames; use Snames;
|
||||
with Stringt;
|
||||
with Switch; use Switch;
|
||||
with Table;
|
||||
with Targparm; use Targparm;
|
||||
with Tempdir;
|
||||
with Types; use Types;
|
||||
|
||||
with Ada.Characters.Handling; use Ada.Characters.Handling;
|
||||
with Ada.Command_Line; use Ada.Command_Line;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
|
||||
procedure GNATCmd is
|
||||
Gprbuild : constant String := "gprbuild";
|
||||
|
|
@ -82,6 +98,25 @@ procedure GNATCmd is
|
|||
Pp => Pretty);
|
||||
-- Mapping of alternate commands to commands
|
||||
|
||||
Call_GPR_Tool : Boolean := False;
|
||||
-- True when a GPR tool should be called, if available
|
||||
|
||||
Project_Node_Tree : Project_Node_Tree_Ref;
|
||||
Project_File : String_Access;
|
||||
Project : Prj.Project_Id;
|
||||
Current_Verbosity : Prj.Verbosity := Prj.Default;
|
||||
Tool_Package_Name : Name_Id := No_Name;
|
||||
|
||||
Project_Tree : constant Project_Tree_Ref :=
|
||||
new Project_Tree_Data (Is_Root_Tree => True);
|
||||
-- The project tree
|
||||
|
||||
All_Projects : Boolean := False;
|
||||
|
||||
Temp_File_Name : Path_Name_Type := No_Path;
|
||||
-- The name of the temporary text file to put a list of source/object
|
||||
-- files to pass to a tool.
|
||||
|
||||
package First_Switches is new Table.Table
|
||||
(Table_Component_Type => String_Access,
|
||||
Table_Index_Type => Integer,
|
||||
|
|
@ -222,16 +257,177 @@ procedure GNATCmd is
|
|||
Unixsws => null)
|
||||
);
|
||||
|
||||
subtype SA is String_Access;
|
||||
|
||||
Naming_String : constant SA := new String'("naming");
|
||||
Gnatls_String : constant SA := new String'("gnatls");
|
||||
|
||||
Packages_To_Check_By_Gnatls : constant String_List_Access :=
|
||||
new String_List'((Naming_String, Gnatls_String));
|
||||
|
||||
Packages_To_Check : String_List_Access := Prj.All_Packages;
|
||||
|
||||
-----------------------
|
||||
-- Local Subprograms --
|
||||
-----------------------
|
||||
|
||||
procedure Check_Files;
|
||||
-- For GNAT LIST -V, check if a project file is specified, without any file
|
||||
-- arguments and without a switch -files=. If it is the case, invoke the
|
||||
-- GNAT tool with the proper list of files, derived from the sources of
|
||||
-- the project.
|
||||
|
||||
procedure Output_Version;
|
||||
-- Output the version of this program
|
||||
|
||||
procedure Usage;
|
||||
-- Display usage
|
||||
|
||||
-----------------
|
||||
-- Check_Files --
|
||||
-----------------
|
||||
|
||||
procedure Check_Files is
|
||||
Add_Sources : Boolean := True;
|
||||
Unit : Prj.Unit_Index;
|
||||
Subunit : Boolean := False;
|
||||
FD : File_Descriptor := Invalid_FD;
|
||||
Status : Integer;
|
||||
Success : Boolean;
|
||||
|
||||
procedure Add_To_Response_File
|
||||
(File_Name : String;
|
||||
Check_File : Boolean := True);
|
||||
-- Include the file name passed as parameter in the response file for
|
||||
-- the tool being called. If the response file can not be written then
|
||||
-- the file name is passed in the parameter list of the tool. If the
|
||||
-- Check_File parameter is True then the procedure verifies the
|
||||
-- existence of the file before adding it to the response file.
|
||||
|
||||
--------------------------
|
||||
-- Add_To_Response_File --
|
||||
--------------------------
|
||||
|
||||
procedure Add_To_Response_File
|
||||
(File_Name : String;
|
||||
Check_File : Boolean := True)
|
||||
is
|
||||
begin
|
||||
Name_Len := 0;
|
||||
|
||||
Add_Str_To_Name_Buffer (File_Name);
|
||||
|
||||
if not Check_File or else
|
||||
Is_Regular_File (Name_Buffer (1 .. Name_Len))
|
||||
then
|
||||
if FD /= Invalid_FD then
|
||||
Name_Len := Name_Len + 1;
|
||||
Name_Buffer (Name_Len) := ASCII.LF;
|
||||
|
||||
Status := Write (FD, Name_Buffer (1)'Address, Name_Len);
|
||||
|
||||
if Status /= Name_Len then
|
||||
Osint.Fail ("disk full");
|
||||
end if;
|
||||
else
|
||||
Last_Switches.Increment_Last;
|
||||
Last_Switches.Table (Last_Switches.Last) :=
|
||||
new String'(File_Name);
|
||||
end if;
|
||||
end if;
|
||||
end Add_To_Response_File;
|
||||
|
||||
-- Start of processing for Check_Files
|
||||
|
||||
begin
|
||||
-- Check if there is at least one argument that is not a switch
|
||||
|
||||
for Index in 1 .. Last_Switches.Last loop
|
||||
if Last_Switches.Table (Index) (1) /= '-'
|
||||
or else (Last_Switches.Table (Index).all'Length > 7
|
||||
and then Last_Switches.Table (Index) (1 .. 7) = "-files=")
|
||||
then
|
||||
Add_Sources := False;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- If all arguments are switches and there is no switch -files=, add the
|
||||
-- path names of all the sources of the main project.
|
||||
|
||||
if Add_Sources then
|
||||
Tempdir.Create_Temp_File (FD, Temp_File_Name);
|
||||
Last_Switches.Increment_Last;
|
||||
Last_Switches.Table (Last_Switches.Last) :=
|
||||
new String'("-files=" & Get_Name_String (Temp_File_Name));
|
||||
|
||||
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
|
||||
while Unit /= No_Unit_Index loop
|
||||
|
||||
-- We only need to put the library units, body or spec, but not
|
||||
-- the subunits.
|
||||
|
||||
if Unit.File_Names (Impl) /= null
|
||||
and then not Unit.File_Names (Impl).Locally_Removed
|
||||
then
|
||||
-- There is a body, check if it is for this project
|
||||
|
||||
if All_Projects
|
||||
or else Unit.File_Names (Impl).Project = Project
|
||||
then
|
||||
Subunit := False;
|
||||
|
||||
if Unit.File_Names (Spec) = null
|
||||
or else Unit.File_Names (Spec).Locally_Removed
|
||||
then
|
||||
-- We have a body with no spec: we need to check if
|
||||
-- this is a subunit, because gnatls will complain
|
||||
-- about subunits.
|
||||
|
||||
declare
|
||||
Src_Ind : constant Source_File_Index :=
|
||||
Sinput.P.Load_Project_File
|
||||
(Get_Name_String
|
||||
(Unit.File_Names (Impl).Path.Name));
|
||||
begin
|
||||
Subunit := Sinput.P.Source_File_Is_Subunit (Src_Ind);
|
||||
end;
|
||||
end if;
|
||||
|
||||
if not Subunit then
|
||||
Add_To_Response_File
|
||||
(Get_Name_String (Unit.File_Names (Impl).Display_File),
|
||||
Check_File => False);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
elsif Unit.File_Names (Spec) /= null
|
||||
and then not Unit.File_Names (Spec).Locally_Removed
|
||||
then
|
||||
-- We have a spec with no body. Check if it is for this project
|
||||
|
||||
if All_Projects
|
||||
or else Unit.File_Names (Spec).Project = Project
|
||||
then
|
||||
Add_To_Response_File
|
||||
(Get_Name_String (Unit.File_Names (Spec).Display_File),
|
||||
Check_File => False);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
|
||||
end loop;
|
||||
|
||||
if FD /= Invalid_FD then
|
||||
Close (FD, Success);
|
||||
|
||||
if not Success then
|
||||
Osint.Fail ("disk full");
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end Check_Files;
|
||||
|
||||
--------------------
|
||||
-- Output_Version --
|
||||
--------------------
|
||||
|
|
@ -293,8 +489,23 @@ procedure GNATCmd is
|
|||
-- Start of processing for GNATCmd
|
||||
|
||||
begin
|
||||
-- All output from GNATCmd is debugging or error output: send to stderr
|
||||
|
||||
Set_Standard_Error;
|
||||
|
||||
-- Initializations
|
||||
|
||||
Csets.Initialize;
|
||||
Snames.Initialize;
|
||||
Stringt.Initialize;
|
||||
|
||||
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
|
||||
|
||||
Project_Node_Tree := new Project_Node_Tree_Data;
|
||||
Prj.Tree.Initialize (Project_Node_Tree);
|
||||
|
||||
Prj.Initialize (Project_Tree);
|
||||
|
||||
Last_Switches.Init;
|
||||
Last_Switches.Set_Last (0);
|
||||
|
||||
|
|
@ -485,21 +696,27 @@ begin
|
|||
or else The_Command = List
|
||||
then
|
||||
declare
|
||||
Project_File_Used : Boolean := False;
|
||||
Switch : String_Access;
|
||||
Dash_V_Switch : constant String := "-V";
|
||||
|
||||
begin
|
||||
for J in 1 .. Last_Switches.Last loop
|
||||
Switch := Last_Switches.Table (J);
|
||||
|
||||
if The_Command = List and then Switch.all = Dash_V_Switch
|
||||
then
|
||||
Call_GPR_Tool := False;
|
||||
exit;
|
||||
end if;
|
||||
|
||||
if Switch'Length >= 2
|
||||
and then Switch (Switch'First .. Switch'First + 1) = "-P"
|
||||
then
|
||||
Project_File_Used := True;
|
||||
exit;
|
||||
Call_GPR_Tool := True;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if Project_File_Used then
|
||||
if Call_GPR_Tool then
|
||||
case The_Command is
|
||||
when Make | Compile | Bind | Link =>
|
||||
if Locate_Exec_On_Path (Gprbuild) /= null then
|
||||
|
|
@ -602,6 +819,382 @@ begin
|
|||
end;
|
||||
end if;
|
||||
|
||||
if The_Command = List and then not Call_GPR_Tool then
|
||||
Tool_Package_Name := Name_Gnatls;
|
||||
Packages_To_Check := Packages_To_Check_By_Gnatls;
|
||||
|
||||
-- Check that the switches are consistent. Detect project file
|
||||
-- related switches.
|
||||
|
||||
Inspect_Switches : declare
|
||||
Arg_Num : Positive := 1;
|
||||
Argv : String_Access;
|
||||
|
||||
procedure Remove_Switch (Num : Positive);
|
||||
-- Remove a project related switch from table Last_Switches
|
||||
|
||||
-------------------
|
||||
-- Remove_Switch --
|
||||
-------------------
|
||||
|
||||
procedure Remove_Switch (Num : Positive) is
|
||||
begin
|
||||
Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
|
||||
Last_Switches.Table (Num + 1 .. Last_Switches.Last);
|
||||
Last_Switches.Decrement_Last;
|
||||
end Remove_Switch;
|
||||
|
||||
-- Start of processing for Inspect_Switches
|
||||
|
||||
begin
|
||||
while Arg_Num <= Last_Switches.Last loop
|
||||
Argv := Last_Switches.Table (Arg_Num);
|
||||
|
||||
if Argv (Argv'First) = '-' then
|
||||
if Argv'Length = 1 then
|
||||
Fail ("switch character cannot be followed by a blank");
|
||||
end if;
|
||||
|
||||
-- --subdirs=... Specify Subdirs
|
||||
|
||||
if Argv'Length > Makeutl.Subdirs_Option'Length
|
||||
and then
|
||||
Argv
|
||||
(Argv'First ..
|
||||
Argv'First + Makeutl.Subdirs_Option'Length - 1) =
|
||||
Makeutl.Subdirs_Option
|
||||
then
|
||||
Subdirs :=
|
||||
new String'
|
||||
(Argv (Argv'First + Makeutl.Subdirs_Option'Length ..
|
||||
Argv'Last));
|
||||
|
||||
Remove_Switch (Arg_Num);
|
||||
|
||||
-- -aPdir Add dir to the project search path
|
||||
|
||||
elsif Argv'Length > 3
|
||||
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
|
||||
then
|
||||
Prj.Env.Add_Directories
|
||||
(Root_Environment.Project_Path,
|
||||
Argv (Argv'First + 3 .. Argv'Last));
|
||||
|
||||
-- Pass -aPdir to gnatls, but not to other tools
|
||||
|
||||
if The_Command = List then
|
||||
Arg_Num := Arg_Num + 1;
|
||||
else
|
||||
Remove_Switch (Arg_Num);
|
||||
end if;
|
||||
|
||||
-- -eL Follow links for files
|
||||
|
||||
elsif Argv.all = "-eL" then
|
||||
Follow_Links_For_Files := True;
|
||||
Follow_Links_For_Dirs := True;
|
||||
|
||||
Remove_Switch (Arg_Num);
|
||||
|
||||
-- -vPx Specify verbosity while parsing project files
|
||||
|
||||
elsif Argv'Length >= 3
|
||||
and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
|
||||
then
|
||||
if Argv'Length = 4
|
||||
and then Argv (Argv'Last) in '0' .. '2'
|
||||
then
|
||||
case Argv (Argv'Last) is
|
||||
when '0' =>
|
||||
Current_Verbosity := Prj.Default;
|
||||
when '1' =>
|
||||
Current_Verbosity := Prj.Medium;
|
||||
when '2' =>
|
||||
Current_Verbosity := Prj.High;
|
||||
when others =>
|
||||
|
||||
-- Cannot happen
|
||||
|
||||
raise Program_Error;
|
||||
end case;
|
||||
else
|
||||
Fail ("invalid verbosity level: "
|
||||
& Argv (Argv'First + 3 .. Argv'Last));
|
||||
end if;
|
||||
|
||||
Remove_Switch (Arg_Num);
|
||||
|
||||
-- -Pproject_file Specify project file to be used
|
||||
|
||||
elsif Argv (Argv'First + 1) = 'P' then
|
||||
|
||||
-- Only one -P switch can be used
|
||||
|
||||
if Project_File /= null then
|
||||
Fail
|
||||
(Argv.all
|
||||
& ": second project file forbidden (first is """
|
||||
& Project_File.all & """)");
|
||||
|
||||
elsif Argv'Length = 2 then
|
||||
|
||||
-- There is space between -P and the project file
|
||||
-- name. -P cannot be the last option.
|
||||
|
||||
if Arg_Num = Last_Switches.Last then
|
||||
Fail ("project file name missing after -P");
|
||||
|
||||
else
|
||||
Remove_Switch (Arg_Num);
|
||||
Argv := Last_Switches.Table (Arg_Num);
|
||||
|
||||
-- After -P, there must be a project file name,
|
||||
-- not another switch.
|
||||
|
||||
if Argv (Argv'First) = '-' then
|
||||
Fail ("project file name missing after -P");
|
||||
|
||||
else
|
||||
Project_File := new String'(Argv.all);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
else
|
||||
-- No space between -P and project file name
|
||||
|
||||
Project_File :=
|
||||
new String'(Argv (Argv'First + 2 .. Argv'Last));
|
||||
end if;
|
||||
|
||||
Remove_Switch (Arg_Num);
|
||||
|
||||
-- -Xexternal=value Specify an external reference to be
|
||||
-- used in project files
|
||||
|
||||
elsif Argv'Length >= 5
|
||||
and then Argv (Argv'First + 1) = 'X'
|
||||
then
|
||||
if not Check (Root_Environment.External,
|
||||
Argv (Argv'First + 2 .. Argv'Last))
|
||||
then
|
||||
Fail
|
||||
(Argv.all & " is not a valid external assignment.");
|
||||
end if;
|
||||
|
||||
Remove_Switch (Arg_Num);
|
||||
|
||||
elsif
|
||||
The_Command = List
|
||||
and then Argv'Length = 2
|
||||
and then Argv (2) = 'U'
|
||||
then
|
||||
All_Projects := True;
|
||||
Remove_Switch (Arg_Num);
|
||||
|
||||
else
|
||||
Arg_Num := Arg_Num + 1;
|
||||
end if;
|
||||
|
||||
else
|
||||
Arg_Num := Arg_Num + 1;
|
||||
end if;
|
||||
end loop;
|
||||
end Inspect_Switches;
|
||||
end if;
|
||||
|
||||
-- Add the default project search directories now, after the directories
|
||||
-- that have been specified by switches -aP<dir>.
|
||||
|
||||
Prj.Env.Initialize_Default_Project_Path
|
||||
(Root_Environment.Project_Path,
|
||||
Target_Name => Sdefault.Target_Name.all);
|
||||
|
||||
-- If there is a project file specified, parse it, get the switches
|
||||
-- for the tool and setup PATH environment variables.
|
||||
|
||||
if Project_File /= null then
|
||||
Prj.Pars.Set_Verbosity (To => Current_Verbosity);
|
||||
|
||||
Prj.Pars.Parse
|
||||
(Project => Project,
|
||||
In_Tree => Project_Tree,
|
||||
In_Node_Tree => Project_Node_Tree,
|
||||
Project_File_Name => Project_File.all,
|
||||
Env => Root_Environment,
|
||||
Packages_To_Check => Packages_To_Check);
|
||||
|
||||
-- Prj.Pars.Parse calls Set_Standard_Output, reset to stderr
|
||||
|
||||
Set_Standard_Error;
|
||||
|
||||
if Project = Prj.No_Project then
|
||||
Fail ("""" & Project_File.all & """ processing failed");
|
||||
|
||||
elsif Project.Qualifier = Aggregate then
|
||||
Fail ("aggregate projects are not supported");
|
||||
|
||||
elsif Aggregate_Libraries_In (Project_Tree) then
|
||||
Fail ("aggregate library projects are not supported");
|
||||
end if;
|
||||
|
||||
-- Check if a package with the name of the tool is in the project
|
||||
-- file and if there is one, get the switches, if any, and scan them.
|
||||
|
||||
declare
|
||||
Pkg : constant Prj.Package_Id :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Tool_Package_Name,
|
||||
In_Packages => Project.Decl.Packages,
|
||||
Shared => Project_Tree.Shared);
|
||||
|
||||
Element : Package_Element;
|
||||
|
||||
Switches_Array : Array_Element_Id;
|
||||
|
||||
The_Switches : Prj.Variable_Value;
|
||||
Current : Prj.String_List_Id;
|
||||
The_String : String_Element;
|
||||
|
||||
Main : String_Access := null;
|
||||
|
||||
begin
|
||||
if Pkg /= No_Package then
|
||||
Element := Project_Tree.Shared.Packages.Table (Pkg);
|
||||
|
||||
-- Package Gnatls has a single attribute Switches, that is not
|
||||
-- an associative array.
|
||||
|
||||
if The_Command = List then
|
||||
The_Switches :=
|
||||
Prj.Util.Value_Of
|
||||
(Variable_Name => Snames.Name_Switches,
|
||||
In_Variables => Element.Decl.Attributes,
|
||||
Shared => Project_Tree.Shared);
|
||||
|
||||
-- Packages Binder (for gnatbind), Cross_Reference (for
|
||||
-- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
|
||||
-- have an attributed Switches, an associative array, indexed
|
||||
-- by the name of the file.
|
||||
|
||||
-- They also have an attribute Default_Switches, indexed by the
|
||||
-- name of the programming language.
|
||||
|
||||
else
|
||||
-- First check if there is a single main
|
||||
|
||||
for J in 1 .. Last_Switches.Last loop
|
||||
if Last_Switches.Table (J) (1) /= '-' then
|
||||
if Main = null then
|
||||
Main := Last_Switches.Table (J);
|
||||
else
|
||||
Main := null;
|
||||
exit;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if Main /= null then
|
||||
Switches_Array :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Switches,
|
||||
In_Arrays => Element.Decl.Arrays,
|
||||
Shared => Project_Tree.Shared);
|
||||
Name_Len := 0;
|
||||
|
||||
-- If the single main has been specified as an absolute
|
||||
-- path, use only the simple file name. If the absolute
|
||||
-- path is incorrect, an error will be reported by the
|
||||
-- underlying tool and it does not make a difference
|
||||
-- what switches are used.
|
||||
|
||||
if Is_Absolute_Path (Main.all) then
|
||||
Add_Str_To_Name_Buffer (File_Name (Main.all));
|
||||
else
|
||||
Add_Str_To_Name_Buffer (Main.all);
|
||||
end if;
|
||||
|
||||
The_Switches := Prj.Util.Value_Of
|
||||
(Index => Name_Find,
|
||||
Src_Index => 0,
|
||||
In_Array => Switches_Array,
|
||||
Shared => Project_Tree.Shared);
|
||||
end if;
|
||||
|
||||
if The_Switches.Kind = Prj.Undefined then
|
||||
Switches_Array :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Default_Switches,
|
||||
In_Arrays => Element.Decl.Arrays,
|
||||
Shared => Project_Tree.Shared);
|
||||
The_Switches := Prj.Util.Value_Of
|
||||
(Index => Name_Ada,
|
||||
Src_Index => 0,
|
||||
In_Array => Switches_Array,
|
||||
Shared => Project_Tree.Shared);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- If there are switches specified in the package of the
|
||||
-- project file corresponding to the tool, scan them.
|
||||
|
||||
case The_Switches.Kind is
|
||||
when Prj.Undefined =>
|
||||
null;
|
||||
|
||||
when Prj.Single =>
|
||||
declare
|
||||
Switch : constant String :=
|
||||
Get_Name_String (The_Switches.Value);
|
||||
begin
|
||||
if Switch'Length > 0 then
|
||||
First_Switches.Increment_Last;
|
||||
First_Switches.Table (First_Switches.Last) :=
|
||||
new String'(Switch);
|
||||
end if;
|
||||
end;
|
||||
|
||||
when Prj.List =>
|
||||
Current := The_Switches.Values;
|
||||
while Current /= Prj.Nil_String loop
|
||||
The_String := Project_Tree.Shared.String_Elements.
|
||||
Table (Current);
|
||||
|
||||
declare
|
||||
Switch : constant String :=
|
||||
Get_Name_String (The_String.Value);
|
||||
begin
|
||||
if Switch'Length > 0 then
|
||||
First_Switches.Increment_Last;
|
||||
First_Switches.Table (First_Switches.Last) :=
|
||||
new String'(Switch);
|
||||
end if;
|
||||
end;
|
||||
|
||||
Current := The_String.Next;
|
||||
end loop;
|
||||
end case;
|
||||
end if;
|
||||
end;
|
||||
|
||||
if The_Command = Bind or else The_Command = Link then
|
||||
if Project.Object_Directory.Name = No_Path then
|
||||
Fail ("project " & Get_Name_String (Project.Display_Name)
|
||||
& " has no object directory");
|
||||
end if;
|
||||
|
||||
Change_Dir (Get_Name_String (Project.Object_Directory.Name));
|
||||
end if;
|
||||
|
||||
-- Set up the env vars for project path files
|
||||
|
||||
Prj.Env.Set_Ada_Paths
|
||||
(Project, Project_Tree, Including_Libraries => True);
|
||||
|
||||
if The_Command = List then
|
||||
Check_Files;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Gather all the arguments and invoke the executable
|
||||
|
||||
declare
|
||||
|
|
|
|||
|
|
@ -6413,16 +6413,29 @@ package body Make is
|
|||
-- Scan again the switch and arguments, now that we are sure that they
|
||||
-- do not include --version or --help.
|
||||
|
||||
-- First, for native gnatmake, check for switch -P and, if found and
|
||||
-- gprbuild is available, silently invoke gprbuild.
|
||||
-- First, check for switch -P and, if found and gprbuild is available,
|
||||
-- silently invoke gprbuild, with switch --target if not on a native
|
||||
-- platform.
|
||||
|
||||
Find_Program_Name;
|
||||
declare
|
||||
Arg_Len : Positive := Argument_Count;
|
||||
Call_Gprbuild : Boolean := False;
|
||||
Gprbuild : String_Access := null;
|
||||
Pos : Natural := 0;
|
||||
Success : Boolean;
|
||||
Target : String_Access := null;
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "gnatmake" then
|
||||
declare
|
||||
Call_Gprbuild : Boolean := False;
|
||||
begin
|
||||
Find_Program_Name;
|
||||
|
||||
if Name_Len >= 8
|
||||
and then Name_Buffer (Name_Len - 7 .. Name_Len) = "gnatmake"
|
||||
then
|
||||
if Name_Len > 8 then
|
||||
Target := new String'(Name_Buffer (1 .. Name_Len - 9));
|
||||
Arg_Len := Arg_Len + 1;
|
||||
end if;
|
||||
|
||||
begin
|
||||
for J in 1 .. Argument_Count loop
|
||||
declare
|
||||
Arg : constant String := Argument (J);
|
||||
|
|
@ -6437,16 +6450,20 @@ package body Make is
|
|||
end loop;
|
||||
|
||||
if Call_Gprbuild then
|
||||
declare
|
||||
Gprbuild : String_Access :=
|
||||
Locate_Exec_On_Path (Exec_Name => "gprbuild");
|
||||
Args : Argument_List (1 .. Argument_Count);
|
||||
Success : Boolean;
|
||||
Gprbuild := Locate_Exec_On_Path (Exec_Name => "gprbuild");
|
||||
|
||||
if Gprbuild /= null then
|
||||
declare
|
||||
Args : Argument_List (1 .. Arg_Len);
|
||||
begin
|
||||
if Target /= null then
|
||||
Args (1) := new String'("--target=" & Target.all);
|
||||
Pos := 1;
|
||||
end if;
|
||||
|
||||
begin
|
||||
if Gprbuild /= null then
|
||||
for J in 1 .. Argument_Count loop
|
||||
Args (J) := new String'(Argument (J));
|
||||
Pos := Pos + 1;
|
||||
Args (Pos) := new String'(Argument (J));
|
||||
end loop;
|
||||
|
||||
Spawn (Gprbuild.all, Args, Success);
|
||||
|
|
@ -6456,11 +6473,11 @@ package body Make is
|
|||
if Success then
|
||||
Exit_Program (E_Success);
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
||||
Scan_Args : for Next_Arg in 1 .. Argument_Count loop
|
||||
Scan_Make_Arg (Env, Argument (Next_Arg), And_Save => True);
|
||||
|
|
|
|||
|
|
@ -14052,7 +14052,7 @@ package body Sem_Ch12 is
|
|||
begin
|
||||
Result := Make_Identifier (Loc, Chars (Typ));
|
||||
|
||||
if Present (Scop) and then Scop /= Standard_Standard then
|
||||
if Present (Scop) and then not Is_Generic_Unit (Scop) then
|
||||
Result :=
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => Make_Identifier (Loc, Chars (Scop)),
|
||||
|
|
|
|||
Loading…
Reference in New Issue