make.adb (Check_Mains, [...]): Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix...
* make.adb (Check_Mains, Switches_Of): Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). Take into account Externally_Built attribute. * clean.adb (In_Extension_Chain): Always return False when one of the parameter is No_Project. (Clean_Project): Adapt to changes in package Prj (Lang_Ada => Ada_Language_Index). (Gnatclean): Adapt to change in package Prj.Pars (no parameter Process_Languages for procedure Parse). * gnatcmd.adb (Carg_Switches): New table. (GNATCmd): Put all switches following -cargs in the Carg_Switches table. Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * mlib-prj.adb: Adapt to changes in packages Prj and Prj.Com: type Header_Num and function Hash are now declared in package Prj, not Prj.Com. * prj.adb (Suffix_Of): New function. (Set (Suffix)): New procedure. (Hash): One function moved from Prj.Com (Is_Present, Language_Processing_Data_Of): New functions (Set): Two new procedures (Add_Language_Name, Display_Language_Name): New procedures * prj.ads: (Suffix_Of): New function (Set (Suffix)): New procedure Add several types and tables for multi-language support. (Header_Num): Type moved from Prj.Com (Hash): Two functions moved from Prj.Com (Is_Present, Language_Processing_Data_Of): New functions (Set): Two new procedures (Add_Language_Name, Display_Language_Name): New procedures (Naming): Component name changes: Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix. Add new components: Impl_Suffixes, Supp_Suffixes. (Project_Data): New components: Externally_Built, Supp_Languages, First_Language_Processing, Supp_Language_Processing, Default_Linker, Default_Linker_Path. * prj-attr.adb: Add new attributes Ada_Roots and Externally_Built and new package Language_Processing with its attributes (Compiler_Driver, Compiler_Kind, Dependency_Option, Compute_Dependency, Include_Option, Binder_Driver, Default_Linker). * prj-com.ads, prj-com.adb (Hash): Function moved to package Prj. (Header_Num): Type moved to package Prj * prj-env.adb: Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * prj-ext.adb: Add the default project dir (<prefix>/log/gnat) by default to the project path, except the "-" is one of the directories in env var ADA_PROJECT_PATH. (Current_Project_Path): Global variable, replacing Project_Path that was in the body of Prj.Part. (Project_Path): New function (Set_Project_Path): New procedure Initialize Current_Project_Path during elaboration of the package Remove dependency on Prj.Com, no longer needed * prj-ext.ads (Project_Path): New function (Set_Project_Path): New procedure * prj-nmsc.adb (Body_Suffix_Of): New function. Returns .<lang> when no suffix is defined for language <lang>. (Find_Sources, Record_Other_Sources): Use Body_Suffix_Of, instead of accessing directly the components of Naming. (Look_For_Sources): Use Set (Suffix) to set the suffix of a language. Reorganise of this package. Break procedure Check in several procedures. * prj-nmsc.ads: Replace all procedures (Ada_Check, Other_Languages_Check and Language_Independent_Check) with a single procedure Check. * prj-pars.ads, prj-pars.adb (Parse): Remove parameter Process_Languages, no longer needed. * prj-part.adb (Project_Path): Move to the body of Prj.Ext as Current_Project_Path. Remove elaboration code, moved to the body of Prj.Ext Use new function Prj.Ext.Project_Path instead of old variable Project_Path. (Post_Parse_Context_Clause): Get Resolved_Path as a case-sensitive path. When comparing with project paths on the stack, first put the resolved path in canonical case. (Parse_Single_Project): Set the path name of the project file in the tree to the normalized path. * prj-proc.ads, prj-proc.adb (Check, Recursive_Check, Process): Remove parameter Process_Languages, no longer needed. (Recursive_Check): Call Prj.Nmsc.Check, instead of Ada_Check and Other_Languages_Check. * prj-tree.ads (Project_Name_And_Node): New component Canonical_Path to store the resolved canonical path of the project file. Remove dependency to Prj.Com, no longer needed * prj-util.adb: Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * snames.ads, snames.adb: New standard names: Ada_Roots, Binder_Driver, Compiler_Driver, Compiler_Kind, Compute_Dependency, Default_Linker, Externally_Built, Include_Option, Language_Processing. * makegpr.adb: Numerous changes due to changes in packages Prj and Prj.Nmsc. * gnatls.adb: Add the default project dir (<prefix>/log/gnat) by default to the project path, except whe "-" is one of the directories in env var ADA_PROJECT_PATH. (Gnatls): In verbose mode, add the new section "Project Search Path:" From-SVN: r91877
This commit is contained in:
Arnaud Charlet
parent
a7e5b6df8d
commit
44e1918abd
|
|
@ -30,7 +30,7 @@ with ALI; use ALI;
|
|||
with Csets;
|
||||
with Gnatvsn;
|
||||
with Hostparm;
|
||||
with Makeutl; use Makeutl;
|
||||
with Makeutl;
|
||||
with MLib.Tgt; use MLib.Tgt;
|
||||
with Namet; use Namet;
|
||||
with Opt; use Opt;
|
||||
|
|
@ -593,7 +593,7 @@ package body Clean is
|
|||
Put_Line ("""");
|
||||
end if;
|
||||
|
||||
-- Add project to the list of proceesed projects
|
||||
-- Add project to the list of processed projects
|
||||
|
||||
Processed_Projects.Increment_Last;
|
||||
Processed_Projects.Table (Processed_Projects.Last) := Project;
|
||||
|
|
@ -611,7 +611,7 @@ package body Clean is
|
|||
-- Look through the units to find those that are either immediate
|
||||
-- sources or inherited sources of the project.
|
||||
|
||||
if Data.Languages (Lang_Ada) then
|
||||
if Data.Languages (Ada_Language_Index) then
|
||||
for Unit in 1 .. Prj.Com.Units.Last loop
|
||||
U_Data := Prj.Com.Units.Table (Unit);
|
||||
File_Name1 := No_Name;
|
||||
|
|
@ -787,7 +787,9 @@ package body Clean is
|
|||
-- If it is a library with only non Ada sources, delete
|
||||
-- the fake archive and the dependency file, if they exist.
|
||||
|
||||
if Data.Library and then not Data.Languages (Lang_Ada) then
|
||||
if Data.Library
|
||||
and then not Data.Languages (Ada_Language_Index)
|
||||
then
|
||||
Clean_Archive (Project);
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -1105,8 +1107,7 @@ package body Clean is
|
|||
Prj.Pars.Parse
|
||||
(Project => Main_Project,
|
||||
Project_File_Name => Project_File_Name.all,
|
||||
Packages_To_Check => Packages_To_Check_By_Gnatmake,
|
||||
Process_Languages => All_Languages);
|
||||
Packages_To_Check => Packages_To_Check_By_Gnatmake);
|
||||
|
||||
if Main_Project = No_Project then
|
||||
Fail ("""" & Project_File_Name.all & """ processing failed");
|
||||
|
|
@ -1202,6 +1203,10 @@ package body Clean is
|
|||
Data : Project_Data;
|
||||
|
||||
begin
|
||||
if Prj = No_Project or else Of_Project = No_Project then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Of_Project = Prj then
|
||||
return True;
|
||||
end if;
|
||||
|
|
@ -1276,13 +1281,13 @@ package body Clean is
|
|||
begin
|
||||
-- Do not insert an empty name or an already marked source
|
||||
|
||||
if Lib_File /= No_Name and then not Is_Marked (Lib_File) then
|
||||
if Lib_File /= No_Name and then not Makeutl.Is_Marked (Lib_File) then
|
||||
Q.Table (Q.Last) := Lib_File;
|
||||
Q.Increment_Last;
|
||||
|
||||
-- Mark the source that has been just added to the Q
|
||||
|
||||
Mark (Lib_File);
|
||||
Makeutl.Mark (Lib_File);
|
||||
end if;
|
||||
end Insert_Q;
|
||||
|
||||
|
|
|
|||
|
|
@ -74,8 +74,6 @@ procedure GNATCmd is
|
|||
-- files to pass to a tool, when there are more than
|
||||
-- Max_Files_On_The_Command_Line files.
|
||||
|
||||
-- A table to keep the switches from the project file
|
||||
|
||||
package First_Switches is new Table.Table
|
||||
(Table_Component_Type => String_Access,
|
||||
Table_Index_Type => Integer,
|
||||
|
|
@ -83,6 +81,16 @@ procedure GNATCmd is
|
|||
Table_Initial => 20,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Gnatcmd.First_Switches");
|
||||
-- A table to keep the switches from the project file
|
||||
|
||||
package Carg_Switches is new Table.Table
|
||||
(Table_Component_Type => String_Access,
|
||||
Table_Index_Type => Integer,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 20,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Gnatcmd.Carg_Switches");
|
||||
-- A table to keep the switches following -cargs for ASIS tools
|
||||
|
||||
package Library_Paths is new Table.Table (
|
||||
Table_Component_Type => String_Access,
|
||||
|
|
@ -152,6 +160,10 @@ procedure GNATCmd is
|
|||
-- Local Subprograms --
|
||||
-----------------------
|
||||
|
||||
procedure Add_To_Carg_Switches (Switch : String_Access);
|
||||
-- Add a switch to the Carg_Switches table. If it is the first one,
|
||||
-- put the switch "-cargs" at the beginning of the table.
|
||||
|
||||
procedure Check_Files;
|
||||
-- For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project
|
||||
-- file is specified, without any file arguments. If it is the case,
|
||||
|
|
@ -209,6 +221,23 @@ procedure GNATCmd is
|
|||
-- If it is and it includes directory information, prepend the path with
|
||||
-- Parent.This subprogram is only called when using project files.
|
||||
|
||||
--------------------------
|
||||
-- Add_To_Carg_Switches --
|
||||
--------------------------
|
||||
|
||||
procedure Add_To_Carg_Switches (Switch : String_Access) is
|
||||
begin
|
||||
-- If the Carg_Switches table is empty, put "-cargs" at the beginning
|
||||
|
||||
if Carg_Switches.Last = 0 then
|
||||
Carg_Switches.Increment_Last;
|
||||
Carg_Switches.Table (Carg_Switches.Last) := new String'("-cargs");
|
||||
end if;
|
||||
|
||||
Carg_Switches.Increment_Last;
|
||||
Carg_Switches.Table (Carg_Switches.Last) := Switch;
|
||||
end Add_To_Carg_Switches;
|
||||
|
||||
-----------------
|
||||
-- Check_Files --
|
||||
-----------------
|
||||
|
|
@ -966,6 +995,8 @@ begin
|
|||
|
||||
First_Switches.Init;
|
||||
First_Switches.Set_Last (0);
|
||||
Carg_Switches.Init;
|
||||
Carg_Switches.Set_Last (0);
|
||||
|
||||
VMS_Conv.Initialize;
|
||||
|
||||
|
|
@ -1626,20 +1657,40 @@ begin
|
|||
or else The_Command = Stub
|
||||
or else The_Command = Elim
|
||||
then
|
||||
-- If -cargs is one of the switches, move the following
|
||||
-- switches to the Carg_Switches table.
|
||||
|
||||
for J in 1 .. First_Switches.Last loop
|
||||
if First_Switches.Table (J).all = "-cargs" then
|
||||
for K in J + 1 .. First_Switches.Last loop
|
||||
Add_To_Carg_Switches (First_Switches.Table (K));
|
||||
end loop;
|
||||
First_Switches.Set_Last (J - 1);
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
for J in 1 .. Last_Switches.Last loop
|
||||
if Last_Switches.Table (J).all = "-cargs" then
|
||||
for K in J + 1 .. Last_Switches.Last loop
|
||||
Add_To_Carg_Switches (Last_Switches.Table (K));
|
||||
end loop;
|
||||
Last_Switches.Set_Last (J - 1);
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
declare
|
||||
CP_File : constant Name_Id := Configuration_Pragmas_File;
|
||||
|
||||
begin
|
||||
if CP_File /= No_Name then
|
||||
First_Switches.Increment_Last;
|
||||
|
||||
if The_Command = Elim then
|
||||
First_Switches.Increment_Last;
|
||||
First_Switches.Table (First_Switches.Last) :=
|
||||
new String'("-C" & Get_Name_String (CP_File));
|
||||
|
||||
else
|
||||
First_Switches.Table (First_Switches.Last) :=
|
||||
new String'("-gnatec=" & Get_Name_String (CP_File));
|
||||
Add_To_Carg_Switches
|
||||
(new String'("-gnatec=" & Get_Name_String (CP_File)));
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
|
@ -1698,7 +1749,7 @@ begin
|
|||
-- indicate to gnatstub the name of the body file with
|
||||
-- a -o switch.
|
||||
|
||||
if Data.Naming.Current_Spec_Suffix /=
|
||||
if Data.Naming.Ada_Spec_Suffix /=
|
||||
Prj.Default_Ada_Spec_Suffix
|
||||
then
|
||||
if File_Index /= 0 then
|
||||
|
|
@ -1708,14 +1759,14 @@ begin
|
|||
Last : Natural := Spec'Last;
|
||||
|
||||
begin
|
||||
Get_Name_String (Data.Naming.Current_Spec_Suffix);
|
||||
Get_Name_String (Data.Naming.Ada_Spec_Suffix);
|
||||
|
||||
if Spec'Length > Name_Len
|
||||
and then Spec (Last - Name_Len + 1 .. Last) =
|
||||
Name_Buffer (1 .. Name_Len)
|
||||
then
|
||||
Last := Last - Name_Len;
|
||||
Get_Name_String (Data.Naming.Current_Body_Suffix);
|
||||
Get_Name_String (Data.Naming.Ada_Body_Suffix);
|
||||
Last_Switches.Increment_Last;
|
||||
Last_Switches.Table (Last_Switches.Last) :=
|
||||
new String'("-o");
|
||||
|
|
@ -1753,7 +1804,7 @@ begin
|
|||
end if;
|
||||
|
||||
-- For gnatmetric, the generated files should be put in the
|
||||
-- object directory. This must be the first dwitch, because it may
|
||||
-- object directory. This must be the first switch, because it may
|
||||
-- be overriden by a switch in package Metrics in the project file
|
||||
-- or by a command line option.
|
||||
|
||||
|
|
@ -1783,7 +1834,9 @@ begin
|
|||
|
||||
declare
|
||||
The_Args : Argument_List
|
||||
(1 .. First_Switches.Last + Last_Switches.Last);
|
||||
(1 .. First_Switches.Last +
|
||||
Last_Switches.Last +
|
||||
Carg_Switches.Last);
|
||||
Arg_Num : Natural := 0;
|
||||
|
||||
begin
|
||||
|
|
@ -1797,6 +1850,11 @@ begin
|
|||
The_Args (Arg_Num) := Last_Switches.Table (J);
|
||||
end loop;
|
||||
|
||||
for J in 1 .. Carg_Switches.Last loop
|
||||
Arg_Num := Arg_Num + 1;
|
||||
The_Args (Arg_Num) := Carg_Switches.Table (J);
|
||||
end loop;
|
||||
|
||||
-- If Display_Command is on, only display the generated command
|
||||
|
||||
if Display_Command then
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@ with Osint; use Osint;
|
|||
with Osint.L; use Osint.L;
|
||||
with Output; use Output;
|
||||
with Rident; use Rident;
|
||||
with Sdefault;
|
||||
with Snames;
|
||||
with Targparm; use Targparm;
|
||||
with Types; use Types;
|
||||
|
|
@ -47,6 +48,18 @@ with GNAT.Case_Util; use GNAT.Case_Util;
|
|||
procedure Gnatls is
|
||||
pragma Ident (Gnat_Static_Version_String);
|
||||
|
||||
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
|
||||
-- Name of the env. variable that contains path name(s) of directories
|
||||
-- where project files may reside.
|
||||
|
||||
Project_Search_Path : constant String := "Project Search Path:";
|
||||
-- Label displayed in verbose mode before the directories in the project
|
||||
-- search path.
|
||||
-- NOTE: This string may be used by other tools, such as GPS; so, it
|
||||
-- should not be modified inconsiderately.
|
||||
|
||||
No_Project_Default_Dir : constant String := "-";
|
||||
|
||||
Max_Column : constant := 80;
|
||||
|
||||
No_Obj : aliased String := "<no_obj>";
|
||||
|
|
@ -1522,6 +1535,105 @@ begin
|
|||
Write_Eol;
|
||||
end loop;
|
||||
|
||||
Write_Eol;
|
||||
Write_Eol;
|
||||
Write_Str (Project_Search_Path);
|
||||
Write_Eol;
|
||||
Write_Str (" <Current_Directory>");
|
||||
Write_Eol;
|
||||
|
||||
declare
|
||||
Project_Path : constant String_Access := Getenv (Ada_Project_Path);
|
||||
|
||||
Lib : constant String :=
|
||||
Directory_Separator & "lib" & Directory_Separator;
|
||||
|
||||
First : Natural;
|
||||
Last : Natural;
|
||||
|
||||
Add_Default_Dir : Boolean := True;
|
||||
|
||||
begin
|
||||
-- If there is a project path, display each directory in the path
|
||||
|
||||
if Project_Path.all /= "" then
|
||||
First := Project_Path'First;
|
||||
|
||||
loop
|
||||
while First <= Project_Path'Last
|
||||
and then (Project_Path (First) = Path_Separator)
|
||||
loop
|
||||
First := First + 1;
|
||||
end loop;
|
||||
|
||||
exit when First > Project_Path'Last;
|
||||
|
||||
Last := First;
|
||||
|
||||
while Last < Project_Path'Last
|
||||
and then Project_Path (Last + 1) /= Path_Separator
|
||||
loop
|
||||
Last := Last + 1;
|
||||
end loop;
|
||||
|
||||
-- If the directory is No_Default_Project_Dir, set
|
||||
-- Add_Default_Dir to False
|
||||
|
||||
if Project_Path (First .. Last) = No_Project_Default_Dir then
|
||||
Add_Default_Dir := False;
|
||||
|
||||
elsif First /= Last or else Project_Path (First) /= '.' then
|
||||
-- If the directory is ".", skip it as it is the current
|
||||
-- directory and it is already the first directory in the
|
||||
-- project path.
|
||||
|
||||
Write_Str (" ");
|
||||
Write_Str (Project_Path (First .. Last));
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
First := Last + 1;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Add the default dir, except if "-" was one of the "directories"
|
||||
-- specified in ADA_PROJECT_DIR.
|
||||
|
||||
if Add_Default_Dir then
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer (Sdefault.Search_Dir_Prefix.all);
|
||||
|
||||
-- On Windows, make sure that all directory separators are '\'
|
||||
|
||||
if Directory_Separator /= '/' then
|
||||
for J in 1 .. Name_Len loop
|
||||
if Name_Buffer (J) = '/' then
|
||||
Name_Buffer (J) := Directory_Separator;
|
||||
end if;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Find the sequence "/lib/"
|
||||
|
||||
while Name_Len >= Lib'Length
|
||||
and then Name_Buffer (Name_Len - 4 .. Name_Len) /= Lib
|
||||
loop
|
||||
Name_Len := Name_Len - 1;
|
||||
end loop;
|
||||
|
||||
-- If the sequence "/lib"/ was found, display the default
|
||||
-- directory <prefix>/lib/gnat/.
|
||||
|
||||
if Name_Len >= 5 then
|
||||
Write_Str (" ");
|
||||
Write_Str (Name_Buffer (1 .. Name_Len));
|
||||
Write_Str ("gnat");
|
||||
Write_Char (Directory_Separator);
|
||||
Write_Eol;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
|
|
|
|||
219
gcc/ada/make.adb
219
gcc/ada/make.adb
|
|
@ -43,7 +43,6 @@ with Namet; use Namet;
|
|||
with Opt; use Opt;
|
||||
with Osint.M; use Osint.M;
|
||||
with Osint; use Osint;
|
||||
with Gnatvsn;
|
||||
with Output; use Output;
|
||||
with Prj; use Prj;
|
||||
with Prj.Com;
|
||||
|
|
@ -120,7 +119,7 @@ package body Make is
|
|||
-- reinitialized, the elements between Q.First and Q.Last - 1 are unmarked.
|
||||
|
||||
procedure Init_Q;
|
||||
-- Must be called to (re)initialize the Q.
|
||||
-- Must be called to (re)initialize the Q
|
||||
|
||||
procedure Insert_Q
|
||||
(Source_File : File_Name_Type;
|
||||
|
|
@ -130,13 +129,13 @@ package body Make is
|
|||
-- for external use (gnatdist). Provide index for multi-unit sources.
|
||||
|
||||
function Empty_Q return Boolean;
|
||||
-- Returns True if Q is empty.
|
||||
-- Returns True if Q is empty
|
||||
|
||||
procedure Extract_From_Q
|
||||
(Source_File : out File_Name_Type;
|
||||
Source_Unit : out Unit_Name_Type;
|
||||
Source_Index : out Int);
|
||||
-- Extracts the first element from the Q.
|
||||
-- Extracts the first element from the Q
|
||||
|
||||
procedure Insert_Project_Sources
|
||||
(The_Project : Project_Id;
|
||||
|
|
@ -151,10 +150,10 @@ package body Make is
|
|||
-- from projects being extended.
|
||||
|
||||
First_Q_Initialization : Boolean := True;
|
||||
-- Will be set to false after Init_Q has been called once.
|
||||
-- Will be set to false after Init_Q has been called once
|
||||
|
||||
Q_Front : Natural;
|
||||
-- Points to the first valid element in the Q.
|
||||
-- Points to the first valid element in the Q
|
||||
|
||||
Unique_Compile : Boolean := False;
|
||||
-- Set to True if -u or -U or a project file with no main is used
|
||||
|
|
@ -182,7 +181,7 @@ package body Make is
|
|||
Table_Initial => 4000,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Make.Q");
|
||||
-- This is the actual Q.
|
||||
-- This is the actual Q
|
||||
|
||||
-- The following instantiations and variables are necessary to save what
|
||||
-- is found on the command line, in case there is a project file specified.
|
||||
|
|
@ -284,7 +283,7 @@ package body Make is
|
|||
-- Avoid calling Change_Dir if the current working directory is already
|
||||
-- this directory
|
||||
|
||||
-- Packages of project files where unknown attributes are errors.
|
||||
-- Packages of project files where unknown attributes are errors
|
||||
|
||||
Naming_String : aliased String := "naming";
|
||||
Builder_String : aliased String := "builder";
|
||||
|
|
@ -338,7 +337,7 @@ package body Make is
|
|||
Table_Initial => 20,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Make.Bad_Compilation");
|
||||
-- Full name of all the source files for which compilation fails.
|
||||
-- Full name of all the source files for which compilation fails
|
||||
|
||||
Do_Compile_Step : Boolean := True;
|
||||
Do_Bind_Step : Boolean := True;
|
||||
|
|
@ -411,7 +410,7 @@ package body Make is
|
|||
This : Name_Id;
|
||||
Depends_On : Name_Id;
|
||||
end record;
|
||||
-- Components of table Dependencies below.
|
||||
-- Components of table Dependencies below
|
||||
|
||||
package Dependencies is new Table.Table (
|
||||
Table_Component_Type => Dependency,
|
||||
|
|
@ -473,10 +472,10 @@ package body Make is
|
|||
-- between the call to Compile_Sources and List_Depend.)
|
||||
|
||||
procedure Inform (N : Name_Id := No_Name; Msg : String);
|
||||
-- Prints out the program name followed by a colon, N and S.
|
||||
-- Prints out the program name followed by a colon, N and S
|
||||
|
||||
procedure List_Bad_Compilations;
|
||||
-- Prints out the list of all files for which the compilation failed.
|
||||
-- Prints out the list of all files for which the compilation failed
|
||||
|
||||
procedure Verbose_Msg
|
||||
(N1 : Name_Id;
|
||||
|
|
@ -485,9 +484,8 @@ package body Make is
|
|||
S2 : String := "";
|
||||
Prefix : String := " -> ");
|
||||
-- If the verbose flag (Verbose_Mode) is set then print Prefix to standard
|
||||
-- output followed by N1 and S1. If N2 /= No_Name then N2 is then printed
|
||||
-- after S1. S2 is printed last. Both N1 and N2 are printed in quotation
|
||||
-- marks.
|
||||
-- output followed by N1 and S1. If N2 /= No_Name then N2 is printed after
|
||||
-- S1. S2 is printed last. Both N1 and N2 are printed in quotation marks.
|
||||
|
||||
Usage_Needed : Boolean := True;
|
||||
-- Flag used to make sure Makeusg is call at most once
|
||||
|
|
@ -497,7 +495,7 @@ package body Make is
|
|||
-- Set Usage_Needed to False.
|
||||
|
||||
procedure Debug_Msg (S : String; N : Name_Id);
|
||||
-- If Debug.Debug_Flag_W is set outputs string S followed by name N.
|
||||
-- If Debug.Debug_Flag_W is set outputs string S followed by name N
|
||||
|
||||
procedure Recursive_Compute_Depth
|
||||
(Project : Project_Id;
|
||||
|
|
@ -587,7 +585,7 @@ package body Make is
|
|||
Saved_Gcc : String_Access := null;
|
||||
Saved_Gnatbind : String_Access := null;
|
||||
Saved_Gnatlink : String_Access := null;
|
||||
-- Given by the command line. Will be used, if non null.
|
||||
-- Given by the command line. Will be used, if non null
|
||||
|
||||
Gcc_Path : String_Access :=
|
||||
GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
|
||||
|
|
@ -613,7 +611,7 @@ package body Make is
|
|||
-- Set to True when compiling with -gnats
|
||||
|
||||
Display_Executed_Programs : Boolean := True;
|
||||
-- Set to True if name of commands should be output on stderr.
|
||||
-- Set to True if name of commands should be output on stderr
|
||||
|
||||
Output_File_Name_Seen : Boolean := False;
|
||||
-- Set to True after having scanned the file_name for
|
||||
|
|
@ -624,14 +622,14 @@ package body Make is
|
|||
-- switch "-D obj_dir".
|
||||
|
||||
Object_Directory_Path : String_Access := null;
|
||||
-- The path name of the object directory, set with switch -D.
|
||||
-- The path name of the object directory, set with switch -D
|
||||
|
||||
type Make_Program_Type is (None, Compiler, Binder, Linker);
|
||||
|
||||
Program_Args : Make_Program_Type := None;
|
||||
-- Used to indicate if we are scanning gnatmake, gcc, gnatbind, or gnatbind
|
||||
-- options within the gnatmake command line.
|
||||
-- Used in Scan_Make_Arg only, but must be a global variable.
|
||||
-- options within the gnatmake command line. Used in Scan_Make_Arg only,
|
||||
-- but must be global since value preserved from one call to another.
|
||||
|
||||
Temporary_Config_File : Boolean := False;
|
||||
-- Set to True when there is a temporary config file used for a project
|
||||
|
|
@ -1209,13 +1207,13 @@ package body Make is
|
|||
-- Full name of current library file
|
||||
|
||||
Full_Obj_File : File_Name_Type;
|
||||
-- Full name of the object file corresponding to Lib_File.
|
||||
-- Full name of the object file corresponding to Lib_File
|
||||
|
||||
Lib_Stamp : Time_Stamp_Type;
|
||||
-- Time stamp of the current ada library file.
|
||||
-- Time stamp of the current ada library file
|
||||
|
||||
Obj_Stamp : Time_Stamp_Type;
|
||||
-- Time stamp of the current object file.
|
||||
-- Time stamp of the current object file
|
||||
|
||||
Modified_Source : File_Name_Type;
|
||||
-- The first source in Lib_File whose current time stamp differs
|
||||
|
|
@ -1640,13 +1638,13 @@ package body Make is
|
|||
O_File := No_File;
|
||||
O_Stamp := (others => ' ');
|
||||
|
||||
-- Process linker options from the ALI files.
|
||||
-- Process linker options from the ALI files
|
||||
|
||||
for Opt in 1 .. Linker_Options.Last loop
|
||||
Check_File (Linker_Options.Table (Opt).Name);
|
||||
end loop;
|
||||
|
||||
-- Process options given on the command line.
|
||||
-- Process options given on the command line
|
||||
|
||||
for Opt in Linker_Switches.First .. Linker_Switches.Last loop
|
||||
|
||||
|
|
@ -1907,7 +1905,7 @@ package body Make is
|
|||
end record;
|
||||
|
||||
Running_Compile : array (1 .. Max_Process) of Compilation_Data;
|
||||
-- Used to save information about outstanding compilations.
|
||||
-- Used to save information about outstanding compilations
|
||||
|
||||
Outstanding_Compiles : Natural := 0;
|
||||
-- Current number of outstanding compiles
|
||||
|
|
@ -1928,10 +1926,10 @@ package body Make is
|
|||
-- Full name of the current library file
|
||||
|
||||
Obj_File : File_Name_Type;
|
||||
-- Full name of the object file corresponding to Lib_File.
|
||||
-- Full name of the object file corresponding to Lib_File
|
||||
|
||||
Obj_Stamp : Time_Stamp_Type;
|
||||
-- Time stamp of the current object file.
|
||||
-- Time stamp of the current object file
|
||||
|
||||
Sfile : File_Name_Type;
|
||||
-- Contains the source file of the units withed by Source_File
|
||||
|
|
@ -1939,6 +1937,8 @@ package body Make is
|
|||
ALI : ALI_Id;
|
||||
-- ALI Id of the current ALI file
|
||||
|
||||
-- Comment following declarations ???
|
||||
|
||||
Read_Only : Boolean := False;
|
||||
|
||||
Compilation_OK : Boolean;
|
||||
|
|
@ -1950,10 +1950,13 @@ package body Make is
|
|||
Mfile : Natural := No_Mapping_File;
|
||||
|
||||
Need_To_Check_Standard_Library : Boolean :=
|
||||
Check_Readonly_Files and not Unique_Compile;
|
||||
Check_Readonly_Files
|
||||
and not Unique_Compile;
|
||||
|
||||
Mapping_File_Arg : String_Access;
|
||||
|
||||
Process_Created : Boolean := False;
|
||||
|
||||
procedure Add_Process
|
||||
(Pid : Process_Id;
|
||||
Sfile : File_Name_Type;
|
||||
|
|
@ -1982,7 +1985,7 @@ package body Make is
|
|||
-- to wait for.
|
||||
|
||||
function Bad_Compilation_Count return Natural;
|
||||
-- Returns the number of compilation failures.
|
||||
-- Returns the number of compilation failures
|
||||
|
||||
procedure Check_Standard_Library;
|
||||
-- Check if s-stalib.adb needs to be compiled
|
||||
|
|
@ -2008,17 +2011,17 @@ package body Make is
|
|||
Table_Initial => 50,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Make.Good_ALI");
|
||||
-- Contains the set of valid ALI files that have not yet been scanned.
|
||||
-- Contains the set of valid ALI files that have not yet been scanned
|
||||
|
||||
function Good_ALI_Present return Boolean;
|
||||
-- Returns True if any ALI file was recorded in the previous set.
|
||||
-- Returns True if any ALI file was recorded in the previous set
|
||||
|
||||
procedure Get_Mapping_File (Project : Project_Id);
|
||||
-- Get a mapping file name. If there is one to be reused, reuse it.
|
||||
-- Otherwise, create a new mapping file.
|
||||
|
||||
function Get_Next_Good_ALI return ALI_Id;
|
||||
-- Returns the next good ALI_Id record;
|
||||
-- Returns the next good ALI_Id record
|
||||
|
||||
procedure Record_Failure
|
||||
(File : File_Name_Type;
|
||||
|
|
@ -2029,7 +2032,7 @@ package body Make is
|
|||
-- could not find it. Records also Unit when possible.
|
||||
|
||||
procedure Record_Good_ALI (A : ALI_Id);
|
||||
-- Records in the previous set the Id of an ALI file.
|
||||
-- Records in the previous set the Id of an ALI file
|
||||
|
||||
-----------------
|
||||
-- Add_Process --
|
||||
|
|
@ -2197,9 +2200,12 @@ package body Make is
|
|||
(Source_File : File_Name_Type; Source_Index : Int)
|
||||
is
|
||||
begin
|
||||
-- Process_Created will be set True if an attempt is made to compile
|
||||
-- the source, that is if it is not in an externally built project.
|
||||
|
||||
-- If arguments have not yet been collected (in Check), collect them
|
||||
-- now.
|
||||
Process_Created := False;
|
||||
|
||||
-- If arguments not yet collected (in Check), collect them now
|
||||
|
||||
if not Arguments_Collected then
|
||||
Collect_Arguments (Source_File, Source_Index, Args);
|
||||
|
|
@ -2215,50 +2221,53 @@ package body Make is
|
|||
-- check for an eventual library project, and use the full path.
|
||||
|
||||
if Arguments_Project /= No_Project then
|
||||
Prj.Env.Set_Ada_Paths (Arguments_Project, True);
|
||||
if not Projects.Table (Arguments_Project).Externally_Built then
|
||||
Prj.Env.Set_Ada_Paths (Arguments_Project, True);
|
||||
|
||||
if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
|
||||
declare
|
||||
The_Data : Project_Data :=
|
||||
Projects.Table (Arguments_Project);
|
||||
Prj : Project_Id := Arguments_Project;
|
||||
if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
|
||||
declare
|
||||
The_Data : Project_Data :=
|
||||
Projects.Table (Arguments_Project);
|
||||
|
||||
begin
|
||||
while The_Data.Extended_By /= No_Project loop
|
||||
Prj := The_Data.Extended_By;
|
||||
The_Data := Projects.Table (Prj);
|
||||
end loop;
|
||||
Prj : Project_Id := Arguments_Project;
|
||||
|
||||
if The_Data.Library
|
||||
and then not The_Data.Need_To_Build_Lib
|
||||
then
|
||||
-- Add to the Q all sources of the project that
|
||||
-- have not been marked
|
||||
begin
|
||||
while The_Data.Extended_By /= No_Project loop
|
||||
Prj := The_Data.Extended_By;
|
||||
The_Data := Projects.Table (Prj);
|
||||
end loop;
|
||||
|
||||
Insert_Project_Sources
|
||||
(The_Project => Prj,
|
||||
All_Projects => False,
|
||||
Into_Q => True);
|
||||
if The_Data.Library
|
||||
and then not The_Data.Need_To_Build_Lib
|
||||
then
|
||||
-- Add to the Q all sources of the project that
|
||||
-- have not been marked
|
||||
|
||||
-- Now mark the project as processed
|
||||
Insert_Project_Sources
|
||||
(The_Project => Prj,
|
||||
All_Projects => False,
|
||||
Into_Q => True);
|
||||
|
||||
Projects.Table (Prj).Need_To_Build_Lib := True;
|
||||
end if;
|
||||
end;
|
||||
-- Now mark the project as processed
|
||||
|
||||
Projects.Table (Prj).Need_To_Build_Lib := True;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Change to the object directory of the project file,
|
||||
-- if necessary.
|
||||
|
||||
Change_To_Object_Directory (Arguments_Project);
|
||||
|
||||
Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index,
|
||||
Arguments (1 .. Last_Argument));
|
||||
Process_Created := True;
|
||||
end if;
|
||||
|
||||
-- Change to the object directory of the project file,
|
||||
-- if necessary.
|
||||
|
||||
Change_To_Object_Directory (Arguments_Project);
|
||||
|
||||
Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index,
|
||||
Arguments (1 .. Last_Argument));
|
||||
|
||||
else
|
||||
-- If this is a source outside of any project file, make sure
|
||||
-- it will be compiled in the object directory of the main project
|
||||
-- file.
|
||||
-- If this is a source outside of any project file, make sure it
|
||||
-- will be compiled in object directory of the main project file.
|
||||
|
||||
if Main_Project /= No_Project then
|
||||
Change_To_Object_Directory (Arguments_Project);
|
||||
|
|
@ -2266,6 +2275,7 @@ package body Make is
|
|||
|
||||
Pid := Compile (Full_Source_File, Lib_File, Source_Index,
|
||||
Arguments (1 .. Last_Argument));
|
||||
Process_Created := True;
|
||||
end if;
|
||||
end Collect_Arguments_And_Compile;
|
||||
|
||||
|
|
@ -2403,8 +2413,7 @@ package body Make is
|
|||
L /= Strip_Directory (L) or else
|
||||
Object_Directory_Path /= null
|
||||
then
|
||||
|
||||
-- Build -o argument.
|
||||
-- Build -o argument
|
||||
|
||||
Get_Name_String (L);
|
||||
|
||||
|
|
@ -2542,7 +2551,7 @@ package body Make is
|
|||
begin
|
||||
pragma Assert (Args'First = 1);
|
||||
|
||||
-- Package and Queue initializations.
|
||||
-- Package and Queue initializations
|
||||
|
||||
Good_ALI.Init;
|
||||
Output.Set_Standard_Error;
|
||||
|
|
@ -2690,7 +2699,7 @@ package body Make is
|
|||
|
||||
if not Need_To_Compile then
|
||||
|
||||
-- The ALI file is up-to-date. Record its Id.
|
||||
-- The ALI file is up-to-date. Record its Id
|
||||
|
||||
Record_Good_ALI (ALI);
|
||||
|
||||
|
|
@ -2742,15 +2751,17 @@ package body Make is
|
|||
|
||||
-- Make sure we could successfully start the compilation
|
||||
|
||||
if Pid = Invalid_Pid then
|
||||
Record_Failure (Full_Source_File, Source_Unit);
|
||||
else
|
||||
Add_Process
|
||||
(Pid,
|
||||
Full_Source_File,
|
||||
Lib_File,
|
||||
Source_Unit,
|
||||
Mfile);
|
||||
if Process_Created then
|
||||
if Pid = Invalid_Pid then
|
||||
Record_Failure (Full_Source_File, Source_Unit);
|
||||
else
|
||||
Add_Process
|
||||
(Pid,
|
||||
Full_Source_File,
|
||||
Lib_File,
|
||||
Source_Unit,
|
||||
Mfile);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -2970,7 +2981,7 @@ package body Make is
|
|||
function Absolute_Path
|
||||
(Path : Name_Id;
|
||||
Project : Project_Id) return String;
|
||||
-- Returns an absolute path for a configuration pragmas file.
|
||||
-- Returns an absolute path for a configuration pragmas file
|
||||
|
||||
-------------------
|
||||
-- Absolute_Path --
|
||||
|
|
@ -3455,14 +3466,14 @@ package body Make is
|
|||
Locate_Regular_File
|
||||
(Main &
|
||||
Get_Name_String
|
||||
(Data.Naming.Current_Body_Suffix),
|
||||
(Data.Naming.Ada_Body_Suffix),
|
||||
"");
|
||||
if Real_Path = null then
|
||||
Real_Path :=
|
||||
Locate_Regular_File
|
||||
(Main &
|
||||
Get_Name_String
|
||||
(Data.Naming.Current_Spec_Suffix),
|
||||
(Data.Naming.Ada_Spec_Suffix),
|
||||
"");
|
||||
end if;
|
||||
|
||||
|
|
@ -3970,6 +3981,13 @@ package body Make is
|
|||
Write_Eol;
|
||||
end if;
|
||||
|
||||
if Main_Project /= No_Project
|
||||
and then Projects.Table (Main_Project).Externally_Built
|
||||
then
|
||||
Make_Failed
|
||||
("nothing to do for a main project that is externally built");
|
||||
end if;
|
||||
|
||||
if Osint.Number_Of_Files = 0 then
|
||||
if Main_Project /= No_Project
|
||||
and then Projects.Table (Main_Project).Library
|
||||
|
|
@ -4338,12 +4356,13 @@ package body Make is
|
|||
for Proj in Projects.First .. Projects.Last loop
|
||||
if Projects.Table (Proj).Library then
|
||||
Projects.Table (Proj).Need_To_Build_Lib :=
|
||||
not MLib.Tgt.Library_Exists_For (Proj);
|
||||
(not MLib.Tgt.Library_Exists_For (Proj))
|
||||
and then (not Projects.Table (Proj).Externally_Built);
|
||||
|
||||
if Projects.Table (Proj).Need_To_Build_Lib then
|
||||
|
||||
-- If there is no object directory, then it will be
|
||||
-- impossible to build the library. So, we fail
|
||||
-- immediately.
|
||||
-- impossible to build the library. So fail immediately.
|
||||
|
||||
if Projects.Table (Proj).Object_Directory = No_Name then
|
||||
Make_Failed
|
||||
|
|
@ -4640,13 +4659,13 @@ package body Make is
|
|||
|
||||
Name_Buffer (Name_Len + 1 ..
|
||||
Name_Len + Exec_File_Name'Length) :=
|
||||
Exec_File_Name;
|
||||
Exec_File_Name;
|
||||
|
||||
Name_Len := Name_Len + Exec_File_Name'Length;
|
||||
Executable := Name_Find;
|
||||
Non_Std_Executable := True;
|
||||
end if;
|
||||
end;
|
||||
|
||||
end if;
|
||||
|
||||
if Do_Compile_Step then
|
||||
|
|
@ -4658,7 +4677,7 @@ package body Make is
|
|||
Youngest_Obj_Stamp : Time_Stamp_Type;
|
||||
|
||||
Executable_Stamp : Time_Stamp_Type;
|
||||
-- Executable is the final executable program.
|
||||
-- Executable is the final executable program
|
||||
|
||||
Library_Rebuilt : Boolean := False;
|
||||
|
||||
|
|
@ -4701,7 +4720,6 @@ package body Make is
|
|||
if Total_Compilation_Failures /= 0 then
|
||||
if Keep_Going then
|
||||
goto Next_Main;
|
||||
|
||||
else
|
||||
List_Bad_Compilations;
|
||||
raise Compilation_Failed;
|
||||
|
|
@ -4736,6 +4754,7 @@ package body Make is
|
|||
|
||||
if Projects.Table (Proj1).Library
|
||||
and then not Projects.Table (Proj1).Need_To_Build_Lib
|
||||
and then not Projects.Table (Proj1).Externally_Built
|
||||
then
|
||||
MLib.Prj.Check_Library (Proj1);
|
||||
end if;
|
||||
|
|
@ -5289,7 +5308,7 @@ package body Make is
|
|||
end Link_Step;
|
||||
end if;
|
||||
|
||||
-- We go to here when we skip the bind and link steps.
|
||||
-- We go to here when we skip the bind and link steps
|
||||
|
||||
<<Next_Main>>
|
||||
|
||||
|
|
@ -5631,7 +5650,7 @@ package body Make is
|
|||
|
||||
Check_Object_Consistency := True;
|
||||
|
||||
-- Package initializations. The order of calls is important here.
|
||||
-- Package initializations. The order of calls is important here
|
||||
|
||||
Output.Set_Standard_Error;
|
||||
|
||||
|
|
@ -6270,7 +6289,7 @@ package body Make is
|
|||
B : Byte;
|
||||
|
||||
begin
|
||||
-- Dir last character is supposed to be a directory separator.
|
||||
-- Dir last character is supposed to be a directory separator
|
||||
|
||||
Name_Len := Dir'Length;
|
||||
Name_Buffer (1 .. Name_Len) := Dir;
|
||||
|
|
@ -6971,9 +6990,9 @@ package body Make is
|
|||
Name : String (1 .. Source_File_Name'Length + 3);
|
||||
Last : Positive := Source_File_Name'Length;
|
||||
Spec_Suffix : constant String :=
|
||||
Get_Name_String (Naming.Current_Spec_Suffix);
|
||||
Get_Name_String (Naming.Ada_Spec_Suffix);
|
||||
Body_Suffix : constant String :=
|
||||
Get_Name_String (Naming.Current_Body_Suffix);
|
||||
Get_Name_String (Naming.Ada_Body_Suffix);
|
||||
Truncated : Boolean := False;
|
||||
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -105,15 +105,27 @@ package body Makegpr is
|
|||
Last_Source : Natural := 0;
|
||||
-- The index of the last valid component of Source_Indexes
|
||||
|
||||
Compiler_Names : array (Programming_Language) of String_Access;
|
||||
Compiler_Names : array (First_Language_Indexes) of String_Access;
|
||||
-- The names of the compilers to be used. Set up by Get_Compiler.
|
||||
-- Used to display the commands spawned.
|
||||
|
||||
Compiler_Paths : array (Programming_Language) of String_Access;
|
||||
Gnatmake_String : constant String_Access := new String'("gnatmake");
|
||||
GCC_String : constant String_Access := new String'("gcc");
|
||||
G_Plus_Plus_String : constant String_Access := new String'("g++");
|
||||
|
||||
Default_Compiler_Names : constant array
|
||||
(First_Language_Indexes range
|
||||
Ada_Language_Index .. C_Plus_Plus_Language_Index)
|
||||
of String_Access :=
|
||||
(Ada_Language_Index => Gnatmake_String,
|
||||
C_Language_Index => GCC_String,
|
||||
C_Plus_Plus_Language_Index => G_Plus_Plus_String);
|
||||
|
||||
Compiler_Paths : array (First_Language_Indexes) of String_Access;
|
||||
-- The path names of the compiler to be used. Set up by Get_Compiler.
|
||||
-- Used to spawn compiling/linking processes.
|
||||
|
||||
Compiler_Is_Gcc : array (Programming_Language) of Boolean;
|
||||
Compiler_Is_Gcc : array (First_Language_Indexes) of Boolean;
|
||||
-- An indication that a compiler is a GCC compiler, to be able to use
|
||||
-- specific GCC switches.
|
||||
|
||||
|
|
@ -163,7 +175,7 @@ package body Makegpr is
|
|||
Current_Processor : Processor := None;
|
||||
-- This variable changes when switches -*args are used
|
||||
|
||||
Current_Language : Programming_Language := Lang_Ada;
|
||||
Current_Language : Language_Index := Ada_Language_Index;
|
||||
-- The compiler language to consider when Processor is Compiler
|
||||
|
||||
package Comp_Opts is new GNAT.Dynamic_Tables
|
||||
|
|
@ -172,7 +184,7 @@ package body Makegpr is
|
|||
Table_Low_Bound => 1,
|
||||
Table_Initial => 20,
|
||||
Table_Increment => 100);
|
||||
Options : array (Programming_Language) of Comp_Opts.Instance;
|
||||
Options : array (First_Language_Indexes) of Comp_Opts.Instance;
|
||||
-- Tables to store compiling options for the different compilers
|
||||
|
||||
package Linker_Options is new Table.Table
|
||||
|
|
@ -300,7 +312,7 @@ package body Makegpr is
|
|||
-- The environment variable to set when compiler is a GCC compiler
|
||||
-- to indicate the include directory path.
|
||||
|
||||
Current_Include_Paths : array (Programming_Language) of String_Access;
|
||||
Current_Include_Paths : array (First_Language_Indexes) of String_Access;
|
||||
-- A cache for the paths of included directories, to avoid setting
|
||||
-- env var CPATH unnecessarily.
|
||||
|
||||
|
|
@ -357,7 +369,7 @@ package body Makegpr is
|
|||
|
||||
procedure Add_Search_Directories
|
||||
(Data : Project_Data;
|
||||
Language : Programming_Language);
|
||||
Language : First_Language_Indexes);
|
||||
-- Either add to the Arguments the necessary -I switches needed to
|
||||
-- compile, or, when compiler is gcc/g++, set up the C*INCLUDE_PATH
|
||||
-- environment variable, if necessary.
|
||||
|
|
@ -368,7 +380,7 @@ package body Makegpr is
|
|||
procedure Add_Switches
|
||||
(Data : Project_Data;
|
||||
Proc : Processor;
|
||||
Language : Other_Programming_Language;
|
||||
Language : Language_Index;
|
||||
File_Name : Name_Id);
|
||||
-- Add to Arguments the switches, if any, for a source (attribute Switches)
|
||||
-- or language (attribute Default_Switches), coming from package Compiler
|
||||
|
|
@ -435,7 +447,7 @@ package body Makegpr is
|
|||
-- Display the command for a spawned process, if in Verbose_Mode or
|
||||
-- not in Quiet_Output.
|
||||
|
||||
procedure Get_Compiler (For_Language : Programming_Language);
|
||||
procedure Get_Compiler (For_Language : First_Language_Indexes);
|
||||
-- Find the compiler name and path name for a specified programming
|
||||
-- language, if not already done. Results are in the corresponding
|
||||
-- elements of arrays Compiler_Names and Compiler_Paths. Name of compiler
|
||||
|
|
@ -877,7 +889,7 @@ package body Makegpr is
|
|||
|
||||
procedure Add_Search_Directories
|
||||
(Data : Project_Data;
|
||||
Language : Programming_Language)
|
||||
Language : First_Language_Indexes)
|
||||
is
|
||||
begin
|
||||
-- If a GNU compiler is used, set the CPATH environment variable,
|
||||
|
|
@ -901,7 +913,7 @@ package body Makegpr is
|
|||
procedure Add_Switches
|
||||
(Data : Project_Data;
|
||||
Proc : Processor;
|
||||
Language : Other_Programming_Language;
|
||||
Language : Language_Index;
|
||||
File_Name : Name_Id)
|
||||
is
|
||||
Switches : Variable_Value;
|
||||
|
|
@ -953,7 +965,7 @@ package body Makegpr is
|
|||
(Name => Name_Default_Switches,
|
||||
In_Arrays => Packages.Table (Pkg).Decl.Arrays);
|
||||
Switches := Prj.Util.Value_Of
|
||||
(Index => Lang_Name_Ids (Language),
|
||||
(Index => Language_Names.Table (Language),
|
||||
Src_Index => 0,
|
||||
In_Array => Defaults);
|
||||
end if;
|
||||
|
|
@ -1546,7 +1558,7 @@ package body Makegpr is
|
|||
-- If there are sources in Ada, then gnatmake will build the
|
||||
-- library, so nothing to do.
|
||||
|
||||
if not Data.Languages (Lang_Ada) then
|
||||
if not Data.Languages (Ada_Language_Index) then
|
||||
|
||||
-- Get all the object files of the project
|
||||
|
||||
|
|
@ -1574,14 +1586,14 @@ package body Makegpr is
|
|||
-- building the library may fail with unresolved symbols.
|
||||
|
||||
if C_Plus_Plus_Is_Used then
|
||||
if Compiler_Names (Lang_C_Plus_Plus) = null then
|
||||
Get_Compiler (Lang_C_Plus_Plus);
|
||||
if Compiler_Names (C_Plus_Plus_Language_Index) = null then
|
||||
Get_Compiler (C_Plus_Plus_Language_Index);
|
||||
end if;
|
||||
|
||||
if Compiler_Is_Gcc (Lang_C_Plus_Plus) then
|
||||
if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer
|
||||
(Compiler_Names (Lang_C_Plus_Plus).all);
|
||||
(Compiler_Names (C_Plus_Plus_Language_Index).all);
|
||||
Driver_Name := Name_Find;
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -2022,7 +2034,9 @@ package body Makegpr is
|
|||
C_Plus_Plus_Is_Used := False;
|
||||
|
||||
for Project in 1 .. Projects.Last loop
|
||||
if Projects.Table (Project).Languages (Lang_C_Plus_Plus) then
|
||||
if
|
||||
Projects.Table (Project).Languages (C_Plus_Plus_Language_Index)
|
||||
then
|
||||
C_Plus_Plus_Is_Used := True;
|
||||
exit;
|
||||
end if;
|
||||
|
|
@ -2171,7 +2185,8 @@ package body Makegpr is
|
|||
if Compiler_Is_Gcc (Source.Language) then
|
||||
Add_Argument (Dash_x, Verbose_Mode);
|
||||
Add_Argument
|
||||
(Lang_Names (Source.Language), Verbose_Mode);
|
||||
(Get_Name_String (Language_Names.Table (Source.Language)),
|
||||
Verbose_Mode);
|
||||
end if;
|
||||
|
||||
Add_Argument (Dash_c, True);
|
||||
|
|
@ -2293,7 +2308,8 @@ package body Makegpr is
|
|||
Project_Name : String := Get_Name_String (Data.Name);
|
||||
Dummy : Boolean := False;
|
||||
|
||||
Ada_Is_A_Language : constant Boolean := Data.Languages (Lang_Ada);
|
||||
Ada_Is_A_Language : constant Boolean :=
|
||||
Data.Languages (Ada_Language_Index);
|
||||
|
||||
begin
|
||||
Ada_Mains.Init;
|
||||
|
|
@ -2398,7 +2414,7 @@ package body Makegpr is
|
|||
|
||||
-- Get the gnatmake to invoke
|
||||
|
||||
Get_Compiler (Lang_Ada);
|
||||
Get_Compiler (Ada_Language_Index);
|
||||
|
||||
-- Specify the project file
|
||||
|
||||
|
|
@ -2480,11 +2496,11 @@ package body Makegpr is
|
|||
|
||||
-- If there are compiling options for Ada, transmit them to gnatmake
|
||||
|
||||
if Comp_Opts.Last (Options (Lang_Ada)) /= 0 then
|
||||
if Comp_Opts.Last (Options (Ada_Language_Index)) /= 0 then
|
||||
Add_Argument (Dash_cargs, True);
|
||||
|
||||
for Arg in 1 .. Comp_Opts.Last (Options (Lang_Ada)) loop
|
||||
Add_Argument (Options (Lang_Ada).Table (Arg), True);
|
||||
for Arg in 1 .. Comp_Opts.Last (Options (Ada_Language_Index)) loop
|
||||
Add_Argument (Options (Ada_Language_Index).Table (Arg), True);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
|
@ -2513,10 +2529,11 @@ package body Makegpr is
|
|||
-- And invoke gnatmake
|
||||
|
||||
Display_Command
|
||||
(Compiler_Names (Lang_Ada).all, Compiler_Paths (Lang_Ada));
|
||||
(Compiler_Names (Ada_Language_Index).all,
|
||||
Compiler_Paths (Ada_Language_Index));
|
||||
|
||||
Spawn
|
||||
(Compiler_Paths (Lang_Ada).all,
|
||||
(Compiler_Paths (Ada_Language_Index).all,
|
||||
Arguments (1 .. Last_Argument),
|
||||
Success);
|
||||
|
||||
|
|
@ -2524,7 +2541,9 @@ package body Makegpr is
|
|||
|
||||
if not Success then
|
||||
Report_Error
|
||||
("invocation of ", Compiler_Names (Lang_Ada).all, " failed");
|
||||
("invocation of ",
|
||||
Compiler_Names (Ada_Language_Index).all,
|
||||
" failed");
|
||||
end if;
|
||||
|
||||
end Compile_Link_With_Gnatmake;
|
||||
|
|
@ -2612,7 +2631,7 @@ package body Makegpr is
|
|||
|
||||
if not Local_Errors
|
||||
and then Data.Library
|
||||
and then not Data.Languages (Lang_Ada)
|
||||
and then not Data.Languages (Ada_Language_Index)
|
||||
and then not Compile_Only
|
||||
then
|
||||
Build_Library (Project, Need_To_Rebuild_Archive);
|
||||
|
|
@ -2770,7 +2789,7 @@ package body Makegpr is
|
|||
-- Get_Compiler --
|
||||
------------------
|
||||
|
||||
procedure Get_Compiler (For_Language : Programming_Language) is
|
||||
procedure Get_Compiler (For_Language : First_Language_Indexes) is
|
||||
Data : constant Project_Data := Projects.Table (Main_Project);
|
||||
|
||||
Ide : constant Package_Id :=
|
||||
|
|
@ -2779,7 +2798,7 @@ package body Makegpr is
|
|||
|
||||
Compiler : constant Variable_Value :=
|
||||
Value_Of
|
||||
(Name => Lang_Name_Ids (For_Language),
|
||||
(Name => Language_Names.Table (For_Language),
|
||||
Index => 0,
|
||||
Attribute_Or_Array_Name => Name_Compiler_Command,
|
||||
In_Package => Ide);
|
||||
|
|
@ -2794,8 +2813,16 @@ package body Makegpr is
|
|||
-- IDE, use the default compiler for this language.
|
||||
|
||||
if Compiler = Nil_Variable_Value then
|
||||
Compiler_Names (For_Language) :=
|
||||
Default_Compiler_Names (For_Language);
|
||||
if For_Language in Default_Compiler_Names'Range then
|
||||
Compiler_Names (For_Language) :=
|
||||
Default_Compiler_Names (For_Language);
|
||||
|
||||
else
|
||||
Osint.Fail
|
||||
("unknow compiler name for language """,
|
||||
Get_Name_String (Language_Names.Table (For_Language)),
|
||||
"""");
|
||||
end if;
|
||||
|
||||
else
|
||||
Compiler_Names (For_Language) :=
|
||||
|
|
@ -2825,7 +2852,7 @@ package body Makegpr is
|
|||
-- Fail if compiler cannot be found
|
||||
|
||||
if Compiler_Paths (For_Language) = null then
|
||||
if For_Language = Lang_Ada then
|
||||
if For_Language = Ada_Language_Index then
|
||||
Osint.Fail
|
||||
("unable to locate """,
|
||||
Compiler_Names (For_Language).all,
|
||||
|
|
@ -2833,7 +2860,8 @@ package body Makegpr is
|
|||
|
||||
else
|
||||
Osint.Fail
|
||||
("unable to locate " & Lang_Display_Names (For_Language).all,
|
||||
("unable to locate " &
|
||||
Get_Name_String (Language_Names.Table (For_Language)),
|
||||
" compiler """, Compiler_Names (For_Language).all & '"');
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -3031,8 +3059,7 @@ package body Makegpr is
|
|||
Prj.Pars.Parse
|
||||
(Project => Main_Project,
|
||||
Project_File_Name => Project_File_Name.all,
|
||||
Packages_To_Check => Packages_To_Check,
|
||||
Process_Languages => Other_Languages);
|
||||
Packages_To_Check => Packages_To_Check);
|
||||
|
||||
-- Fail if parsing/processing was unsuccessful
|
||||
|
||||
|
|
@ -3238,9 +3265,9 @@ package body Makegpr is
|
|||
|
||||
procedure Add_C_Plus_Plus_Link_For_Gnatmake is
|
||||
begin
|
||||
if Compiler_Is_Gcc (Lang_C_Plus_Plus) then
|
||||
if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then
|
||||
Add_Argument
|
||||
("--LINK=" & Compiler_Names (Lang_C_Plus_Plus).all,
|
||||
("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all,
|
||||
Verbose_Mode);
|
||||
|
||||
else
|
||||
|
|
@ -3313,11 +3340,11 @@ package body Makegpr is
|
|||
|
||||
procedure Choose_C_Plus_Plus_Link_Process is
|
||||
begin
|
||||
if Compiler_Names (Lang_C_Plus_Plus) = null then
|
||||
Get_Compiler (Lang_C_Plus_Plus);
|
||||
if Compiler_Names (C_Plus_Plus_Language_Index) = null then
|
||||
Get_Compiler (C_Plus_Plus_Language_Index);
|
||||
end if;
|
||||
|
||||
if not Compiler_Is_Gcc (Lang_C_Plus_Plus) then
|
||||
if not Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then
|
||||
Change_Dir (Object_Dir);
|
||||
|
||||
declare
|
||||
|
|
@ -3332,7 +3359,7 @@ package body Makegpr is
|
|||
Put_Line (File, "LIBGCC=`gcc -print-libgcc-file-name`");
|
||||
Put_Line
|
||||
(File,
|
||||
Compiler_Names (Lang_C_Plus_Plus).all &
|
||||
Compiler_Names (C_Plus_Plus_Language_Index).all &
|
||||
" $* ${LIBGCC}");
|
||||
|
||||
Close (File);
|
||||
|
|
@ -3538,7 +3565,7 @@ package body Makegpr is
|
|||
|
||||
-- Only Ada sources in the main project, and even maybe not
|
||||
|
||||
if not Data.Languages (Lang_Ada) then
|
||||
if not Data.Languages (Ada_Language_Index) then
|
||||
|
||||
-- Fail if the main project has no source of any language
|
||||
|
||||
|
|
@ -3568,7 +3595,7 @@ package body Makegpr is
|
|||
-- There are other language sources. First check if there are also
|
||||
-- sources in Ada.
|
||||
|
||||
if Data.Languages (Lang_Ada) then
|
||||
if Data.Languages (Ada_Language_Index) then
|
||||
|
||||
-- There is a mix of Ada and other language sources in the main
|
||||
-- project. Any main that is not a source of the other languages
|
||||
|
|
@ -3694,7 +3721,7 @@ package body Makegpr is
|
|||
-- If C++ is one of the languages, add the --LINK switch to
|
||||
-- the linking switches.
|
||||
|
||||
if Data.Languages (Lang_C_Plus_Plus) then
|
||||
if Data.Languages (C_Plus_Plus_Language_Index) then
|
||||
Add_Argument (Dash_largs, Verbose_Mode);
|
||||
Add_C_Plus_Plus_Link_For_Gnatmake;
|
||||
Add_Argument (Dash_margs, Verbose_Mode);
|
||||
|
|
@ -3710,15 +3737,15 @@ package body Makegpr is
|
|||
|
||||
-- First, get the linker to invoke
|
||||
|
||||
if Data.Languages (Lang_C_Plus_Plus) then
|
||||
Get_Compiler (Lang_C_Plus_Plus);
|
||||
Linker_Name := Compiler_Names (Lang_C_Plus_Plus);
|
||||
Linker_Path := Compiler_Paths (Lang_C_Plus_Plus);
|
||||
if Data.Languages (C_Plus_Plus_Language_Index) then
|
||||
Get_Compiler (C_Plus_Plus_Language_Index);
|
||||
Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index);
|
||||
Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index);
|
||||
|
||||
else
|
||||
Get_Compiler (Lang_C);
|
||||
Linker_Name := Compiler_Names (Lang_C);
|
||||
Linker_Path := Compiler_Paths (Lang_C);
|
||||
Get_Compiler (C_Language_Index);
|
||||
Linker_Name := Compiler_Names (C_Language_Index);
|
||||
Linker_Path := Compiler_Paths (C_Language_Index);
|
||||
end if;
|
||||
|
||||
Link_Done := False;
|
||||
|
|
@ -3883,31 +3910,28 @@ package body Makegpr is
|
|||
|
||||
-- Set the processor/language for the following switches
|
||||
|
||||
-- -c???args: Compiler arguments
|
||||
-- -cargs: Ada compiler arguments
|
||||
|
||||
elsif Arg = "-cargs" then
|
||||
Current_Language := Ada_Language_Index;
|
||||
Current_Processor := Compiler;
|
||||
|
||||
elsif Arg'Length > 7 and then Arg (1 .. 7) = "-cargs:" then
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer (Arg (8 .. Arg'Last));
|
||||
To_Lower (Name_Buffer (1 .. Name_Len));
|
||||
|
||||
elsif Arg'Length >= 6
|
||||
and then Arg (Arg'First .. Arg'First + 1) = "-c"
|
||||
and then Arg (Arg'Last - 3 .. Arg'Last) = "args"
|
||||
then
|
||||
declare
|
||||
OK : Boolean := False;
|
||||
Args_String : constant String :=
|
||||
Arg (Arg'First + 2 .. Arg'Last - 4);
|
||||
|
||||
Lang : constant Name_Id := Name_Find;
|
||||
begin
|
||||
for Lang in Programming_Language loop
|
||||
if Args_String = Lang_Args (Lang).all then
|
||||
OK := True;
|
||||
Current_Language := Lang;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
Current_Language := Language_Indexes.Get (Lang);
|
||||
|
||||
if OK then
|
||||
Current_Processor := Compiler;
|
||||
else
|
||||
Osint.Fail ("illegal option """, Arg, """");
|
||||
if Current_Language = No_Language_Index then
|
||||
Add_Language_Name (Lang);
|
||||
Current_Language := Last_Language_Index;
|
||||
end if;
|
||||
|
||||
Current_Processor := Compiler;
|
||||
end;
|
||||
|
||||
elsif Arg = "-largs" then
|
||||
|
|
@ -4045,10 +4069,8 @@ package body Makegpr is
|
|||
Osint.Write_Program_Name;
|
||||
Write_Str (" -P<project file> [opts] [name] {");
|
||||
|
||||
for Lang in Programming_Language loop
|
||||
Write_Str ("[-c");
|
||||
Write_Str (Lang_Args (Lang).all);
|
||||
Write_Str ("args opts] ");
|
||||
for Lang in First_Language_Indexes loop
|
||||
Write_Str ("[-cargs:lang opts] ");
|
||||
end loop;
|
||||
|
||||
Write_Str ("[-largs opts] [-gargs opts]}");
|
||||
|
|
@ -4116,30 +4138,15 @@ package body Makegpr is
|
|||
Write_Eol;
|
||||
Write_Eol;
|
||||
|
||||
-- Lines for -c*args
|
||||
-- Line for -cargs
|
||||
|
||||
for Lang in Programming_Language loop
|
||||
declare
|
||||
Column : Positive := 13 + Lang_Args (Lang)'Length;
|
||||
-- " -cargs opts" is the minimum and is 13 character long
|
||||
Write_Line (" -cargs opts opts are passed to the Ada compiler");
|
||||
|
||||
begin
|
||||
Write_Str (" -c");
|
||||
Write_Str (Lang_Args (Lang).all);
|
||||
Write_Str ("args opts");
|
||||
-- Line for -cargs:lang
|
||||
|
||||
loop
|
||||
Write_Char (' ');
|
||||
Column := Column + 1;
|
||||
exit when Column >= 17;
|
||||
end loop;
|
||||
|
||||
Write_Str ("opts are passed to the ");
|
||||
Write_Str (Lang_Display_Names (Lang).all);
|
||||
Write_Str (" compiler");
|
||||
Write_Eol;
|
||||
end;
|
||||
end loop;
|
||||
Write_Line (" -cargs:<lang> opts");
|
||||
Write_Line (" opts are passed to the compiler " &
|
||||
"for language < lang > ");
|
||||
|
||||
-- Line for -largs
|
||||
|
||||
|
|
|
|||
|
|
@ -109,11 +109,11 @@ package body MLib.Prj is
|
|||
Table_Increment => 100);
|
||||
|
||||
package Objects_Htable is new GNAT.HTable.Simple_HTable
|
||||
(Header_Num => Com.Header_Num,
|
||||
(Header_Num => Header_Num,
|
||||
Element => Boolean,
|
||||
No_Element => False,
|
||||
Key => Name_Id,
|
||||
Hash => Com.Hash,
|
||||
Hash => Hash,
|
||||
Equal => "=");
|
||||
|
||||
-- List of non-Ada object files
|
||||
|
|
@ -155,42 +155,42 @@ package body MLib.Prj is
|
|||
-- All the ALI file in the library
|
||||
|
||||
package Library_ALIs is new GNAT.HTable.Simple_HTable
|
||||
(Header_Num => Com.Header_Num,
|
||||
(Header_Num => Header_Num,
|
||||
Element => Boolean,
|
||||
No_Element => False,
|
||||
Key => Name_Id,
|
||||
Hash => Com.Hash,
|
||||
Hash => Hash,
|
||||
Equal => "=");
|
||||
|
||||
-- The ALI files in the interface sets
|
||||
|
||||
package Interface_ALIs is new GNAT.HTable.Simple_HTable
|
||||
(Header_Num => Com.Header_Num,
|
||||
(Header_Num => Header_Num,
|
||||
Element => Boolean,
|
||||
No_Element => False,
|
||||
Key => Name_Id,
|
||||
Hash => Com.Hash,
|
||||
Hash => Hash,
|
||||
Equal => "=");
|
||||
|
||||
-- The ALI files that have been processed to check if the corresponding
|
||||
-- library unit is in the interface set.
|
||||
|
||||
package Processed_ALIs is new GNAT.HTable.Simple_HTable
|
||||
(Header_Num => Com.Header_Num,
|
||||
(Header_Num => Header_Num,
|
||||
Element => Boolean,
|
||||
No_Element => False,
|
||||
Key => Name_Id,
|
||||
Hash => Com.Hash,
|
||||
Hash => Hash,
|
||||
Equal => "=");
|
||||
|
||||
-- The projects imported directly or indirectly.
|
||||
|
||||
package Processed_Projects is new GNAT.HTable.Simple_HTable
|
||||
(Header_Num => Com.Header_Num,
|
||||
(Header_Num => Header_Num,
|
||||
Element => Boolean,
|
||||
No_Element => False,
|
||||
Key => Name_Id,
|
||||
Hash => Com.Hash,
|
||||
Hash => Hash,
|
||||
Equal => "=");
|
||||
|
||||
-- The library projects imported directly or indirectly.
|
||||
|
|
|
|||
|
|
@ -82,6 +82,8 @@ package body Prj.Attr is
|
|||
"lVmain#" &
|
||||
"LVlanguages#" &
|
||||
"SVmain_language#" &
|
||||
"LVada_roots#" &
|
||||
"SVexternally_built#" &
|
||||
|
||||
-- package Naming
|
||||
|
||||
|
|
@ -184,6 +186,17 @@ package body Prj.Attr is
|
|||
"SVvcs_file_check#" &
|
||||
"SVvcs_log_check#" &
|
||||
|
||||
-- package Language_Processing
|
||||
|
||||
"Planguage_processing#" &
|
||||
"Lacompiler_driver#" &
|
||||
"Sacompiler_kind#" &
|
||||
"Ladependency_option#" &
|
||||
"Lacompute_dependency#" &
|
||||
"Lainclude_option#" &
|
||||
"Sabinder_driver#" &
|
||||
"SVdefault_linker#" &
|
||||
|
||||
"#";
|
||||
|
||||
Initialized : Boolean := False;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -33,11 +33,6 @@ package body Prj.Com is
|
|||
-- Hash --
|
||||
----------
|
||||
|
||||
function Hash (Name : Name_Id) return Header_Num is
|
||||
begin
|
||||
return Hash (Get_Name_String (Name));
|
||||
end Hash;
|
||||
|
||||
function Hash (Name : String_Id) return Header_Num is
|
||||
begin
|
||||
String_To_Name_Buffer (Name);
|
||||
|
|
|
|||
|
|
@ -84,12 +84,6 @@ package Prj.Com is
|
|||
Table_Increment => 100,
|
||||
Table_Name => "Prj.Com.Units");
|
||||
|
||||
type Header_Num is range 0 .. 2047;
|
||||
|
||||
function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num);
|
||||
|
||||
function Hash (Name : Name_Id) return Header_Num;
|
||||
|
||||
function Hash (Name : String_Id) return Header_Num;
|
||||
|
||||
package Units_Htable is new GNAT.HTable.Simple_HTable
|
||||
|
|
|
|||
|
|
@ -703,7 +703,7 @@ package body Prj.Env is
|
|||
(File, "pragma Source_File_Name_Project");
|
||||
Put_Line
|
||||
(File, " (Spec_File_Name => ""*" &
|
||||
Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
|
||||
Namet.Get_Name_String (Data.Naming.Ada_Spec_Suffix) &
|
||||
""",");
|
||||
Put_Line
|
||||
(File, " Casing => " &
|
||||
|
|
@ -719,7 +719,7 @@ package body Prj.Env is
|
|||
(File, "pragma Source_File_Name_Project");
|
||||
Put_Line
|
||||
(File, " (Body_File_Name => ""*" &
|
||||
Namet.Get_Name_String (Data.Naming.Current_Body_Suffix) &
|
||||
Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix) &
|
||||
""",");
|
||||
Put_Line
|
||||
(File, " Casing => " &
|
||||
|
|
@ -732,7 +732,7 @@ package body Prj.Env is
|
|||
-- and maybe separate
|
||||
|
||||
if
|
||||
Data.Naming.Current_Body_Suffix /= Data.Naming.Separate_Suffix
|
||||
Data.Naming.Ada_Body_Suffix /= Data.Naming.Separate_Suffix
|
||||
then
|
||||
Put_Line
|
||||
(File, "pragma Source_File_Name_Project");
|
||||
|
|
@ -1186,10 +1186,10 @@ package body Prj.Env is
|
|||
|
||||
Extended_Spec_Name : String :=
|
||||
Name & Namet.Get_Name_String
|
||||
(Data.Naming.Current_Spec_Suffix);
|
||||
(Data.Naming.Ada_Spec_Suffix);
|
||||
Extended_Body_Name : String :=
|
||||
Name & Namet.Get_Name_String
|
||||
(Data.Naming.Current_Body_Suffix);
|
||||
(Data.Naming.Ada_Body_Suffix);
|
||||
|
||||
Unit : Unit_Data;
|
||||
|
||||
|
|
@ -1674,10 +1674,10 @@ package body Prj.Env is
|
|||
|
||||
Extended_Spec_Name : String :=
|
||||
Name & Namet.Get_Name_String
|
||||
(Data.Naming.Current_Spec_Suffix);
|
||||
(Data.Naming.Ada_Spec_Suffix);
|
||||
Extended_Body_Name : String :=
|
||||
Name & Namet.Get_Name_String
|
||||
(Data.Naming.Current_Body_Suffix);
|
||||
(Data.Naming.Ada_Body_Suffix);
|
||||
|
||||
First : Unit_Id := Units.First;
|
||||
Current : Unit_Id;
|
||||
|
|
@ -1862,10 +1862,10 @@ package body Prj.Env is
|
|||
|
||||
Extended_Spec_Name : String :=
|
||||
Name & Namet.Get_Name_String
|
||||
(Data.Naming.Current_Spec_Suffix);
|
||||
(Data.Naming.Ada_Spec_Suffix);
|
||||
Extended_Body_Name : String :=
|
||||
Name & Namet.Get_Name_String
|
||||
(Data.Naming.Current_Body_Suffix);
|
||||
(Data.Naming.Ada_Body_Suffix);
|
||||
|
||||
Unit : Unit_Data;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -26,7 +26,7 @@
|
|||
|
||||
with Namet; use Namet;
|
||||
with Osint; use Osint;
|
||||
with Prj.Com; use Prj.Com;
|
||||
with Sdefault;
|
||||
with Types; use Types;
|
||||
|
||||
with GNAT.HTable;
|
||||
|
|
@ -34,6 +34,20 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|||
|
||||
package body Prj.Ext is
|
||||
|
||||
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
|
||||
-- Name of the env. variable that contains path name(s) of directories
|
||||
-- where project files may reside.
|
||||
|
||||
Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
|
||||
-- The path name(s) of directories where project files may reside.
|
||||
-- May be empty.
|
||||
|
||||
No_Project_Default_Dir : constant String := "-";
|
||||
|
||||
Current_Project_Path : String_Access;
|
||||
-- The project path; initialized during elaboration of package
|
||||
-- Contains at least the current working directory.
|
||||
|
||||
package Htable is new GNAT.HTable.Simple_HTable
|
||||
(Header_Num => Header_Num,
|
||||
Element => Name_Id,
|
||||
|
|
@ -91,6 +105,15 @@ package body Prj.Ext is
|
|||
return False;
|
||||
end Check;
|
||||
|
||||
------------------
|
||||
-- Project_Path --
|
||||
------------------
|
||||
|
||||
function Project_Path return String is
|
||||
begin
|
||||
return Current_Project_Path.all;
|
||||
end Project_Path;
|
||||
|
||||
-----------
|
||||
-- Reset --
|
||||
-----------
|
||||
|
|
@ -100,6 +123,16 @@ package body Prj.Ext is
|
|||
Htable.Reset;
|
||||
end Reset;
|
||||
|
||||
----------------------
|
||||
-- Set_Project_Path --
|
||||
----------------------
|
||||
|
||||
procedure Set_Project_Path (New_Path : String) is
|
||||
begin
|
||||
Free (Current_Project_Path);
|
||||
Current_Project_Path := new String'(New_Path);
|
||||
end Set_Project_Path;
|
||||
|
||||
--------------
|
||||
-- Value_Of --
|
||||
--------------
|
||||
|
|
@ -144,4 +177,77 @@ package body Prj.Ext is
|
|||
end;
|
||||
end Value_Of;
|
||||
|
||||
begin
|
||||
-- Initialize Current_Project_Path during package elaboration
|
||||
|
||||
declare
|
||||
Add_Default_Dir : Boolean := True;
|
||||
First : Positive;
|
||||
Last : Positive;
|
||||
|
||||
begin
|
||||
-- The current directory is always first
|
||||
|
||||
Name_Len := 1;
|
||||
Name_Buffer (Name_Len) := '.';
|
||||
|
||||
-- If env. var. is defined and not empty, add its content
|
||||
|
||||
if Prj_Path.all /= "" then
|
||||
Name_Len := Name_Len + 1;
|
||||
Name_Buffer (Name_Len) := Path_Separator;
|
||||
|
||||
Add_Str_To_Name_Buffer (Prj_Path.all);
|
||||
|
||||
-- Scan the directory path to see if "-" is one of the directories.
|
||||
-- Remove each occurence of "-" and set Add_Default_Dir to False.
|
||||
|
||||
First := 3;
|
||||
loop
|
||||
while First <= Name_Len
|
||||
and then (Name_Buffer (First) = Path_Separator)
|
||||
loop
|
||||
First := First + 1;
|
||||
end loop;
|
||||
|
||||
exit when First > Name_Len;
|
||||
|
||||
Last := First;
|
||||
|
||||
while Last < Name_Len
|
||||
and then Name_Buffer (Last + 1) /= Path_Separator
|
||||
loop
|
||||
Last := Last + 1;
|
||||
end loop;
|
||||
|
||||
-- If the directory is "-", set Add_Default_Dir to False and
|
||||
-- remove from path.
|
||||
|
||||
if Name_Buffer (First .. Last) = No_Project_Default_Dir then
|
||||
Add_Default_Dir := False;
|
||||
|
||||
for J in Last + 1 .. Name_Len loop
|
||||
Name_Buffer (J - No_Project_Default_Dir'Length - 1) :=
|
||||
Name_Buffer (J);
|
||||
end loop;
|
||||
|
||||
Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
|
||||
end if;
|
||||
|
||||
First := Last + 1;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Set the initial value of Current_Project_Path
|
||||
|
||||
if Add_Default_Dir then
|
||||
Current_Project_Path :=
|
||||
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
|
||||
Sdefault.Search_Dir_Prefix.all & ".." &
|
||||
Directory_Separator & ".." & Directory_Separator &
|
||||
".." & Directory_Separator & "gnat");
|
||||
else
|
||||
Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len));
|
||||
end if;
|
||||
end;
|
||||
end Prj.Ext;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -31,6 +31,16 @@ with Types; use Types;
|
|||
|
||||
package Prj.Ext is
|
||||
|
||||
function Project_Path return String;
|
||||
-- Return the current value of the project path, either the value set
|
||||
-- during elaboration of the package or, if procedure Set_Project_Path has
|
||||
-- been called, the value set by the last call to Set_Project_Path.
|
||||
|
||||
procedure Set_Project_Path (New_Path : String);
|
||||
-- Give a new value to the project path. The new value New_Path should
|
||||
-- always start with the current directory (".") and the path separators
|
||||
-- should be the correct ones for the platform.
|
||||
|
||||
procedure Add
|
||||
(External_Name : String;
|
||||
Value : String);
|
||||
|
|
|
|||
4854
gcc/ada/prj-nmsc.adb
4854
gcc/ada/prj-nmsc.adb
File diff suppressed because it is too large
Load Diff
|
|
@ -32,27 +32,23 @@ private package Prj.Nmsc is
|
|||
-- procedures do (related to their names), rather than just an english
|
||||
-- language summary of the implementation ???
|
||||
|
||||
procedure Other_Languages_Check
|
||||
(Project : Project_Id;
|
||||
Report_Error : Put_Line_Access);
|
||||
-- Call Language_Independent_Check
|
||||
--
|
||||
-- Check the naming scheme for the supported languages (c, c++, ...) other
|
||||
-- than Ada. Find the source files if any.
|
||||
--
|
||||
-- If Report_Error is null, use the standard error reporting mechanism
|
||||
-- (Errout). Otherwise, report errors using Report_Error.
|
||||
|
||||
procedure Ada_Check
|
||||
procedure Check
|
||||
(Project : Project_Id;
|
||||
Report_Error : Put_Line_Access;
|
||||
Follow_Links : Boolean);
|
||||
-- Call Language_Independent_Check
|
||||
-- Check the object directory and the source directories
|
||||
--
|
||||
-- Check the library attributes, including the library directory if any
|
||||
--
|
||||
-- Get the set of specification and implementation suffixes, if any
|
||||
--
|
||||
-- Check the naming scheme for Ada
|
||||
--
|
||||
-- Find the Ada source files if any
|
||||
--
|
||||
-- Check the naming scheme for the supported languages (c, c++, ...) other
|
||||
-- than Ada. Find the source files if any.
|
||||
--
|
||||
-- If Report_Error is null , use the standard error reporting mechanism
|
||||
-- (Errout). Otherwise, report errors using Report_Error.
|
||||
--
|
||||
|
|
@ -61,16 +57,4 @@ private package Prj.Nmsc is
|
|||
-- still valid if they point to a file which is outside of the project),
|
||||
-- and that no directory has a name which is a valid source name.
|
||||
|
||||
procedure Language_Independent_Check
|
||||
(Project : Project_Id;
|
||||
Report_Error : Put_Line_Access);
|
||||
-- Check the object directory and the source directories
|
||||
--
|
||||
-- Check the library attributes, including the library directory if any
|
||||
--
|
||||
-- Get the set of specification and implementation suffixes, if any
|
||||
--
|
||||
-- If Report_Error is null , use the standard error reporting mechanism
|
||||
-- (Errout). Otherwise, report errors using Report_Error.
|
||||
|
||||
end Prj.Nmsc;
|
||||
|
|
|
|||
|
|
@ -43,8 +43,7 @@ package body Prj.Pars is
|
|||
procedure Parse
|
||||
(Project : out Project_Id;
|
||||
Project_File_Name : String;
|
||||
Packages_To_Check : String_List_Access := All_Packages;
|
||||
Process_Languages : Languages_Processed := Ada_Language)
|
||||
Packages_To_Check : String_List_Access := All_Packages)
|
||||
is
|
||||
Project_Tree : Project_Node_Id := Empty_Node;
|
||||
The_Project : Project_Id := No_Project;
|
||||
|
|
@ -67,7 +66,6 @@ package body Prj.Pars is
|
|||
Success => Success,
|
||||
From_Project_Node => Project_Tree,
|
||||
Report_Error => null,
|
||||
Process_Languages => Process_Languages,
|
||||
Follow_Links => Opt.Follow_Links);
|
||||
Prj.Err.Finalize;
|
||||
|
||||
|
|
|
|||
|
|
@ -24,24 +24,25 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Implements the parsing of project files.
|
||||
-- Implements the parsing of project files
|
||||
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
|
||||
package Prj.Pars is
|
||||
|
||||
procedure Set_Verbosity (To : Verbosity);
|
||||
-- Set the verbosity when parsing the project files.
|
||||
-- Set the verbosity when parsing the project files
|
||||
|
||||
procedure Parse
|
||||
(Project : out Project_Id;
|
||||
Project_File_Name : String;
|
||||
Packages_To_Check : String_List_Access := All_Packages;
|
||||
Process_Languages : Languages_Processed := Ada_Language);
|
||||
Packages_To_Check : String_List_Access := All_Packages);
|
||||
-- Parse a project files and all its imported project files.
|
||||
--
|
||||
-- If parsing is successful, Project_Id is the project ID
|
||||
-- of the main project file; otherwise, Project_Id is set
|
||||
-- to No_Project.
|
||||
--
|
||||
-- Packages_To_Check indicates the packages where any unknown attribute
|
||||
-- produces an error. For other packages, an unknown attribute produces
|
||||
-- a warning.
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@ with Output; use Output;
|
|||
with Prj.Com; use Prj.Com;
|
||||
with Prj.Dect;
|
||||
with Prj.Err; use Prj.Err;
|
||||
with Prj.Ext; use Prj.Ext;
|
||||
with Scans; use Scans;
|
||||
with Sdefault;
|
||||
with Sinput; use Sinput;
|
||||
with Sinput.P; use Sinput.P;
|
||||
with Snames;
|
||||
|
|
@ -54,18 +54,6 @@ package body Prj.Part is
|
|||
|
||||
Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
|
||||
|
||||
Project_Path : String_Access;
|
||||
-- The project path; initialized during package elaboration.
|
||||
-- Contains at least the current working directory.
|
||||
|
||||
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
|
||||
-- Name of the env. variable that contains path name(s) of directories
|
||||
-- where project files may reside.
|
||||
|
||||
Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
|
||||
-- The path name(s) of directories where project files may reside.
|
||||
-- May be empty.
|
||||
|
||||
type Extension_Origin is (None, Extending_Simple, Extending_All);
|
||||
-- Type of parameter From_Extended for procedures Parse_Single_Project and
|
||||
-- Post_Parse_Context_Clause. Extending_All means that we are parsing the
|
||||
|
|
@ -449,7 +437,7 @@ package body Prj.Part is
|
|||
|
||||
if Current_Verbosity >= Medium then
|
||||
Write_Str ("ADA_PROJECT_PATH=""");
|
||||
Write_Str (Project_Path.all);
|
||||
Write_Str (Project_Path);
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
|
||||
|
|
@ -707,7 +695,7 @@ package body Prj.Part is
|
|||
Normalize_Pathname
|
||||
(Imported_Path_Name,
|
||||
Resolve_Links => True,
|
||||
Case_Sensitive => False);
|
||||
Case_Sensitive => True);
|
||||
|
||||
Withed_Project : Project_Node_Id := Empty_Node;
|
||||
|
||||
|
|
@ -763,6 +751,7 @@ package body Prj.Part is
|
|||
begin
|
||||
Name_Len := Resolved_Path'Length;
|
||||
Name_Buffer (1 .. Name_Len) := Resolved_Path;
|
||||
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
|
||||
Canonical_Path_Name := Name_Find;
|
||||
|
||||
for Index in 1 .. Project_Stack.Last loop
|
||||
|
|
@ -922,73 +911,60 @@ package body Prj.Part is
|
|||
Project_Stack.Table (Project_Stack.Last).Canonical_Path_Name :=
|
||||
Canonical_Path_Name;
|
||||
|
||||
-- Check if the project file has already been parsed.
|
||||
-- Check if the project file has already been parsed
|
||||
|
||||
while
|
||||
A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
|
||||
loop
|
||||
declare
|
||||
Path_Id : Name_Id := Path_Name_Of (A_Project_Name_And_Node.Node);
|
||||
if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
|
||||
if Extended then
|
||||
|
||||
begin
|
||||
if Path_Id /= No_Name then
|
||||
Get_Name_String (Path_Id);
|
||||
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
|
||||
Path_Id := Name_Find;
|
||||
end if;
|
||||
|
||||
if Path_Id = Canonical_Path_Name then
|
||||
if Extended then
|
||||
|
||||
if A_Project_Name_And_Node.Extended then
|
||||
Error_Msg
|
||||
("cannot extend the same project file several times",
|
||||
Token_Ptr);
|
||||
|
||||
else
|
||||
Error_Msg
|
||||
("cannot extend an already imported project file",
|
||||
Token_Ptr);
|
||||
end if;
|
||||
|
||||
elsif A_Project_Name_And_Node.Extended then
|
||||
Extends_All :=
|
||||
Is_Extending_All (A_Project_Name_And_Node.Node);
|
||||
|
||||
-- If the imported project is an extended project A,
|
||||
-- and we are in an extended project, replace A with the
|
||||
-- ultimate project extending A.
|
||||
|
||||
if From_Extended /= None then
|
||||
declare
|
||||
Decl : Project_Node_Id :=
|
||||
Project_Declaration_Of
|
||||
(A_Project_Name_And_Node.Node);
|
||||
|
||||
Prj : Project_Node_Id :=
|
||||
Extending_Project_Of (Decl);
|
||||
|
||||
begin
|
||||
loop
|
||||
Decl := Project_Declaration_Of (Prj);
|
||||
exit when Extending_Project_Of (Decl) = Empty_Node;
|
||||
Prj := Extending_Project_Of (Decl);
|
||||
end loop;
|
||||
|
||||
A_Project_Name_And_Node.Node := Prj;
|
||||
end;
|
||||
else
|
||||
Error_Msg
|
||||
("cannot import an already extended project file",
|
||||
Token_Ptr);
|
||||
end if;
|
||||
if A_Project_Name_And_Node.Extended then
|
||||
Error_Msg
|
||||
("cannot extend the same project file several times",
|
||||
Token_Ptr);
|
||||
else
|
||||
Error_Msg
|
||||
("cannot extend an already imported project file",
|
||||
Token_Ptr);
|
||||
end if;
|
||||
|
||||
Project := A_Project_Name_And_Node.Node;
|
||||
Project_Stack.Decrement_Last;
|
||||
return;
|
||||
elsif A_Project_Name_And_Node.Extended then
|
||||
Extends_All :=
|
||||
Is_Extending_All (A_Project_Name_And_Node.Node);
|
||||
|
||||
-- If the imported project is an extended project A,
|
||||
-- and we are in an extended project, replace A with the
|
||||
-- ultimate project extending A.
|
||||
|
||||
if From_Extended /= None then
|
||||
declare
|
||||
Decl : Project_Node_Id :=
|
||||
Project_Declaration_Of
|
||||
(A_Project_Name_And_Node.Node);
|
||||
|
||||
Prj : Project_Node_Id := Extending_Project_Of (Decl);
|
||||
|
||||
begin
|
||||
loop
|
||||
Decl := Project_Declaration_Of (Prj);
|
||||
exit when Extending_Project_Of (Decl) = Empty_Node;
|
||||
Prj := Extending_Project_Of (Decl);
|
||||
end loop;
|
||||
|
||||
A_Project_Name_And_Node.Node := Prj;
|
||||
end;
|
||||
else
|
||||
Error_Msg
|
||||
("cannot import an already extended project file",
|
||||
Token_Ptr);
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
||||
Project := A_Project_Name_And_Node.Node;
|
||||
Project_Stack.Decrement_Last;
|
||||
return;
|
||||
end if;
|
||||
|
||||
A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
|
||||
end loop;
|
||||
|
|
@ -1037,7 +1013,7 @@ package body Prj.Part is
|
|||
Project := Default_Project_Node (Of_Kind => N_Project);
|
||||
Project_Stack.Table (Project_Stack.Last).Id := Project;
|
||||
Set_Directory_Of (Project, Project_Directory);
|
||||
Set_Path_Name_Of (Project, Canonical_Path_Name);
|
||||
Set_Path_Name_Of (Project, Normed_Path_Name);
|
||||
Set_Location_Of (Project, Token_Ptr);
|
||||
|
||||
Expect (Tok_Project, "PROJECT");
|
||||
|
|
@ -1052,7 +1028,6 @@ package body Prj.Part is
|
|||
-- Clear the Buffer
|
||||
|
||||
Buffer_Last := 0;
|
||||
|
||||
loop
|
||||
Expect (Tok_Identifier, "identifier");
|
||||
|
||||
|
|
@ -1201,9 +1176,10 @@ package body Prj.Part is
|
|||
|
||||
Tree_Private_Part.Projects_Htable.Set
|
||||
(K => Name_Of_Project,
|
||||
E => (Name => Name_Of_Project,
|
||||
Node => Project,
|
||||
Extended => Extended));
|
||||
E => (Name => Name_Of_Project,
|
||||
Node => Project,
|
||||
Canonical_Path => Canonical_Path_Name,
|
||||
Extended => Extended));
|
||||
end if;
|
||||
end;
|
||||
|
||||
|
|
@ -1370,7 +1346,7 @@ package body Prj.Part is
|
|||
Project_Declaration : Project_Node_Id := Empty_Node;
|
||||
|
||||
begin
|
||||
-- No need to Scan past "is", Prj.Dect.Parse will do it.
|
||||
-- No need to Scan past "is", Prj.Dect.Parse will do it
|
||||
|
||||
Prj.Dect.Parse
|
||||
(Declarations => Project_Declaration,
|
||||
|
|
@ -1630,7 +1606,7 @@ package body Prj.Part is
|
|||
Locate_Regular_File
|
||||
(File_Name => Directory & Directory_Separator &
|
||||
Project_File_Name & Project_File_Extension,
|
||||
Path => Project_Path.all);
|
||||
Path => Project_Path);
|
||||
|
||||
-- Then we try <directory>/<file_name>
|
||||
|
||||
|
|
@ -1646,7 +1622,7 @@ package body Prj.Part is
|
|||
Locate_Regular_File
|
||||
(File_Name => Directory & Directory_Separator &
|
||||
Project_File_Name,
|
||||
Path => Project_Path.all);
|
||||
Path => Project_Path);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
|
@ -1663,7 +1639,7 @@ package body Prj.Part is
|
|||
Result :=
|
||||
Locate_Regular_File
|
||||
(File_Name => Project_File_Name & Project_File_Extension,
|
||||
Path => Project_Path.all);
|
||||
Path => Project_Path);
|
||||
end if;
|
||||
|
||||
if Result = null then
|
||||
|
|
@ -1678,7 +1654,7 @@ package body Prj.Part is
|
|||
Result :=
|
||||
Locate_Regular_File
|
||||
(File_Name => Project_File_Name,
|
||||
Path => Project_Path.all);
|
||||
Path => Project_Path);
|
||||
end if;
|
||||
|
||||
-- If we cannot find the project file, we return an empty string
|
||||
|
|
@ -1700,15 +1676,4 @@ package body Prj.Part is
|
|||
end if;
|
||||
end Project_Path_Name_Of;
|
||||
|
||||
begin
|
||||
-- Initialize Project_Path during package elaboration
|
||||
|
||||
if Prj_Path.all = "" then
|
||||
Project_Path :=
|
||||
new String'("." & Path_Separator & Sdefault.Search_Dir_Prefix.all &
|
||||
".." & Directory_Separator & ".." & Directory_Separator &
|
||||
".." & Directory_Separator & "gnat");
|
||||
else
|
||||
Project_Path := new String'("." & Path_Separator & Prj_Path.all);
|
||||
end if;
|
||||
end Prj.Part;
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@ with Opt;
|
|||
with Osint; use Osint;
|
||||
with Output; use Output;
|
||||
with Prj.Attr; use Prj.Attr;
|
||||
with Prj.Com; use Prj.Com;
|
||||
with Prj.Err; use Prj.Err;
|
||||
with Prj.Ext; use Prj.Ext;
|
||||
with Prj.Nmsc; use Prj.Nmsc;
|
||||
|
|
@ -64,12 +63,10 @@ package body Prj.Proc is
|
|||
-- values to the package or project with declarations Decl.
|
||||
|
||||
procedure Check
|
||||
(Project : in out Project_Id;
|
||||
Process_Languages : Languages_Processed;
|
||||
Follow_Links : Boolean);
|
||||
(Project : in out Project_Id;
|
||||
Follow_Links : Boolean);
|
||||
-- Set all projects to not checked, then call Recursive_Check for the
|
||||
-- main project Project. Project is set to No_Project if errors occurred.
|
||||
-- See Prj.Nmsc.Ada_Check for information on Follow_Links.
|
||||
|
||||
function Expression
|
||||
(Project : Project_Id;
|
||||
|
|
@ -111,13 +108,11 @@ package body Prj.Proc is
|
|||
-- Then process the declarative items of the project.
|
||||
|
||||
procedure Recursive_Check
|
||||
(Project : Project_Id;
|
||||
Process_Languages : Languages_Processed;
|
||||
Follow_Links : Boolean);
|
||||
(Project : Project_Id;
|
||||
Follow_Links : Boolean);
|
||||
-- If Project is not marked as checked, mark it as checked, call
|
||||
-- Check_Naming_Scheme for the project, then call itself for a
|
||||
-- possible extended project and all the imported projects of Project.
|
||||
-- See Prj.Nmsc.Ada_Check for information on Follow_Links
|
||||
|
||||
---------
|
||||
-- Add --
|
||||
|
|
@ -127,7 +122,7 @@ package body Prj.Proc is
|
|||
begin
|
||||
if To_Exp = Types.No_Name or else To_Exp = Empty_String then
|
||||
|
||||
-- To_Exp is nil or empty. The result is Str.
|
||||
-- To_Exp is nil or empty. The result is Str
|
||||
|
||||
To_Exp := Str;
|
||||
|
||||
|
|
@ -213,9 +208,9 @@ package body Prj.Proc is
|
|||
-----------
|
||||
|
||||
procedure Check
|
||||
(Project : in out Project_Id;
|
||||
Process_Languages : Languages_Processed;
|
||||
Follow_Links : Boolean) is
|
||||
(Project : in out Project_Id;
|
||||
Follow_Links : Boolean)
|
||||
is
|
||||
begin
|
||||
-- Make sure that all projects are marked as not checked
|
||||
|
||||
|
|
@ -223,8 +218,7 @@ package body Prj.Proc is
|
|||
Projects.Table (Index).Checked := False;
|
||||
end loop;
|
||||
|
||||
Recursive_Check (Project, Process_Languages, Follow_Links);
|
||||
|
||||
Recursive_Check (Project, Follow_Links);
|
||||
end Check;
|
||||
|
||||
----------------
|
||||
|
|
@ -248,7 +242,7 @@ package body Prj.Proc is
|
|||
-- The returned result
|
||||
|
||||
Last : String_List_Id := Nil_String;
|
||||
-- Reference to the last string elements in Result, when Kind is List.
|
||||
-- Reference to the last string elements in Result, when Kind is List
|
||||
|
||||
begin
|
||||
Result.Project := Project;
|
||||
|
|
@ -282,8 +276,7 @@ package body Prj.Proc is
|
|||
|
||||
if Last = Nil_String then
|
||||
|
||||
-- This can happen in an expression such as
|
||||
-- () & "toto"
|
||||
-- This can happen in an expression like () & "toto"
|
||||
|
||||
Result.Values := String_Elements.Last;
|
||||
|
||||
|
|
@ -300,7 +293,6 @@ package body Prj.Proc is
|
|||
Location => Location_Of (The_Current_Term),
|
||||
Flag => False,
|
||||
Next => Nil_String);
|
||||
|
||||
end case;
|
||||
|
||||
when N_Literal_String_List =>
|
||||
|
|
@ -856,7 +848,6 @@ package body Prj.Proc is
|
|||
Success : out Boolean;
|
||||
From_Project_Node : Project_Node_Id;
|
||||
Report_Error : Put_Line_Access;
|
||||
Process_Languages : Languages_Processed := Ada_Language;
|
||||
Follow_Links : Boolean := True)
|
||||
is
|
||||
Obj_Dir : Name_Id;
|
||||
|
|
@ -881,7 +872,7 @@ package body Prj.Proc is
|
|||
Extended_By => No_Project);
|
||||
|
||||
if Project /= No_Project then
|
||||
Check (Project, Process_Languages, Follow_Links);
|
||||
Check (Project, Follow_Links);
|
||||
end if;
|
||||
|
||||
-- If main project is an extending all project, set the object
|
||||
|
|
@ -922,15 +913,20 @@ package body Prj.Proc is
|
|||
Extending2 := Extending;
|
||||
|
||||
while Extending2 /= No_Project loop
|
||||
if ((Process_Languages = Ada_Language
|
||||
and then
|
||||
Projects.Table (Extending2).Ada_Sources_Present)
|
||||
or else
|
||||
(Process_Languages = Other_Languages
|
||||
and then
|
||||
Projects.Table (Extending2).Other_Sources_Present))
|
||||
|
||||
-- why is this code commented out ???
|
||||
|
||||
-- if ((Process_Languages = Ada_Language
|
||||
-- and then
|
||||
-- Projects.Table (Extending2).Ada_Sources_Present)
|
||||
-- or else
|
||||
-- (Process_Languages = Other_Languages
|
||||
-- and then
|
||||
-- Projects.Table (Extending2).Other_Sources_Present))
|
||||
|
||||
if Projects.Table (Extending2).Ada_Sources_Present
|
||||
and then
|
||||
Projects.Table (Extending2).Object_Directory = Obj_Dir
|
||||
Projects.Table (Extending2).Object_Directory = Obj_Dir
|
||||
then
|
||||
if Projects.Table (Extending2).Virtual then
|
||||
Error_Msg_Name_1 := Projects.Table (Proj).Name;
|
||||
|
|
@ -1267,9 +1263,11 @@ package body Prj.Proc is
|
|||
-- Copy each array element
|
||||
|
||||
while Orig_Element /= No_Array_Element loop
|
||||
-- If it is the first element ...
|
||||
|
||||
-- Case of first element
|
||||
|
||||
if Prev_Element = No_Array_Element then
|
||||
|
||||
-- And there is no array element declared yet,
|
||||
-- create a new first array element.
|
||||
|
||||
|
|
@ -1324,6 +1322,7 @@ package body Prj.Proc is
|
|||
Prev_Element := New_Element;
|
||||
|
||||
-- Go to the next element in the original array
|
||||
|
||||
Orig_Element :=
|
||||
Array_Elements.Table (Orig_Element).Next;
|
||||
end loop;
|
||||
|
|
@ -1804,7 +1803,6 @@ package body Prj.Proc is
|
|||
|
||||
procedure Recursive_Check
|
||||
(Project : Project_Id;
|
||||
Process_Languages : Languages_Processed;
|
||||
Follow_Links : Boolean)
|
||||
is
|
||||
Data : Project_Data;
|
||||
|
|
@ -1827,7 +1825,7 @@ package body Prj.Proc is
|
|||
-- Call itself for a possible extended project.
|
||||
-- (if there is no extended project, then nothing happens).
|
||||
|
||||
Recursive_Check (Data.Extends, Process_Languages, Follow_Links);
|
||||
Recursive_Check (Data.Extends, Follow_Links);
|
||||
|
||||
-- Call itself for all imported projects
|
||||
|
||||
|
|
@ -1835,7 +1833,7 @@ package body Prj.Proc is
|
|||
while Imported_Project_List /= Empty_Project_List loop
|
||||
Recursive_Check
|
||||
(Project_Lists.Table (Imported_Project_List).Project,
|
||||
Process_Languages, Follow_Links);
|
||||
Follow_Links);
|
||||
Imported_Project_List :=
|
||||
Project_Lists.Table (Imported_Project_List).Next;
|
||||
end loop;
|
||||
|
|
@ -1846,18 +1844,7 @@ package body Prj.Proc is
|
|||
Write_Line ("""");
|
||||
end if;
|
||||
|
||||
case Process_Languages is
|
||||
when Ada_Language =>
|
||||
Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links);
|
||||
|
||||
when Other_Languages =>
|
||||
Prj.Nmsc.Other_Languages_Check (Project, Error_Report);
|
||||
|
||||
when All_Languages =>
|
||||
Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links);
|
||||
Prj.Nmsc.Other_Languages_Check (Project, Error_Report);
|
||||
|
||||
end case;
|
||||
Prj.Nmsc.Check (Project, Error_Report, Follow_Links);
|
||||
end if;
|
||||
end Recursive_Check;
|
||||
|
||||
|
|
|
|||
|
|
@ -37,7 +37,6 @@ package Prj.Proc is
|
|||
Success : out Boolean;
|
||||
From_Project_Node : Project_Node_Id;
|
||||
Report_Error : Put_Line_Access;
|
||||
Process_Languages : Languages_Processed := Ada_Language;
|
||||
Follow_Links : Boolean := True);
|
||||
-- Process a project file tree into project file data structures.
|
||||
-- If Report_Error is null, use the error reporting mechanism.
|
||||
|
|
|
|||
|
|
@ -24,12 +24,11 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package defines the structure of the Project File tree.
|
||||
-- This package defines the structure of the Project File tree
|
||||
|
||||
with GNAT.HTable;
|
||||
|
||||
with Prj.Attr; use Prj.Attr;
|
||||
with Prj.Com; use Prj.Com;
|
||||
with Table; use Table;
|
||||
with Types; use Types;
|
||||
|
||||
|
|
@ -150,7 +149,7 @@ package Prj.Tree is
|
|||
-- this node.
|
||||
|
||||
procedure Remove_Next_End_Node;
|
||||
-- Remove the top of the end node stack.
|
||||
-- Remove the top of the end node stack
|
||||
|
||||
------------------------
|
||||
-- Comment Processing --
|
||||
|
|
@ -172,13 +171,13 @@ package Prj.Tree is
|
|||
-- A table to store the comments that may be stored is the tree
|
||||
|
||||
procedure Scan;
|
||||
-- Scan the tokens and accumulate comments.
|
||||
-- Scan the tokens and accumulate comments
|
||||
|
||||
type Comment_Location is
|
||||
(Before, After, Before_End, After_End, End_Of_Line);
|
||||
|
||||
procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location);
|
||||
-- Add comments to this node.
|
||||
-- Add comments to this node
|
||||
|
||||
----------------------
|
||||
-- Access Functions --
|
||||
|
|
@ -235,7 +234,7 @@ package Prj.Tree is
|
|||
|
||||
function Directory_Of (Node : Project_Node_Id) return Name_Id;
|
||||
pragma Inline (Directory_Of);
|
||||
-- Only valid for N_Project nodes.
|
||||
-- Only valid for N_Project nodes
|
||||
|
||||
function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind;
|
||||
pragma Inline (Expression_Kind_Of);
|
||||
|
|
@ -263,7 +262,7 @@ package Prj.Tree is
|
|||
|
||||
function Path_Name_Of (Node : Project_Node_Id) return Name_Id;
|
||||
pragma Inline (Path_Name_Of);
|
||||
-- Only valid for N_Project and N_With_Clause nodes.
|
||||
-- Only valid for N_Project and N_With_Clause nodes
|
||||
|
||||
function String_Value_Of (Node : Project_Node_Id) return Name_Id;
|
||||
pragma Inline (String_Value_Of);
|
||||
|
|
@ -1046,12 +1045,18 @@ package Prj.Tree is
|
|||
Node : Project_Node_Id;
|
||||
-- Node of the project in table Project_Nodes
|
||||
|
||||
Canonical_Path : Name_Id;
|
||||
-- Resolved and canonical path of the project file
|
||||
|
||||
Extended : Boolean;
|
||||
-- True when the project is being extended by another project
|
||||
end record;
|
||||
|
||||
No_Project_Name_And_Node : constant Project_Name_And_Node :=
|
||||
(Name => No_Name, Node => Empty_Node, Extended => True);
|
||||
(Name => No_Name,
|
||||
Node => Empty_Node,
|
||||
Canonical_Path => No_Name,
|
||||
Extended => True);
|
||||
|
||||
package Projects_Htable is new GNAT.HTable.Simple_HTable
|
||||
(Header_Num => Header_Num,
|
||||
|
|
|
|||
|
|
@ -107,12 +107,12 @@ package body Prj.Util is
|
|||
Body_Append : constant String := Get_Name_String
|
||||
(Projects.Table
|
||||
(Project).
|
||||
Naming.Current_Body_Suffix);
|
||||
Naming.Ada_Body_Suffix);
|
||||
|
||||
Spec_Append : constant String := Get_Name_String
|
||||
(Projects.Table
|
||||
(Project).
|
||||
Naming.Current_Spec_Suffix);
|
||||
Naming.Ada_Spec_Suffix);
|
||||
|
||||
begin
|
||||
if Builder_Package /= No_Package then
|
||||
|
|
@ -131,9 +131,9 @@ package body Prj.Util is
|
|||
Projects.Table (Project).Naming;
|
||||
|
||||
Spec_Suffix : constant String :=
|
||||
Get_Name_String (Naming.Current_Spec_Suffix);
|
||||
Get_Name_String (Naming.Ada_Spec_Suffix);
|
||||
Body_Suffix : constant String :=
|
||||
Get_Name_String (Naming.Current_Body_Suffix);
|
||||
Get_Name_String (Naming.Ada_Body_Suffix);
|
||||
|
||||
Truncated : Boolean := False;
|
||||
|
||||
|
|
|
|||
339
gcc/ada/prj.adb
339
gcc/ada/prj.adb
|
|
@ -27,6 +27,7 @@
|
|||
with Ada.Characters.Handling; use Ada.Characters.Handling;
|
||||
|
||||
with Namet; use Namet;
|
||||
with Output; use Output;
|
||||
with Osint; use Osint;
|
||||
with Prj.Attr;
|
||||
with Prj.Com;
|
||||
|
|
@ -36,12 +37,15 @@ with Scans; use Scans;
|
|||
with Snames; use Snames;
|
||||
with Uintp; use Uintp;
|
||||
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.Case_Util; use GNAT.Case_Util;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
|
||||
package body Prj is
|
||||
|
||||
The_Empty_String : Name_Id;
|
||||
|
||||
Name_C_Plus_Plus : Name_Id;
|
||||
|
||||
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
|
||||
|
||||
The_Casing_Images : constant array (Known_Casing) of String_Access :=
|
||||
|
|
@ -55,15 +59,16 @@ package body Prj is
|
|||
First_Name_Id + Character'Pos ('-');
|
||||
|
||||
Std_Naming_Data : Naming_Data :=
|
||||
(Current_Language => No_Name,
|
||||
Dot_Replacement => Standard_Dot_Replacement,
|
||||
(Dot_Replacement => Standard_Dot_Replacement,
|
||||
Dot_Repl_Loc => No_Location,
|
||||
Casing => All_Lower_Case,
|
||||
Spec_Suffix => No_Array_Element,
|
||||
Current_Spec_Suffix => No_Name,
|
||||
Ada_Spec_Suffix => No_Name,
|
||||
Spec_Suffix_Loc => No_Location,
|
||||
Impl_Suffixes => No_Impl_Suffixes,
|
||||
Supp_Suffixes => No_Supp_Language_Index,
|
||||
Body_Suffix => No_Array_Element,
|
||||
Current_Body_Suffix => No_Name,
|
||||
Ada_Body_Suffix => No_Name,
|
||||
Body_Suffix_Loc => No_Location,
|
||||
Separate_Suffix => No_Name,
|
||||
Sep_Suffix_Loc => No_Location,
|
||||
|
|
@ -73,8 +78,9 @@ package body Prj is
|
|||
Implementation_Exceptions => No_Array_Element);
|
||||
|
||||
Project_Empty : constant Project_Data :=
|
||||
(Languages => No_Languages,
|
||||
Impl_Suffixes => No_Impl_Suffixes,
|
||||
(Externally_Built => False,
|
||||
Languages => No_Languages,
|
||||
Supp_Languages => No_Supp_Language_Index,
|
||||
First_Referred_By => No_Project,
|
||||
Name => No_Name,
|
||||
Path_Name => No_Name,
|
||||
|
|
@ -114,6 +120,10 @@ package body Prj is
|
|||
Extends => No_Project,
|
||||
Extended_By => No_Project,
|
||||
Naming => Std_Naming_Data,
|
||||
First_Language_Processing => Default_First_Language_Processing_Data,
|
||||
Supp_Language_Processing => No_Supp_Language_Index,
|
||||
Default_Linker => No_Name,
|
||||
Default_Linker_Path => No_Name,
|
||||
Decl => No_Declarations,
|
||||
Imported_Projects => Empty_Project_List,
|
||||
Ada_Include_Path => null,
|
||||
|
|
@ -131,6 +141,18 @@ package body Prj is
|
|||
Depth => 0,
|
||||
Unkept_Comments => False);
|
||||
|
||||
-----------------------
|
||||
-- Add_Language_Name --
|
||||
-----------------------
|
||||
|
||||
procedure Add_Language_Name (Name : Name_Id) is
|
||||
begin
|
||||
Last_Language_Index := Last_Language_Index + 1;
|
||||
Language_Indexes.Set (Name, Last_Language_Index);
|
||||
Language_Names.Increment_Last;
|
||||
Language_Names.Table (Last_Language_Index) := Name;
|
||||
end Add_Language_Name;
|
||||
|
||||
-------------------
|
||||
-- Add_To_Buffer --
|
||||
-------------------
|
||||
|
|
@ -155,6 +177,17 @@ package body Prj is
|
|||
Buffer_Last := Buffer_Last + S'Length;
|
||||
end Add_To_Buffer;
|
||||
|
||||
---------------------------
|
||||
-- Display_Language_Name --
|
||||
---------------------------
|
||||
|
||||
procedure Display_Language_Name (Language : Language_Index) is
|
||||
begin
|
||||
Get_Name_String (Language_Names.Table (Language));
|
||||
To_Upper (Name_Buffer (1 .. 1));
|
||||
Write_Str (Name_Buffer (1 .. Name_Len));
|
||||
end Display_Language_Name;
|
||||
|
||||
-------------------
|
||||
-- Empty_Project --
|
||||
-------------------
|
||||
|
|
@ -195,9 +228,12 @@ package body Prj is
|
|||
is
|
||||
|
||||
procedure Check (Project : Project_Id);
|
||||
-- Check if a project has already been seen.
|
||||
-- If not seen, mark it as seen, call Action,
|
||||
-- and check all its imported projects.
|
||||
-- Check if a project has already been seen. If not seen, mark it as
|
||||
-- Seen, Call Action, and check all its imported projects.
|
||||
|
||||
-----------
|
||||
-- Check --
|
||||
-----------
|
||||
|
||||
procedure Check (Project : Project_Id) is
|
||||
List : Project_List;
|
||||
|
|
@ -215,6 +251,8 @@ package body Prj is
|
|||
end if;
|
||||
end Check;
|
||||
|
||||
-- Start of procecessing for For_Every_Project_Imported
|
||||
|
||||
begin
|
||||
for Project in Projects.First .. Projects.Last loop
|
||||
Projects.Table (Project).Seen := False;
|
||||
|
|
@ -223,6 +261,15 @@ package body Prj is
|
|||
Check (Project => By);
|
||||
end For_Every_Project_Imported;
|
||||
|
||||
----------
|
||||
-- Hash --
|
||||
----------
|
||||
|
||||
function Hash (Name : Name_Id) return Header_Num is
|
||||
begin
|
||||
return Hash (Get_Name_String (Name));
|
||||
end Hash;
|
||||
|
||||
-----------
|
||||
-- Image --
|
||||
-----------
|
||||
|
|
@ -253,18 +300,12 @@ package body Prj is
|
|||
Name_Len := 1;
|
||||
Name_Buffer (1) := '/';
|
||||
Slash := Name_Find;
|
||||
Name_Len := 3;
|
||||
Name_Buffer (1 .. 3) := "c++";
|
||||
Name_C_Plus_Plus := Name_Find;
|
||||
|
||||
for Lang in Programming_Language loop
|
||||
Name_Len := Lang_Names (Lang)'Length;
|
||||
Name_Buffer (1 .. Name_Len) := Lang_Names (Lang).all;
|
||||
Lang_Name_Ids (Lang) := Name_Find;
|
||||
Name_Len := Lang_Suffixes (Lang)'Length;
|
||||
Name_Buffer (1 .. Name_Len) := Lang_Suffixes (Lang).all;
|
||||
Lang_Suffix_Ids (Lang) := Name_Find;
|
||||
end loop;
|
||||
|
||||
Std_Naming_Data.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
|
||||
Std_Naming_Data.Current_Body_Suffix := Default_Ada_Body_Suffix;
|
||||
Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
|
||||
Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
|
||||
Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
|
||||
Register_Default_Naming_Scheme
|
||||
(Language => Name_Ada,
|
||||
|
|
@ -275,9 +316,91 @@ package body Prj is
|
|||
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
|
||||
Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
|
||||
Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
|
||||
|
||||
Language_Indexes.Reset;
|
||||
Last_Language_Index := No_Language_Index;
|
||||
Language_Names.Init;
|
||||
Add_Language_Name (Name_Ada);
|
||||
Add_Language_Name (Name_C);
|
||||
Add_Language_Name (Name_C_Plus_Plus);
|
||||
end if;
|
||||
end Initialize;
|
||||
|
||||
----------------
|
||||
-- Is_Present --
|
||||
----------------
|
||||
|
||||
function Is_Present
|
||||
(Language : Language_Index;
|
||||
In_Project : Project_Data) return Boolean
|
||||
is
|
||||
begin
|
||||
case Language is
|
||||
when No_Language_Index =>
|
||||
return False;
|
||||
|
||||
when First_Language_Indexes =>
|
||||
return In_Project.Languages (Language);
|
||||
|
||||
when others =>
|
||||
declare
|
||||
Supp : Supp_Language;
|
||||
Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
|
||||
|
||||
begin
|
||||
while Supp_Index /= No_Supp_Language_Index loop
|
||||
Supp := Present_Languages.Table (Supp_Index);
|
||||
|
||||
if Supp.Index = Language then
|
||||
return Supp.Present;
|
||||
end if;
|
||||
|
||||
Supp_Index := Supp.Next;
|
||||
end loop;
|
||||
|
||||
return False;
|
||||
end;
|
||||
end case;
|
||||
end Is_Present;
|
||||
|
||||
---------------------------------
|
||||
-- Language_Processing_Data_Of --
|
||||
---------------------------------
|
||||
|
||||
function Language_Processing_Data_Of
|
||||
(Language : Language_Index;
|
||||
In_Project : Project_Data) return Language_Processing_Data
|
||||
is
|
||||
begin
|
||||
case Language is
|
||||
when No_Language_Index =>
|
||||
return Default_Language_Processing_Data;
|
||||
|
||||
when First_Language_Indexes =>
|
||||
return In_Project.First_Language_Processing (Language);
|
||||
|
||||
when others =>
|
||||
declare
|
||||
Supp : Supp_Language_Data;
|
||||
Supp_Index : Supp_Language_Index :=
|
||||
In_Project.Supp_Language_Processing;
|
||||
|
||||
begin
|
||||
while Supp_Index /= No_Supp_Language_Index loop
|
||||
Supp := Supp_Languages.Table (Supp_Index);
|
||||
|
||||
if Supp.Index = Language then
|
||||
return Supp.Data;
|
||||
end if;
|
||||
|
||||
Supp_Index := Supp.Next;
|
||||
end loop;
|
||||
|
||||
return Default_Language_Processing_Data;
|
||||
end;
|
||||
end case;
|
||||
end Language_Processing_Data_Of;
|
||||
|
||||
------------------------------------
|
||||
-- Register_Default_Naming_Scheme --
|
||||
------------------------------------
|
||||
|
|
@ -398,17 +521,145 @@ package body Prj is
|
|||
------------------------
|
||||
|
||||
function Same_Naming_Scheme
|
||||
(Left, Right : Naming_Data)
|
||||
return Boolean
|
||||
(Left, Right : Naming_Data) return Boolean
|
||||
is
|
||||
begin
|
||||
return Left.Dot_Replacement = Right.Dot_Replacement
|
||||
and then Left.Casing = Right.Casing
|
||||
and then Left.Current_Spec_Suffix = Right.Current_Spec_Suffix
|
||||
and then Left.Current_Body_Suffix = Right.Current_Body_Suffix
|
||||
and then Left.Ada_Spec_Suffix = Right.Ada_Spec_Suffix
|
||||
and then Left.Ada_Body_Suffix = Right.Ada_Body_Suffix
|
||||
and then Left.Separate_Suffix = Right.Separate_Suffix;
|
||||
end Same_Naming_Scheme;
|
||||
|
||||
---------
|
||||
-- Set --
|
||||
---------
|
||||
|
||||
procedure Set
|
||||
(Language : Language_Index;
|
||||
Present : Boolean;
|
||||
In_Project : in out Project_Data)
|
||||
is
|
||||
begin
|
||||
case Language is
|
||||
when No_Language_Index =>
|
||||
null;
|
||||
|
||||
when First_Language_Indexes =>
|
||||
In_Project.Languages (Language) := Present;
|
||||
|
||||
when others =>
|
||||
declare
|
||||
Supp : Supp_Language;
|
||||
Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
|
||||
|
||||
begin
|
||||
while Supp_Index /= No_Supp_Language_Index loop
|
||||
Supp := Present_Languages.Table (Supp_Index);
|
||||
|
||||
if Supp.Index = Language then
|
||||
Present_Languages.Table (Supp_Index).Present := Present;
|
||||
return;
|
||||
end if;
|
||||
|
||||
Supp_Index := Supp.Next;
|
||||
end loop;
|
||||
|
||||
Supp := (Index => Language, Present => Present,
|
||||
Next => In_Project.Supp_Languages);
|
||||
Present_Languages.Increment_Last;
|
||||
Supp_Index := Present_Languages.Last;
|
||||
Present_Languages.Table (Supp_Index) := Supp;
|
||||
In_Project.Supp_Languages := Supp_Index;
|
||||
end;
|
||||
end case;
|
||||
end Set;
|
||||
|
||||
procedure Set
|
||||
(Language_Processing : in Language_Processing_Data;
|
||||
For_Language : Language_Index;
|
||||
In_Project : in out Project_Data)
|
||||
is
|
||||
begin
|
||||
case For_Language is
|
||||
when No_Language_Index =>
|
||||
null;
|
||||
|
||||
when First_Language_Indexes =>
|
||||
In_Project.First_Language_Processing (For_Language) :=
|
||||
Language_Processing;
|
||||
|
||||
when others =>
|
||||
declare
|
||||
Supp : Supp_Language_Data;
|
||||
Supp_Index : Supp_Language_Index :=
|
||||
In_Project.Supp_Language_Processing;
|
||||
|
||||
begin
|
||||
while Supp_Index /= No_Supp_Language_Index loop
|
||||
Supp := Supp_Languages.Table (Supp_Index);
|
||||
|
||||
if Supp.Index = For_Language then
|
||||
Supp_Languages.Table (Supp_Index).Data :=
|
||||
Language_Processing;
|
||||
return;
|
||||
end if;
|
||||
|
||||
Supp_Index := Supp.Next;
|
||||
end loop;
|
||||
|
||||
Supp := (Index => For_Language, Data => Language_Processing,
|
||||
Next => In_Project.Supp_Language_Processing);
|
||||
Supp_Languages.Increment_Last;
|
||||
Supp_Index := Supp_Languages.Last;
|
||||
Supp_Languages.Table (Supp_Index) := Supp;
|
||||
In_Project.Supp_Language_Processing := Supp_Index;
|
||||
end;
|
||||
end case;
|
||||
end Set;
|
||||
|
||||
procedure Set
|
||||
(Suffix : Name_Id;
|
||||
For_Language : Language_Index;
|
||||
In_Project : in out Project_Data)
|
||||
is
|
||||
begin
|
||||
case For_Language is
|
||||
when No_Language_Index =>
|
||||
null;
|
||||
|
||||
when First_Language_Indexes =>
|
||||
In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
|
||||
|
||||
when others =>
|
||||
declare
|
||||
Supp : Supp_Suffix;
|
||||
Supp_Index : Supp_Language_Index :=
|
||||
In_Project.Naming.Supp_Suffixes;
|
||||
|
||||
begin
|
||||
while Supp_Index /= No_Supp_Language_Index loop
|
||||
Supp := Supp_Suffix_Table.Table (Supp_Index);
|
||||
|
||||
if Supp.Index = For_Language then
|
||||
Supp_Suffix_Table.Table (Supp_Index).Suffix := Suffix;
|
||||
return;
|
||||
end if;
|
||||
|
||||
Supp_Index := Supp.Next;
|
||||
end loop;
|
||||
|
||||
Supp := (Index => For_Language, Suffix => Suffix,
|
||||
Next => In_Project.Naming.Supp_Suffixes);
|
||||
Supp_Suffix_Table.Increment_Last;
|
||||
Supp_Index := Supp_Suffix_Table.Last;
|
||||
Supp_Suffix_Table.Table (Supp_Index) := Supp;
|
||||
In_Project.Naming.Supp_Suffixes := Supp_Index;
|
||||
end;
|
||||
end case;
|
||||
end Set;
|
||||
|
||||
|
||||
--------------------------
|
||||
-- Standard_Naming_Data --
|
||||
--------------------------
|
||||
|
|
@ -419,6 +670,44 @@ package body Prj is
|
|||
return Std_Naming_Data;
|
||||
end Standard_Naming_Data;
|
||||
|
||||
---------------
|
||||
-- Suffix_Of --
|
||||
---------------
|
||||
|
||||
function Suffix_Of
|
||||
(Language : Language_Index;
|
||||
In_Project : Project_Data) return Name_Id
|
||||
is
|
||||
begin
|
||||
case Language is
|
||||
when No_Language_Index =>
|
||||
return No_Name;
|
||||
|
||||
when First_Language_Indexes =>
|
||||
return In_Project.Naming.Impl_Suffixes (Language);
|
||||
|
||||
when others =>
|
||||
declare
|
||||
Supp : Supp_Suffix;
|
||||
Supp_Index : Supp_Language_Index :=
|
||||
In_Project.Naming.Supp_Suffixes;
|
||||
|
||||
begin
|
||||
while Supp_Index /= No_Supp_Language_Index loop
|
||||
Supp := Supp_Suffix_Table.Table (Supp_Index);
|
||||
|
||||
if Supp.Index = Language then
|
||||
return Supp.Suffix;
|
||||
end if;
|
||||
|
||||
Supp_Index := Supp.Next;
|
||||
end loop;
|
||||
|
||||
return No_Name;
|
||||
end;
|
||||
end case;
|
||||
end Suffix_Of;
|
||||
|
||||
-----------
|
||||
-- Value --
|
||||
-----------
|
||||
|
|
|
|||
287
gcc/ada/prj.ads
287
gcc/ada/prj.ads
|
|
@ -37,6 +37,8 @@ with Types; use Types;
|
|||
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
|
||||
with System.HTable; use System.HTable;
|
||||
|
||||
package Prj is
|
||||
|
||||
Empty_Name : Name_Id;
|
||||
|
|
@ -66,96 +68,167 @@ package Prj is
|
|||
Slash : Name_Id;
|
||||
-- "/", used as the path of locally removed files
|
||||
|
||||
type Languages_Processed is (Ada_Language, Other_Languages, All_Languages);
|
||||
-- To specify how to process project files
|
||||
type Language_Index is new Nat;
|
||||
|
||||
type Programming_Language is
|
||||
(Lang_Ada, Lang_C, Lang_C_Plus_Plus);
|
||||
-- The set of languages supported
|
||||
No_Language_Index : constant Language_Index := 0;
|
||||
First_Language_Index : constant Language_Index := 1;
|
||||
First_Language_Indexes_Last : constant Language_Index := 5;
|
||||
|
||||
subtype Other_Programming_Language is
|
||||
Programming_Language range Lang_C .. Programming_Language'Last;
|
||||
-- The set of non-Ada languages supported
|
||||
Ada_Language_Index : constant Language_Index :=
|
||||
First_Language_Index;
|
||||
C_Language_Index : constant Language_Index :=
|
||||
Ada_Language_Index + 1;
|
||||
C_Plus_Plus_Language_Index : constant Language_Index :=
|
||||
C_Language_Index + 1;
|
||||
|
||||
type Languages_In_Project is array (Programming_Language) of Boolean;
|
||||
Last_Language_Index : Language_Index := No_Language_Index;
|
||||
|
||||
subtype First_Language_Indexes is Language_Index
|
||||
range First_Language_Index .. First_Language_Indexes_Last;
|
||||
|
||||
type Header_Num is range 0 .. 2047;
|
||||
|
||||
function Hash is new System.HTable.Hash (Header_Num => Header_Num);
|
||||
|
||||
function Hash (Name : Name_Id) return Header_Num;
|
||||
|
||||
package Language_Indexes is new System.HTable.Simple_HTable
|
||||
(Header_Num => Header_Num,
|
||||
Element => Language_Index,
|
||||
No_Element => No_Language_Index,
|
||||
Key => Name_Id,
|
||||
Hash => Hash,
|
||||
Equal => "=");
|
||||
-- Mapping of language names to language indexes
|
||||
|
||||
package Language_Names is new Table.Table
|
||||
(Table_Component_Type => Name_Id,
|
||||
Table_Index_Type => Language_Index,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 4,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Prj.Language_Names");
|
||||
-- The table for the name of programming languages
|
||||
|
||||
procedure Add_Language_Name (Name : Name_Id);
|
||||
|
||||
procedure Display_Language_Name (Language : Language_Index);
|
||||
|
||||
type Languages_In_Project is array (First_Language_Indexes) of Boolean;
|
||||
-- Set of supported languages used in a project
|
||||
|
||||
No_Languages : constant Languages_In_Project := (others => False);
|
||||
-- No supported languages are used
|
||||
|
||||
type Impl_Suffix_Array is array (Programming_Language) of Name_Id;
|
||||
type Supp_Language_Index is new Nat;
|
||||
No_Supp_Language_Index : constant Supp_Language_Index := 0;
|
||||
|
||||
type Supp_Language is record
|
||||
Index : Language_Index := No_Language_Index;
|
||||
Present : Boolean := False;
|
||||
Next : Supp_Language_Index := No_Supp_Language_Index;
|
||||
end record;
|
||||
|
||||
package Present_Languages is new Table.Table
|
||||
(Table_Component_Type => Supp_Language,
|
||||
Table_Index_Type => Supp_Language_Index,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 4,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Prj.Present_Languages");
|
||||
-- The table for the presence of languages with an index that is outside
|
||||
-- of First_Language_Indexes.
|
||||
|
||||
type Impl_Suffix_Array is array (First_Language_Indexes) of Name_Id;
|
||||
-- Suffixes for the non spec sources of the different supported languages
|
||||
-- in a project.
|
||||
|
||||
No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_Name);
|
||||
-- A default value for the non spec source suffixes
|
||||
|
||||
Lang_Ada_Name : aliased String := "ada";
|
||||
Lang_C_Name : aliased String := "c";
|
||||
Lang_C_Plus_Plus_Name : aliased String := "c++";
|
||||
Lang_Names : constant array (Programming_Language) of String_Access :=
|
||||
(Lang_Ada => Lang_Ada_Name 'Access,
|
||||
Lang_C => Lang_C_Name 'Access,
|
||||
Lang_C_Plus_Plus => Lang_C_Plus_Plus_Name'Access);
|
||||
-- Names of the supported programming languages, to be used after switch
|
||||
-- -x when using a GCC compiler.
|
||||
type Supp_Suffix is record
|
||||
Index : Language_Index := No_Language_Index;
|
||||
Suffix : Name_Id := No_Name;
|
||||
Next : Supp_Language_Index := No_Supp_Language_Index;
|
||||
end record;
|
||||
|
||||
Lang_Name_Ids : array (Programming_Language) of Name_Id;
|
||||
-- Same as Lang_Names, but using Name_Id, instead of String_Access.
|
||||
-- Initialized by Prj.Initialize.
|
||||
package Supp_Suffix_Table is new Table.Table
|
||||
(Table_Component_Type => Supp_Suffix,
|
||||
Table_Index_Type => Supp_Language_Index,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 4,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Prj.Supp_Suffix_Table");
|
||||
-- The table for the presence of languages with an index that is outside
|
||||
-- of First_Language_Indexes.
|
||||
|
||||
Lang_Ada_Display_Name : aliased String := "Ada";
|
||||
Lang_C_Display_Name : aliased String := "C";
|
||||
Lang_C_Plus_Plus_Display_Name : aliased String := "C++";
|
||||
Lang_Display_Names :
|
||||
constant array (Programming_Language) of String_Access :=
|
||||
(Lang_Ada => Lang_Ada_Display_Name 'Access,
|
||||
Lang_C => Lang_C_Display_Name 'Access,
|
||||
Lang_C_Plus_Plus => Lang_C_Plus_Plus_Display_Name'Access);
|
||||
-- Names of the supported programming languages, to be used for display
|
||||
-- purposes.
|
||||
type Language_Kind is (GNU, other);
|
||||
|
||||
Ada_Impl_Suffix : aliased String := ".adb";
|
||||
C_Impl_Suffix : aliased String := ".c";
|
||||
C_Plus_Plus_Impl_Suffix : aliased String := ".cc";
|
||||
Lang_Suffixes : constant array (Programming_Language) of String_Access :=
|
||||
(Lang_Ada => Ada_Impl_Suffix 'Access,
|
||||
Lang_C => C_Impl_Suffix 'Access,
|
||||
Lang_C_Plus_Plus => C_Plus_Plus_Impl_Suffix'Access);
|
||||
-- Default extension of the sources of the different languages.
|
||||
type Name_List_Index is new Nat;
|
||||
No_Name_List : constant Name_List_Index := 0;
|
||||
|
||||
Lang_Suffix_Ids : array (Programming_Language) of Name_Id;
|
||||
-- Same as Lang_Suffixes, but using Name_Id, instead of String_Access.
|
||||
-- Initialized by Prj.Initialize.
|
||||
type Name_Node is record
|
||||
Name : Name_Id := No_Name;
|
||||
Next : Name_List_Index := No_Name_List;
|
||||
end record;
|
||||
|
||||
Gnatmake_String : aliased String := "gnatmake";
|
||||
Gcc_String : aliased String := "gcc";
|
||||
G_Plus_Plus_String : aliased String := "g++";
|
||||
Default_Compiler_Names :
|
||||
constant array (Programming_Language) of String_Access :=
|
||||
(Lang_Ada => Gnatmake_String 'Access,
|
||||
Lang_C => Gcc_String 'Access,
|
||||
Lang_C_Plus_Plus => G_Plus_Plus_String'Access);
|
||||
-- Default names of the compilers for the supported languages.
|
||||
-- Used when no IDE'Compiler_Command is specified for a language.
|
||||
-- For Ada, specify the gnatmake executable.
|
||||
package Name_Lists is new Table.Table
|
||||
(Table_Component_Type => Name_Node,
|
||||
Table_Index_Type => Name_List_Index,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 10,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Prj.Name_Lists");
|
||||
-- The table for lists of names used in package Language_Processing
|
||||
|
||||
Ada_Args_Strings : aliased String := "";
|
||||
C_Args_String : aliased String := "c";
|
||||
C_Plus_Plus_Args_String : aliased String := "xx";
|
||||
Lang_Args : constant array (Programming_Language) of String_Access :=
|
||||
(Lang_Ada => Ada_Args_Strings 'Access,
|
||||
Lang_C => C_Args_String 'Access,
|
||||
Lang_C_Plus_Plus => C_Plus_Plus_Args_String'Access);
|
||||
-- For each supported language, the string between "-c" and "args" to
|
||||
-- be used in the gprmake switch for the start of the compiling switch
|
||||
-- section for each supported language. For example, "-ccargs" indicates
|
||||
-- the start of the C compiler switch section.
|
||||
type Language_Processing_Data is record
|
||||
Compiler_Drivers : Name_List_Index := No_Name_List;
|
||||
Compiler_Paths : Name_Id := No_Name;
|
||||
Compiler_Kinds : Language_Kind := GNU;
|
||||
Dependency_Options : Name_List_Index := No_Name_List;
|
||||
Compute_Dependencies : Name_List_Index := No_Name_List;
|
||||
Include_Options : Name_List_Index := No_Name_List;
|
||||
Binder_Drivers : Name_Id := No_Name;
|
||||
Binder_Driver_Paths : Name_Id := No_Name;
|
||||
end record;
|
||||
|
||||
Default_Language_Processing_Data :
|
||||
constant Language_Processing_Data :=
|
||||
(Compiler_Drivers => No_Name_List,
|
||||
Compiler_Paths => No_Name,
|
||||
Compiler_Kinds => GNU,
|
||||
Dependency_Options => No_Name_List,
|
||||
Compute_Dependencies => No_Name_List,
|
||||
Include_Options => No_Name_List,
|
||||
Binder_Drivers => No_Name,
|
||||
Binder_Driver_Paths => No_Name);
|
||||
|
||||
type First_Language_Processing_Data is
|
||||
array (First_Language_Indexes) of Language_Processing_Data;
|
||||
|
||||
Default_First_Language_Processing_Data : First_Language_Processing_Data :=
|
||||
(others => Default_Language_Processing_Data);
|
||||
|
||||
type Supp_Language_Data is record
|
||||
Index : Language_Index := No_Language_Index;
|
||||
Data : Language_Processing_Data := Default_Language_Processing_Data;
|
||||
Next : Supp_Language_Index := No_Supp_Language_Index;
|
||||
end record;
|
||||
|
||||
package Supp_Languages is new Table.Table
|
||||
(Table_Component_Type => Supp_Language_Data,
|
||||
Table_Index_Type => Supp_Language_Index,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 4,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Prj.Supp_Languages");
|
||||
-- The table for language data when there are more languages than
|
||||
-- in First_Language_Indexes.
|
||||
|
||||
type Other_Source_Id is new Nat;
|
||||
No_Other_Source : constant Other_Source_Id := 0;
|
||||
type Other_Source is record
|
||||
Language : Programming_Language; -- language of the source
|
||||
Language : Language_Index; -- language of the source
|
||||
File_Name : Name_Id; -- source file simple name
|
||||
Path_Name : Name_Id; -- source full path name
|
||||
Source_TS : Time_Stamp_Type; -- source file time stamp
|
||||
|
|
@ -375,8 +448,6 @@ package Prj is
|
|||
-- The following record contains data for a naming scheme
|
||||
|
||||
type Naming_Data is record
|
||||
Current_Language : Name_Id := No_Name;
|
||||
-- The programming language being currently considered
|
||||
|
||||
Dot_Replacement : Name_Id := No_Name;
|
||||
-- The string to replace '.' in the source file name (for Ada).
|
||||
|
|
@ -393,24 +464,28 @@ package Prj is
|
|||
-- source file name of a spec.
|
||||
-- Indexed by the programming language.
|
||||
|
||||
Current_Spec_Suffix : Name_Id := No_Name;
|
||||
-- The "spec" suffix of the current programming language
|
||||
Ada_Spec_Suffix : Name_Id := No_Name;
|
||||
-- The suffix of the Ada spec sources
|
||||
|
||||
Spec_Suffix_Loc : Source_Ptr := No_Location;
|
||||
-- The position in the project file source where
|
||||
-- Current_Spec_Suffix is defined.
|
||||
-- Ada_Spec_Suffix is defined.
|
||||
|
||||
Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes;
|
||||
Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index;
|
||||
-- The source suffixes of the different languages
|
||||
|
||||
Body_Suffix : Array_Element_Id := No_Array_Element;
|
||||
-- The string to append to the unit name for the
|
||||
-- source file name of a body.
|
||||
-- Indexed by the programming language.
|
||||
|
||||
Current_Body_Suffix : Name_Id := No_Name;
|
||||
-- The "body" suffix of the current programming language
|
||||
Ada_Body_Suffix : Name_Id := No_Name;
|
||||
-- The suffix of the Ada body sources
|
||||
|
||||
Body_Suffix_Loc : Source_Ptr := No_Location;
|
||||
-- The position in the project file source where
|
||||
-- Current_Body_Suffix is defined.
|
||||
-- Ada_Body_Suffix is defined.
|
||||
|
||||
Separate_Suffix : Name_Id := No_Name;
|
||||
-- String to append to unit name for source file name of an Ada subunit.
|
||||
|
|
@ -441,8 +516,7 @@ package Prj is
|
|||
-- The standard GNAT naming scheme
|
||||
|
||||
function Same_Naming_Scheme
|
||||
(Left, Right : Naming_Data)
|
||||
return Boolean;
|
||||
(Left, Right : Naming_Data) return Boolean;
|
||||
-- Returns True if Left and Right are the same naming scheme
|
||||
-- not considering Specs and Bodies.
|
||||
|
||||
|
|
@ -469,11 +543,11 @@ package Prj is
|
|||
-- The following record describes a project file representation
|
||||
|
||||
type Project_Data is record
|
||||
Languages : Languages_In_Project := No_Languages;
|
||||
-- Indicate the different languages of the source of this project
|
||||
Externally_Built : Boolean := False;
|
||||
|
||||
Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes;
|
||||
-- The source suffixes of the different languages other than Ada
|
||||
Languages : Languages_In_Project := No_Languages;
|
||||
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
|
||||
-- Indicate the different languages of the source of this project
|
||||
|
||||
First_Referred_By : Project_Id := No_Project;
|
||||
-- The project, if any, that was the first to be known
|
||||
|
|
@ -498,7 +572,7 @@ package Prj is
|
|||
-- project. Set by Prj.Proc.Process.
|
||||
|
||||
Mains : String_List_Id := Nil_String;
|
||||
-- List of mains specified by attribute Main. Set by Prj.Nmsc.Ada_Check.
|
||||
-- List of mains specified by attribute Main. Set by Prj.Nmsc.Check.
|
||||
|
||||
Directory : Name_Id := No_Name;
|
||||
-- Directory where the project file resides. Set by Prj.Proc.Process.
|
||||
|
|
@ -548,11 +622,11 @@ package Prj is
|
|||
|
||||
Standalone_Library : Boolean := False;
|
||||
-- Indicate that this is a Standalone Library Project File.
|
||||
-- Set by Prj.Nmsc.Ada_Check.
|
||||
-- Set by Prj.Nmsc.Check.
|
||||
|
||||
Lib_Interface_ALIs : String_List_Id := Nil_String;
|
||||
-- For Standalone Library Project Files, indicate the list
|
||||
-- of Interface ALI files. Set by Prj.Nmsc.Ada_Check.
|
||||
-- of Interface ALI files. Set by Prj.Nmsc.Check.
|
||||
|
||||
Lib_Auto_Init : Boolean := False;
|
||||
-- For non static Standalone Library Project Files, indicate if
|
||||
|
|
@ -629,6 +703,15 @@ package Prj is
|
|||
-- The naming scheme of this project file.
|
||||
-- Set by Prj.Nmsc.Check_Naming_Scheme.
|
||||
|
||||
First_Language_Processing : First_Language_Processing_Data :=
|
||||
Default_First_Language_Processing_Data;
|
||||
|
||||
Supp_Language_Processing : Supp_Language_Index :=
|
||||
No_Supp_Language_Index;
|
||||
|
||||
Default_Linker : Name_Id := No_Name;
|
||||
Default_Linker_Path : Name_Id := No_Name;
|
||||
|
||||
Decl : Declarations := No_Declarations;
|
||||
-- The declarations (variables, attributes and packages) of this
|
||||
-- project file. Set by Prj.Proc.Process.
|
||||
|
|
@ -699,6 +782,44 @@ package Prj is
|
|||
|
||||
end record;
|
||||
|
||||
function Is_Present
|
||||
(Language : Language_Index;
|
||||
In_Project : Project_Data) return Boolean;
|
||||
-- Return True when Language is one of the languages used in
|
||||
-- project Project.
|
||||
|
||||
procedure Set
|
||||
(Language : Language_Index;
|
||||
Present : Boolean;
|
||||
In_Project : in out Project_Data);
|
||||
-- Indicate if Language is or not a language used in project Project
|
||||
|
||||
function Language_Processing_Data_Of
|
||||
(Language : Language_Index;
|
||||
In_Project : Project_Data) return Language_Processing_Data;
|
||||
-- Return the Language_Processing_Data for language Language in project
|
||||
-- In_Project. Return the default when no Language_Processing_Data are
|
||||
-- defined for the language.
|
||||
|
||||
procedure Set
|
||||
(Language_Processing : Language_Processing_Data;
|
||||
For_Language : Language_Index;
|
||||
In_Project : in out Project_Data);
|
||||
-- Set the Language_Processing_Data for language Language in project
|
||||
-- In_Project.
|
||||
|
||||
function Suffix_Of
|
||||
(Language : Language_Index;
|
||||
In_Project : Project_Data) return Name_Id;
|
||||
-- Return the suffix for language Language in project In_Project. Return
|
||||
-- No_Name when no suffix is defined for the language.
|
||||
|
||||
procedure Set
|
||||
(Suffix : Name_Id;
|
||||
For_Language : Language_Index;
|
||||
In_Project : in out Project_Data);
|
||||
-- Set the suffix for language Language in project In_Project
|
||||
|
||||
Project_Error : exception;
|
||||
-- Raised by some subprograms in Prj.Attr.
|
||||
|
||||
|
|
|
|||
|
|
@ -626,16 +626,24 @@ package body Snames is
|
|||
"requeue#" &
|
||||
"tagged#" &
|
||||
"raise_exception#" &
|
||||
"ada_roots#" &
|
||||
"binder#" &
|
||||
"binder_driver#" &
|
||||
"body_suffix#" &
|
||||
"builder#" &
|
||||
"compiler#" &
|
||||
"compiler_driver#" &
|
||||
"compiler_kind#" &
|
||||
"compute_dependency#" &
|
||||
"cross_reference#" &
|
||||
"default_linker#" &
|
||||
"default_switches#" &
|
||||
"dependency_option#" &
|
||||
"exec_dir#" &
|
||||
"executable#" &
|
||||
"executable_suffix#" &
|
||||
"extends#" &
|
||||
"externally_built#" &
|
||||
"finder#" &
|
||||
"global_configuration_pragmas#" &
|
||||
"gnatls#" &
|
||||
|
|
@ -643,6 +651,8 @@ package body Snames is
|
|||
"implementation#" &
|
||||
"implementation_exceptions#" &
|
||||
"implementation_suffix#" &
|
||||
"include_option#" &
|
||||
"language_processing#" &
|
||||
"languages#" &
|
||||
"library_dir#" &
|
||||
"library_auto_init#" &
|
||||
|
|
|
|||
|
|
@ -921,64 +921,75 @@ package Snames is
|
|||
|
||||
Name_Raise_Exception : constant Name_Id := N + 568;
|
||||
|
||||
-- Additional reserved words in GNAT Project Files
|
||||
-- Additional reserved words and identifiers used in GNAT Project Files
|
||||
-- Note that Name_External is already previously declared
|
||||
|
||||
Name_Binder : constant Name_Id := N + 569;
|
||||
Name_Body_Suffix : constant Name_Id := N + 570;
|
||||
Name_Builder : constant Name_Id := N + 571;
|
||||
Name_Compiler : constant Name_Id := N + 572;
|
||||
Name_Cross_Reference : constant Name_Id := N + 573;
|
||||
Name_Default_Switches : constant Name_Id := N + 574;
|
||||
Name_Exec_Dir : constant Name_Id := N + 575;
|
||||
Name_Executable : constant Name_Id := N + 576;
|
||||
Name_Executable_Suffix : constant Name_Id := N + 577;
|
||||
Name_Extends : constant Name_Id := N + 578;
|
||||
Name_Finder : constant Name_Id := N + 579;
|
||||
Name_Global_Configuration_Pragmas : constant Name_Id := N + 580;
|
||||
Name_Gnatls : constant Name_Id := N + 581;
|
||||
Name_Gnatstub : constant Name_Id := N + 582;
|
||||
Name_Implementation : constant Name_Id := N + 583;
|
||||
Name_Implementation_Exceptions : constant Name_Id := N + 584;
|
||||
Name_Implementation_Suffix : constant Name_Id := N + 585;
|
||||
Name_Languages : constant Name_Id := N + 586;
|
||||
Name_Library_Dir : constant Name_Id := N + 587;
|
||||
Name_Library_Auto_Init : constant Name_Id := N + 588;
|
||||
Name_Library_GCC : constant Name_Id := N + 589;
|
||||
Name_Library_Interface : constant Name_Id := N + 590;
|
||||
Name_Library_Kind : constant Name_Id := N + 591;
|
||||
Name_Library_Name : constant Name_Id := N + 592;
|
||||
Name_Library_Options : constant Name_Id := N + 593;
|
||||
Name_Library_Reference_Symbol_File : constant Name_Id := N + 594;
|
||||
Name_Library_Src_Dir : constant Name_Id := N + 595;
|
||||
Name_Library_Symbol_File : constant Name_Id := N + 596;
|
||||
Name_Library_Symbol_Policy : constant Name_Id := N + 597;
|
||||
Name_Library_Version : constant Name_Id := N + 598;
|
||||
Name_Linker : constant Name_Id := N + 599;
|
||||
Name_Local_Configuration_Pragmas : constant Name_Id := N + 600;
|
||||
Name_Locally_Removed_Files : constant Name_Id := N + 601;
|
||||
Name_Metrics : constant Name_Id := N + 602;
|
||||
Name_Naming : constant Name_Id := N + 603;
|
||||
Name_Object_Dir : constant Name_Id := N + 604;
|
||||
Name_Pretty_Printer : constant Name_Id := N + 605;
|
||||
Name_Project : constant Name_Id := N + 606;
|
||||
Name_Separate_Suffix : constant Name_Id := N + 607;
|
||||
Name_Source_Dirs : constant Name_Id := N + 608;
|
||||
Name_Source_Files : constant Name_Id := N + 609;
|
||||
Name_Source_List_File : constant Name_Id := N + 610;
|
||||
Name_Spec : constant Name_Id := N + 611;
|
||||
Name_Spec_Suffix : constant Name_Id := N + 612;
|
||||
Name_Specification : constant Name_Id := N + 613;
|
||||
Name_Specification_Exceptions : constant Name_Id := N + 614;
|
||||
Name_Specification_Suffix : constant Name_Id := N + 615;
|
||||
Name_Switches : constant Name_Id := N + 616;
|
||||
Name_Ada_Roots : constant Name_Id := N + 569;
|
||||
Name_Binder : constant Name_Id := N + 570;
|
||||
Name_Binder_Driver : constant Name_Id := N + 571;
|
||||
Name_Body_Suffix : constant Name_Id := N + 572;
|
||||
Name_Builder : constant Name_Id := N + 573;
|
||||
Name_Compiler : constant Name_Id := N + 574;
|
||||
Name_Compiler_Driver : constant Name_Id := N + 575;
|
||||
Name_Compiler_Kind : constant Name_Id := N + 576;
|
||||
Name_Compute_Dependency : constant Name_Id := N + 577;
|
||||
Name_Cross_Reference : constant Name_Id := N + 578;
|
||||
Name_Default_Linker : constant Name_Id := N + 579;
|
||||
Name_Default_Switches : constant Name_Id := N + 580;
|
||||
Name_Dependency_Option : constant Name_Id := N + 581;
|
||||
Name_Exec_Dir : constant Name_Id := N + 582;
|
||||
Name_Executable : constant Name_Id := N + 583;
|
||||
Name_Executable_Suffix : constant Name_Id := N + 584;
|
||||
Name_Extends : constant Name_Id := N + 585;
|
||||
Name_Externally_Built : constant Name_Id := N + 586;
|
||||
Name_Finder : constant Name_Id := N + 587;
|
||||
Name_Global_Configuration_Pragmas : constant Name_Id := N + 588;
|
||||
Name_Gnatls : constant Name_Id := N + 589;
|
||||
Name_Gnatstub : constant Name_Id := N + 590;
|
||||
Name_Implementation : constant Name_Id := N + 591;
|
||||
Name_Implementation_Exceptions : constant Name_Id := N + 592;
|
||||
Name_Implementation_Suffix : constant Name_Id := N + 593;
|
||||
Name_Include_Option : constant Name_Id := N + 594;
|
||||
Name_Language_Processing : constant Name_Id := N + 595;
|
||||
Name_Languages : constant Name_Id := N + 596;
|
||||
Name_Library_Dir : constant Name_Id := N + 597;
|
||||
Name_Library_Auto_Init : constant Name_Id := N + 598;
|
||||
Name_Library_GCC : constant Name_Id := N + 599;
|
||||
Name_Library_Interface : constant Name_Id := N + 600;
|
||||
Name_Library_Kind : constant Name_Id := N + 601;
|
||||
Name_Library_Name : constant Name_Id := N + 602;
|
||||
Name_Library_Options : constant Name_Id := N + 603;
|
||||
Name_Library_Reference_Symbol_File : constant Name_Id := N + 604;
|
||||
Name_Library_Src_Dir : constant Name_Id := N + 605;
|
||||
Name_Library_Symbol_File : constant Name_Id := N + 606;
|
||||
Name_Library_Symbol_Policy : constant Name_Id := N + 607;
|
||||
Name_Library_Version : constant Name_Id := N + 608;
|
||||
Name_Linker : constant Name_Id := N + 609;
|
||||
Name_Local_Configuration_Pragmas : constant Name_Id := N + 610;
|
||||
Name_Locally_Removed_Files : constant Name_Id := N + 611;
|
||||
Name_Metrics : constant Name_Id := N + 612;
|
||||
Name_Naming : constant Name_Id := N + 613;
|
||||
Name_Object_Dir : constant Name_Id := N + 614;
|
||||
Name_Pretty_Printer : constant Name_Id := N + 615;
|
||||
Name_Project : constant Name_Id := N + 616;
|
||||
Name_Separate_Suffix : constant Name_Id := N + 617;
|
||||
Name_Source_Dirs : constant Name_Id := N + 618;
|
||||
Name_Source_Files : constant Name_Id := N + 619;
|
||||
Name_Source_List_File : constant Name_Id := N + 620;
|
||||
Name_Spec : constant Name_Id := N + 621;
|
||||
Name_Spec_Suffix : constant Name_Id := N + 622;
|
||||
Name_Specification : constant Name_Id := N + 623;
|
||||
Name_Specification_Exceptions : constant Name_Id := N + 624;
|
||||
Name_Specification_Suffix : constant Name_Id := N + 625;
|
||||
Name_Switches : constant Name_Id := N + 626;
|
||||
|
||||
-- Other miscellaneous names used in front end
|
||||
|
||||
Name_Unaligned_Valid : constant Name_Id := N + 617;
|
||||
Name_Unaligned_Valid : constant Name_Id := N + 627;
|
||||
|
||||
-- Mark last defined name for consistency check in Snames body
|
||||
|
||||
Last_Predefined_Name : constant Name_Id := N + 617;
|
||||
Last_Predefined_Name : constant Name_Id := N + 627;
|
||||
|
||||
subtype Any_Operator_Name is Name_Id range
|
||||
First_Operator_Name .. Last_Operator_Name;
|
||||
|
|
|
|||
Loading…
Reference in New Issue