Skip to content

R
riscv-gcc-1
Commit 4f6447c5 by Vincent Celier Committed by Arnaud Charlet
Options

prj.ads (Project_Data): Add comments. 

2007-08-16  Vincent Celier  <celier@adacore.com>

	* prj.ads (Project_Data): Add comments.

	* prj-attr.adb: New attribute Removed_Source_Dirs

	* prj-nmsc.adb (Get_Directories): Take into account new attribute
	Removed_Source_Dirs

	* snames.ads, snames.adb: New standard name Removed_Source_Dirs

From-SVN: r127544
parent e03a78d5
Showing with 272 additions and 140 deletions
gcc/ada/prj-attr.adb
...@@ -75,6 +75,7 @@ package body Prj.Attr is ...@@ -75,6 +75,7 @@ package body Prj.Attr is
"SVobject_dir#" & "SVobject_dir#" &
"SVexec_dir#" & "SVexec_dir#" &
"LVsource_dirs#" & "LVsource_dirs#" &
"LVremoved_source_dirs#" &
-- Source files -- Source files
......
gcc/ada/prj-nmsc.adb
...@@ -4174,6 +4174,9 @@ package body Prj.Nmsc is ...@@ -4174,6 +4174,9 @@ package body Prj.Nmsc is
elsif Value = "restricted" then elsif Value = "restricted" then
Data.Symbol_Data.Symbol_Policy := Restricted; Data.Symbol_Data.Symbol_Policy := Restricted;
elsif Value = "direct" then
Data.Symbol_Data.Symbol_Policy := Direct;
else else
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
...@@ -4196,7 +4199,7 @@ package body Prj.Nmsc is ...@@ -4196,7 +4199,7 @@ package body Prj.Nmsc is
end if; end if;
else else
-- Library_Symbol_File is defined. Check that the file exists -- Library_Symbol_File is defined.
Data.Symbol_Data.Symbol_File := Data.Symbol_Data.Symbol_File :=
Path_Name_Type (Lib_Symbol_File.Value); Path_Name_Type (Lib_Symbol_File.Value);
...@@ -4262,43 +4265,28 @@ package body Prj.Nmsc is ...@@ -4262,43 +4265,28 @@ package body Prj.Nmsc is
Lib_Symbol_File.Location); Lib_Symbol_File.Location);
else else
OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
Name_Len := 0;
if OK then Add_Str_To_Name_Buffer (Get_Name_String (Data.Directory));
for J in 1 .. Name_Len loop Add_Char_To_Name_Buffer (Directory_Separator);
if Name_Buffer (J) = '/' Add_Str_To_Name_Buffer
or else Name_Buffer (J) = Directory_Separator (Get_Name_String (Lib_Ref_Symbol_File.Value));
then Data.Symbol_Data.Reference := Name_Find;
OK := False;
exit;
end if;
end loop;
end if;
if not OK then
Error_Msg_File_1 :=
File_Name_Type (Lib_Ref_Symbol_File.Value);
Error_Msg
(Project, In_Tree,
"reference symbol file { name is illegal. " &
"Name canot include directory info.",
Lib_Ref_Symbol_File.Location);
end if; end if;
if not Is_Regular_File if not Is_Regular_File
(Get_Name_String (Data.Object_Directory) & (Get_Name_String (Data.Symbol_Data.Reference))
Directory_Separator &
Get_Name_String (Lib_Ref_Symbol_File.Value))
then then
Error_Msg_File_1 := Error_Msg_File_1 :=
File_Name_Type (Lib_Ref_Symbol_File.Value); File_Name_Type (Lib_Ref_Symbol_File.Value);
-- For controlled symbol policy, it is an error if the -- For controlled and direct symbol policies, it is an error
-- reference symbol file does not exist. For other symbol -- if the reference symbol file does not exist. For other
-- policies, this is just a warning -- symbol policies, this is just a warning
Error_Msg_Warn := Error_Msg_Warn :=
Data.Symbol_Data.Symbol_Policy /= Controlled; Data.Symbol_Data.Symbol_Policy /= Controlled
and then Data.Symbol_Data.Symbol_Policy /= Direct;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
...@@ -4316,6 +4304,36 @@ package body Prj.Nmsc is ...@@ -4316,6 +4304,36 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
end if; end if;
-- If both the reference symbol file and the symbol file are
-- defined, then check that they are not the same file.
if Data.Symbol_Data.Symbol_File /= No_Path then
Get_Name_String (Data.Symbol_Data.Symbol_File);
if Name_Len > 0 then
declare
Symb_Path : constant String :=
Normalize_Pathname
(Get_Name_String
(Data.Object_Directory) &
Directory_Separator &
Name_Buffer (1 .. Name_Len));
Ref_Path : constant String :=
Normalize_Pathname
(Get_Name_String
(Data.Symbol_Data.Reference));
begin
if Symb_Path = Ref_Path then
Error_Msg
(Project, In_Tree,
"library reference symbol file and library" &
" symbol file cannot be the same file",
Lib_Ref_Symbol_File.Location);
end if;
end;
end if;
end if;
end if; end if;
end if; end if;
end if; end if;
...@@ -4794,6 +4812,12 @@ package body Prj.Nmsc is ...@@ -4794,6 +4812,12 @@ package body Prj.Nmsc is
Util.Value_Of Util.Value_Of
(Name_Source_Dirs, Data.Decl.Attributes, In_Tree); (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
Removed_Source_Dirs : constant Variable_Value :=
Util.Value_Of
(Name_Removed_Source_Dirs,
Data.Decl.Attributes,
In_Tree);
Source_Files : constant Variable_Value := Source_Files : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Files, Data.Decl.Attributes, In_Tree); (Name_Source_Files, Data.Decl.Attributes, In_Tree);
...@@ -4802,9 +4826,11 @@ package body Prj.Nmsc is ...@@ -4802,9 +4826,11 @@ package body Prj.Nmsc is
procedure Find_Source_Dirs procedure Find_Source_Dirs
(From : File_Name_Type; (From : File_Name_Type;
Location : Source_Ptr); Location : Source_Ptr;
-- Find one or several source directories, and add them Removed : Boolean := False);
-- to the list of source directories of the project. -- Find one or several source directories, and add (or remove, if
-- Removed is True) them to the list of source directories of the
-- project.
---------------------- ----------------------
-- Find_Source_Dirs -- -- Find_Source_Dirs --
...@@ -4812,7 +4838,8 @@ package body Prj.Nmsc is ...@@ -4812,7 +4838,8 @@ package body Prj.Nmsc is
procedure Find_Source_Dirs procedure Find_Source_Dirs
(From : File_Name_Type; (From : File_Name_Type;
Location : Source_Ptr) Location : Source_Ptr;
Removed : Boolean := False)
is is
Directory : constant String := Get_Name_String (From); Directory : constant String := Get_Name_String (From);
Element : String_Element; Element : String_Element;
...@@ -4830,6 +4857,7 @@ package body Prj.Nmsc is ...@@ -4830,6 +4857,7 @@ package body Prj.Nmsc is
Name : String (1 .. 250); Name : String (1 .. 250);
Last : Natural; Last : Natural;
List : String_List_Id := Data.Source_Dirs; List : String_List_Id := Data.Source_Dirs;
Prev : String_List_Id := Nil_String;
Element : String_Element; Element : String_Element;
Found : Boolean := False; Found : Boolean := False;
...@@ -4857,12 +4885,13 @@ package body Prj.Nmsc is ...@@ -4857,12 +4885,13 @@ package body Prj.Nmsc is
-- then there is nothing to do, just return. If it is not, put -- then there is nothing to do, just return. If it is not, put
-- it there and continue recursive processing. -- it there and continue recursive processing.
if not Removed then
if Recursive_Dirs.Get (Canonical_Path) then if Recursive_Dirs.Get (Canonical_Path) then
return; return;
else else
Recursive_Dirs.Set (Canonical_Path, True); Recursive_Dirs.Set (Canonical_Path, True);
end if; end if;
end if;
-- Check if directory is already in list -- Check if directory is already in list
...@@ -4874,12 +4903,13 @@ package body Prj.Nmsc is ...@@ -4874,12 +4903,13 @@ package body Prj.Nmsc is
exit when Found; exit when Found;
end if; end if;
Prev := List;
List := Element.Next; List := Element.Next;
end loop; end loop;
-- If directory is not already in list, put it there -- If directory is not already in list, put it there
if not Found then if (not Removed) and (not Found) then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" "); Write_Str (" ");
Write_Line (The_Path (The_Path'First .. The_Path_Last)); Write_Line (The_Path (The_Path'First .. The_Path_Last));
...@@ -4918,6 +4948,15 @@ package body Prj.Nmsc is ...@@ -4918,6 +4948,15 @@ package body Prj.Nmsc is
(In_Tree.String_Elements); (In_Tree.String_Elements);
In_Tree.String_Elements.Table (Last_Source_Dir) := In_Tree.String_Elements.Table (Last_Source_Dir) :=
Element; Element;
elsif Removed and Found then
if Prev = Nil_String then
Data.Source_Dirs :=
In_Tree.String_Elements.Table (List).Next;
else
In_Tree.String_Elements.Table (Prev).Next :=
In_Tree.String_Elements.Table (List).Next;
end if;
end if; end if;
-- Now look for subdirectories. We do that even when this -- Now look for subdirectories. We do that even when this
...@@ -4973,14 +5012,14 @@ package body Prj.Nmsc is ...@@ -4973,14 +5012,14 @@ package body Prj.Nmsc is
-- Start of processing for Find_Source_Dirs -- Start of processing for Find_Source_Dirs
begin begin
if Current_Verbosity = High then if Current_Verbosity = High and then not Removed then
Write_Str ("Find_Source_Dirs ("""); Write_Str ("Find_Source_Dirs (""");
Write_Str (Directory); Write_Str (Directory);
Write_Line (""")"); Write_Line (""")");
end if; end if;
-- First, check if we are looking for a directory tree, -- First, check if we are looking for a directory tree, indicated
-- indicated by "/**" at the end. -- by "/**" at the end.
if Directory'Length >= 3 if Directory'Length >= 3
and then Directory (Directory'Last - 1 .. Directory'Last) = "**" and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
...@@ -4988,14 +5027,15 @@ package body Prj.Nmsc is ...@@ -4988,14 +5027,15 @@ package body Prj.Nmsc is
or else or else
Directory (Directory'Last - 2) = Directory_Separator) Directory (Directory'Last - 2) = Directory_Separator)
then then
if not Removed then
Data.Known_Order_Of_Source_Dirs := False; Data.Known_Order_Of_Source_Dirs := False;
end if;
Name_Len := Directory'Length - 3; Name_Len := Directory'Length - 3;
if Name_Len = 0 then if Name_Len = 0 then
-- This is the case of "/**": all directories -- Case of "/**": all directories in file system
-- in the file system.
Name_Len := 1; Name_Len := 1;
Name_Buffer (1) := Directory (Directory'First); Name_Buffer (1) := Directory (Directory'First);
...@@ -5038,8 +5078,8 @@ package body Prj.Nmsc is ...@@ -5038,8 +5078,8 @@ package body Prj.Nmsc is
end if; end if;
else else
-- We have an existing directory, we register it and all -- We have an existing directory, we register it and all of
-- of its subdirectories. -- its subdirectories.
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("Looking for source directories:"); Write_Line ("Looking for source directories:");
...@@ -5061,6 +5101,8 @@ package body Prj.Nmsc is ...@@ -5061,6 +5101,8 @@ package body Prj.Nmsc is
declare declare
Path_Name : Path_Name_Type; Path_Name : Path_Name_Type;
Display_Path_Name : Path_Name_Type; Display_Path_Name : Path_Name_Type;
List : String_List_Id;
Prev : String_List_Id;
begin begin
Locate_Directory Locate_Directory
...@@ -5087,13 +5129,46 @@ package body Prj.Nmsc is ...@@ -5087,13 +5129,46 @@ package body Prj.Nmsc is
end if; end if;
else else
-- As it is an existing directory, we add it to declare
-- the list of directories. Path : constant String :=
Get_Name_String (Path_Name) &
Directory_Separator;
Last_Path : constant Natural :=
Compute_Directory_Last (Path);
Path_Id : Name_Id;
Display_Path : constant String :=
Get_Name_String
(Display_Path_Name) &
Directory_Separator;
Last_Display_Path : constant Natural :=
Compute_Directory_Last
(Display_Path);
Display_Path_Id : Name_Id;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
Path_Id := Name_Find;
Name_Len := 0;
Add_Str_To_Name_Buffer
(Display_Path
(Display_Path'First .. Last_Display_Path));
Display_Path_Id := Name_Find;
if not Removed then
-- As it is an existing directory, we add it to the
-- list of directories.
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
Element.Value := Name_Id (Path_Name); Element :=
Element.Display_Value := Name_Id (Display_Path_Name); (Value => Path_Id,
Index => 0,
Display_Value => Display_Path_Id,
Location => No_Location,
Flag => False,
Next => Nil_String);
if Last_Source_Dir = Nil_String then if Last_Source_Dir = Nil_String then
...@@ -5103,8 +5178,8 @@ package body Prj.Nmsc is ...@@ -5103,8 +5178,8 @@ package body Prj.Nmsc is
(In_Tree.String_Elements); (In_Tree.String_Elements);
else else
-- We already have source directories, -- We already have source directories, link the
-- link the previous last to the new one. -- previous last to the new one.
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Last_Source_Dir).Next := (Last_Source_Dir).Next :=
...@@ -5118,6 +5193,36 @@ package body Prj.Nmsc is ...@@ -5118,6 +5193,36 @@ package body Prj.Nmsc is
(In_Tree.String_Elements); (In_Tree.String_Elements);
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Last_Source_Dir) := Element; (Last_Source_Dir) := Element;
else
-- Remove source dir, if present
List := Data.Source_Dirs;
Prev := Nil_String;
-- Look for source dir in current list
while List /= Nil_String loop
Element := In_Tree.String_Elements.Table (List);
exit when Element.Value = Path_Id;
Prev := List;
List := Element.Next;
end loop;
if List /= Nil_String then
-- Source dir was found, remove it from the list
if Prev = Nil_String then
Data.Source_Dirs :=
In_Tree.String_Elements.Table (List).Next;
else
In_Tree.String_Elements.Table (Prev).Next :=
In_Tree.String_Elements.Table (List).Next;
end if;
end if;
end if;
end;
end if; end if;
end; end;
end if; end if;
...@@ -5219,8 +5324,7 @@ package body Prj.Nmsc is ...@@ -5219,8 +5324,7 @@ package body Prj.Nmsc is
Exec_Dir.Location); Exec_Dir.Location);
else else
-- We check that the specified object directory -- We check that the specified object directory does exist
-- does exist.
Locate_Directory Locate_Directory
(Project, (Project,
...@@ -5273,8 +5377,8 @@ package body Prj.Nmsc is ...@@ -5273,8 +5377,8 @@ package body Prj.Nmsc is
elsif Source_Dirs.Default then elsif Source_Dirs.Default then
-- No Source_Dirs specified: the single source directory -- No Source_Dirs specified: the single source directory is the one
-- is the one containing the project file -- containing the project file
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
...@@ -5297,10 +5401,10 @@ package body Prj.Nmsc is ...@@ -5297,10 +5401,10 @@ package body Prj.Nmsc is
elsif Source_Dirs.Values = Nil_String then elsif Source_Dirs.Values = Nil_String then
-- If Source_Dirs is an empty string list, this means -- If Source_Dirs is an empty string list, this means that this
-- that this project contains no source. For projects that -- project contains no source. For projects that don't extend other
-- don't extend other projects, this also means that there is no -- projects, this also means that there is no need for an object
-- need for an object directory, if not specified. -- directory, if not specified.
if Data.Extends = No_Project if Data.Extends = No_Project
and then Data.Object_Directory = Data.Directory and then Data.Object_Directory = Data.Directory
...@@ -5316,8 +5420,7 @@ package body Prj.Nmsc is ...@@ -5316,8 +5420,7 @@ package body Prj.Nmsc is
Element : String_Element; Element : String_Element;
begin begin
-- We will find the source directories for each -- Process the source directories for each element of the list
-- element of the list
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
Element := Element :=
...@@ -5329,6 +5432,28 @@ package body Prj.Nmsc is ...@@ -5329,6 +5432,28 @@ package body Prj.Nmsc is
end; end;
end if; end if;
if (not Removed_Source_Dirs.Default) and then
Removed_Source_Dirs.Values /= Nil_String then
declare
Source_Dir : String_List_Id;
Element : String_Element;
begin
-- Process the source directories for each element of the list
Source_Dir := Removed_Source_Dirs.Values;
while Source_Dir /= Nil_String loop
Element :=
In_Tree.String_Elements.Table (Source_Dir);
Find_Source_Dirs
(File_Name_Type (Element.Value),
Element.Location,
Removed => True);
Source_Dir := Element.Next;
end loop;
end;
end if;
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("Putting source directories in canonical cases"); Write_Line ("Putting source directories in canonical cases");
end if; end if;
...@@ -5368,8 +5493,8 @@ package body Prj.Nmsc is ...@@ -5368,8 +5493,8 @@ package body Prj.Nmsc is
begin begin
Data.Mains := Mains.Values; Data.Mains := Mains.Values;
-- If no Mains were specified, and if we are an extending -- If no Mains were specified, and if we are an extending project,
-- project, inherit the Mains from the project we are extending. -- inherit the Mains from the project we are extending.
if Mains.Default then if Mains.Default then
if Data.Extends /= No_Project then if Data.Extends /= No_Project then
...@@ -5602,8 +5727,8 @@ package body Prj.Nmsc is ...@@ -5602,8 +5727,8 @@ package body Prj.Nmsc is
if Name_Buffer (1 .. Name_Len) /= "." then if Name_Buffer (1 .. Name_Len) /= "." then
-- If Dot_Replacement is not a single dot, then there should -- If Dot_Replacement is not a single dot, then there should not
-- not be any dot in the name. -- be any dot in the name.
for Index in First .. Last loop for Index in First .. Last loop
if File (Index) = '.' then if File (Index) = '.' then
...@@ -5757,8 +5882,8 @@ package body Prj.Nmsc is ...@@ -5757,8 +5882,8 @@ package body Prj.Nmsc is
return True; return True;
end if; end if;
-- If dot replacement is a single dot, and first character of -- If dot replacement is a single dot, and first character of suffix is
-- suffix is also a dot -- also a dot
if Dot_Replacement_Is_A_Single_Dot if Dot_Replacement_Is_A_Single_Dot
and then Suffix (Suffix'First) = '.' and then Suffix (Suffix'First) = '.'
...@@ -5862,6 +5987,7 @@ package body Prj.Nmsc is ...@@ -5862,6 +5987,7 @@ package body Prj.Nmsc is
Location); Location);
end; end;
end if; end if;
if Is_Directory (Full_Path_Name) then if Is_Directory (Full_Path_Name) then
declare declare
Normed : constant String := Normed : constant String :=
...@@ -5903,8 +6029,6 @@ package body Prj.Nmsc is ...@@ -5903,8 +6029,6 @@ package body Prj.Nmsc is
-- Find the path names of the source files in the Source_Names table -- Find the path names of the source files in the Source_Names table
-- in the source directories and record those that are Ada sources. -- in the source directories and record those that are Ada sources.
-- function Source_Of (File_Name : Name_Id) return Source_Id;
procedure Get_Sources_From_File procedure Get_Sources_From_File
(Path : String; (Path : String;
Location : Source_Ptr); Location : Source_Ptr);
...@@ -5931,11 +6055,8 @@ package body Prj.Nmsc is ...@@ -5931,11 +6055,8 @@ package body Prj.Nmsc is
Name_Str : String (1 .. 1_024); Name_Str : String (1 .. 1_024);
Last : Natural := 0; Last : Natural := 0;
NL : Name_Location; NL : Name_Location;
Current_Source : String_List_Id := Nil_String; Current_Source : String_List_Id := Nil_String;
First_Error : Boolean := True; First_Error : Boolean := True;
Source_Recorded : Boolean := False; Source_Recorded : Boolean := False;
begin begin
...@@ -6020,7 +6141,6 @@ package body Prj.Nmsc is ...@@ -6020,7 +6141,6 @@ package body Prj.Nmsc is
-- in a source list file is not found. -- in a source list file is not found.
NL := Source_Names.Get_First; NL := Source_Names.Get_First;
while NL /= No_Name_Location loop while NL /= No_Name_Location loop
if not NL.Found then if not NL.Found then
Err_Vars.Error_Msg_File_1 := NL.Name; Err_Vars.Error_Msg_File_1 := NL.Name;
...@@ -6080,7 +6200,7 @@ package body Prj.Nmsc is ...@@ -6080,7 +6200,7 @@ package body Prj.Nmsc is
------------------------ ------------------------
procedure Search_Directories (For_All_Sources : Boolean) is procedure Search_Directories (For_All_Sources : Boolean) is
Source_Dir : String_List_Id := Data.Source_Dirs; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
Dir : Dir_Type; Dir : Dir_Type;
Name : String (1 .. 1_000); Name : String (1 .. 1_000);
...@@ -6088,14 +6208,11 @@ package body Prj.Nmsc is ...@@ -6088,14 +6208,11 @@ package body Prj.Nmsc is
File_Name : File_Name_Type; File_Name : File_Name_Type;
Display_File_Name : File_Name_Type; Display_File_Name : File_Name_Type;
Source : Source_Id; Source : Source_Id;
Source_To_Replace : Source_Id := No_Source; Source_To_Replace : Source_Id := No_Source;
Src_Data : Source_Data; Src_Data : Source_Data;
Add_Src : Boolean; Add_Src : Boolean;
Name_Loc : Name_Location; Name_Loc : Name_Location;
Check_Name : Boolean; Check_Name : Boolean;
Language : Language_Index; Language : Language_Index;
...@@ -6121,10 +6238,8 @@ package body Prj.Nmsc is ...@@ -6121,10 +6238,8 @@ package body Prj.Nmsc is
procedure Check_Naming_Schemes is procedure Check_Naming_Schemes is
Filename : constant String := Get_Name_String (File_Name); Filename : constant String := Get_Name_String (File_Name);
Last : Positive := Filename'Last; Last : Positive := Filename'Last;
Config : Language_Config; Config : Language_Config;
Lang : Name_List_Index;
Lang : Name_List_Index := Data.Languages;
Header_File : Boolean := False; Header_File : Boolean := False;
First_Language : Language_Index; First_Language : Language_Index;
...@@ -6132,11 +6247,11 @@ package body Prj.Nmsc is ...@@ -6132,11 +6247,11 @@ package body Prj.Nmsc is
begin begin
Unit := No_Name; Unit := No_Name;
Lang := Data.Languages;
while Lang /= No_Name_List loop while Lang /= No_Name_List loop
Language := Data.First_Language_Processing;
Language_Name := In_Tree.Name_Lists.Table (Lang).Name; Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
Language := Data.First_Language_Processing;
while Language /= No_Language_Index loop while Language /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Language).Name = if In_Tree.Languages_Data.Table (Language).Name =
Language_Name Language_Name
...@@ -6146,9 +6261,10 @@ package body Prj.Nmsc is ...@@ -6146,9 +6261,10 @@ package body Prj.Nmsc is
Config := In_Tree.Languages_Data.Table (Language).Config; Config := In_Tree.Languages_Data.Table (Language).Config;
if Config.Kind = File_Based then if Config.Kind = File_Based then
-- For file based languages, there is no Unit.
-- Just check if the file name has the implementation -- For file based languages, there is no Unit. Just
-- or, if it is specified, the template suffix of the -- check if the file name has the implementation or,
-- if it is specified, the template suffix of the
-- language. -- language.
Unit := No_Name; Unit := No_Name;
...@@ -6225,11 +6341,13 @@ package body Prj.Nmsc is ...@@ -6225,11 +6341,13 @@ package body Prj.Nmsc is
end if; end if;
elsif not Header_File then elsif not Header_File then
-- Unit based language -- Unit based language
OK := Config.Naming_Data.Dot_Replacement /= No_File; OK := Config.Naming_Data.Dot_Replacement /= No_File;
if OK then if OK then
-- Check casing -- Check casing
case Config.Naming_Data.Casing is case Config.Naming_Data.Casing is
...@@ -6270,7 +6388,6 @@ package body Prj.Nmsc is ...@@ -6270,7 +6388,6 @@ package body Prj.Nmsc is
Suffix : constant String := Suffix : constant String :=
Get_Name_String Get_Name_String
(Config.Naming_Data.Separate_Suffix); (Config.Naming_Data.Separate_Suffix);
begin begin
if Filename'Length > Suffix'Length if Filename'Length > Suffix'Length
and then and then
...@@ -6292,7 +6409,6 @@ package body Prj.Nmsc is ...@@ -6292,7 +6409,6 @@ package body Prj.Nmsc is
Suffix : constant String := Suffix : constant String :=
Get_Name_String Get_Name_String
(Config.Naming_Data.Body_Suffix); (Config.Naming_Data.Body_Suffix);
begin begin
if Filename'Length > Suffix'Length if Filename'Length > Suffix'Length
and then and then
...@@ -6314,7 +6430,6 @@ package body Prj.Nmsc is ...@@ -6314,7 +6430,6 @@ package body Prj.Nmsc is
Suffix : constant String := Suffix : constant String :=
Get_Name_String Get_Name_String
(Config.Naming_Data.Spec_Suffix); (Config.Naming_Data.Spec_Suffix);
begin begin
if Filename'Length > Suffix'Length if Filename'Length > Suffix'Length
and then and then
...@@ -6331,15 +6446,19 @@ package body Prj.Nmsc is ...@@ -6331,15 +6446,19 @@ package body Prj.Nmsc is
end if; end if;
if OK then if OK then
-- Replace dot replacements with dots -- Replace dot replacements with dots
Name_Len := 0; Name_Len := 0;
declare declare
J : Positive := Filename'First; J : Positive := Filename'First;
Dot_Replacement : constant String := Dot_Replacement : constant String :=
Get_Name_String Get_Name_String
(Config.Naming_Data.Dot_Replacement); (Config.Naming_Data.
Dot_Replacement);
Max : constant Positive := Max : constant Positive :=
Last - Dot_Replacement'Length + 1; Last - Dot_Replacement'Length + 1;
...@@ -6354,6 +6473,7 @@ package body Prj.Nmsc is ...@@ -6354,6 +6473,7 @@ package body Prj.Nmsc is
then then
Name_Buffer (Name_Len) := '.'; Name_Buffer (Name_Len) := '.';
J := J + Dot_Replacement'Length; J := J + Dot_Replacement'Length;
else else
if Filename (J) = '.' then if Filename (J) = '.' then
OK := False; OK := False;
...@@ -6371,8 +6491,10 @@ package body Prj.Nmsc is ...@@ -6371,8 +6491,10 @@ package body Prj.Nmsc is
end if; end if;
if OK then if OK then
-- The name buffer should contain the name of the -- The name buffer should contain the name of the
-- the unit, if it is one. -- the unit, if it is one.
-- Check that this is a valid unit name -- Check that this is a valid unit name
Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit); Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
...@@ -6418,13 +6540,16 @@ package body Prj.Nmsc is ...@@ -6418,13 +6540,16 @@ package body Prj.Nmsc is
end if; end if;
end Check_Naming_Schemes; end Check_Naming_Schemes;
-- Start of processing for Search_Directories
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("Looking for sources:"); Write_Line ("Looking for sources:");
end if; end if;
-- For each subdirectory -- Loop through subdirectories
Source_Dir := Data.Source_Dirs;
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
begin begin
Element := In_Tree.String_Elements.Table (Source_Dir); Element := In_Tree.String_Elements.Table (Source_Dir);
...@@ -6458,7 +6583,6 @@ package body Prj.Nmsc is ...@@ -6458,7 +6583,6 @@ package body Prj.Nmsc is
if Is_Regular_File if Is_Regular_File
(Source_Directory & Name (1 .. Last)) (Source_Directory & Name (1 .. Last))
then then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Checking "); Write_Str (" Checking ");
Write_Line (Name (1 .. Last)); Write_Line (Name (1 .. Last));
...@@ -6507,9 +6631,9 @@ package body Prj.Nmsc is ...@@ -6507,9 +6631,9 @@ package body Prj.Nmsc is
else else
if Name_Loc.Found then if Name_Loc.Found then
-- Check if it is allowed to have the
-- same file name in several source -- Check if it is OK to have the same file
-- directories. -- name in several source directories.
if if
not Data.Known_Order_Of_Source_Dirs not Data.Known_Order_Of_Source_Dirs
...@@ -6576,6 +6700,7 @@ package body Prj.Nmsc is ...@@ -6576,6 +6700,7 @@ package body Prj.Nmsc is
if Language = No_Language_Index then if Language = No_Language_Index then
if Name_Loc.Found then if Name_Loc.Found then
-- A file name in a list must be -- A file name in a list must be
-- a source of a language. -- a source of a language.
...@@ -6737,9 +6862,10 @@ package body Prj.Nmsc is ...@@ -6737,9 +6862,10 @@ package body Prj.Nmsc is
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("end Looking for sources."); Write_Line ("end Looking for sources.");
end if; end if;
end Search_Directories; end Search_Directories;
-- Start of processing for Look_For_Sources
begin begin
if Get_Mode = Ada_Only and then if Get_Mode = Ada_Only and then
Is_A_Language (In_Tree, Data, "ada") Is_A_Language (In_Tree, Data, "ada")
...@@ -6898,15 +7024,13 @@ package body Prj.Nmsc is ...@@ -6898,15 +7024,13 @@ package body Prj.Nmsc is
begin begin
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Element := In_Tree.String_Elements.Table (Current);
In_Tree.String_Elements.Table (Current);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Name := Name_Find; Name := Name_Find;
-- If the element has no location, then use the -- If the element has no location, then use the location
-- location of Locally_Removed to report -- of Locally_Removed to report possible errors.
-- possible errors.
if Element.Location = No_Location then if Element.Location = No_Location then
Location := Locally_Removed.Location; Location := Locally_Removed.Location;
...@@ -6990,6 +7114,7 @@ package body Prj.Nmsc is ...@@ -6990,6 +7114,7 @@ package body Prj.Nmsc is
end if; end if;
if Get_Mode = Ada_Only and then Data.Other_Sources_Present then if Get_Mode = Ada_Only and then Data.Other_Sources_Present then
-- Set Source_Present to False. It will be set back to True -- Set Source_Present to False. It will be set back to True
-- whenever a source is found. -- whenever a source is found.
...@@ -7001,8 +7126,8 @@ package body Prj.Nmsc is ...@@ -7001,8 +7126,8 @@ package body Prj.Nmsc is
if Is_Present (Lang, Data, In_Tree) then if Is_Present (Lang, Data, In_Tree) then
-- Reset the indication that there are sources of this -- Reset the indication that there are sources of this
-- language. It will be set back to True whenever we find a -- language. It will be set back to True whenever we find
-- source of the language. -- a source of the language.
Set (Lang, False, Data, In_Tree); Set (Lang, False, Data, In_Tree);
...@@ -7358,6 +7483,7 @@ package body Prj.Nmsc is ...@@ -7358,6 +7483,7 @@ package body Prj.Nmsc is
end; end;
elsif not Source_List_File.Default then elsif not Source_List_File.Default then
-- Source_List_File is the name of the file -- Source_List_File is the name of the file
-- that contains the source file names -- that contains the source file names
...@@ -7389,13 +7515,11 @@ package body Prj.Nmsc is ...@@ -7389,13 +7515,11 @@ package body Prj.Nmsc is
(For_All_Sources => (For_All_Sources =>
Sources.Default and then Source_List_File.Default); Sources.Default and then Source_List_File.Default);
-- If there are sources that are locally removed, mark them as -- If there are locally removed sources, mark them as such
-- such.
if not Locally_Removed.Default then if not Locally_Removed.Default then
declare declare
Current : String_List_Id := Locally_Removed.Values; Current : String_List_Id;
Element : String_Element; Element : String_Element;
Location : Source_Ptr; Location : Source_Ptr;
OK : Boolean; OK : Boolean;
...@@ -7404,6 +7528,7 @@ package body Prj.Nmsc is ...@@ -7404,6 +7528,7 @@ package body Prj.Nmsc is
Src_Data : Source_Data; Src_Data : Source_Data;
begin begin
Current := Locally_Removed.Values;
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Element :=
In_Tree.String_Elements.Table (Current); In_Tree.String_Elements.Table (Current);
...@@ -7411,9 +7536,8 @@ package body Prj.Nmsc is ...@@ -7411,9 +7536,8 @@ package body Prj.Nmsc is
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Name := Name_Find; Name := Name_Find;
-- If the element has no location, then use the -- If the element has no location, then use the location
-- location of Locally_Removed to report -- of Locally_Removed to report possible errors.
-- possible errors.
if Element.Location = No_Location then if Element.Location = No_Location then
Location := Locally_Removed.Location; Location := Locally_Removed.Location;
...@@ -7429,6 +7553,7 @@ package body Prj.Nmsc is ...@@ -7429,6 +7553,7 @@ package body Prj.Nmsc is
Src_Data := In_Tree.Sources.Table (Source); Src_Data := In_Tree.Sources.Table (Source);
if Src_Data.File = Name then if Src_Data.File = Name then
-- Check that this is from this project or a -- Check that this is from this project or a
-- project that the current project extends. -- project that the current project extends.
...@@ -7497,13 +7622,14 @@ package body Prj.Nmsc is ...@@ -7497,13 +7622,14 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Kind : Spec_Or_Body) Kind : Spec_Or_Body)
is is
Current : Array_Element_Id := List; Current : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
Unit : Unit_Info; Unit : Unit_Info;
begin begin
-- Traverse the list -- Traverse the list
Current := List;
while Current /= No_Array_Element loop while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current); Element := In_Tree.Array_Elements.Table (Current);
...@@ -7641,9 +7767,8 @@ package body Prj.Nmsc is ...@@ -7641,9 +7767,8 @@ package body Prj.Nmsc is
Write_Line (""" (ignored)."); Write_Line (""" (ignored).");
end if; end if;
-- The file is not included in the source of the project, -- The file is not included in the source of the project since
-- because it is hidden by the exception. -- it is hidden by the exception. So, nothing else to do.
-- So, there is nothing else to do.
return; return;
end if; end if;
...@@ -7694,6 +7819,7 @@ package body Prj.Nmsc is ...@@ -7694,6 +7819,7 @@ package body Prj.Nmsc is
declare declare
The_Unit : Unit_Index := The_Unit : Unit_Index :=
Units_Htable.Get (In_Tree.Units_HT, Unit_Name); Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
The_Unit_Data : Unit_Data; The_Unit_Data : Unit_Data;
begin begin
...@@ -7870,7 +7996,6 @@ package body Prj.Nmsc is ...@@ -7870,7 +7996,6 @@ package body Prj.Nmsc is
Last : Natural := 0; Last : Natural := 0;
NL : Name_Location; NL : Name_Location;
First_Error : Boolean := True; First_Error : Boolean := True;
Suffix : constant String := Suffix : constant String :=
Body_Suffix_Of (Language, Data, In_Tree); Body_Suffix_Of (Language, Data, In_Tree);
...@@ -8049,7 +8174,8 @@ package body Prj.Nmsc is ...@@ -8049,7 +8174,8 @@ package body Prj.Nmsc is
end if; end if;
In_Tree.Sources.Table (Id).Replaced_By := Replaced_By; In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
-- Remove the source from the global list
-- Remove the source from the global source list
Source := In_Tree.First_Source; Source := In_Tree.First_Source;
...@@ -8132,7 +8258,6 @@ package body Prj.Nmsc is ...@@ -8132,7 +8258,6 @@ package body Prj.Nmsc is
In_Tree.Sources.Table (Source).Next_In_Lang := In_Tree.Sources.Table (Source).Next_In_Lang :=
Src_Data.Next_In_Lang; Src_Data.Next_In_Lang;
end if; end if;
end Remove_Source; end Remove_Source;
----------------------- -----------------------
......
gcc/ada/prj.ads
...@@ -1029,6 +1029,10 @@ package Prj is ...@@ -1029,6 +1029,10 @@ package Prj is
-- The following record describes a project file representation -- The following record describes a project file representation
-- Note that it is not specified if the path names of directories (source,
-- object, library or exec directories) end with or without a directory
-- separator.
type Project_Data is record type Project_Data is record
Externally_Built : Boolean := False; Externally_Built : Boolean := False;
-- True if the project is externally built. In such case, the Project -- True if the project is externally built. In such case, the Project
......
gcc/ada/snames.adb
...@@ -753,6 +753,7 @@ package body Snames is ...@@ -753,6 +753,7 @@ package body Snames is
"prefix#" & "prefix#" &
"project#" & "project#" &
"roots#" & "roots#" &
"removed_source_dirs#" &
"required_switches#" & "required_switches#" &
"run_path_option#" & "run_path_option#" &
"runtime_project#" & "runtime_project#" &
......
gcc/ada/snames.ads
...@@ -1069,45 +1069,46 @@ package Snames is ...@@ -1069,45 +1069,46 @@ package Snames is
Name_Prefix : constant Name_Id := N + 692; Name_Prefix : constant Name_Id := N + 692;
Name_Project : constant Name_Id := N + 693; Name_Project : constant Name_Id := N + 693;
Name_Roots : constant Name_Id := N + 694; Name_Roots : constant Name_Id := N + 694;
Name_Required_Switches : constant Name_Id := N + 695; Name_Removed_Source_Dirs : constant Name_Id := N + 695;
Name_Run_Path_Option : constant Name_Id := N + 696; Name_Required_Switches : constant Name_Id := N + 696;
Name_Runtime_Project : constant Name_Id := N + 697; Name_Run_Path_Option : constant Name_Id := N + 697;
Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 698; Name_Runtime_Project : constant Name_Id := N + 698;
Name_Shared_Library_Prefix : constant Name_Id := N + 699; Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 699;
Name_Shared_Library_Suffix : constant Name_Id := N + 700; Name_Shared_Library_Prefix : constant Name_Id := N + 700;
Name_Separate_Suffix : constant Name_Id := N + 701; Name_Shared_Library_Suffix : constant Name_Id := N + 701;
Name_Source_Dirs : constant Name_Id := N + 702; Name_Separate_Suffix : constant Name_Id := N + 702;
Name_Source_Files : constant Name_Id := N + 703; Name_Source_Dirs : constant Name_Id := N + 703;
Name_Source_List_File : constant Name_Id := N + 704; Name_Source_Files : constant Name_Id := N + 704;
Name_Spec : constant Name_Id := N + 705; Name_Source_List_File : constant Name_Id := N + 705;
Name_Spec_Suffix : constant Name_Id := N + 706; Name_Spec : constant Name_Id := N + 706;
Name_Specification : constant Name_Id := N + 707; Name_Spec_Suffix : constant Name_Id := N + 707;
Name_Specification_Exceptions : constant Name_Id := N + 708; Name_Specification : constant Name_Id := N + 708;
Name_Specification_Suffix : constant Name_Id := N + 709; Name_Specification_Exceptions : constant Name_Id := N + 709;
Name_Stack : constant Name_Id := N + 710; Name_Specification_Suffix : constant Name_Id := N + 710;
Name_Switches : constant Name_Id := N + 711; Name_Stack : constant Name_Id := N + 711;
Name_Symbolic_Link_Supported : constant Name_Id := N + 712; Name_Switches : constant Name_Id := N + 712;
Name_Toolchain_Description : constant Name_Id := N + 713; Name_Symbolic_Link_Supported : constant Name_Id := N + 713;
Name_Toolchain_Version : constant Name_Id := N + 714; Name_Toolchain_Description : constant Name_Id := N + 714;
Name_Toolchain_Version : constant Name_Id := N + 715;
-- Other miscellaneous names used in front end -- Other miscellaneous names used in front end
Name_Unaligned_Valid : constant Name_Id := N + 715; Name_Unaligned_Valid : constant Name_Id := N + 716;
-- Ada 2005 reserved words -- Ada 2005 reserved words
First_2005_Reserved_Word : constant Name_Id := N + 716; First_2005_Reserved_Word : constant Name_Id := N + 717;
Name_Interface : constant Name_Id := N + 716; Name_Interface : constant Name_Id := N + 717;
Name_Overriding : constant Name_Id := N + 717; Name_Overriding : constant Name_Id := N + 718;
Name_Synchronized : constant Name_Id := N + 718; Name_Synchronized : constant Name_Id := N + 719;
Last_2005_Reserved_Word : constant Name_Id := N + 718; Last_2005_Reserved_Word : constant Name_Id := N + 719;
subtype Ada_2005_Reserved_Words is subtype Ada_2005_Reserved_Words is
Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word; Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
-- Mark last defined name for consistency check in Snames body -- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 718; Last_Predefined_Name : constant Name_Id := N + 719;
--------------------------------------- ---------------------------------------
-- Subtypes Defining Name Categories -- -- Subtypes Defining Name Categories --
......
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