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 2004-12-08 12:25:51 +01:00
parent a7e5b6df8d
commit 44e1918abd
25 changed files with 3755 additions and 2980 deletions

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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;

View File

@ -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);

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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);

File diff suppressed because it is too large Load Diff

View File

@ -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;

View File

@ -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;

View File

@ -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.

View File

@ -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;

View File

@ -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;

View File

@ -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.

View File

@ -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,

View File

@ -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;

View File

@ -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 --
-----------

View File

@ -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.

View File

@ -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#" &

View File

@ -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;