Skip to content

R
riscv-gcc-1
Commit 44e1918a by Arnaud Charlet
Options

make.adb (Check_Mains, [...]): Adapt to name changes in package Prj… 

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
parent a7e5b6df
Showing with 539 additions and 286 deletions
gcc/ada/clean.adb
......@@ -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;
......
gcc/ada/gnatcmd.adb
......@@ -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
......
gcc/ada/gnatls.adb
......@@ -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>";
......@@ -1523,6 +1536,105 @@ begin
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;
-- Output usage information when requested
......
gcc/ada/mlib-prj.adb
......@@ -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.
......
gcc/ada/prj-attr.adb
......@@ -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;
......
gcc/ada/prj-com.adb
......@@ -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);
......
gcc/ada/prj-com.ads
......@@ -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
......
gcc/ada/prj-env.adb
......@@ -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;
......
gcc/ada/prj-ext.adb
......@@ -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;
gcc/ada/prj-ext.ads
......@@ -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);
......
gcc/ada/prj-nmsc.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/prj-nmsc.ads
......@@ -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;
gcc/ada/prj-pars.adb
......@@ -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;
......
gcc/ada/prj-pars.ads
......@@ -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.
......
gcc/ada/prj-part.adb
......@@ -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);
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.Canonical_Path = 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;
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);
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 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);
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);
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;
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;
A_Project_Name_And_Node.Node := Prj;
end;
else
Error_Msg
("cannot import an already extended project file",
Token_Ptr);
end if;
Project := A_Project_Name_And_Node.Node;
Project_Stack.Decrement_Last;
return;
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;
gcc/ada/prj-proc.adb
......@@ -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;
......
gcc/ada/prj-proc.ads
......@@ -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.
......
gcc/ada/prj-tree.ads
......@@ -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,
......
gcc/ada/prj-util.adb
......@@ -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;
......
gcc/ada/snames.adb
......@@ -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#" &
......
gcc/ada/snames.ads
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment