Skip to content

R
riscv-gcc-1
Commit 751089b2 by Vincent Celier Committed by Arnaud Charlet
Options

gnatsym.adb: Update Copyright notice 

2007-04-20  Vincent Celier  <celier@adacore.com>

	* gnatsym.adb: Update Copyright notice
	(Parse_Cmd_Line): Accept new switch -D
	(Gnatsym): In Direct policy (switch -D) copy reference file to symbol
	 file.

	* prj.ads (Policy): New policy Direct
	(Yes_No_Unknown): New enumeration type
	(Project_Data): New component Libgnarl_Needed

	* prj-nmsc.adb (Check_For_Source): When recording a source file make
	use the untouched pathname casing.
	(Get_Directories): Ensure that the Display_Exec_Directory is using the
	proper casing on non case-sensitive platforms like Windows.
	(Get_Unit): Accept file names x__... and x~... (where x = a, g, i or s)
	on all platforms, as it is not possible to know which one is allowed
	before processing the project files.
	(Check_Stand_Alone_Library): Check that Library_Reference_Symbol_File is
	specified when symbol policy is Direct. Check that when there is a
	symbol file defined (either by default or with attribute
	Library_Symbol_File) it is not the same as the reference symbol file.
	(Check_Stand_Alone_Library): Recognize new symbol policy Direct.
	(Look_For_Sources): Allow Locally_Removed_Files to be declare in non
	extending projects.
	(Record_Ada_Source): Record a source that has been locally removed in an
	imported project.

	* symbols.ads (Policy): New policy Direct

	* symbols-vms.adb (Initialize): Take new policy Direct in case
	statement

From-SVN: r125420
parent 8cc39ff2
Showing with 623 additions and 467 deletions
gcc/ada/gnatsym.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2003-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -42,6 +42,9 @@ ...@@ -42,6 +42,9 @@
-- - (optional) the name of the reference symbol file -- - (optional) the name of the reference symbol file
-- - the names of one or more object files where the symbols are found -- - the names of one or more object files where the symbols are found
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
...@@ -125,7 +128,7 @@ procedure Gnatsym is ...@@ -125,7 +128,7 @@ procedure Gnatsym is
procedure Parse_Cmd_Line is procedure Parse_Cmd_Line is
begin begin
loop loop
case GNAT.Command_Line.Getopt ("c C q r: R s: v V:") is case GNAT.Command_Line.Getopt ("c C D q r: R s: v V:") is
when ASCII.NUL => when ASCII.NUL =>
exit; exit;
...@@ -135,6 +138,9 @@ procedure Gnatsym is ...@@ -135,6 +138,9 @@ procedure Gnatsym is
when 'C' => when 'C' =>
Symbol_Policy := Controlled; Symbol_Policy := Controlled;
when 'D' =>
Symbol_Policy := Direct;
when 'q' => when 'q' =>
Quiet := True; Quiet := True;
...@@ -222,6 +228,56 @@ begin ...@@ -222,6 +228,56 @@ begin
Usage; Usage;
OS_Exit (1); OS_Exit (1);
-- When symbol policy is direct, simply copy the reference symbol file to
-- the symbol file.
elsif Symbol_Policy = Direct then
declare
File_In : Ada.Text_IO.File_Type;
File_Out : Ada.Text_IO.File_Type;
Line : String (1 .. 1_000);
Last : Natural;
begin
begin
Open (File_In, In_File, Reference_Symbol_File_Name.all);
exception
when X : others =>
if not Quiet then
Put_Line
("could not open """ &
Reference_Symbol_File_Name.all
& """");
Put_Line (Exception_Message (X));
end if;
OS_Exit (1);
end;
begin
Create (File_Out, Out_File, Symbol_File_Name.all);
exception
when X : others =>
if not Quiet then
Put_Line
("could not create """ & Symbol_File_Name.all & """");
Put_Line (Exception_Message (X));
end if;
OS_Exit (1);
end;
while not End_Of_File (File_In) loop
Get_Line (File_In, Line, Last);
Put_Line (File_Out, Line (1 .. Last));
end loop;
Close (File_In);
Close (File_Out);
end;
else else
if Verbose then if Verbose then
Write_Str ("Initializing symbol file """); Write_Str ("Initializing symbol file """);
......
gcc/ada/prj-nmsc.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -28,7 +28,6 @@ with Err_Vars; use Err_Vars; ...@@ -28,7 +28,6 @@ with Err_Vars; use Err_Vars;
with Fmap; use Fmap; with Fmap; use Fmap;
with Hostparm; with Hostparm;
with MLib.Tgt; use MLib.Tgt; with MLib.Tgt; use MLib.Tgt;
with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
...@@ -66,7 +65,7 @@ package body Prj.Nmsc is ...@@ -66,7 +65,7 @@ package body Prj.Nmsc is
-- File suffix for object files -- File suffix for object files
type Name_Location is record type Name_Location is record
Name : Name_Id; Name : File_Name_Type;
Location : Source_Ptr; Location : Source_Ptr;
Found : Boolean := False; Found : Boolean := False;
end record; end record;
...@@ -75,13 +74,15 @@ package body Prj.Nmsc is ...@@ -75,13 +74,15 @@ package body Prj.Nmsc is
-- Source_Names, used by procedure Get_Path_Names_And_Record_Sources. -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
No_Name_Location : constant Name_Location := No_Name_Location : constant Name_Location :=
(Name => No_Name, Location => No_Location, Found => False); (Name => No_File,
Location => No_Location,
Found => False);
package Source_Names is new GNAT.HTable.Simple_HTable package Source_Names is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Name_Location, Element => Name_Location,
No_Element => No_Name_Location, No_Element => No_Name_Location,
Key => Name_Id, Key => File_Name_Type,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Hash table to store file names found in string list attribute -- Hash table to store file names found in string list attribute
...@@ -92,7 +93,7 @@ package body Prj.Nmsc is ...@@ -92,7 +93,7 @@ package body Prj.Nmsc is
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Boolean, Element => Boolean,
No_Element => False, No_Element => False,
Key => Name_Id, Key => File_Name_Type,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Hash table to store recursive source directories, to avoid looking -- Hash table to store recursive source directories, to avoid looking
...@@ -122,7 +123,7 @@ package body Prj.Nmsc is ...@@ -122,7 +123,7 @@ package body Prj.Nmsc is
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Ada_Naming_Exception_Id, Element => Ada_Naming_Exception_Id,
No_Element => No_Ada_Naming_Exception, No_Element => No_Ada_Naming_Exception,
Key => Name_Id, Key => File_Name_Type,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- A hash table to store naming exceptions for Ada. For each file name -- A hash table to store naming exceptions for Ada. For each file name
...@@ -151,7 +152,9 @@ package body Prj.Nmsc is ...@@ -151,7 +152,9 @@ package body Prj.Nmsc is
-- Return the ALI file name corresponding to a source -- Return the ALI file name corresponding to a source
procedure Check_Ada_Name (Name : String; Unit : out Name_Id); procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
-- Check that a name is a valid Ada unit name -- Check that Name is a valid Ada unit name. If not, an error message is
-- output, and Unit is set to No_Name, otherwise Unit is set to the
-- unit name referenced by Name.
procedure Check_Naming_Scheme procedure Check_Naming_Scheme
(Data : in out Project_Data; (Data : in out Project_Data;
...@@ -166,8 +169,8 @@ package body Prj.Nmsc is ...@@ -166,8 +169,8 @@ package body Prj.Nmsc is
-- Check that the package Naming is correct -- Check that the package Naming is correct
procedure Check_For_Source procedure Check_For_Source
(File_Name : Name_Id; (File_Name : File_Name_Type;
Path_Name : Name_Id; Path_Name : File_Name_Type;
Project : Project_Id; Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
...@@ -278,7 +281,7 @@ package body Prj.Nmsc is ...@@ -278,7 +281,7 @@ package body Prj.Nmsc is
-- Source_Names. -- Source_Names.
procedure Get_Unit procedure Get_Unit
(Canonical_File_Name : Name_Id; (Canonical_File_Name : File_Name_Type;
Naming : Naming_Data; Naming : Naming_Data;
Exception_Id : out Ada_Naming_Exception_Id; Exception_Id : out Ada_Naming_Exception_Id;
Unit_Name : out Name_Id; Unit_Name : out Name_Id;
...@@ -299,10 +302,10 @@ package body Prj.Nmsc is ...@@ -299,10 +302,10 @@ package body Prj.Nmsc is
procedure Locate_Directory procedure Locate_Directory
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Name : Name_Id; Name : File_Name_Type;
Parent : Name_Id; Parent : Path_Name_Type;
Dir : out Name_Id; Dir : out Path_Name_Type;
Display : out Name_Id; Display : out Path_Name_Type;
Create : String := ""; Create : String := "";
Location : Source_Ptr := No_Location); Location : Source_Ptr := No_Location);
-- Locate a directory. Name is the directory name. Parent is the root -- Locate a directory. Name is the directory name. Parent is the root
...@@ -323,10 +326,10 @@ package body Prj.Nmsc is ...@@ -323,10 +326,10 @@ package body Prj.Nmsc is
-- if Follow_Links is True. -- if Follow_Links is True.
function Path_Name_Of function Path_Name_Of
(File_Name : Name_Id; (File_Name : File_Name_Type;
Directory : Name_Id) return String; Directory : Path_Name_Type) return String;
-- Returns the path name of a (non project) file. -- Returns the path name of a (non project) file. Returns an empty string
-- Returns an empty string if file cannot be found. -- if file cannot be found.
procedure Prepare_Ada_Naming_Exceptions procedure Prepare_Ada_Naming_Exceptions
(List : Array_Element_Id; (List : Array_Element_Id;
...@@ -343,8 +346,8 @@ package body Prj.Nmsc is ...@@ -343,8 +346,8 @@ package body Prj.Nmsc is
-- indirectly. -- indirectly.
procedure Record_Ada_Source procedure Record_Ada_Source
(File_Name : Name_Id; (File_Name : File_Name_Type;
Path_Name : Name_Id; Path_Name : File_Name_Type;
Project : Project_Id; Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
...@@ -378,7 +381,7 @@ package body Prj.Nmsc is ...@@ -378,7 +381,7 @@ package body Prj.Nmsc is
function Suffix_For function Suffix_For
(Language : Language_Index; (Language : Language_Index;
Naming : Naming_Data; Naming : Naming_Data;
In_Tree : Project_Tree_Ref) return Name_Id; In_Tree : Project_Tree_Ref) return File_Name_Type;
-- Get the suffix for the source of a language from a package naming. -- Get the suffix for the source of a language from a package naming.
-- If not specified, return the default for the language. -- If not specified, return the default for the language.
...@@ -697,17 +700,15 @@ package body Prj.Nmsc is ...@@ -697,17 +700,15 @@ package body Prj.Nmsc is
if Is_Illegal_Suffix if Is_Illegal_Suffix
(Spec_Suffix, Dot_Replacement = ".") (Spec_Suffix, Dot_Replacement = ".")
then then
Err_Vars.Error_Msg_Name_1 := Naming.Ada_Spec_Suffix; Err_Vars.Error_Msg_File_1 := Naming.Ada_Spec_Suffix;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is illegal for Spec_Suffix", "{ is illegal for Spec_Suffix",
Naming.Spec_Suffix_Loc); Naming.Spec_Suffix_Loc);
end if; end if;
if Is_Illegal_Suffix if Is_Illegal_Suffix (Body_Suffix, Dot_Replacement = ".") then
(Body_Suffix, Dot_Replacement = ".") Err_Vars.Error_Msg_File_1 := Naming.Ada_Body_Suffix;
then
Err_Vars.Error_Msg_Name_1 := Naming.Ada_Body_Suffix;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is illegal for Body_Suffix", "{ is illegal for Body_Suffix",
...@@ -718,7 +719,7 @@ package body Prj.Nmsc is ...@@ -718,7 +719,7 @@ package body Prj.Nmsc is
if Is_Illegal_Suffix if Is_Illegal_Suffix
(Separate_Suffix, Dot_Replacement = ".") (Separate_Suffix, Dot_Replacement = ".")
then then
Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix; Err_Vars.Error_Msg_File_1 := Naming.Separate_Suffix;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is illegal for Separate_Suffix", "{ is illegal for Separate_Suffix",
...@@ -771,8 +772,8 @@ package body Prj.Nmsc is ...@@ -771,8 +772,8 @@ package body Prj.Nmsc is
---------------------- ----------------------
procedure Check_For_Source procedure Check_For_Source
(File_Name : Name_Id; (File_Name : File_Name_Type;
Path_Name : Name_Id; Path_Name : File_Name_Type;
Project : Project_Id; Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
...@@ -790,8 +791,10 @@ package body Prj.Nmsc is ...@@ -790,8 +791,10 @@ package body Prj.Nmsc is
-- A file is a source of a language if Naming_Exception is True (case -- A file is a source of a language if Naming_Exception is True (case
-- of naming exceptions) or if its file name ends with the suffix. -- of naming exceptions) or if its file name ends with the suffix.
if Naming_Exception or else if Naming_Exception
(Name'Length > Suffix'Length and then or else
(Name'Length > Suffix'Length
and then
Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix) Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix)
then then
if Real_Location = No_Location then if Real_Location = No_Location then
...@@ -799,24 +802,26 @@ package body Prj.Nmsc is ...@@ -799,24 +802,26 @@ package body Prj.Nmsc is
end if; end if;
declare declare
Path : String := Get_Name_String (Path_Name); Path : constant String := Get_Name_String (Path_Name);
C_Path : String := Path;
Path_Id : Name_Id; Path_Id : Path_Name_Type;
C_Path_Id : Path_Name_Type;
-- The path name id (in canonical case) -- The path name id (in canonical case)
File_Id : Name_Id; File_Id : File_Name_Type;
-- The file name id (in canonical case) -- The file name id (in canonical case)
Obj_Id : Name_Id; Obj_Id : File_Name_Type;
-- The object file name -- The object file name
Obj_Path_Id : Name_Id; Obj_Path_Id : Path_Name_Type;
-- The object path name -- The object path name
Dep_Id : Name_Id; Dep_Id : File_Name_Type;
-- The dependency file name -- The dependency file name
Dep_Path_Id : Name_Id; Dep_Path_Id : Path_Name_Type;
-- The dependency path name -- The dependency path name
Dot_Pos : Natural := 0; Dot_Pos : Natural := 0;
...@@ -826,7 +831,7 @@ package body Prj.Nmsc is ...@@ -826,7 +831,7 @@ package body Prj.Nmsc is
Source_Id : Other_Source_Id := Data.First_Other_Source; Source_Id : Other_Source_Id := Data.First_Other_Source;
begin begin
Canonical_Case_File_Name (Path); Canonical_Case_File_Name (C_Path);
-- Get the file name id -- Get the file name id
...@@ -840,6 +845,10 @@ package body Prj.Nmsc is ...@@ -840,6 +845,10 @@ package body Prj.Nmsc is
Name_Buffer (1 .. Name_Len) := Path; Name_Buffer (1 .. Name_Len) := Path;
Path_Id := Name_Find; Path_Id := Name_Find;
Name_Len := C_Path'Length;
Name_Buffer (1 .. Name_Len) := C_Path;
C_Path_Id := Name_Find;
-- Find the position of the last dot -- Find the position of the last dot
for J in reverse Name'Range loop for J in reverse Name'Range loop
...@@ -867,10 +876,10 @@ package body Prj.Nmsc is ...@@ -867,10 +876,10 @@ package body Prj.Nmsc is
-- Compute the object path name -- Compute the object path name
Get_Name_String (Data.Object_Directory); Get_Name_String (Data.Display_Object_Dir);
if Name_Buffer (Name_Len) /= Directory_Separator and then if Name_Buffer (Name_Len) /= Directory_Separator
Name_Buffer (Name_Len) /= '/' and then Name_Buffer (Name_Len) /= '/'
then then
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Directory_Separator; Name_Buffer (Name_Len) := Directory_Separator;
...@@ -890,10 +899,10 @@ package body Prj.Nmsc is ...@@ -890,10 +899,10 @@ package body Prj.Nmsc is
-- Compute the dependency path name -- Compute the dependency path name
Get_Name_String (Data.Object_Directory); Get_Name_String (Data.Display_Object_Dir);
if Name_Buffer (Name_Len) /= Directory_Separator and then if Name_Buffer (Name_Len) /= Directory_Separator
Name_Buffer (Name_Len) /= '/' and then Name_Buffer (Name_Len) /= '/'
then then
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Directory_Separator; Name_Buffer (Name_Len) := Directory_Separator;
...@@ -917,7 +926,7 @@ package body Prj.Nmsc is ...@@ -917,7 +926,7 @@ package body Prj.Nmsc is
-- file name. -- file name.
if Source.Language /= Language then if Source.Language /= Language then
Error_Msg_Name_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ cannot be a source of several languages", "{ cannot be a source of several languages",
...@@ -927,7 +936,7 @@ package body Prj.Nmsc is ...@@ -927,7 +936,7 @@ package body Prj.Nmsc is
-- No problem if a file has already been specified as -- No problem if a file has already been specified as
-- a naming exception of this language. -- a naming exception of this language.
elsif Source.Path_Name = Path_Id then elsif Source.Path_Name = C_Path_Id then
-- Reset the naming exception flag, if this is not a -- Reset the naming exception flag, if this is not a
-- naming exception. -- naming exception.
...@@ -951,7 +960,7 @@ package body Prj.Nmsc is ...@@ -951,7 +960,7 @@ package body Prj.Nmsc is
-- is not known. -- is not known.
else else
Error_Msg_Name_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is found in several source directories", "{ is found in several source directories",
...@@ -963,9 +972,9 @@ package body Prj.Nmsc is ...@@ -963,9 +972,9 @@ package body Prj.Nmsc is
-- object file name. -- object file name.
elsif Source.Object_Name = Obj_Id then elsif Source.Object_Name = Obj_Id then
Error_Msg_Name_1 := File_Id; Error_Msg_File_1 := File_Id;
Error_Msg_Name_2 := Source.File_Name; Error_Msg_File_2 := Source.File_Name;
Error_Msg_Name_3 := Obj_Id; Error_Msg_File_3 := Obj_Id;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ and { have the same object file {", "{ and { have the same object file {",
...@@ -1004,11 +1013,9 @@ package body Prj.Nmsc is ...@@ -1004,11 +1013,9 @@ package body Prj.Nmsc is
-- And add it to the Other_Sources table -- And add it to the Other_Sources table
Other_Source_Table.Increment_Last Other_Source_Table.Increment_Last (In_Tree.Other_Sources);
(In_Tree.Other_Sources);
In_Tree.Other_Sources.Table In_Tree.Other_Sources.Table
(Other_Source_Table.Last (In_Tree.Other_Sources)) := (Other_Source_Table.Last (In_Tree.Other_Sources)) := Source;
Source;
-- There are sources of languages other than Ada in this project -- There are sources of languages other than Ada in this project
...@@ -1120,10 +1127,11 @@ package body Prj.Nmsc is ...@@ -1120,10 +1127,11 @@ package body Prj.Nmsc is
Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name); Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
if Unit_Name = No_Name then if Unit_Name = No_Name then
Err_Vars.Error_Msg_Name_1 := Element.Index; Error_Msg_Name_1 := Element.Index;
-- Errutil.Set_Msg_Txt ignores '$' (unit name insertion)
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is not a valid unit name.", "%% is not a valid unit name.",
Element.Value.Location); Element.Value.Location);
else else
...@@ -1277,7 +1285,7 @@ package body Prj.Nmsc is ...@@ -1277,7 +1285,7 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_Name_1 := Name_Find; Err_Vars.Error_Msg_Name_1 := Name_Find;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is not a correct Casing", "%% is not a correct Casing",
Casing_String.Location); Casing_String.Location);
end if; end if;
end; end;
...@@ -1479,11 +1487,16 @@ package body Prj.Nmsc is ...@@ -1479,11 +1487,16 @@ package body Prj.Nmsc is
-- Find path name, check that it is a directory -- Find path name, check that it is a directory
Locate_Directory Locate_Directory
(Project, In_Tree, Lib_Dir.Value, Data.Display_Directory, (Project,
Data.Library_Dir, Data.Display_Library_Dir, Create => "library", In_Tree,
File_Name_Type (Lib_Dir.Value),
Data.Display_Directory,
Data.Library_Dir,
Data.Display_Library_Dir,
Create => "library",
Location => Lib_Dir.Location); Location => Lib_Dir.Location);
if Data.Library_Dir = No_Name then if Data.Library_Dir = No_Path then
-- Get the absolute name of the library directory that -- Get the absolute name of the library directory that
-- does not exist, to report an error. -- does not exist, to report an error.
...@@ -1493,7 +1506,8 @@ package body Prj.Nmsc is ...@@ -1493,7 +1506,8 @@ package body Prj.Nmsc is
begin begin
if Is_Absolute_Path (Dir_Name) then if Is_Absolute_Path (Dir_Name) then
Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value; Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Lib_Dir.Value);
else else
Get_Name_String (Data.Display_Directory); Get_Name_String (Data.Display_Directory);
...@@ -1503,11 +1517,10 @@ package body Prj.Nmsc is ...@@ -1503,11 +1517,10 @@ package body Prj.Nmsc is
Name_Buffer (Name_Len) := Directory_Separator; Name_Buffer (Name_Len) := Directory_Separator;
end if; end if;
Name_Buffer Name_Buffer (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
(Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
Dir_Name; Dir_Name;
Name_Len := Name_Len + Dir_Name'Length; Name_Len := Name_Len + Dir_Name'Length;
Err_Vars.Error_Msg_Name_1 := Name_Find; Err_Vars.Error_Msg_File_1 := Name_Find;
end if; end if;
-- Report the error -- Report the error
...@@ -1526,8 +1539,8 @@ package body Prj.Nmsc is ...@@ -1526,8 +1539,8 @@ package body Prj.Nmsc is
"library directory cannot be the same " & "library directory cannot be the same " &
"as object directory", "as object directory",
Lib_Dir.Location); Lib_Dir.Location);
Data.Library_Dir := No_Name; Data.Library_Dir := No_Path;
Data.Display_Library_Dir := No_Name; Data.Display_Library_Dir := No_Path;
else else
declare declare
...@@ -1544,8 +1557,11 @@ package body Prj.Nmsc is ...@@ -1544,8 +1557,11 @@ package body Prj.Nmsc is
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if Data.Library_Dir = Dir_Elem.Value then if Data.Library_Dir =
Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value; Path_Name_Type (Dir_Elem.Value)
then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"library directory cannot be the same " & "library directory cannot be the same " &
...@@ -1570,15 +1586,18 @@ package body Prj.Nmsc is ...@@ -1570,15 +1586,18 @@ package body Prj.Nmsc is
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if Data.Library_Dir = Dir_Elem.Value then if Data.Library_Dir =
Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value; Path_Name_Type (Dir_Elem.Value)
Err_Vars.Error_Msg_Name_2 := then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
Err_Vars.Error_Msg_Name_1 :=
In_Tree.Projects.Table (Pid).Name; In_Tree.Projects.Table (Pid).Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"library directory cannot be the same " & "library directory cannot be the same " &
"as source directory { of project {", "as source directory { of project %%",
Lib_Dir.Location); Lib_Dir.Location);
OK := False; OK := False;
exit Project_Loop; exit Project_Loop;
...@@ -1589,8 +1608,8 @@ package body Prj.Nmsc is ...@@ -1589,8 +1608,8 @@ package body Prj.Nmsc is
end if; end if;
if not OK then if not OK then
Data.Library_Dir := No_Name; Data.Library_Dir := No_Path;
Data.Display_Library_Dir := No_Name; Data.Display_Library_Dir := No_Path;
elsif Current_Verbosity = High then elsif Current_Verbosity = High then
...@@ -1608,7 +1627,7 @@ package body Prj.Nmsc is ...@@ -1608,7 +1627,7 @@ package body Prj.Nmsc is
if Lib_Name.Value = Empty_String then if Lib_Name.Value = Empty_String then
if Current_Verbosity = High if Current_Verbosity = High
and then Data.Library_Name = No_Name and then Data.Library_Name = No_File
then then
Write_Line ("No library name"); Write_Line ("No library name");
end if; end if;
...@@ -1616,10 +1635,10 @@ package body Prj.Nmsc is ...@@ -1616,10 +1635,10 @@ package body Prj.Nmsc is
else else
-- There is no restriction on the syntax of library names -- There is no restriction on the syntax of library names
Data.Library_Name := Lib_Name.Value; Data.Library_Name := File_Name_Type (Lib_Name.Value);
end if; end if;
if Data.Library_Name /= No_Name if Data.Library_Name /= No_File
and then Current_Verbosity = High and then Current_Verbosity = High
then then
Write_Str ("Library name = """); Write_Str ("Library name = """);
...@@ -1628,9 +1647,8 @@ package body Prj.Nmsc is ...@@ -1628,9 +1647,8 @@ package body Prj.Nmsc is
end if; end if;
Data.Library := Data.Library :=
Data.Library_Dir /= No_Name Data.Library_Dir /= No_Path
and then and then Data.Library_Name /= No_File;
Data.Library_Name /= No_Name;
if Data.Library then if Data.Library then
if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then
...@@ -1652,11 +1670,16 @@ package body Prj.Nmsc is ...@@ -1652,11 +1670,16 @@ package body Prj.Nmsc is
-- Find path name, check that it is a directory -- Find path name, check that it is a directory
Locate_Directory Locate_Directory
(Project, In_Tree, Lib_ALI_Dir.Value, Data.Display_Directory, (Project,
Data.Library_ALI_Dir, Data.Display_Library_ALI_Dir, In_Tree,
Create => "library ALI", Location => Lib_ALI_Dir.Location); File_Name_Type (Lib_ALI_Dir.Value),
Data.Display_Directory,
Data.Library_ALI_Dir,
Data.Display_Library_ALI_Dir,
Create => "library ALI",
Location => Lib_ALI_Dir.Location);
if Data.Library_ALI_Dir = No_Name then if Data.Library_ALI_Dir = No_Path then
-- Get the absolute name of the library ALI directory that -- Get the absolute name of the library ALI directory that
-- does not exist, to report an error. -- does not exist, to report an error.
...@@ -1667,7 +1690,8 @@ package body Prj.Nmsc is ...@@ -1667,7 +1690,8 @@ package body Prj.Nmsc is
begin begin
if Is_Absolute_Path (Dir_Name) then if Is_Absolute_Path (Dir_Name) then
Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value; Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Lib_Dir.Value);
else else
Get_Name_String (Data.Display_Directory); Get_Name_String (Data.Display_Directory);
...@@ -1681,7 +1705,7 @@ package body Prj.Nmsc is ...@@ -1681,7 +1705,7 @@ package body Prj.Nmsc is
(Name_Len + 1 .. Name_Len + Dir_Name'Length) := (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
Dir_Name; Dir_Name;
Name_Len := Name_Len + Dir_Name'Length; Name_Len := Name_Len + Dir_Name'Length;
Err_Vars.Error_Msg_Name_1 := Name_Find; Err_Vars.Error_Msg_File_1 := Name_Find;
end if; end if;
-- Report the error -- Report the error
...@@ -1704,8 +1728,8 @@ package body Prj.Nmsc is ...@@ -1704,8 +1728,8 @@ package body Prj.Nmsc is
"library 'A'L'I directory cannot be the same " & "library 'A'L'I directory cannot be the same " &
"as object directory", "as object directory",
Lib_ALI_Dir.Location); Lib_ALI_Dir.Location);
Data.Library_ALI_Dir := No_Name; Data.Library_ALI_Dir := No_Path;
Data.Display_Library_ALI_Dir := No_Name; Data.Display_Library_ALI_Dir := No_Path;
else else
declare declare
...@@ -1722,8 +1746,11 @@ package body Prj.Nmsc is ...@@ -1722,8 +1746,11 @@ package body Prj.Nmsc is
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if Data.Library_ALI_Dir = Dir_Elem.Value then if Data.Library_ALI_Dir =
Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value; Path_Name_Type (Dir_Elem.Value)
then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"library 'A'L'I directory cannot be " & "library 'A'L'I directory cannot be " &
...@@ -1754,18 +1781,19 @@ package body Prj.Nmsc is ...@@ -1754,18 +1781,19 @@ package body Prj.Nmsc is
Dirs_Id := Dir_Elem.Next; Dirs_Id := Dir_Elem.Next;
if if
Data.Library_ALI_Dir = Dir_Elem.Value Data.Library_ALI_Dir =
Path_Name_Type (Dir_Elem.Value)
then then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
Err_Vars.Error_Msg_Name_1 := Err_Vars.Error_Msg_Name_1 :=
Dir_Elem.Value;
Err_Vars.Error_Msg_Name_2 :=
In_Tree.Projects.Table (Pid).Name; In_Tree.Projects.Table (Pid).Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"library 'A'L'I directory cannot " & "library 'A'L'I directory cannot " &
"be the same as source directory " & "be the same as source directory " &
"{ of project {", "{ of project %%",
Lib_ALI_Dir.Location); Lib_ALI_Dir.Location);
OK := False; OK := False;
exit ALI_Project_Loop; exit ALI_Project_Loop;
...@@ -1776,8 +1804,8 @@ package body Prj.Nmsc is ...@@ -1776,8 +1804,8 @@ package body Prj.Nmsc is
end if; end if;
if not OK then if not OK then
Data.Library_ALI_Dir := No_Name; Data.Library_ALI_Dir := No_Path;
Data.Display_Library_ALI_Dir := No_Name; Data.Display_Library_ALI_Dir := No_Path;
elsif Current_Verbosity = High then elsif Current_Verbosity = High then
...@@ -1802,7 +1830,7 @@ package body Prj.Nmsc is ...@@ -1802,7 +1830,7 @@ package body Prj.Nmsc is
end if; end if;
else else
Data.Lib_Internal_Name := Lib_Version.Value; Data.Lib_Internal_Name := File_Name_Type (Lib_Version.Value);
end if; end if;
pragma Assert (The_Lib_Kind.Kind = Single); pragma Assert (The_Lib_Kind.Kind = Single);
...@@ -2250,21 +2278,23 @@ package body Prj.Nmsc is ...@@ -2250,21 +2278,23 @@ package body Prj.Nmsc is
The_Unit_Id : Unit_Id; The_Unit_Id : Unit_Id;
The_Unit_Data : Unit_Data; The_Unit_Data : Unit_Data;
procedure Add_ALI_For (Source : Name_Id); procedure Add_ALI_For (Source : File_Name_Type);
-- Add an ALI file name to the list of Interface ALIs -- Add an ALI file name to the list of Interface ALIs
----------------- -----------------
-- Add_ALI_For -- -- Add_ALI_For --
----------------- -----------------
procedure Add_ALI_For (Source : Name_Id) is procedure Add_ALI_For (Source : File_Name_Type) is
begin begin
Get_Name_String (Source); Get_Name_String (Source);
declare declare
ALI : constant String := ALI : constant String :=
ALI_File_Name (Name_Buffer (1 .. Name_Len)); ALI_File_Name (Name_Buffer (1 .. Name_Len));
ALI_Name_Id : Name_Id;
ALI_Name_Id : File_Name_Type;
begin begin
Name_Len := ALI'Length; Name_Len := ALI'Length;
Name_Buffer (1 .. Name_Len) := ALI; Name_Buffer (1 .. Name_Len) := ALI;
...@@ -2272,17 +2302,19 @@ package body Prj.Nmsc is ...@@ -2272,17 +2302,19 @@ package body Prj.Nmsc is
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(String_Element_Table.Last (String_Element_Table.Last
(In_Tree.String_Elements)) := (In_Tree.String_Elements)) :=
(Value => ALI_Name_Id, (Value => Name_Id (ALI_Name_Id),
Index => 0, Index => 0,
Display_Value => ALI_Name_Id, Display_Value => Name_Id (ALI_Name_Id),
Location => Location =>
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Interfaces).Location, (Interfaces).Location,
Flag => False, Flag => False,
Next => Interface_ALIs); Next => Interface_ALIs);
Interface_ALIs := String_Element_Table.Last Interface_ALIs := String_Element_Table.Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
end; end;
...@@ -2327,7 +2359,7 @@ package body Prj.Nmsc is ...@@ -2327,7 +2359,7 @@ package body Prj.Nmsc is
if The_Unit_Id = No_Unit then if The_Unit_Id = No_Unit then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"unknown unit {", "unknown unit %%",
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Interfaces).Location); (Interfaces).Location);
...@@ -2337,7 +2369,7 @@ package body Prj.Nmsc is ...@@ -2337,7 +2369,7 @@ package body Prj.Nmsc is
The_Unit_Data := The_Unit_Data :=
In_Tree.Units.Table (The_Unit_Id); In_Tree.Units.Table (The_Unit_Id);
if The_Unit_Data.File_Names (Body_Part).Name /= No_Name if The_Unit_Data.File_Names (Body_Part).Name /= No_File
and then The_Unit_Data.File_Names (Body_Part).Path /= and then The_Unit_Data.File_Names (Body_Part).Path /=
Slash Slash
then then
...@@ -2349,14 +2381,15 @@ package body Prj.Nmsc is ...@@ -2349,14 +2381,15 @@ package body Prj.Nmsc is
-- If there is no spec, we need to check -- If there is no spec, we need to check
-- that it is not a subunit. -- that it is not a subunit.
if The_Unit_Data.File_Names if The_Unit_Data.File_Names (Specification).Name =
(Specification).Name = No_Name No_File
then then
declare declare
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
begin begin
Src_Ind := Sinput.P.Load_Project_File Src_Ind :=
Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(The_Unit_Data.File_Names (The_Unit_Data.File_Names
(Body_Part).Path)); (Body_Part).Path));
...@@ -2366,7 +2399,7 @@ package body Prj.Nmsc is ...@@ -2366,7 +2399,7 @@ package body Prj.Nmsc is
then then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is a subunit; " & "%% is a subunit; " &
"it cannot be an interface", "it cannot be an interface",
In_Tree. In_Tree.
String_Elements.Table String_Elements.Table
...@@ -2385,18 +2418,18 @@ package body Prj.Nmsc is ...@@ -2385,18 +2418,18 @@ package body Prj.Nmsc is
else else
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is not an unit of this project", "%% is not an unit of this project",
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Interfaces).Location); (Interfaces).Location);
end if; end if;
elsif The_Unit_Data.File_Names elsif The_Unit_Data.File_Names (Specification).Name /=
(Specification).Name /= No_Name No_File
and then The_Unit_Data.File_Names and then
(Specification).Path /= Slash The_Unit_Data.File_Names (Specification).Path /= Slash
and then Check_Project and then
(The_Unit_Data.File_Names Check_Project
(Specification).Project, (The_Unit_Data.File_Names (Specification).Project,
Project, In_Tree, Extending) Project, In_Tree, Extending)
then then
...@@ -2410,7 +2443,7 @@ package body Prj.Nmsc is ...@@ -2410,7 +2443,7 @@ package body Prj.Nmsc is
else else
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is not an unit of this project", "%% is not an unit of this project",
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Interfaces).Location); (Interfaces).Location);
end if; end if;
...@@ -2476,11 +2509,15 @@ package body Prj.Nmsc is ...@@ -2476,11 +2509,15 @@ package body Prj.Nmsc is
if Lib_Src_Dir.Value /= Empty_String then if Lib_Src_Dir.Value /= Empty_String then
declare declare
Dir_Id : constant Name_Id := Lib_Src_Dir.Value; Dir_Id : constant File_Name_Type :=
File_Name_Type (Lib_Src_Dir.Value);
begin begin
Locate_Directory Locate_Directory
(Project, In_Tree, Dir_Id, Data.Display_Directory, (Project,
In_Tree,
Dir_Id,
Data.Display_Directory,
Data.Library_Src_Dir, Data.Library_Src_Dir,
Data.Display_Library_Src_Dir, Data.Display_Library_Src_Dir,
Create => "library source copy", Create => "library source copy",
...@@ -2488,7 +2525,7 @@ package body Prj.Nmsc is ...@@ -2488,7 +2525,7 @@ package body Prj.Nmsc is
-- If directory does not exist, report an error -- If directory does not exist, report an error
if Data.Library_Src_Dir = No_Name then if Data.Library_Src_Dir = No_Path then
-- Get the absolute name of the library directory -- Get the absolute name of the library directory
-- that does not exist, to report an error. -- that does not exist, to report an error.
...@@ -2499,7 +2536,7 @@ package body Prj.Nmsc is ...@@ -2499,7 +2536,7 @@ package body Prj.Nmsc is
begin begin
if Is_Absolute_Path (Dir_Name) then if Is_Absolute_Path (Dir_Name) then
Err_Vars.Error_Msg_Name_1 := Dir_Id; Err_Vars.Error_Msg_File_1 := Dir_Id;
else else
Get_Name_String (Data.Directory); Get_Name_String (Data.Directory);
...@@ -2517,7 +2554,7 @@ package body Prj.Nmsc is ...@@ -2517,7 +2554,7 @@ package body Prj.Nmsc is
Name_Len + Dir_Name'Length) := Name_Len + Dir_Name'Length) :=
Dir_Name; Dir_Name;
Name_Len := Name_Len + Dir_Name'Length; Name_Len := Name_Len + Dir_Name'Length;
Err_Vars.Error_Msg_Name_1 := Name_Find; Err_Vars.Error_Msg_File_1 := Name_Find;
end if; end if;
-- Report the error -- Report the error
...@@ -2537,7 +2574,7 @@ package body Prj.Nmsc is ...@@ -2537,7 +2574,7 @@ package body Prj.Nmsc is
"directory to copy interfaces cannot be " & "directory to copy interfaces cannot be " &
"the object directory", "the object directory",
Lib_Src_Dir.Location); Lib_Src_Dir.Location);
Data.Library_Src_Dir := No_Name; Data.Library_Src_Dir := No_Path;
else else
declare declare
...@@ -2555,20 +2592,22 @@ package body Prj.Nmsc is ...@@ -2555,20 +2592,22 @@ package body Prj.Nmsc is
-- Report error if it is one of the source directories -- Report error if it is one of the source directories
if Data.Library_Src_Dir = Src_Dir.Value then if Data.Library_Src_Dir =
Path_Name_Type (Src_Dir.Value)
then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"directory to copy interfaces cannot " & "directory to copy interfaces cannot " &
"be one of the source directories", "be one of the source directories",
Lib_Src_Dir.Location); Lib_Src_Dir.Location);
Data.Library_Src_Dir := No_Name; Data.Library_Src_Dir := No_Path;
exit; exit;
end if; end if;
Src_Dirs := Src_Dir.Next; Src_Dirs := Src_Dir.Next;
end loop; end loop;
if Data.Library_Src_Dir /= No_Name then if Data.Library_Src_Dir /= No_Path then
-- It cannot be a source directory of any other -- It cannot be a source directory of any other
-- project either. -- project either.
...@@ -2585,17 +2624,20 @@ package body Prj.Nmsc is ...@@ -2585,17 +2624,20 @@ package body Prj.Nmsc is
-- Report error if it is one of the source -- Report error if it is one of the source
-- directories -- directories
if Data.Library_Src_Dir = Src_Dir.Value then if Data.Library_Src_Dir =
Error_Msg_Name_1 := Src_Dir.Value; Path_Name_Type (Src_Dir.Value)
Error_Msg_Name_2 := then
Error_Msg_File_1 :=
File_Name_Type (Src_Dir.Value);
Error_Msg_Name_1 :=
In_Tree.Projects.Table (Pid).Name; In_Tree.Projects.Table (Pid).Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"directory to copy interfaces cannot " & "directory to copy interfaces cannot " &
"be the same as source directory { of " & "be the same as source directory { of " &
"project {", "project %%",
Lib_Src_Dir.Location); Lib_Src_Dir.Location);
Data.Library_Src_Dir := No_Name; Data.Library_Src_Dir := No_Path;
exit Project_Loop; exit Project_Loop;
end if; end if;
...@@ -2608,7 +2650,7 @@ package body Prj.Nmsc is ...@@ -2608,7 +2650,7 @@ package body Prj.Nmsc is
-- In high verbosity, if there is a valid Library_Src_Dir, -- In high verbosity, if there is a valid Library_Src_Dir,
-- display its path name. -- display its path name.
if Data.Library_Src_Dir /= No_Name if Data.Library_Src_Dir /= No_Path
and then Current_Verbosity = High and then Current_Verbosity = High
then then
Write_Str ("Directory to copy interfaces ="""); Write_Str ("Directory to copy interfaces =""");
...@@ -2644,6 +2686,9 @@ package body Prj.Nmsc is ...@@ -2644,6 +2686,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,
...@@ -2654,7 +2699,7 @@ package body Prj.Nmsc is ...@@ -2654,7 +2699,7 @@ package body Prj.Nmsc is
end if; end if;
-- If attribute Library_Symbol_File is not specified, symbol policy -- If attribute Library_Symbol_File is not specified, symbol policy
-- cannot be Restricted. -- cannot be Restricted or Direct.
if Lib_Symbol_File.Default then if Lib_Symbol_File.Default then
if Data.Symbol_Data.Symbol_Policy = Restricted then if Data.Symbol_Data.Symbol_Policy = Restricted then
...@@ -2665,8 +2710,13 @@ package body Prj.Nmsc is ...@@ -2665,8 +2710,13 @@ package body Prj.Nmsc is
Lib_Symbol_Policy.Location); Lib_Symbol_Policy.Location);
end if; end if;
Name_Len := 0;
Add_Str_To_Name_Buffer (Default_Symbol_File_Name);
Data.Symbol_Data.Symbol_File := Name_Find;
Get_Name_String (Data.Symbol_Data.Symbol_File);
else else
-- Library_Symbol_File is defined. Check that the file exists -- Library_Symbol_File is defined
Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value; Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value;
...@@ -2677,8 +2727,10 @@ package body Prj.Nmsc is ...@@ -2677,8 +2727,10 @@ package body Prj.Nmsc is
(Project, In_Tree, (Project, In_Tree,
"symbol file name cannot be an empty string", "symbol file name cannot be an empty string",
Lib_Symbol_File.Location); Lib_Symbol_File.Location);
end if;
end if;
else if Name_Len /= 0 then
OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
if OK then if OK then
...@@ -2693,7 +2745,8 @@ package body Prj.Nmsc is ...@@ -2693,7 +2745,8 @@ package body Prj.Nmsc is
end if; end if;
if not OK then if not OK then
Error_Msg_Name_1 := Lib_Symbol_File.Value; Error_Msg_File_1 :=
File_Name_Type (Lib_Symbol_File.Value);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"symbol file name { is illegal. " & "symbol file name { is illegal. " &
...@@ -2701,14 +2754,14 @@ package body Prj.Nmsc is ...@@ -2701,14 +2754,14 @@ package body Prj.Nmsc is
Lib_Symbol_File.Location); Lib_Symbol_File.Location);
end if; end if;
end if; end if;
end if;
-- If attribute Library_Reference_Symbol_File is not defined, -- If attribute Library_Reference_Symbol_File is not defined,
-- symbol policy cannot be Compilant or Controlled. -- symbol policy cannot be Compilant, Controlled or Direct.
if Lib_Ref_Symbol_File.Default then if Lib_Ref_Symbol_File.Default then
if Data.Symbol_Data.Symbol_Policy = Compliant if Data.Symbol_Data.Symbol_Policy = Compliant
or else Data.Symbol_Data.Symbol_Policy = Controlled or else Data.Symbol_Data.Symbol_Policy = Controlled
or else Data.Symbol_Data.Symbol_Policy = Direct
then then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
...@@ -2730,41 +2783,28 @@ package body Prj.Nmsc is ...@@ -2730,41 +2783,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_Name_1 := 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_Name_1 := Lib_Ref_Symbol_File.Value; Error_Msg_File_1 :=
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,
...@@ -2782,6 +2822,34 @@ package body Prj.Nmsc is ...@@ -2782,6 +2822,34 @@ 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.
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;
...@@ -2812,10 +2880,10 @@ package body Prj.Nmsc is ...@@ -2812,10 +2880,10 @@ package body Prj.Nmsc is
In_Project : Project_Data; In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return String In_Tree : Project_Tree_Ref) return String
is is
Suffix_Id : constant Name_Id := Suffix_Id : constant File_Name_Type :=
Suffix_Of (Language, In_Project, In_Tree); Suffix_Of (Language, In_Project, In_Tree);
begin begin
if Suffix_Id /= No_Name then if Suffix_Id /= No_File then
return Get_Name_String (Suffix_Id); return Get_Name_String (Suffix_Id);
else else
return "." & Get_Name_String (Language_Names.Table (Language)); return "." & Get_Name_String (Language_Names.Table (Language));
...@@ -2835,8 +2903,10 @@ package body Prj.Nmsc is ...@@ -2835,8 +2903,10 @@ package body Prj.Nmsc is
Real_Location : Source_Ptr := Flag_Location; Real_Location : Source_Ptr := Flag_Location;
Error_Buffer : String (1 .. 5_000); Error_Buffer : String (1 .. 5_000);
Error_Last : Natural := 0; Error_Last : Natural := 0;
Msg_Name : Natural := 0; Name_Number : Natural := 0;
File_Number : Natural := 0;
First : Positive := Msg'First; First : Positive := Msg'First;
Index : Positive;
procedure Add (C : Character); procedure Add (C : Character);
-- Add a character to the buffer -- Add a character to the buffer
...@@ -2844,9 +2914,12 @@ package body Prj.Nmsc is ...@@ -2844,9 +2914,12 @@ package body Prj.Nmsc is
procedure Add (S : String); procedure Add (S : String);
-- Add a string to the buffer -- Add a string to the buffer
procedure Add (Id : Name_Id); procedure Add_Name;
-- Add a name to the buffer -- Add a name to the buffer
procedure Add_File;
-- Add a file name to the buffer
--------- ---------
-- Add -- -- Add --
--------- ---------
...@@ -2863,11 +2936,57 @@ package body Prj.Nmsc is ...@@ -2863,11 +2936,57 @@ package body Prj.Nmsc is
Error_Last := Error_Last + S'Length; Error_Last := Error_Last + S'Length;
end Add; end Add;
procedure Add (Id : Name_Id) is --------------
-- Add_File --
--------------
procedure Add_File is
File : File_Name_Type;
begin begin
Get_Name_String (Id); Add ('"');
File_Number := File_Number + 1;
case File_Number is
when 1 =>
File := Err_Vars.Error_Msg_File_1;
when 2 =>
File := Err_Vars.Error_Msg_File_2;
when 3 =>
File := Err_Vars.Error_Msg_File_3;
when others =>
null;
end case;
Get_Name_String (File);
Add (Name_Buffer (1 .. Name_Len)); Add (Name_Buffer (1 .. Name_Len));
end Add; Add ('"');
end Add_File;
--------------
-- Add_Name --
--------------
procedure Add_Name is
Name : Name_Id;
begin
Add ('"');
Name_Number := Name_Number + 1;
case Name_Number is
when 1 =>
Name := Err_Vars.Error_Msg_Name_1;
when 2 =>
Name := Err_Vars.Error_Msg_Name_2;
when 3 =>
Name := Err_Vars.Error_Msg_Name_3;
when others =>
null;
end case;
Get_Name_String (Name);
Add (Name_Buffer (1 .. Name_Len));
Add ('"');
end Add_Name;
-- Start of processing for Error_Msg -- Start of processing for Error_Msg
...@@ -2888,8 +3007,8 @@ package body Prj.Nmsc is ...@@ -2888,8 +3007,8 @@ package body Prj.Nmsc is
if Msg (First) = '\' then if Msg (First) = '\' then
First := First + 1; First := First + 1;
-- Warniung character is always the first one in this package -- Warning character is always the first one in this package
-- this is an undoocumented kludge!!! -- this is an undocumented kludge!!!
elsif Msg (First) = '?' then elsif Msg (First) = '?' then
First := First + 1; First := First + 1;
...@@ -2903,27 +3022,21 @@ package body Prj.Nmsc is ...@@ -2903,27 +3022,21 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
for Index in First .. Msg'Last loop Index := First;
if Msg (Index) = '{' or else Msg (Index) = '%' then while Index <= Msg'Last loop
if Msg (Index) = '{' then
-- Include a name between double quotes Add_File;
Msg_Name := Msg_Name + 1;
Add ('"');
case Msg_Name is
when 1 => Add (Err_Vars.Error_Msg_Name_1);
when 2 => Add (Err_Vars.Error_Msg_Name_2);
when 3 => Add (Err_Vars.Error_Msg_Name_3);
when others => null; elsif Msg (Index) = '%' then
end case; if Index < Msg'Last and then Msg (Index + 1) = '%' then
Index := Index + 1;
Add ('"'); end if;
Add_Name;
else else
Add (Msg (Index)); Add (Msg (Index));
end if; end if;
Index := Index + 1;
end loop; end loop;
...@@ -2958,12 +3071,15 @@ package body Prj.Nmsc is ...@@ -2958,12 +3071,15 @@ package body Prj.Nmsc is
begin begin
Source_Recorded := False; Source_Recorded := False;
Element := In_Tree.String_Elements.Table (Source_Dir); Element := In_Tree.String_Elements.Table (Source_Dir);
if Element.Value /= No_Name then if Element.Value /= No_Name then
Get_Name_String (Element.Display_Value); Get_Name_String (Element.Display_Value);
declare declare
Source_Directory : constant String := Source_Directory : constant String :=
Name_Buffer (1 .. Name_Len) & Directory_Separator; Name_Buffer (1 .. Name_Len) &
Directory_Separator;
Dir_Last : constant Natural := Dir_Last : constant Natural :=
Compute_Directory_Last (Source_Directory); Compute_Directory_Last (Source_Directory);
...@@ -2989,7 +3105,7 @@ package body Prj.Nmsc is ...@@ -2989,7 +3105,7 @@ package body Prj.Nmsc is
exit when Name_Len = 0; exit when Name_Len = 0;
declare declare
File_Name : constant Name_Id := Name_Find; File_Name : constant File_Name_Type := Name_Find;
Path : constant String := Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => Name_Buffer (1 .. Name_Len), (Name => Name_Buffer (1 .. Name_Len),
...@@ -2997,7 +3113,7 @@ package body Prj.Nmsc is ...@@ -2997,7 +3113,7 @@ package body Prj.Nmsc is
(Source_Directory'First .. Dir_Last), (Source_Directory'First .. Dir_Last),
Resolve_Links => Follow_Links, Resolve_Links => Follow_Links,
Case_Sensitive => True); Case_Sensitive => True);
Path_Name : Name_Id; Path_Name : File_Name_Type;
begin begin
Name_Len := Path'Length; Name_Len := Path'Length;
...@@ -3109,15 +3225,21 @@ package body Prj.Nmsc is ...@@ -3109,15 +3225,21 @@ package body Prj.Nmsc is
Last_Source_Dir : String_List_Id := Nil_String; Last_Source_Dir : String_List_Id := Nil_String;
procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr); procedure Find_Source_Dirs
-- Find one or several source directories, and add them (From : File_Name_Type;
-- to the list of source directories of the project. Location : Source_Ptr);
-- Find one or several source directories, and add them to the list of
-- source directories of the project.
-- What is Location??? and what is From???
---------------------- ----------------------
-- Find_Source_Dirs -- -- Find_Source_Dirs --
---------------------- ----------------------
procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr) is procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr)
is
Directory : constant String := Get_Name_String (From); Directory : constant String := Get_Name_String (From);
Element : String_Element; Element : String_Element;
...@@ -3137,8 +3259,8 @@ package body Prj.Nmsc is ...@@ -3137,8 +3259,8 @@ package body Prj.Nmsc is
Element : String_Element; Element : String_Element;
Found : Boolean := False; Found : Boolean := False;
Non_Canonical_Path : Name_Id := No_Name; Non_Canonical_Path : File_Name_Type := No_File;
Canonical_Path : Name_Id := No_Name; Canonical_Path : File_Name_Type := No_File;
The_Path : constant String := The_Path : constant String :=
Normalize_Pathname (Get_Name_String (Path)) & Normalize_Pathname (Get_Name_String (Path)) &
...@@ -3174,7 +3296,7 @@ package body Prj.Nmsc is ...@@ -3174,7 +3296,7 @@ package body Prj.Nmsc is
Element := In_Tree.String_Elements.Table (List); Element := In_Tree.String_Elements.Table (List);
if Element.Value /= No_Name then if Element.Value /= No_Name then
Found := Element.Value = Canonical_Path; Found := Element.Value = Name_Id (Canonical_Path);
exit when Found; exit when Found;
end if; end if;
...@@ -3192,8 +3314,8 @@ package body Prj.Nmsc is ...@@ -3192,8 +3314,8 @@ package body Prj.Nmsc is
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
Element := Element :=
(Value => Canonical_Path, (Value => Name_Id (Canonical_Path),
Display_Value => Non_Canonical_Path, Display_Value => Name_Id (Non_Canonical_Path),
Location => No_Location, Location => No_Location,
Flag => False, Flag => False,
Next => Nil_String, Next => Nil_String,
...@@ -3212,16 +3334,14 @@ package body Prj.Nmsc is ...@@ -3212,16 +3334,14 @@ package body Prj.Nmsc is
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Last_Source_Dir).Next := (Last_Source_Dir).Next :=
String_Element_Table.Last String_Element_Table.Last (In_Tree.String_Elements);
(In_Tree.String_Elements);
end if; end if;
-- And register this source directory as the new last -- And register this source directory as the new last
Last_Source_Dir := String_Element_Table.Last Last_Source_Dir := String_Element_Table.Last
(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;
end if; end if;
-- Now look for subdirectories. We do that even when this -- Now look for subdirectories. We do that even when this
...@@ -3316,7 +3436,7 @@ package body Prj.Nmsc is ...@@ -3316,7 +3436,7 @@ package body Prj.Nmsc is
end if; end if;
declare declare
Base_Dir : constant Name_Id := Name_Find; Base_Dir : constant File_Name_Type := Name_Find;
Root_Dir : constant String := Root_Dir : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => Get_Name_String (Base_Dir), (Name => Get_Name_String (Base_Dir),
...@@ -3327,7 +3447,7 @@ package body Prj.Nmsc is ...@@ -3327,7 +3447,7 @@ package body Prj.Nmsc is
begin begin
if Root_Dir'Length = 0 then if Root_Dir'Length = 0 then
Err_Vars.Error_Msg_Name_1 := Base_Dir; Err_Vars.Error_Msg_File_1 := Base_Dir;
if Location = No_Location then if Location = No_Location then
Error_Msg Error_Msg
...@@ -3363,17 +3483,20 @@ package body Prj.Nmsc is ...@@ -3363,17 +3483,20 @@ package body Prj.Nmsc is
else else
declare declare
Path_Name : Name_Id; Path_Name : Path_Name_Type;
Display_Path_Name : Name_Id; Display_Path_Name : Path_Name_Type;
begin begin
Locate_Directory Locate_Directory
(Project, In_Tree, (Project,
From, Data.Display_Directory, In_Tree,
Path_Name, Display_Path_Name); From,
Data.Display_Directory,
Path_Name,
Display_Path_Name);
if Path_Name = No_Name then if Path_Name = No_Path then
Err_Vars.Error_Msg_Name_1 := From; Err_Vars.Error_Msg_File_1 := From;
if Location = No_Location then if Location = No_Location then
Error_Msg Error_Msg
...@@ -3388,13 +3511,13 @@ package body Prj.Nmsc is ...@@ -3388,13 +3511,13 @@ package body Prj.Nmsc is
end if; end if;
else else
-- As it is an existing directory, we add it to -- As it is an existing directory, we add it to the list of
-- the list of directories. -- directories.
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
Element.Value := Path_Name; Element.Value := Name_Id (Path_Name);
Element.Display_Value := Display_Path_Name; Element.Display_Value := Name_Id (Display_Path_Name);
if Last_Source_Dir = Nil_String then if Last_Source_Dir = Nil_String then
...@@ -3409,16 +3532,14 @@ package body Prj.Nmsc is ...@@ -3409,16 +3532,14 @@ package body Prj.Nmsc is
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Last_Source_Dir).Next := (Last_Source_Dir).Next :=
String_Element_Table.Last String_Element_Table.Last (In_Tree.String_Elements);
(In_Tree.String_Elements);
end if; end if;
-- And register this source directory as the new last -- And register this source directory as the new last
Last_Source_Dir := String_Element_Table.Last Last_Source_Dir := String_Element_Table.Last
(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;
end if; end if;
end; end;
end if; end if;
...@@ -3454,15 +3575,20 @@ package body Prj.Nmsc is ...@@ -3454,15 +3575,20 @@ package body Prj.Nmsc is
-- We check that the specified object directory does exist -- We check that the specified object directory does exist
Locate_Directory Locate_Directory
(Project, In_Tree, Object_Dir.Value, Data.Display_Directory, (Project,
Data.Object_Directory, Data.Display_Object_Dir, In_Tree,
Create => "object", Location => Object_Dir.Location); File_Name_Type (Object_Dir.Value),
Data.Display_Directory,
Data.Object_Directory,
Data.Display_Object_Dir,
Create => "object",
Location => Object_Dir.Location);
if Data.Object_Directory = No_Name then if Data.Object_Directory = No_Path then
-- The object directory does not exist, report an error -- The object directory does not exist, report an error
Err_Vars.Error_Msg_Name_1 := Object_Dir.Value; Err_Vars.Error_Msg_File_1 := File_Name_Type (Object_Dir.Value);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"the object directory { cannot be found", "the object directory { cannot be found",
...@@ -3473,7 +3599,7 @@ package body Prj.Nmsc is ...@@ -3473,7 +3599,7 @@ package body Prj.Nmsc is
-- tools that recover from errors; for example, these tools -- tools that recover from errors; for example, these tools
-- could create the non existent directory. -- could create the non existent directory.
Data.Display_Object_Dir := Object_Dir.Value; Data.Display_Object_Dir := Path_Name_Type (Object_Dir.Value);
Get_Name_String (Object_Dir.Value); Get_Name_String (Object_Dir.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Data.Object_Directory := Name_Find; Data.Object_Directory := Name_Find;
...@@ -3482,7 +3608,7 @@ package body Prj.Nmsc is ...@@ -3482,7 +3608,7 @@ package body Prj.Nmsc is
end if; end if;
if Current_Verbosity = High then if Current_Verbosity = High then
if Data.Object_Directory = No_Name then if Data.Object_Directory = No_Path then
Write_Line ("No object directory"); Write_Line ("No object directory");
else else
Write_Str ("Object directory: """); Write_Str ("Object directory: """);
...@@ -3511,16 +3637,21 @@ package body Prj.Nmsc is ...@@ -3511,16 +3637,21 @@ 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, In_Tree, Exec_Dir.Value, Data.Directory, (Project,
Data.Exec_Directory, Data.Display_Exec_Dir, In_Tree,
Create => "exec", Location => Exec_Dir.Location); File_Name_Type (Exec_Dir.Value),
Data.Display_Directory,
if Data.Exec_Directory = No_Name then Data.Exec_Directory,
Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value; Data.Display_Exec_Dir,
Create => "exec",
Location => Exec_Dir.Location);
if Data.Exec_Directory = No_Path then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Exec_Dir.Value);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"the exec directory { cannot be found", "the exec directory { cannot be found",
...@@ -3530,7 +3661,7 @@ package body Prj.Nmsc is ...@@ -3530,7 +3661,7 @@ package body Prj.Nmsc is
end if; end if;
if Current_Verbosity = High then if Current_Verbosity = High then
if Data.Exec_Directory = No_Name then if Data.Exec_Directory = No_Path then
Write_Line ("No exec directory"); Write_Line ("No exec directory");
else else
Write_Str ("Exec directory: """); Write_Str ("Exec directory: """);
...@@ -3557,8 +3688,8 @@ package body Prj.Nmsc is ...@@ -3557,8 +3688,8 @@ package body Prj.Nmsc is
Data.Source_Dirs := String_Element_Table.Last Data.Source_Dirs := String_Element_Table.Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
In_Tree.String_Elements.Table (Data.Source_Dirs) := In_Tree.String_Elements.Table (Data.Source_Dirs) :=
(Value => Data.Directory, (Value => Name_Id (Data.Directory),
Display_Value => Data.Display_Directory, Display_Value => Name_Id (Data.Display_Directory),
Location => No_Location, Location => No_Location,
Flag => False, Flag => False,
Next => Nil_String, Next => Nil_String,
...@@ -3581,7 +3712,7 @@ package body Prj.Nmsc is ...@@ -3581,7 +3712,7 @@ package body Prj.Nmsc is
if Data.Extends = No_Project if Data.Extends = No_Project
and then Data.Object_Directory = Data.Directory and then Data.Object_Directory = Data.Directory
then then
Data.Object_Directory := No_Name; Data.Object_Directory := No_Path;
end if; end if;
Data.Source_Dirs := Nil_String; Data.Source_Dirs := Nil_String;
...@@ -3598,9 +3729,9 @@ package body Prj.Nmsc is ...@@ -3598,9 +3729,9 @@ package body Prj.Nmsc is
-- element of the list -- element of the list
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
Element := Element := In_Tree.String_Elements.Table (Source_Dir);
In_Tree.String_Elements.Table (Source_Dir); Find_Source_Dirs
Find_Source_Dirs (Element.Value, Element.Location); (File_Name_Type (Element.Value), Element.Location);
Source_Dir := Element.Next; Source_Dir := Element.Next;
end loop; end loop;
end; end;
...@@ -3627,7 +3758,6 @@ package body Prj.Nmsc is ...@@ -3627,7 +3758,6 @@ package body Prj.Nmsc is
Current := Element.Next; Current := Element.Next;
end loop; end loop;
end; end;
end Get_Directories; end Get_Directories;
--------------- ---------------
...@@ -3650,8 +3780,7 @@ package body Prj.Nmsc is ...@@ -3650,8 +3780,7 @@ package body Prj.Nmsc is
if Mains.Default then if Mains.Default then
if Data.Extends /= No_Project then if Data.Extends /= No_Project then
Data.Mains := Data.Mains := In_Tree.Projects.Table (Data.Extends).Mains;
In_Tree.Projects.Table (Data.Extends).Mains;
end if; end if;
-- In a library project file, Main cannot be specified -- In a library project file, Main cannot be specified
...@@ -3677,7 +3806,7 @@ package body Prj.Nmsc is ...@@ -3677,7 +3806,7 @@ package body Prj.Nmsc is
File : Prj.Util.Text_File; File : Prj.Util.Text_File;
Line : String (1 .. 250); Line : String (1 .. 250);
Last : Natural; Last : Natural;
Source_Name : Name_Id; Source_Name : File_Name_Type;
begin begin
Source_Names.Reset; Source_Names.Reset;
...@@ -3730,7 +3859,7 @@ package body Prj.Nmsc is ...@@ -3730,7 +3859,7 @@ package body Prj.Nmsc is
-------------- --------------
procedure Get_Unit procedure Get_Unit
(Canonical_File_Name : Name_Id; (Canonical_File_Name : File_Name_Type;
Naming : Naming_Data; Naming : Naming_Data;
Exception_Id : out Ada_Naming_Exception_Id; Exception_Id : out Ada_Naming_Exception_Id;
Unit_Name : out Name_Id; Unit_Name : out Name_Id;
...@@ -3739,7 +3868,7 @@ package body Prj.Nmsc is ...@@ -3739,7 +3868,7 @@ package body Prj.Nmsc is
is is
Info_Id : Ada_Naming_Exception_Id := Info_Id : Ada_Naming_Exception_Id :=
Ada_Naming_Exceptions.Get (Canonical_File_Name); Ada_Naming_Exceptions.Get (Canonical_File_Name);
VMS_Name : Name_Id; VMS_Name : File_Name_Type;
begin begin
if Info_Id = No_Ada_Naming_Exception then if Info_Id = No_Ada_Naming_Exception then
...@@ -3960,24 +4089,20 @@ package body Prj.Nmsc is ...@@ -3960,24 +4089,20 @@ package body Prj.Nmsc is
S1 = 'i' or else S1 = 'i' or else
S1 = 's' S1 = 's'
then then
-- Children or separates of packages A, G, I or S. On -- Children or separates of packages A, G, I or S. These
-- VMS these names are x__ ... and on other systems the -- names are x__ ... or x~... (where x is a, g, i, or s).
-- names are x~... (where x is a, g, i, or s). -- Both versions (x__... and x~...) are allowed in all
-- platforms, because it is not possible to know the
-- platform before processing of the project files.
if (OpenVMS_On_Target if S2 = '_' and then S3 = '_' then
and then S2 = '_'
and then S3 = '_')
or else
(not OpenVMS_On_Target
and then S2 = '~')
then
Src (Src'First + 1) := '.'; Src (Src'First + 1) := '.';
if OpenVMS_On_Target then
Src_Last := Src_Last - 1; Src_Last := Src_Last - 1;
Src (Src'First + 2 .. Src_Last) := Src (Src'First + 2 .. Src_Last) :=
Src (Src'First + 3 .. Src_Last + 1); Src (Src'First + 3 .. Src_Last + 1);
end if;
elsif S2 = '~' then
Src (Src'First + 1) := '.';
-- If it is potentially a run time source, disable -- If it is potentially a run time source, disable
-- filling of the mapping file to avoid warnings. -- filling of the mapping file to avoid warnings.
...@@ -4056,10 +4181,10 @@ package body Prj.Nmsc is ...@@ -4056,10 +4181,10 @@ package body Prj.Nmsc is
procedure Locate_Directory procedure Locate_Directory
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Name : Name_Id; Name : File_Name_Type;
Parent : Name_Id; Parent : Path_Name_Type;
Dir : out Name_Id; Dir : out Path_Name_Type;
Display : out Name_Id; Display : out Path_Name_Type;
Create : String := ""; Create : String := "";
Location : Source_Ptr := No_Location) Location : Source_Ptr := No_Location)
is is
...@@ -4071,7 +4196,7 @@ package body Prj.Nmsc is ...@@ -4071,7 +4196,7 @@ package body Prj.Nmsc is
The_Parent_Last : constant Natural := The_Parent_Last : constant Natural :=
Compute_Directory_Last (The_Parent); Compute_Directory_Last (The_Parent);
Full_Name : Name_Id; Full_Name : File_Name_Type;
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -4082,8 +4207,8 @@ package body Prj.Nmsc is ...@@ -4082,8 +4207,8 @@ package body Prj.Nmsc is
Write_Line (""")"); Write_Line (""")");
end if; end if;
Dir := No_Name; Dir := No_Path;
Display := No_Name; Display := No_Path;
if Is_Absolute_Path (The_Name) then if Is_Absolute_Path (The_Name) then
Full_Name := Name; Full_Name := Name;
...@@ -4175,11 +4300,11 @@ package body Prj.Nmsc is ...@@ -4175,11 +4300,11 @@ package body Prj.Nmsc is
procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean) is procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean) is
Source_Dir : String_List_Id := Data.Source_Dirs; Source_Dir : String_List_Id := Data.Source_Dirs;
Element : String_Element; Element : String_Element;
Path : Name_Id; Path : File_Name_Type;
Dir : Dir_Type; Dir : Dir_Type;
Name : Name_Id; Name : File_Name_Type;
Canonical_Name : Name_Id; Canonical_Name : File_Name_Type;
Name_Str : String (1 .. 1_024); Name_Str : String (1 .. 1_024);
Last : Natural := 0; Last : Natural := 0;
NL : Name_Location; NL : Name_Location;
...@@ -4261,8 +4386,7 @@ package body Prj.Nmsc is ...@@ -4261,8 +4386,7 @@ package body Prj.Nmsc is
end; end;
if Source_Recorded then if Source_Recorded then
In_Tree.String_Elements.Table (Source_Dir).Flag := In_Tree.String_Elements.Table (Source_Dir).Flag := True;
True;
end if; end if;
Source_Dir := Element.Next; Source_Dir := Element.Next;
...@@ -4275,7 +4399,7 @@ package body Prj.Nmsc is ...@@ -4275,7 +4399,7 @@ package body Prj.Nmsc is
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_Name_1 := NL.Name; Err_Vars.Error_Msg_File_1 := NL.Name;
if First_Error then if First_Error then
Error_Msg Error_Msg
...@@ -4367,7 +4491,7 @@ package body Prj.Nmsc is ...@@ -4367,7 +4491,7 @@ package body Prj.Nmsc is
Current : String_List_Id := Sources.Values; Current : String_List_Id := Sources.Values;
Element : String_Element; Element : String_Element;
Location : Source_Ptr; Location : Source_Ptr;
Name : Name_Id; Name : File_Name_Type;
begin begin
Source_Names.Reset; Source_Names.Reset;
...@@ -4375,8 +4499,7 @@ package body Prj.Nmsc is ...@@ -4375,8 +4499,7 @@ package body Prj.Nmsc is
Data.Ada_Sources_Present := Current /= Nil_String; Data.Ada_Sources_Present := Current /= Nil_String;
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;
...@@ -4409,18 +4532,21 @@ package body Prj.Nmsc is ...@@ -4409,18 +4532,21 @@ package body Prj.Nmsc is
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
-- that contains the source file names -- source file names
declare declare
Source_File_Path_Name : constant String := Source_File_Path_Name : constant String :=
Path_Name_Of Path_Name_Of
(Source_List_File.Value, (File_Name_Type
(Source_List_File.Value),
Data.Directory); Data.Directory);
begin begin
if Source_File_Path_Name'Length = 0 then if Source_File_Path_Name'Length = 0 then
Err_Vars.Error_Msg_Name_1 := Source_List_File.Value; Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Source_List_File.Value);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"file with sources { does not exist", "file with sources { does not exist",
...@@ -4446,28 +4572,17 @@ package body Prj.Nmsc is ...@@ -4446,28 +4572,17 @@ package body Prj.Nmsc is
-- such in the Units table. -- such in the Units table.
if not Locally_Removed.Default then if not Locally_Removed.Default then
-- Sources can be locally removed only in extending
-- project files.
if Data.Extends = No_Project then
Error_Msg
(Project, In_Tree,
"Locally_Removed_Files can only be used " &
"in an extending project file",
Locally_Removed.Location);
else
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;
Unit : Unit_Data; Unit : Unit_Data;
Name : Name_Id; Name : File_Name_Type;
Extended : Project_Id; Extended : Project_Id;
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);
...@@ -4495,29 +4610,19 @@ package body Prj.Nmsc is ...@@ -4495,29 +4610,19 @@ package body Prj.Nmsc is
if Unit.File_Names (Specification).Name = Name then if Unit.File_Names (Specification).Name = Name then
OK := True; OK := True;
-- Check that this is from a project that -- Check that this is from the current project or
-- the current project extends, but not the -- that the current project extends.
-- current project.
Extended := Unit.File_Names
(Specification).Project;
if Extended = Project then Extended := Unit.File_Names (Specification).Project;
Error_Msg
(Project, In_Tree,
"cannot remove a source " &
"of the same project",
Location);
elsif if Extended = Project or else
Project_Extends (Project, Extended, In_Tree) Project_Extends (Project, Extended, In_Tree)
then then
Unit.File_Names Unit.File_Names
(Specification).Path := Slash; (Specification).Path := Slash;
Unit.File_Names Unit.File_Names
(Specification).Needs_Pragma := False; (Specification).Needs_Pragma := False;
In_Tree.Units.Table (Index) := In_Tree.Units.Table (Index) := Unit;
Unit;
Add_Forbidden_File_Name Add_Forbidden_File_Name
(Unit.File_Names (Specification).Name); (Unit.File_Names (Specification).Name);
exit; exit;
...@@ -4535,28 +4640,19 @@ package body Prj.Nmsc is ...@@ -4535,28 +4640,19 @@ package body Prj.Nmsc is
then then
OK := True; OK := True;
-- Check that this is from a project that -- Check that this is from the current project or
-- the current project extends, but not the -- that the current project extends.
-- current project.
Extended := Unit.File_Names Extended := Unit.File_Names
(Body_Part).Project; (Body_Part).Project;
if Extended = Project then if Extended = Project or else
Error_Msg
(Project, In_Tree,
"cannot remove a source " &
"of the same project",
Location);
elsif
Project_Extends (Project, Extended, In_Tree) Project_Extends (Project, Extended, In_Tree)
then then
Unit.File_Names (Body_Part).Path := Slash; Unit.File_Names (Body_Part).Path := Slash;
Unit.File_Names (Body_Part).Needs_Pragma Unit.File_Names (Body_Part).Needs_Pragma
:= False; := False;
In_Tree.Units.Table (Index) := In_Tree.Units.Table (Index) := Unit;
Unit;
Add_Forbidden_File_Name Add_Forbidden_File_Name
(Unit.File_Names (Body_Part).Name); (Unit.File_Names (Body_Part).Name);
exit; exit;
...@@ -4566,7 +4662,7 @@ package body Prj.Nmsc is ...@@ -4566,7 +4662,7 @@ package body Prj.Nmsc is
end loop; end loop;
if not OK then if not OK then
Err_Vars.Error_Msg_Name_1 := Name; Err_Vars.Error_Msg_File_1 := Name;
Error_Msg Error_Msg
(Project, In_Tree, "unknown file {", Location); (Project, In_Tree, "unknown file {", Location);
end if; end if;
...@@ -4575,7 +4671,6 @@ package body Prj.Nmsc is ...@@ -4575,7 +4671,6 @@ package body Prj.Nmsc is
end loop; end loop;
end; end;
end if; end if;
end if;
end; end;
end if; end if;
...@@ -4617,7 +4712,7 @@ package body Prj.Nmsc is ...@@ -4617,7 +4712,7 @@ package body Prj.Nmsc is
In_Tree => In_Tree); In_Tree => In_Tree);
Element_Id : String_List_Id; Element_Id : String_List_Id;
Element : String_Element; Element : String_Element;
File_Id : Name_Id; File_Id : File_Name_Type;
Source_Found : Boolean := False; Source_Found : Boolean := False;
begin begin
...@@ -4711,7 +4806,7 @@ package body Prj.Nmsc is ...@@ -4711,7 +4806,7 @@ package body Prj.Nmsc is
Current : String_List_Id := Sources.Values; Current : String_List_Id := Sources.Values;
Element : String_Element; Element : String_Element;
Location : Source_Ptr; Location : Source_Ptr;
Name : Name_Id; Name : File_Name_Type;
begin begin
Source_Names.Reset; Source_Names.Reset;
...@@ -4768,13 +4863,14 @@ package body Prj.Nmsc is ...@@ -4768,13 +4863,14 @@ package body Prj.Nmsc is
declare declare
Source_File_Path_Name : constant String := Source_File_Path_Name : constant String :=
Path_Name_Of Path_Name_Of
(Source_List_File.Value, (File_Name_Type (Source_List_File.Value),
Data.Directory); Data.Directory);
begin begin
if Source_File_Path_Name'Length = 0 then if Source_File_Path_Name'Length = 0 then
Err_Vars.Error_Msg_Name_1 := Err_Vars.Error_Msg_File_1 :=
Source_List_File.Value; File_Name_Type (Source_List_File.Value);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"file with sources { does not exist", "file with sources { does not exist",
...@@ -4821,16 +4917,16 @@ package body Prj.Nmsc is ...@@ -4821,16 +4917,16 @@ package body Prj.Nmsc is
------------------ ------------------
function Path_Name_Of function Path_Name_Of
(File_Name : Name_Id; (File_Name : File_Name_Type;
Directory : Name_Id) return String Directory : Path_Name_Type) return String
is is
Result : String_Access;
The_Directory : constant String := Get_Name_String (Directory); The_Directory : constant String := Get_Name_String (Directory);
Result : String_Access;
begin begin
Get_Name_String (File_Name); Get_Name_String (File_Name);
Result := Locate_Regular_File Result :=
Locate_Regular_File
(File_Name => Name_Buffer (1 .. Name_Len), (File_Name => Name_Buffer (1 .. Name_Len),
Path => The_Directory); Path => The_Directory);
...@@ -4864,16 +4960,19 @@ package body Prj.Nmsc is ...@@ -4864,16 +4960,19 @@ package body Prj.Nmsc is
if Element.Index /= No_Name then if Element.Index /= No_Name then
Unit := Unit :=
(Kind => Kind, (Kind => Kind,
Unit => Element.Index, Unit => Name_Id (Element.Index),
Next => No_Ada_Naming_Exception); Next => No_Ada_Naming_Exception);
Reverse_Ada_Naming_Exceptions.Set Reverse_Ada_Naming_Exceptions.Set
(Unit, (Element.Value.Value, Element.Value.Index)); (Unit, (Element.Value.Value, Element.Value.Index));
Unit.Next := Ada_Naming_Exceptions.Get (Element.Value.Value); Unit.Next :=
(Ada_Naming_Exceptions.Get
(File_Name_Type (Element.Value.Value)));
Ada_Naming_Exception_Table.Increment_Last; Ada_Naming_Exception_Table.Increment_Last;
Ada_Naming_Exception_Table.Table Ada_Naming_Exception_Table.Table
(Ada_Naming_Exception_Table.Last) := Unit; (Ada_Naming_Exception_Table.Last) := Unit;
Ada_Naming_Exceptions.Set Ada_Naming_Exceptions.Set
(Element.Value.Value, Ada_Naming_Exception_Table.Last); (File_Name_Type (Element.Value.Value),
Ada_Naming_Exception_Table.Last);
end if; end if;
Current := Element.Next; Current := Element.Next;
...@@ -4908,8 +5007,8 @@ package body Prj.Nmsc is ...@@ -4908,8 +5007,8 @@ package body Prj.Nmsc is
----------------------- -----------------------
procedure Record_Ada_Source procedure Record_Ada_Source
(File_Name : Name_Id; (File_Name : File_Name_Type;
Path_Name : Name_Id; Path_Name : File_Name_Type;
Project : Project_Id; Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
...@@ -4918,8 +5017,8 @@ package body Prj.Nmsc is ...@@ -4918,8 +5017,8 @@ package body Prj.Nmsc is
Source_Recorded : in out Boolean; Source_Recorded : in out Boolean;
Follow_Links : Boolean) Follow_Links : Boolean)
is is
Canonical_File_Name : Name_Id; Canonical_File_Name : File_Name_Type;
Canonical_Path_Name : Name_Id; Canonical_Path_Name : File_Name_Type;
Exception_Id : Ada_Naming_Exception_Id; Exception_Id : Ada_Naming_Exception_Id;
Unit_Name : Name_Id; Unit_Name : Name_Id;
...@@ -4954,8 +5053,7 @@ package body Prj.Nmsc is ...@@ -4954,8 +5053,7 @@ package body Prj.Nmsc is
Canonical_Path_Name := Name_Find; Canonical_Path_Name := Name_Find;
end; end;
-- Find out the unit name, the unit kind and if it needs -- Find out unit name/unit kind and if it needs a specific SFN pragma
-- a specific SFN pragma.
Get_Unit Get_Unit
(Canonical_File_Name => Canonical_File_Name, (Canonical_File_Name => Canonical_File_Name,
...@@ -5014,36 +5112,34 @@ package body Prj.Nmsc is ...@@ -5014,36 +5112,34 @@ package body Prj.Nmsc is
-- Put the file name in the list of sources of the project -- Put the file name in the list of sources of the project
String_Element_Table.Increment_Last String_Element_Table.Increment_Last (In_Tree.String_Elements);
(In_Tree.String_Elements);
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(String_Element_Table.Last (String_Element_Table.Last
(In_Tree.String_Elements)) := (In_Tree.String_Elements)) :=
(Value => Canonical_File_Name, (Value => Name_Id (Canonical_File_Name),
Display_Value => File_Name, Display_Value => Name_Id (File_Name),
Location => No_Location, Location => No_Location,
Flag => False, Flag => False,
Next => Nil_String, Next => Nil_String,
Index => Unit_Index); Index => Unit_Index);
if Current_Source = Nil_String then if Current_Source = Nil_String then
Data.Sources := String_Element_Table.Last Data.Sources :=
(In_Tree.String_Elements); String_Element_Table.Last (In_Tree.String_Elements);
else else
In_Tree.String_Elements.Table In_Tree.String_Elements.Table (Current_Source).Next :=
(Current_Source).Next := String_Element_Table.Last (In_Tree.String_Elements);
String_Element_Table.Last
(In_Tree.String_Elements);
end if; end if;
Current_Source := String_Element_Table.Last Current_Source :=
(In_Tree.String_Elements); String_Element_Table.Last (In_Tree.String_Elements);
-- Put the unit in unit list -- Put the unit in unit list
declare declare
The_Unit : Unit_Id := The_Unit : Unit_Id :=
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
...@@ -5060,7 +5156,11 @@ package body Prj.Nmsc is ...@@ -5060,7 +5156,11 @@ package body Prj.Nmsc is
if The_Unit /= No_Unit then if The_Unit /= No_Unit then
The_Unit_Data := In_Tree.Units.Table (The_Unit); The_Unit_Data := In_Tree.Units.Table (The_Unit);
if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name if (The_Unit_Data.File_Names (Unit_Kind).Name =
Canonical_File_Name
and then
The_Unit_Data.File_Names (Unit_Kind).Path = Slash)
or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
or else Project_Extends or else Project_Extends
(Data.Extends, (Data.Extends,
The_Unit_Data.File_Names (Unit_Kind).Project, The_Unit_Data.File_Names (Unit_Kind).Project,
...@@ -5075,9 +5175,7 @@ package body Prj.Nmsc is ...@@ -5075,9 +5175,7 @@ package body Prj.Nmsc is
Unit_Prj := (Unit => The_Unit, Project => Project); Unit_Prj := (Unit => The_Unit, Project => Project);
Files_Htable.Set Files_Htable.Set
(In_Tree.Files_HT, (In_Tree.Files_HT, Canonical_File_Name, Unit_Prj);
Canonical_File_Name,
Unit_Prj);
The_Unit_Data.File_Names (Unit_Kind) := The_Unit_Data.File_Names (Unit_Kind) :=
(Name => Canonical_File_Name, (Name => Canonical_File_Name,
...@@ -5087,8 +5185,7 @@ package body Prj.Nmsc is ...@@ -5087,8 +5185,7 @@ package body Prj.Nmsc is
Display_Path => Path_Name, Display_Path => Path_Name,
Project => Project, Project => Project,
Needs_Pragma => Needs_Pragma); Needs_Pragma => Needs_Pragma);
In_Tree.Units.Table (The_Unit) := In_Tree.Units.Table (The_Unit) := The_Unit_Data;
The_Unit_Data;
Source_Recorded := True; Source_Recorded := True;
elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
...@@ -5113,29 +5210,28 @@ package body Prj.Nmsc is ...@@ -5113,29 +5210,28 @@ package body Prj.Nmsc is
if The_Location = No_Location then if The_Location = No_Location then
The_Location := The_Location :=
In_Tree.Projects.Table In_Tree.Projects.Table (Project).Location;
(Project).Location;
end if; end if;
Err_Vars.Error_Msg_Name_1 := Unit_Name; Err_Vars.Error_Msg_Name_1 := Unit_Name;
Error_Msg Error_Msg
(Project, In_Tree, "duplicate source {", The_Location); (Project, In_Tree, "duplicate source %%", The_Location);
Err_Vars.Error_Msg_Name_1 := Err_Vars.Error_Msg_Name_1 :=
In_Tree.Projects.Table In_Tree.Projects.Table
(The_Unit_Data.File_Names (Unit_Kind).Project).Name; (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
Err_Vars.Error_Msg_Name_2 := Err_Vars.Error_Msg_File_1 :=
The_Unit_Data.File_Names (Unit_Kind).Path; The_Unit_Data.File_Names (Unit_Kind).Path;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"\ project file {, {", The_Location); "\\ project file %%, {", The_Location);
Err_Vars.Error_Msg_Name_1 := Err_Vars.Error_Msg_Name_1 :=
In_Tree.Projects.Table (Project).Name; In_Tree.Projects.Table (Project).Name;
Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name; Err_Vars.Error_Msg_File_1 := Canonical_Path_Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"\ project file {, {", The_Location); "\\ project file %%, {", The_Location);
end if; end if;
-- It is a new unit, create a new record -- It is a new unit, create a new record
...@@ -5152,25 +5248,21 @@ package body Prj.Nmsc is ...@@ -5152,25 +5248,21 @@ package body Prj.Nmsc is
if not File_Name_Recorded and then if not File_Name_Recorded and then
Unit_Prj /= No_Unit_Project Unit_Prj /= No_Unit_Project
then then
Error_Msg_Name_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg_Name_2 := Error_Msg_Name_1 :=
In_Tree.Projects.Table In_Tree.Projects.Table (Unit_Prj.Project).Name;
(Unit_Prj.Project).Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is already a source of project {", "{ is already a source of project %%",
Location); Location);
else else
Unit_Table.Increment_Last (In_Tree.Units); Unit_Table.Increment_Last (In_Tree.Units);
The_Unit := Unit_Table.Last (In_Tree.Units); The_Unit := Unit_Table.Last (In_Tree.Units);
Units_Htable.Set Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
(In_Tree.Units_HT, Unit_Name, The_Unit);
Unit_Prj := (Unit => The_Unit, Project => Project); Unit_Prj := (Unit => The_Unit, Project => Project);
Files_Htable.Set Files_Htable.Set
(In_Tree.Files_HT, (In_Tree.Files_HT, Canonical_File_Name, Unit_Prj);
Canonical_File_Name,
Unit_Prj);
The_Unit_Data.Name := Unit_Name; The_Unit_Data.Name := Unit_Name;
The_Unit_Data.File_Names (Unit_Kind) := The_Unit_Data.File_Names (Unit_Kind) :=
(Name => Canonical_File_Name, (Name => Canonical_File_Name,
...@@ -5180,8 +5272,7 @@ package body Prj.Nmsc is ...@@ -5180,8 +5272,7 @@ package body Prj.Nmsc is
Display_Path => Path_Name, Display_Path => Path_Name,
Project => Project, Project => Project,
Needs_Pragma => Needs_Pragma); Needs_Pragma => Needs_Pragma);
In_Tree.Units.Table (The_Unit) := In_Tree.Units.Table (The_Unit) := The_Unit_Data;
The_Unit_Data;
Source_Recorded := True; Source_Recorded := True;
end if; end if;
end if; end if;
...@@ -5204,22 +5295,20 @@ package body Prj.Nmsc is ...@@ -5204,22 +5295,20 @@ package body Prj.Nmsc is
Language : Language_Index; Language : Language_Index;
Naming_Exceptions : Boolean) Naming_Exceptions : Boolean)
is is
Source_Dir : String_List_Id := Data.Source_Dirs; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
Path : Name_Id; Path : File_Name_Type;
Dir : Dir_Type; Dir : Dir_Type;
Canonical_Name : Name_Id; Canonical_Name : File_Name_Type;
Name_Str : String (1 .. 1_024); Name_Str : String (1 .. 1_024);
Last : Natural := 0; Last : Natural := 0;
NL : Name_Location; NL : Name_Location;
First_Error : Boolean := True; First_Error : Boolean := True;
Suffix : constant String := Body_Suffix_Of (Language, Data, In_Tree); Suffix : constant String := Body_Suffix_Of (Language, Data, In_Tree);
begin begin
Source_Dir := Data.Source_Dirs;
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
Element := In_Tree.String_Elements.Table (Source_Dir); Element := In_Tree.String_Elements.Table (Source_Dir);
...@@ -5261,7 +5350,7 @@ package body Prj.Nmsc is ...@@ -5261,7 +5350,7 @@ package body Prj.Nmsc is
if NL /= No_Name_Location then if NL /= No_Name_Location then
if NL.Found then if NL.Found then
if not Data.Known_Order_Of_Source_Dirs then if not Data.Known_Order_Of_Source_Dirs then
Error_Msg_Name_1 := Canonical_Name; Error_Msg_File_1 := Canonical_Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is found in several source directories", "{ is found in several source directories",
...@@ -5306,7 +5395,7 @@ package body Prj.Nmsc is ...@@ -5306,7 +5395,7 @@ package body Prj.Nmsc is
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_Name_1 := NL.Name; Err_Vars.Error_Msg_File_1 := NL.Name;
if First_Error then if First_Error then
Error_Msg Error_Msg
...@@ -5427,7 +5516,7 @@ package body Prj.Nmsc is ...@@ -5427,7 +5516,7 @@ package body Prj.Nmsc is
function Suffix_For function Suffix_For
(Language : Language_Index; (Language : Language_Index;
Naming : Naming_Data; Naming : Naming_Data;
In_Tree : Project_Tree_Ref) return Name_Id In_Tree : Project_Tree_Ref) return File_Name_Type
is is
Suffix : constant Variable_Value := Suffix : constant Variable_Value :=
Value_Of Value_Of
...@@ -5452,7 +5541,7 @@ package body Prj.Nmsc is ...@@ -5452,7 +5541,7 @@ package body Prj.Nmsc is
Add_Str_To_Name_Buffer (".cpp"); Add_Str_To_Name_Buffer (".cpp");
when others => when others =>
return No_Name; return No_File;
end case; end case;
-- Otherwise use the one specified -- Otherwise use the one specified
...@@ -5491,15 +5580,13 @@ package body Prj.Nmsc is ...@@ -5491,15 +5580,13 @@ package body Prj.Nmsc is
Get_Name_String (Unit); Get_Name_String (Unit);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Unit := Name_Find; Unit := Name_Find;
The_Unit_Id := Units_Htable.Get The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
(In_Tree.Units_HT, Unit); Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
Location := In_Tree.Array_Elements.Table
(Conv).Value.Location;
if The_Unit_Id = No_Unit then if The_Unit_Id = No_Unit then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"?unknown unit {", "?unknown unit %%",
Location); Location);
else else
...@@ -5514,7 +5601,7 @@ package body Prj.Nmsc is ...@@ -5514,7 +5601,7 @@ package body Prj.Nmsc is
then then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"?source of spec of unit { ({)" & "?source of spec of unit %% (%%)" &
" cannot be found in this project", " cannot be found in this project",
Location); Location);
end if; end if;
...@@ -5526,7 +5613,7 @@ package body Prj.Nmsc is ...@@ -5526,7 +5613,7 @@ package body Prj.Nmsc is
then then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"?source of body of unit { ({)" & "?source of body of unit %% (%%)" &
" cannot be found in this project", " cannot be found in this project",
Location); Location);
end if; end if;
......
gcc/ada/prj.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -31,6 +31,7 @@ ...@@ -31,6 +31,7 @@
-- See in particular Prj.Pars and Prj.Env. -- See in particular Prj.Pars and Prj.Env.
with Casing; use Casing; with Casing; use Casing;
with Namet; use Namet;
with Scans; use Scans; with Scans; use Scans;
with Table; with Table;
with Types; use Types; with Types; use Types;
...@@ -54,17 +55,17 @@ package Prj is ...@@ -54,17 +55,17 @@ package Prj is
No_Project_Tree : constant Project_Tree_Ref; No_Project_Tree : constant Project_Tree_Ref;
function Default_Ada_Spec_Suffix return Name_Id; function Default_Ada_Spec_Suffix return File_Name_Type;
pragma Inline (Default_Ada_Spec_Suffix); pragma Inline (Default_Ada_Spec_Suffix);
-- The Name_Id for the standard GNAT suffix for Ada spec source file -- The Name_Id for the standard GNAT suffix for Ada spec source file
-- name ".ads". Initialized by Prj.Initialize. -- name ".ads". Initialized by Prj.Initialize.
function Default_Ada_Body_Suffix return Name_Id; function Default_Ada_Body_Suffix return File_Name_Type;
pragma Inline (Default_Ada_Body_Suffix); pragma Inline (Default_Ada_Body_Suffix);
-- The Name_Id for the standard GNAT suffix for Ada body source file -- The Name_Id for the standard GNAT suffix for Ada body source file
-- name ".adb". Initialized by Prj.Initialize. -- name ".adb". Initialized by Prj.Initialize.
function Slash return Name_Id; function Slash return File_Name_Type;
pragma Inline (Slash); pragma Inline (Slash);
-- "/", used as the path of locally removed files -- "/", used as the path of locally removed files
...@@ -82,6 +83,9 @@ package Prj is ...@@ -82,6 +83,9 @@ package Prj is
-- - Warning: issue a warning, does not cause the tool to fail -- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail -- - Error: issue an error, causes the tool to fail
type Yes_No_Unknown is (Yes, No, Unknown);
-- Tri-state to decide if -lgnarl is needed when linking
----------------------------------------------------- -----------------------------------------------------
-- Multi-language Stuff That Will be Modified Soon -- -- Multi-language Stuff That Will be Modified Soon --
----------------------------------------------------- -----------------------------------------------------
...@@ -111,6 +115,7 @@ package Prj is ...@@ -111,6 +115,7 @@ package Prj is
function Hash is new System.HTable.Hash (Header_Num => Header_Num); function Hash is new System.HTable.Hash (Header_Num => Header_Num);
function Hash (Name : Name_Id) return Header_Num; function Hash (Name : Name_Id) return Header_Num;
function Hash (Name : File_Name_Type) return Header_Num;
package Language_Indexes is new System.HTable.Simple_HTable package Language_Indexes is new System.HTable.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
...@@ -158,16 +163,16 @@ package Prj is ...@@ -158,16 +163,16 @@ package Prj is
-- The table for the presence of languages with an index that is outside -- The table for the presence of languages with an index that is outside
-- of First_Language_Indexes. -- of First_Language_Indexes.
type Impl_Suffix_Array is array (First_Language_Indexes) of Name_Id; type Impl_Suffix_Array is array (First_Language_Indexes) of File_Name_Type;
-- Suffixes for the non spec sources of the different supported languages -- Suffixes for the non spec sources of the different supported languages
-- in a project. -- in a project.
No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_Name); No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_File);
-- A default value for the non spec source suffixes -- A default value for the non spec source suffixes
type Supp_Suffix is record type Supp_Suffix is record
Index : Language_Index := No_Language_Index; Index : Language_Index := No_Language_Index;
Suffix : Name_Id := No_Name; Suffix : File_Name_Type := No_File;
Next : Supp_Language_Index := No_Supp_Language_Index; Next : Supp_Language_Index := No_Supp_Language_Index;
end record; end record;
...@@ -247,14 +252,14 @@ package Prj is ...@@ -247,14 +252,14 @@ package Prj is
type Other_Source is record type Other_Source is record
Language : Language_Index; -- language of the source Language : Language_Index; -- language of the source
File_Name : Name_Id; -- source file simple name File_Name : File_Name_Type; -- source file simple name
Path_Name : Name_Id; -- source full path name Path_Name : Path_Name_Type; -- source full path name
Source_TS : Time_Stamp_Type; -- source file time stamp Source_TS : Time_Stamp_Type; -- source file time stamp
Object_Name : Name_Id; -- object file simple name Object_Name : File_Name_Type; -- object file simple name
Object_Path : Name_Id; -- object full path name Object_Path : Path_Name_Type; -- object full path name
Object_TS : Time_Stamp_Type; -- object file time stamp Object_TS : Time_Stamp_Type; -- object file time stamp
Dep_Name : Name_Id; -- dependency file simple name Dep_Name : File_Name_Type; -- dependency file simple name
Dep_Path : Name_Id; -- dependency full path name Dep_Path : Path_Name_Type; -- dependency full path name
Dep_TS : Time_Stamp_Type; -- dependency file time stamp Dep_TS : Time_Stamp_Type; -- dependency file time stamp
Naming_Exception : Boolean := False; -- True if a naming exception Naming_Exception : Boolean := False; -- True if a naming exception
Next : Other_Source_Id := No_Other_Source; Next : Other_Source_Id := No_Other_Source;
...@@ -283,13 +288,14 @@ package Prj is ...@@ -283,13 +288,14 @@ package Prj is
-- The current value of the verbosity the project files are parsed with -- The current value of the verbosity the project files are parsed with
type Lib_Kind is (Static, Dynamic, Relocatable); type Lib_Kind is (Static, Dynamic, Relocatable);
type Policy is (Autonomous, Compliant, Controlled, Restricted); type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);
-- Type to specify the symbol policy, when symbol control is supported. -- Type to specify the symbol policy, when symbol control is supported.
-- See full explanation about this type in package Symbols. -- See full explanation about this type in package Symbols.
-- Autonomous: Create a symbol file without considering any reference -- Autonomous: Create a symbol file without considering any reference
-- Compliant: Try to be as compatible as possible with an existing ref -- Compliant: Try to be as compatible as possible with an existing ref
-- Controlled: Fail if symbols are not the same as those in the reference -- Controlled: Fail if symbols are not the same as those in the reference
-- Restricted: Restrict the symbols to those in the symbol file -- Restricted: Restrict the symbols to those in the symbol file
-- Direct: The symbol file is used as is
type Symbol_Record is record type Symbol_Record is record
Symbol_File : Name_Id := No_Name; Symbol_File : Name_Id := No_Name;
...@@ -322,7 +328,7 @@ package Prj is ...@@ -322,7 +328,7 @@ package Prj is
Next : String_List_Id := Nil_String; Next : String_List_Id := Nil_String;
end record; end record;
-- To hold values for string list variables and array elements. -- To hold values for string list variables and array elements.
-- Component Flag may be used for various purposes. For source -- The component Flag may be used for various purposes. For source
-- directories, it indicates if the directory contains Ada source(s). -- directories, it indicates if the directory contains Ada source(s).
package String_Element_Table is new GNAT.Dynamic_Tables package String_Element_Table is new GNAT.Dynamic_Tables
...@@ -464,7 +470,7 @@ package Prj is ...@@ -464,7 +470,7 @@ package Prj is
type Naming_Data is record type Naming_Data is record
Dot_Replacement : Name_Id := No_Name; Dot_Replacement : File_Name_Type := No_File;
-- The string to replace '.' in the source file name (for Ada) -- The string to replace '.' in the source file name (for Ada)
Dot_Repl_Loc : Source_Ptr := No_Location; Dot_Repl_Loc : Source_Ptr := No_Location;
...@@ -479,7 +485,7 @@ package Prj is ...@@ -479,7 +485,7 @@ package Prj is
-- source file name of a spec. -- source file name of a spec.
-- Indexed by the programming language. -- Indexed by the programming language.
Ada_Spec_Suffix : Name_Id := No_Name; Ada_Spec_Suffix : File_Name_Type := No_File;
-- The suffix of the Ada spec sources -- The suffix of the Ada spec sources
Spec_Suffix_Loc : Source_Ptr := No_Location; Spec_Suffix_Loc : Source_Ptr := No_Location;
...@@ -495,14 +501,14 @@ package Prj is ...@@ -495,14 +501,14 @@ package Prj is
-- source file name of a body. -- source file name of a body.
-- Indexed by the programming language. -- Indexed by the programming language.
Ada_Body_Suffix : Name_Id := No_Name; Ada_Body_Suffix : File_Name_Type := No_File;
-- The suffix of the Ada body sources -- The suffix of the Ada body sources
Body_Suffix_Loc : Source_Ptr := No_Location; Body_Suffix_Loc : Source_Ptr := No_Location;
-- The position in the project file source where -- The position in the project file source where
-- Ada_Body_Suffix is defined. -- Ada_Body_Suffix is defined.
Separate_Suffix : Name_Id := No_Name; Separate_Suffix : File_Name_Type := No_File;
-- String to append to unit name for source file name of an Ada subunit -- String to append to unit name for source file name of an Ada subunit
Sep_Suffix_Loc : Source_Ptr := No_Location; Sep_Suffix_Loc : Source_Ptr := No_Location;
...@@ -577,10 +583,10 @@ package Prj is ...@@ -577,10 +583,10 @@ package Prj is
-- The name of the project with the spelling of its declaration. -- The name of the project with the spelling of its declaration.
-- Set by Prj.Proc.Process. -- Set by Prj.Proc.Process.
Path_Name : Name_Id := No_Name; Path_Name : Path_Name_Type := No_Path;
-- The path name of the project file. Set by Prj.Proc.Process -- The path name of the project file. Set by Prj.Proc.Process
Display_Path_Name : Name_Id := No_Name; Display_Path_Name : Path_Name_Type := No_Path;
-- The path name used for display purposes. May be different from -- The path name used for display purposes. May be different from
-- Path_Name for platforms where the file names are case-insensitive. -- Path_Name for platforms where the file names are case-insensitive.
...@@ -594,11 +600,12 @@ package Prj is ...@@ -594,11 +600,12 @@ package Prj is
Mains : String_List_Id := Nil_String; Mains : String_List_Id := Nil_String;
-- List of mains specified by attribute Main. Set by Prj.Nmsc.Check -- List of mains specified by attribute Main. Set by Prj.Nmsc.Check
Directory : Name_Id := No_Name; Directory : Path_Name_Type := No_Path;
-- Directory where the project file resides. Set by Prj.Proc.Process -- Directory where the project file resides. Set by Prj.Proc.Process
Display_Directory : Name_Id := No_Name; Display_Directory : Path_Name_Type := No_Path;
-- comment ??? -- Project directory path name for display purposes. May be different
-- from Directory for platforms where file names are case-insensitive.
Dir_Path : String_Access; Dir_Path : String_Access;
-- Same as Directory, but as an access to String. Set by -- Same as Directory, but as an access to String. Set by
...@@ -608,11 +615,11 @@ package Prj is ...@@ -608,11 +615,11 @@ package Prj is
-- True if this is a library project. Set by -- True if this is a library project. Set by
-- Prj.Nmsc.Language_Independent_Check. -- Prj.Nmsc.Language_Independent_Check.
Library_Dir : Name_Id := No_Name; Library_Dir : Path_Name_Type := No_Path;
-- If a library project, directory where resides the library Set by -- If a library project, directory where the library Set by
-- Prj.Nmsc.Language_Independent_Check. -- Prj.Nmsc.Language_Independent_Check.
Display_Library_Dir : Name_Id := No_Name; Display_Library_Dir : Path_Name_Type := No_Path;
-- The name of the library directory, for display purposes. May be -- The name of the library directory, for display purposes. May be
-- different from Library_Dir for platforms where the file names are -- different from Library_Dir for platforms where the file names are
-- case-insensitive. -- case-insensitive.
...@@ -621,28 +628,28 @@ package Prj is ...@@ -621,28 +628,28 @@ package Prj is
-- The timestamp of a library file in a library project. -- The timestamp of a library file in a library project.
-- Set by MLib.Prj.Check_Library. -- Set by MLib.Prj.Check_Library.
Library_Src_Dir : Name_Id := No_Name; Library_Src_Dir : Path_Name_Type := No_Path;
-- If a Stand-Alone Library project, directory where the sources -- If a Stand-Alone Library project, directory where the sources
-- of the interfaces of the library are copied. By default, if -- of the interfaces of the library are copied. By default, if
-- attribute Library_Src_Dir is not specified, sources of the interfaces -- attribute Library_Src_Dir is not specified, sources of the interfaces
-- are not copied anywhere. Set by Prj.Nmsc.Check_Stand_Alone_Library. -- are not copied anywhere. Set by Prj.Nmsc.Check_Stand_Alone_Library.
Display_Library_Src_Dir : Name_Id := No_Name; Display_Library_Src_Dir : Path_Name_Type := No_Path;
-- The name of the library source directory, for display purposes. -- The name of the library source directory, for display purposes.
-- May be different from Library_Src_Dir for platforms where the file -- May be different from Library_Src_Dir for platforms where the file
-- names are case-insensitive. -- names are case-insensitive.
Library_ALI_Dir : Name_Id := No_Name; Library_ALI_Dir : Path_Name_Type := No_Path;
-- In a library project, directory where the ALI files are copied. -- In a library project, directory where the ALI files are copied.
-- If attribute Library_ALI_Dir is not specified, ALI files are -- If attribute Library_ALI_Dir is not specified, ALI files are
-- copied in the Library_Dir. Set by Prj.Nmsc.Check_Library_Attributes. -- copied in the Library_Dir. Set by Prj.Nmsc.Check_Library_Attributes.
Display_Library_ALI_Dir : Name_Id := No_Name; Display_Library_ALI_Dir : Path_Name_Type := No_Path;
-- The name of the library ALI directory, for display purposes. May be -- The name of the library ALI directory, for display purposes. May be
-- different from Library_ALI_Dir for platforms where the file names are -- different from Library_ALI_Dir for platforms where the file names are
-- case-insensitive. -- case-insensitive.
Library_Name : Name_Id := No_Name; Library_Name : File_Name_Type := No_File;
-- If a library project, name of the library -- If a library project, name of the library
-- Set by Prj.Nmsc.Language_Independent_Check. -- Set by Prj.Nmsc.Language_Independent_Check.
...@@ -650,7 +657,7 @@ package Prj is ...@@ -650,7 +657,7 @@ package Prj is
-- If a library project, kind of library -- If a library project, kind of library
-- Set by Prj.Nmsc.Language_Independent_Check. -- Set by Prj.Nmsc.Language_Independent_Check.
Lib_Internal_Name : Name_Id := No_Name; Lib_Internal_Name : File_Name_Type := No_File;
-- If a library project, internal name store inside the library Set by -- If a library project, internal name store inside the library Set by
-- Prj.Nmsc.Language_Independent_Check. -- Prj.Nmsc.Language_Independent_Check.
...@@ -666,6 +673,9 @@ package Prj is ...@@ -666,6 +673,9 @@ package Prj is
-- For non static Standalone Library Project Files, indicate if -- For non static Standalone Library Project Files, indicate if
-- the library initialisation should be automatic. -- the library initialisation should be automatic.
Libgnarl_Needed : Yes_No_Unknown := Unknown;
-- Set to True when libgnarl is needed to link
Symbol_Data : Symbol_Record := No_Symbols; Symbol_Data : Symbol_Record := No_Symbols;
-- Symbol file name, reference symbol file name, symbol policy -- Symbol file name, reference symbol file name, symbol policy
...@@ -707,20 +717,20 @@ package Prj is ...@@ -707,20 +717,20 @@ package Prj is
-- the ordering of the source subdirs depend on the OS. If True, -- the ordering of the source subdirs depend on the OS. If True,
-- duplicate file names in the same project file are allowed. -- duplicate file names in the same project file are allowed.
Object_Directory : Name_Id := No_Name; Object_Directory : Path_Name_Type := No_Path;
-- The object directory of this project file. -- The object directory of this project file.
-- Set by Prj.Nmsc.Language_Independent_Check. -- Set by Prj.Nmsc.Language_Independent_Check.
Display_Object_Dir : Name_Id := No_Name; Display_Object_Dir : Path_Name_Type := No_Path;
-- The name of the object directory, for display purposes. -- The name of the object directory, for display purposes.
-- May be different from Object_Directory for platforms where the file -- May be different from Object_Directory for platforms where the file
-- names are case-insensitive. -- names are case-insensitive.
Exec_Directory : Name_Id := No_Name; Exec_Directory : Path_Name_Type := No_Path;
-- The exec directory of this project file. Default is equal to -- The exec directory of this project file. Default is equal to
-- Object_Directory. Set by Prj.Nmsc.Language_Independent_Check. -- Object_Directory. Set by Prj.Nmsc.Language_Independent_Check.
Display_Exec_Dir : Name_Id := No_Name; Display_Exec_Dir : Path_Name_Type := No_Path;
-- The name of the exec directory, for display purposes. May be -- The name of the exec directory, for display purposes. May be
-- different from Exec_Directory for platforms where the file names are -- different from Exec_Directory for platforms where the file names are
-- case-insensitive. -- case-insensitive.
...@@ -744,8 +754,8 @@ package Prj is ...@@ -744,8 +754,8 @@ package Prj is
Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index; Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index;
-- Comment needed -- Comment needed
Default_Linker : Name_Id := No_Name; Default_Linker : File_Name_Type := No_File;
Default_Linker_Path : Name_Id := No_Name; Default_Linker_Path : Path_Name_Type := No_Path;
Decl : Declarations := No_Declarations; Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages) of this -- The declarations (variables, attributes and packages) of this
...@@ -769,19 +779,19 @@ package Prj is ...@@ -769,19 +779,19 @@ package Prj is
-- use this field directly outside of the compiler, use -- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Objects_Path instead. Set by Prj.Env.Ada_Objects_Path -- Prj.Env.Ada_Objects_Path instead. Set by Prj.Env.Ada_Objects_Path
Include_Path_File : Name_Id := No_Name; Include_Path_File : Path_Name_Type := No_Path;
-- The cached value of the source path temp file for this project file. -- The cached value of the source path temp file for this project file.
-- Set by gnatmake (Prj.Env.Set_Ada_Paths). -- Set by gnatmake (Prj.Env.Set_Ada_Paths).
Objects_Path_File_With_Libs : Name_Id := No_Name; Objects_Path_File_With_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (including library -- The cached value of the object path temp file (including library
-- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths). -- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths).
Objects_Path_File_Without_Libs : Name_Id := No_Name; Objects_Path_File_Without_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (excluding library -- The cached value of the object path temp file (excluding library
-- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths). -- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths).
Config_File_Name : Name_Id := No_Name; Config_File_Name : Path_Name_Type := No_Path;
-- The name of the configuration pragmas file, if any. -- The name of the configuration pragmas file, if any.
-- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File). -- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File).
...@@ -818,7 +828,6 @@ package Prj is ...@@ -818,7 +828,6 @@ package Prj is
Unkept_Comments : Boolean := False; Unkept_Comments : Boolean := False;
-- True if there are comments in the project sources that cannot -- True if there are comments in the project sources that cannot
-- be kept in the project tree. -- be kept in the project tree.
end record; end record;
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data; function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
...@@ -840,11 +849,11 @@ package Prj is ...@@ -840,11 +849,11 @@ package Prj is
(Specification, Body_Part); (Specification, Body_Part);
type File_Name_Data is record type File_Name_Data is record
Name : Name_Id := No_Name; Name : File_Name_Type := No_File;
Index : Int := 0; Index : Int := 0;
Display_Name : Name_Id := No_Name; Display_Name : File_Name_Type := No_File;
Path : Name_Id := No_Name; Path : File_Name_Type := No_File;
Display_Path : Name_Id := No_Name; Display_Path : File_Name_Type := No_File;
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False; Needs_Pragma : Boolean := False;
end record; end record;
...@@ -889,7 +898,7 @@ package Prj is ...@@ -889,7 +898,7 @@ package Prj is
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Unit_Project, Element => Unit_Project,
No_Element => No_Unit_Project, No_Element => No_Unit_Project,
Key => Name_Id, Key => File_Name_Type,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Mapping of file names to indexes in the Units table -- Mapping of file names to indexes in the Units table
...@@ -938,8 +947,8 @@ package Prj is ...@@ -938,8 +947,8 @@ package Prj is
procedure Register_Default_Naming_Scheme procedure Register_Default_Naming_Scheme
(Language : Name_Id; (Language : Name_Id;
Default_Spec_Suffix : Name_Id; Default_Spec_Suffix : File_Name_Type;
Default_Body_Suffix : Name_Id; Default_Body_Suffix : File_Name_Type;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
-- Register the default suffixes for a given language. These extensions -- Register the default suffixes for a given language. These extensions
-- will be ignored if the user has specified a new naming scheme in a -- will be ignored if the user has specified a new naming scheme in a
...@@ -1003,12 +1012,12 @@ package Prj is ...@@ -1003,12 +1012,12 @@ package Prj is
function Suffix_Of function Suffix_Of
(Language : Language_Index; (Language : Language_Index;
In_Project : Project_Data; In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Name_Id; In_Tree : Project_Tree_Ref) return File_Name_Type;
-- Return the suffix for language Language in project In_Project. Return -- Return the suffix for language Language in project In_Project. Return
-- No_Name when no suffix is defined for the language. -- No_Name when no suffix is defined for the language.
procedure Set procedure Set
(Suffix : Name_Id; (Suffix : File_Name_Type;
For_Language : Language_Index; For_Language : Language_Index;
In_Project : in out Project_Data; In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
...@@ -1053,7 +1062,7 @@ private ...@@ -1053,7 +1062,7 @@ private
-- Comment ??? -- Comment ???
package Path_File_Table is new GNAT.Dynamic_Tables package Path_File_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Id, (Table_Component_Type => Path_Name_Type,
Table_Index_Type => Natural, Table_Index_Type => Natural,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 50, Table_Initial => 50,
...@@ -1062,7 +1071,7 @@ private ...@@ -1062,7 +1071,7 @@ private
-- Used by Delete_All_Path_Files. -- Used by Delete_All_Path_Files.
package Source_Path_Table is new GNAT.Dynamic_Tables package Source_Path_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Id, (Table_Component_Type => File_Name_Type,
Table_Index_Type => Natural, Table_Index_Type => Natural,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 50, Table_Initial => 50,
...@@ -1070,7 +1079,7 @@ private ...@@ -1070,7 +1079,7 @@ private
-- A table to store the source dirs before creating the source path file -- A table to store the source dirs before creating the source path file
package Object_Path_Table is new GNAT.Dynamic_Tables package Object_Path_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Id, (Table_Component_Type => Path_Name_Type,
Table_Index_Type => Natural, Table_Index_Type => Natural,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 50, Table_Initial => 50,
......
gcc/ada/symbols-vms.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2003-2005 Free Software Foundation, Inc. -- -- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -176,7 +176,7 @@ package body Symbols is ...@@ -176,7 +176,7 @@ package body Symbols is
if Sym_Policy /= Autonomous then if Sym_Policy /= Autonomous then
case Sym_Policy is case Sym_Policy is
when Autonomous => when Autonomous | Direct =>
null; null;
when Compliant | Controlled => when Compliant | Controlled =>
......
gcc/ada/symbols.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2003-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,7 +29,8 @@ ...@@ -29,7 +29,8 @@
-- several implementations of the body. -- several implementations of the body.
with GNAT.Dynamic_Tables; with GNAT.Dynamic_Tables;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with System.OS_Lib; use System.OS_Lib;
package Symbols is package Symbols is
...@@ -47,10 +48,13 @@ package Symbols is ...@@ -47,10 +48,13 @@ package Symbols is
Controlled, Controlled,
-- Fail if symbols are not the same as those in the reference file -- Fail if symbols are not the same as those in the reference file
Restricted); Restricted,
-- Restrict the symbols to those in the symbol file. Fail if some -- Restrict the symbols to those in the symbol file. Fail if some
-- symbols in the symbol file are not exported from the object files. -- symbols in the symbol file are not exported from the object files.
Direct);
-- The reference symbol file is copied to the symbol file
type Symbol_Kind is (Data, Proc); type Symbol_Kind is (Data, Proc);
-- To distinguish between the different kinds of symbols -- To distinguish between the different kinds of symbols
......
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