Skip to content

R
riscv-gcc-1
Commit 104e4daa by Vincent Celier Committed by Arnaud Charlet
Options

clean.adb (Check_Project): Look for Ada code in extending project, even if Ada… 

clean.adb (Check_Project): Look for Ada code in extending project, even if Ada is not specified as a language.

2005-11-14  Vincent Celier  <celier@adacore.com>

	* clean.adb (Check_Project): Look for Ada code in extending project,
	even if Ada is not specified as a language.
	Use new function DLL_Prefix for DLL_Name
	(Clean_Interface_Copy_Directory): New procedure
	(Clean_Library_Directory): New procedure
	(Clean_Directory): Remove procedure, no longer used
	(Clean_Project): Do not delete any file in an externally built project

	* prj-env.adb (Set_Ada_Paths.Add.Recursive_Add): Add the object
	directory of an extending project, even when there are no Ada source
	present.
	(Ada_Objects_Path.Add): Add Library_ALI_Dir, not Library_Dir to the path
	(Set_Ada_Paths.Add.Recursive_Add): Ditto

	* mlib-prj.adb (Check_Library): For all library projects, get the
	library file timestamp.
	(Build_Library): Copy ALI files in Library_ALI_Dir, not in Library_Dir
	(Build_Library): Use new function DLL_Prefix for the DLL_Name
	(Clean): Remove procedure, no longer used
	(Ultimate_Extension_Of): New function
	(Build_Library): When cleaning the library directory, only remove an
	existing library file and any ALI file of a source of the project.
	When cleaning the interface copy directory, remove any source that
	could be a source of the project.

	* prj.ads, prj.adb (Project_Empty): Add values of new components
	Library_TS and All_Imported_Projects.
	(Project_Empty): Add values for new components of Project_Data:
	Library_ALI_Dir and Display_Library_ALI_Dir

	* prj-attr.adb: New project level attribute name Library_ALI_Dir

	* prj-nmsc.adb (Check_Library_Attributes): Take into account new
	attribute Library_ALI_Dir.
	(Check_Library_Attributes): The library directory cannot be the same as
	any source directory of the project tree.
	(Check_Stand_Alone_Library): The interface copy directory cannot be
	the same as any source directory of the project tree.

	* mlib.adb: Use Prj.Com.Fail, instead of Osint.Fail directly, to delete
	all temporary files.

From-SVN: r106967
parent f9f7e102
Showing with 1133 additions and 446 deletions
gcc/ada/clean.adb
...@@ -24,8 +24,6 @@ ...@@ -24,8 +24,6 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Command_Line; use Ada.Command_Line;
with ALI; use ALI; with ALI; use ALI;
with Csets; with Csets;
with Gnatvsn; with Gnatvsn;
...@@ -45,6 +43,8 @@ with Snames; ...@@ -45,6 +43,8 @@ with Snames;
with Table; with Table;
with Types; use Types; with Types; use Types;
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.IO; use GNAT.IO; with GNAT.IO; use GNAT.IO;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
...@@ -191,13 +191,17 @@ package body Clean is ...@@ -191,13 +191,17 @@ package body Clean is
-- Delete a global archive or a fake library project archive and the -- Delete a global archive or a fake library project archive and the
-- dependency file, if they exist. -- dependency file, if they exist.
procedure Clean_Directory (Dir : Name_Id);
-- Delete all regular files in a library directory or in a library
-- interface dir.
procedure Clean_Executables; procedure Clean_Executables;
-- Do the cleaning work when no project file is specified -- Do the cleaning work when no project file is specified
procedure Clean_Interface_Copy_Directory (Project : Project_Id);
-- Delete files in an interface coy directory directory: any file that is
-- a copy of a source of the project.
procedure Clean_Library_Directory (Project : Project_Id);
-- Delete the library file in a library directory and any ALI file
-- of a source of the project in a library ALI directory.
procedure Clean_Project (Project : Project_Id); procedure Clean_Project (Project : Project_Id);
-- Do the cleaning work when a project file is specified. -- Do the cleaning work when a project file is specified.
-- This procedure calls itself recursively when there are several -- This procedure calls itself recursively when there are several
...@@ -241,6 +245,11 @@ package body Clean is ...@@ -241,6 +245,11 @@ package body Clean is
-- Returns True iff Prj is an extension of Of_Project or if Of_Project is -- Returns True iff Prj is an extension of Of_Project or if Of_Project is
-- an extension of Prj. -- an extension of Prj.
function Ultimate_Extension_Of (Project : Project_Id) return Project_Id;
-- Returns either Project, if it is not extended by another project, or
-- the project that extends Project, directly or indirectly, and that is
-- not itself extended. Returns No_Project if Project is No_Project.
procedure Usage; procedure Usage;
-- Display the usage. -- Display the usage.
-- If called several times, the usage is displayed only the first time. -- If called several times, the usage is displayed only the first time.
...@@ -356,46 +365,6 @@ package body Clean is ...@@ -356,46 +365,6 @@ package body Clean is
Change_Dir (Current_Dir); Change_Dir (Current_Dir);
end Clean_Archive; end Clean_Archive;
---------------------
-- Clean_Directory --
---------------------
procedure Clean_Directory (Dir : Name_Id) is
Directory : constant String := Get_Name_String (Dir);
Current : constant Dir_Name_Str := Get_Current_Dir;
Direc : Dir_Type;
Name : String (1 .. 200);
Last : Natural;
begin
Change_Dir (Directory);
Open (Direc, ".");
-- For each regular file in the directory, if switch -n has not been
-- specified, make it writable and delete the file.
loop
Read (Direc, Name, Last);
exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then
if not Do_Nothing then
Set_Writable (Name (1 .. Last));
end if;
Delete (Directory, Name (1 .. Last));
end if;
end loop;
Close (Direc);
-- Restore the initial working directory
Change_Dir (Current);
end Clean_Directory;
----------------------- -----------------------
-- Clean_Executables -- -- Clean_Executables --
----------------------- -----------------------
...@@ -550,6 +519,242 @@ package body Clean is ...@@ -550,6 +519,242 @@ package body Clean is
end loop; end loop;
end Clean_Executables; end Clean_Executables;
------------------------------------
-- Clean_Interface_Copy_Directory --
------------------------------------
procedure Clean_Interface_Copy_Directory (Project : Project_Id) is
Current : constant String := Get_Current_Dir;
Data : constant Project_Data := Project_Tree.Projects.Table (Project);
Direc : Dir_Type;
Name : String (1 .. 200);
Last : Natural;
Delete_File : Boolean;
Unit : Unit_Data;
begin
if Data.Library and then Data.Library_Src_Dir /= No_Name then
declare
Directory : constant String :=
Get_Name_String (Data.Library_Src_Dir);
begin
Change_Dir (Get_Name_String (Data.Library_Src_Dir));
Open (Direc, ".");
-- For each regular file in the directory, if switch -n has not
-- been specified, make it writable and delete the file if it is
-- a copy of a source of the project.
loop
Read (Direc, Name, Last);
exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then
Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False;
-- Compare with source file names of the project
for Index in 1 .. Unit_Table.Last (Project_Tree.Units) loop
Unit := Project_Tree.Units.Table (Index);
if Ultimate_Extension_Of
(Unit.File_Names (Body_Part).Project) = Project
and then
Get_Name_String
(Unit.File_Names (Body_Part).Name) =
Name (1 .. Last)
then
Delete_File := True;
exit;
end if;
if Ultimate_Extension_Of
(Unit.File_Names (Specification).Project) = Project
and then
Get_Name_String
(Unit.File_Names (Specification).Name) =
Name (1 .. Last)
then
Delete_File := True;
exit;
end if;
end loop;
if Delete_File then
if not Do_Nothing then
Set_Writable (Name (1 .. Last));
end if;
Delete (Directory, Name (1 .. Last));
end if;
end if;
end loop;
Close (Direc);
-- Restore the initial working directory
Change_Dir (Current);
end;
end if;
end Clean_Interface_Copy_Directory;
-----------------------------
-- Clean_Library_Directory --
-----------------------------
procedure Clean_Library_Directory (Project : Project_Id) is
Current : constant String := Get_Current_Dir;
Data : constant Project_Data := Project_Tree.Projects.Table (Project);
Lib_Filename : constant String := Get_Name_String (Data.Library_Name);
DLL_Name : constant String :=
DLL_Prefix & Lib_Filename & "." & DLL_Ext;
Archive_Name : constant String :=
"lib" & Lib_Filename & "." & Archive_Ext;
Direc : Dir_Type;
Name : String (1 .. 200);
Last : Natural;
Delete_File : Boolean;
begin
if Data.Library then
declare
Lib_Directory : constant String :=
Get_Name_String (Data.Library_Dir);
Lib_ALI_Directory : constant String :=
Get_Name_String (Data.Library_ALI_Dir);
begin
Change_Dir (Lib_Directory);
Open (Direc, ".");
-- For each regular file in the directory, if switch -n has not
-- been specified, make it writable and delete the file if it is
-- the library file.
loop
Read (Direc, Name, Last);
exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then
Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False;
if (Data.Library_Kind = Static and then
Name (1 .. Last) = Archive_Name)
or else
((Data.Library_Kind = Dynamic or else
Data.Library_Kind = Relocatable)
and then
Name (1 .. Last) = DLL_Name)
then
if not Do_Nothing then
Set_Writable (Name (1 .. Last));
end if;
Delete (Lib_Directory, Name (1 .. Last));
exit;
end if;
end if;
end loop;
Close (Direc);
Change_Dir (Lib_ALI_Directory);
Open (Direc, ".");
-- For each regular file in the directory, if switch -n has not
-- been specified, make it writable and delete the file if it is
-- any ALI file of a source of the project.
loop
Read (Direc, Name, Last);
exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then
Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False;
if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
declare
Unit : Unit_Data;
begin
-- Compare with ALI file names of the project
for
Index in 1 .. Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Index);
if Unit.File_Names (Body_Part).Project /=
No_Project
then
if Ultimate_Extension_Of
(Unit.File_Names (Body_Part).Project) =
Project
then
Get_Name_String
(Unit.File_Names (Body_Part).Name);
Name_Len := Name_Len -
File_Extension
(Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) =
Name (1 .. Last - 4)
then
Delete_File := True;
exit;
end if;
end if;
elsif Ultimate_Extension_Of
(Unit.File_Names (Specification).Project) =
Project
then
Get_Name_String
(Unit.File_Names (Specification).Name);
Name_Len := Name_Len -
File_Extension
(Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) =
Name (1 .. Last - 4)
then
Delete_File := True;
exit;
end if;
end if;
end loop;
end;
end if;
if Delete_File then
if not Do_Nothing then
Set_Writable (Name (1 .. Last));
end if;
Delete (Lib_ALI_Directory, Name (1 .. Last));
end if;
end if;
end loop;
Close (Direc);
-- Restore the initial working directory
Change_Dir (Current);
end;
end if;
end Clean_Library_Directory;
------------------- -------------------
-- Clean_Project -- -- Clean_Project --
------------------- -------------------
...@@ -588,251 +793,271 @@ package body Clean is ...@@ -588,251 +793,271 @@ package body Clean is
("Cannot specify executable(s) for a Library Project File"); ("Cannot specify executable(s) for a Library Project File");
end if; end if;
if Verbose_Mode then -- Nothing to clean in an externally built project
Put ("Cleaning project """);
Put (Get_Name_String (Data.Name));
Put_Line ("""");
end if;
-- Add project to the list of processed projects if Data.Externally_Built then
if Verbose_Mode then
Put ("Nothing to do to clean externally built project """);
Put (Get_Name_String (Data.Name));
Put_Line ("""");
end if;
Processed_Projects.Increment_Last; else
Processed_Projects.Table (Processed_Projects.Last) := Project; if Verbose_Mode then
Put ("Cleaning project """);
Put (Get_Name_String (Data.Name));
Put_Line ("""");
end if;
if Data.Object_Directory /= No_Name then -- Add project to the list of processed projects
declare
Obj_Dir : constant String :=
Get_Name_String (Data.Object_Directory);
begin Processed_Projects.Increment_Last;
Change_Dir (Obj_Dir); Processed_Projects.Table (Processed_Projects.Last) := Project;
-- First, deal with Ada if Data.Object_Directory /= No_Name then
declare
Obj_Dir : constant String :=
Get_Name_String (Data.Object_Directory);
-- Look through the units to find those that are either immediate begin
-- sources or inherited sources of the project. Change_Dir (Obj_Dir);
if Data.Languages (Ada_Language_Index) then -- First, deal with Ada
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
U_Data := Project_Tree.Units.Table (Unit);
File_Name1 := No_Name;
File_Name2 := No_Name;
-- If either the spec or the body is a source of the -- Look through the units to find those that are either
-- project, check for the corresponding ALI file in the -- immediate sources or inherited sources of the project.
-- object directory. -- Extending projects may have no language specified, if
-- Source_Dirs or Source_Files is specified as an empty list,
-- so always look for Ada units in extending projects.
if In_Extension_Chain if Data.Languages (Ada_Language_Index)
(U_Data.File_Names (Body_Part).Project, Project) or else Data.Extends /= No_Project
or else then
In_Extension_Chain for Unit in Unit_Table.First ..
(U_Data.File_Names (Specification).Project, Project) Unit_Table.Last (Project_Tree.Units)
then loop
File_Name1 := U_Data.File_Names (Body_Part).Name; U_Data := Project_Tree.Units.Table (Unit);
Index1 := U_Data.File_Names (Body_Part).Index; File_Name1 := No_Name;
File_Name2 := U_Data.File_Names (Specification).Name; File_Name2 := No_Name;
Index2 := U_Data.File_Names (Specification).Index;
-- If either the spec or the body is a source of the
-- If there is no body file name, then there may be only -- project, check for the corresponding ALI file in the
-- a spec. -- object directory.
if File_Name1 = No_Name then if In_Extension_Chain
File_Name1 := File_Name2; (U_Data.File_Names (Body_Part).Project, Project)
Index1 := Index2; or else
File_Name2 := No_Name; In_Extension_Chain
Index2 := 0; (U_Data.File_Names (Specification).Project, Project)
then
File_Name1 := U_Data.File_Names (Body_Part).Name;
Index1 := U_Data.File_Names (Body_Part).Index;
File_Name2 := U_Data.File_Names (Specification).Name;
Index2 := U_Data.File_Names (Specification).Index;
-- If there is no body file name, then there may be
-- only a spec.
if File_Name1 = No_Name then
File_Name1 := File_Name2;
Index1 := Index2;
File_Name2 := No_Name;
Index2 := 0;
end if;
end if; end if;
end if;
-- If there is either a spec or a body, look for files -- If there is either a spec or a body, look for files
-- in the object directory. -- in the object directory.
if File_Name1 /= No_Name then if File_Name1 /= No_Name then
Lib_File := Osint.Lib_File_Name (File_Name1, Index1); Lib_File := Osint.Lib_File_Name (File_Name1, Index1);
declare declare
Asm : constant String := Assembly_File_Name (Lib_File); Asm : constant String :=
ALI : constant String := ALI_File_Name (Lib_File); Assembly_File_Name (Lib_File);
Obj : constant String := Object_File_Name (Lib_File); ALI : constant String :=
Adt : constant String := Tree_File_Name (Lib_File); ALI_File_Name (Lib_File);
Deb : constant String := Obj : constant String :=
Debug_File_Name (File_Name1); Object_File_Name (Lib_File);
Rep : constant String := Adt : constant String :=
Repinfo_File_Name (File_Name1); Tree_File_Name (Lib_File);
Del : Boolean := True; Deb : constant String :=
Debug_File_Name (File_Name1);
Rep : constant String :=
Repinfo_File_Name (File_Name1);
Del : Boolean := True;
begin begin
-- If the ALI file exists and is read-only, no file -- If the ALI file exists and is read-only, no file
-- is deleted. -- is deleted.
if Is_Regular_File (ALI) then if Is_Regular_File (ALI) then
if Is_Writable_File (ALI) then if Is_Writable_File (ALI) then
Delete (Obj_Dir, ALI); Delete (Obj_Dir, ALI);
else else
Del := False; Del := False;
if Verbose_Mode then if Verbose_Mode then
Put ('"'); Put ('"');
Put (Obj_Dir); Put (Obj_Dir);
if Obj_Dir (Obj_Dir'Last) /= if Obj_Dir (Obj_Dir'Last) /=
Dir_Separator Dir_Separator
then then
Put (Dir_Separator); Put (Dir_Separator);
end if; end if;
Put (ALI); Put (ALI);
Put_Line (""" is read-only"); Put_Line (""" is read-only");
end if;
end if; end if;
end if; end if;
end if;
if Del then if Del then
-- Object file -- Object file
if Is_Regular_File (Obj) then if Is_Regular_File (Obj) then
Delete (Obj_Dir, Obj); Delete (Obj_Dir, Obj);
end if; end if;
-- Assembly file -- Assembly file
if Is_Regular_File (Asm) then if Is_Regular_File (Asm) then
Delete (Obj_Dir, Asm); Delete (Obj_Dir, Asm);
end if; end if;
-- Tree file -- Tree file
if Is_Regular_File (Adt) then if Is_Regular_File (Adt) then
Delete (Obj_Dir, Adt); Delete (Obj_Dir, Adt);
end if; end if;
-- First expanded source file -- First expanded source file
if Is_Regular_File (Deb) then if Is_Regular_File (Deb) then
Delete (Obj_Dir, Deb); Delete (Obj_Dir, Deb);
end if; end if;
-- Repinfo file -- Repinfo file
if Is_Regular_File (Rep) then if Is_Regular_File (Rep) then
Delete (Obj_Dir, Rep); Delete (Obj_Dir, Rep);
end if; end if;
-- Second expanded source file -- Second expanded source file
if File_Name2 /= No_Name then
declare
Deb : constant String :=
Debug_File_Name (File_Name2);
Rep : constant String :=
Repinfo_File_Name (File_Name2);
begin
if Is_Regular_File (Deb) then
Delete (Obj_Dir, Deb);
end if;
if Is_Regular_File (Rep) then if File_Name2 /= No_Name then
Delete (Obj_Dir, Rep); declare
end if; Deb : constant String :=
end; Debug_File_Name (File_Name2);
Rep : constant String :=
Repinfo_File_Name (File_Name2);
begin
if Is_Regular_File (Deb) then
Delete (Obj_Dir, Deb);
end if;
if Is_Regular_File (Rep) then
Delete (Obj_Dir, Rep);
end if;
end;
end if;
end if; end if;
end if; end;
end; end if;
end if; end loop;
end loop; end if;
end if;
-- Check if a global archive and it dependency file could have -- Check if a global archive and it dependency file could have
-- been created and, if they exist, delete them. -- been created and, if they exist, delete them.
if Project = Main_Project and then not Data.Library then if Project = Main_Project and then not Data.Library then
Global_Archive := False; Global_Archive := False;
for Proj in Project_Table.First .. for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects) Project_Table.Last (Project_Tree.Projects)
loop loop
if Project_Tree.Projects.Table if Project_Tree.Projects.Table
(Proj).Other_Sources_Present (Proj).Other_Sources_Present
then then
Global_Archive := True; Global_Archive := True;
exit; exit;
end if; end if;
end loop; end loop;
if Global_Archive then if Global_Archive then
Clean_Archive (Project); Clean_Archive (Project);
end if;
end if; end if;
end if;
if Data.Other_Sources_Present then
-- There is non-Ada code: delete the object files and if Data.Other_Sources_Present then
-- the dependency files if they exist.
Source_Id := Data.First_Other_Source; -- There is non-Ada code: delete the object files and
-- the dependency files if they exist.
while Source_Id /= No_Other_Source loop Source_Id := Data.First_Other_Source;
Source := while Source_Id /= No_Other_Source loop
Project_Tree.Other_Sources.Table (Source_Id); Source :=
Project_Tree.Other_Sources.Table (Source_Id);
if Is_Regular_File if Is_Regular_File
(Get_Name_String (Source.Object_Name)) (Get_Name_String (Source.Object_Name))
then then
Delete (Obj_Dir, Get_Name_String (Source.Object_Name)); Delete (Obj_Dir, Get_Name_String (Source.Object_Name));
end if; end if;
if Is_Regular_File (Get_Name_String (Source.Dep_Name)) then if
Delete (Obj_Dir, Get_Name_String (Source.Dep_Name)); Is_Regular_File (Get_Name_String (Source.Dep_Name))
end if; then
Delete (Obj_Dir, Get_Name_String (Source.Dep_Name));
end if;
Source_Id := Source.Next; Source_Id := Source.Next;
end loop; end loop;
-- If it is a library with only non Ada sources, delete -- If it is a library with only non Ada sources, delete
-- the fake archive and the dependency file, if they exist. -- the fake archive and the dependency file, if they exist.
if Data.Library if Data.Library
and then not Data.Languages (Ada_Language_Index) and then not Data.Languages (Ada_Language_Index)
then then
Clean_Archive (Project); Clean_Archive (Project);
end if;
end if; end if;
end if; end;
end; end if;
end if;
-- If this is a library project, clean the library directory, the -- If this is a library project, clean the library directory, the
-- interface copy dir and, for a Stand-Alone Library, the binder -- interface copy dir and, for a Stand-Alone Library, the binder
-- generated files of the library. -- generated files of the library.
-- The directories are cleaned only if switch -c is not specified -- The directories are cleaned only if switch -c is not specified
if Data.Library then if Data.Library then
if not Compile_Only then if not Compile_Only then
Clean_Directory (Data.Library_Dir); Clean_Library_Directory (Project);
if Data.Library_Src_Dir /= No_Name then
Clean_Interface_Copy_Directory (Project);
end if;
end if;
if Data.Library_Src_Dir /= No_Name if Data.Standalone_Library and then
and then Data.Library_Src_Dir /= Data.Library_Dir Data.Object_Directory /= No_Name
then then
Clean_Directory (Data.Library_Src_Dir); Delete_Binder_Generated_Files
(Get_Name_String (Data.Object_Directory), Data.Library_Name);
end if; end if;
end if; end if;
if Data.Standalone_Library and then if Verbose_Mode then
Data.Object_Directory /= No_Name New_Line;
then
Delete_Binder_Generated_Files
(Get_Name_String (Data.Object_Directory), Data.Library_Name);
end if; end if;
end if; end if;
if Verbose_Mode then
New_Line;
end if;
-- If switch -r is specified, call Clean_Project recursively for the -- If switch -r is specified, call Clean_Project recursively for the
-- imported projects and the project being extended. -- imported projects and the project being extended.
...@@ -1610,6 +1835,26 @@ package body Clean is ...@@ -1610,6 +1835,26 @@ package body Clean is
return Src & Tree_Suffix; return Src & Tree_Suffix;
end Tree_File_Name; end Tree_File_Name;
---------------------------
-- Ultimate_Extension_Of --
---------------------------
function Ultimate_Extension_Of (Project : Project_Id) return Project_Id is
Result : Project_Id := Project;
Data : Project_Data;
begin
if Project /= No_Project then
loop
Data := Project_Tree.Projects.Table (Result);
exit when Data.Extended_By = No_Project;
Result := Data.Extended_By;
end loop;
end if;
return Result;
end Ultimate_Extension_Of;
----------- -----------
-- Usage -- -- Usage --
----------- -----------
......
gcc/ada/mlib-prj.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2005, Ada Core Technologies, Inc. -- -- Copyright (C) 2001-2005, AdaCore --
-- -- -- --
-- 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- --
...@@ -139,7 +139,7 @@ package body MLib.Prj is ...@@ -139,7 +139,7 @@ package body MLib.Prj is
Table_Initial => 50, Table_Initial => 50,
Table_Increment => 100); Table_Increment => 100);
-- List of options set in the command line. -- List of options set in the command line
Options : Argument_List_Access; Options : Argument_List_Access;
...@@ -182,7 +182,7 @@ package body MLib.Prj is ...@@ -182,7 +182,7 @@ package body MLib.Prj is
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- The projects imported directly or indirectly. -- The projects imported directly or indirectly
package Processed_Projects is new GNAT.HTable.Simple_HTable package Processed_Projects is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
...@@ -192,7 +192,7 @@ package body MLib.Prj is ...@@ -192,7 +192,7 @@ package body MLib.Prj is
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- The library projects imported directly or indirectly. -- The library projects imported directly or indirectly
package Library_Projs is new Table.Table ( package Library_Projs is new Table.Table (
Table_Component_Type => Project_Id, Table_Component_Type => Project_Id,
...@@ -205,22 +205,18 @@ package body MLib.Prj is ...@@ -205,22 +205,18 @@ package body MLib.Prj is
type Build_Mode_State is (None, Static, Dynamic, Relocatable); type Build_Mode_State is (None, Static, Dynamic, Relocatable);
procedure Add_Argument (S : String); procedure Add_Argument (S : String);
-- Add one argument to the array Arguments. -- Add one argument to Arguments array, if array is full, double its size
-- If Arguments is full, double its size.
function ALI_File_Name (Source : String) return String; function ALI_File_Name (Source : String) return String;
-- Return the ALI file name corresponding to a source. -- Return the ALI file name corresponding to a source
procedure Check (Filename : String); procedure Check (Filename : String);
-- Check if filename is a regular file. Fail if it is not. -- Check if filename is a regular file. Fail if it is not
procedure Check_Context; procedure Check_Context;
-- Check each object files in table Object_Files -- Check each object files in table Object_Files
-- Fail if any of them is not a regular file -- Fail if any of them is not a regular file
procedure Clean (Directory : Name_Id);
-- Attempt to delete all files in Directory, but not subdirectories
procedure Copy_Interface_Sources procedure Copy_Interface_Sources
(For_Project : Project_Id; (For_Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
...@@ -244,6 +240,12 @@ package body MLib.Prj is ...@@ -244,6 +240,12 @@ package body MLib.Prj is
-- Indicate if Stand-Alone Libraries are automatically initialized using -- Indicate if Stand-Alone Libraries are automatically initialized using
-- the constructor mechanism. -- the constructor mechanism.
function Ultimate_Extension_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Project_Id;
-- Returns the Project_Id of project Project. Returns No_Project
-- if Project is No_Project.
------------------ ------------------
-- Add_Argument -- -- Add_Argument --
------------------ ------------------
...@@ -360,9 +362,6 @@ package body MLib.Prj is ...@@ -360,9 +362,6 @@ package body MLib.Prj is
-- If null, Path Option is not supported. -- If null, Path Option is not supported.
-- Not a constant so that it can be deallocated. -- Not a constant so that it can be deallocated.
Copy_Dir : Name_Id;
-- Directory where to copy ALI files and possibly interface sources
First_ALI : Name_Id := No_Name; First_ALI : Name_Id := No_Name;
-- Store the ALI file name of a source of the library (the first found) -- Store the ALI file name of a source of the library (the first found)
...@@ -1395,7 +1394,7 @@ package body MLib.Prj is ...@@ -1395,7 +1394,7 @@ package body MLib.Prj is
declare declare
DLL_Name : aliased String := DLL_Name : aliased String :=
Lib_Dirpath.all & "/lib" & Lib_Dirpath.all & '/' & DLL_Prefix &
Lib_Filename.all & "." & DLL_Ext; Lib_Filename.all & "." & DLL_Ext;
Archive_Name : aliased String := Archive_Name : aliased String :=
...@@ -1477,14 +1476,120 @@ package body MLib.Prj is ...@@ -1477,14 +1476,120 @@ package body MLib.Prj is
end; end;
end if; end if;
-- Clean the library directory, if it is also the directory where declare
-- the ALI files are copied, either because there is no interface Current_Dir : constant String := Get_Current_Dir;
-- copy directory or because the interface copy directory is the Dir : Dir_Type;
-- same as the library directory.
Name : String (1 .. 200);
Last : Natural;
Disregard : Boolean;
DLL_Name : aliased constant String :=
Lib_Filename.all & "." & DLL_Ext;
Archive_Name : aliased constant String :=
Lib_Filename.all & "." & Archive_Ext;
Delete : Boolean := False;
begin
-- Clean the library directory: remove any file with the name of
-- the library file and any ALI file of a source of the project.
begin
Get_Name_String
(In_Tree.Projects.Table (For_Project).Library_Dir);
Change_Dir (Name_Buffer (1 .. Name_Len));
exception
when others =>
Com.Fail
("unable to access library directory """,
Name_Buffer (1 .. Name_Len),
"""");
end;
Open (Dir, ".");
loop
Read (Dir, Name, Last);
exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then
Canonical_Case_File_Name (Name (1 .. Last));
Delete := False;
if (The_Build_Mode = Static and then
Name (1 .. Last) = Archive_Name)
or else
((The_Build_Mode = Dynamic or else
The_Build_Mode = Relocatable)
and then
Name (1 .. Last) = DLL_Name)
then
Delete := True;
elsif Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
declare
Unit : Unit_Data;
begin
-- Compare with ALI file names of the project
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index);
if Unit.File_Names (Body_Part).Project /=
No_Project
then
if Ultimate_Extension_Of
(Unit.File_Names (Body_Part).Project, In_Tree)
= For_Project
then
Get_Name_String
(Unit.File_Names (Body_Part).Name);
Name_Len := Name_Len -
File_Extension
(Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) =
Name (1 .. Last - 4)
then
Delete := True;
exit;
end if;
end if;
elsif Ultimate_Extension_Of
(Unit.File_Names (Specification).Project, In_Tree)
= For_Project
then
Get_Name_String
(Unit.File_Names (Specification).Name);
Name_Len := Name_Len -
File_Extension (Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) =
Name (1 .. Last - 4)
then
Delete := True;
exit;
end if;
end if;
end loop;
end;
end if;
if Delete then
Set_Writable (Name (1 .. Last));
Delete_File (Name (1 .. Last), Disregard);
end if;
end if;
end loop;
Copy_Dir := Close (Dir);
In_Tree.Projects.Table (For_Project).Library_Dir;
Clean (Copy_Dir); Change_Dir (Current_Dir);
end;
-- Call procedure to build the library, depending on the build mode -- Call procedure to build the library, depending on the build mode
...@@ -1516,7 +1621,7 @@ package body MLib.Prj is ...@@ -1516,7 +1621,7 @@ package body MLib.Prj is
end case; end case;
-- We need to copy the ALI files from the object directory to -- We need to copy the ALI files from the object directory to
-- the library directory, so that the linker find them there, -- the library ALI directory, so that the linker find them there,
-- and does not need to look in the object directory where it -- and does not need to look in the object directory where it
-- would also find the object files; and we don't want that: -- would also find the object files; and we don't want that:
-- we want the linker to use the library. -- we want the linker to use the library.
...@@ -1526,7 +1631,7 @@ package body MLib.Prj is ...@@ -1526,7 +1631,7 @@ package body MLib.Prj is
Copy_ALI_Files Copy_ALI_Files
(Files => Ali_Files.all, (Files => Ali_Files.all,
To => Copy_Dir, To => In_Tree.Projects.Table (For_Project).Library_ALI_Dir,
Interfaces => Arguments (1 .. Argument_Number)); Interfaces => Arguments (1 .. Argument_Number));
-- Copy interface sources if Library_Src_Dir specified -- Copy interface sources if Library_Src_Dir specified
...@@ -1535,23 +1640,89 @@ package body MLib.Prj is ...@@ -1535,23 +1640,89 @@ package body MLib.Prj is
and then In_Tree.Projects.Table and then In_Tree.Projects.Table
(For_Project).Library_Src_Dir /= No_Name (For_Project).Library_Src_Dir /= No_Name
then then
-- Clean the interface copy directory, if it is not also the -- Clean the interface copy directory: remove any source that
-- library directory. If it is also the library directory, it -- could be a source of the project.
-- has already been cleaned before generation of the library.
if In_Tree.Projects.Table begin
(For_Project).Library_Src_Dir /= Copy_Dir Get_Name_String
then (In_Tree.Projects.Table (For_Project).Library_Src_Dir);
Copy_Dir := In_Tree.Projects.Table Change_Dir (Name_Buffer (1 .. Name_Len));
(For_Project).Library_Src_Dir;
Clean (Copy_Dir); exception
end if; when others =>
Com.Fail
("unable to access library source copy directory """,
Name_Buffer (1 .. Name_Len),
"""");
end;
declare
Dir : Dir_Type;
Delete : Boolean;
Unit : Unit_Data;
Name : String (1 .. 200);
Last : Natural;
Disregard : Boolean;
begin
Open (Dir, ".");
loop
Read (Dir, Name, Last);
exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then
Canonical_Case_File_Name (Name (1 .. Last));
Delete := False;
-- Compare with source file names of the project
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index);
if Ultimate_Extension_Of
(Unit.File_Names (Body_Part).Project, In_Tree) =
For_Project
and then
Get_Name_String
(Unit.File_Names (Body_Part).Name) =
Name (1 .. Last)
then
Delete := True;
exit;
end if;
if Ultimate_Extension_Of
(Unit.File_Names (Specification).Project, In_Tree) =
For_Project
and then
Get_Name_String
(Unit.File_Names (Specification).Name) =
Name (1 .. Last)
then
Delete := True;
exit;
end if;
end loop;
end if;
if Delete then
Set_Writable (Name (1 .. Last));
Delete_File (Name (1 .. Last), Disregard);
end if;
end loop;
Close (Dir);
end;
Copy_Interface_Sources Copy_Interface_Sources
(For_Project => For_Project, (For_Project => For_Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Interfaces => Arguments (1 .. Argument_Number), Interfaces => Arguments (1 .. Argument_Number),
To_Dir => Copy_Dir); To_Dir => In_Tree.Projects.Table
(For_Project).Library_Src_Dir);
end if; end if;
end if; end if;
...@@ -1591,130 +1762,84 @@ package body MLib.Prj is ...@@ -1591,130 +1762,84 @@ package body MLib.Prj is
procedure Check_Library procedure Check_Library
(For_Project : Project_Id; In_Tree : Project_Tree_Ref) (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
is is
Data : constant Project_Data := Data : constant Project_Data :=
In_Tree.Projects.Table (For_Project); In_Tree.Projects.Table (For_Project);
Lib_TS : Time_Stamp_Type;
Current : constant Dir_Name_Str := Get_Current_Dir;
begin begin
-- No need to build the library if there is no object directory, -- No need to build the library if there is no object directory,
-- hence no object files to build the library. -- hence no object files to build the library.
if Data.Library if Data.Library then
and then not Data.Need_To_Build_Lib
and then Data.Object_Directory /= No_Name
then
declare declare
Current : constant Dir_Name_Str := Get_Current_Dir;
Lib_Name : constant Name_Id := Lib_Name : constant Name_Id :=
Library_File_Name_For (For_Project, In_Tree); Library_File_Name_For (For_Project, In_Tree);
Lib_TS : Time_Stamp_Type;
Obj_TS : Time_Stamp_Type;
Object_Dir : Dir_Type;
begin begin
if Hostparm.OpenVMS then
B_Start (B_Start'Last) := '$';
end if;
Change_Dir (Get_Name_String (Data.Library_Dir)); Change_Dir (Get_Name_String (Data.Library_Dir));
Lib_TS := File_Stamp (Lib_Name); Lib_TS := File_Stamp (Lib_Name);
In_Tree.Projects.Table (For_Project).Library_TS := Lib_TS;
end;
-- If the library file does not exist, then the time stamp will if not Data.Externally_Built
-- be Empty_Time_Stamp, earlier than any other time stamp. and then not Data.Need_To_Build_Lib
and then Data.Object_Directory /= No_Name
Change_Dir (Get_Name_String (Data.Object_Directory)); then
Open (Dir => Object_Dir, Dir_Name => "."); declare
Obj_TS : Time_Stamp_Type;
-- For all entries in the object directory Object_Dir : Dir_Type;
loop
Read (Object_Dir, Name_Buffer, Name_Len);
exit when Name_Len = 0;
-- Check if it is an object file, but ignore any binder
-- generated file.
if Is_Obj (Name_Buffer (1 .. Name_Len))
and then Name_Buffer (1 .. B_Start'Length) /= B_Start
then
-- Get the object file time stamp
Obj_TS := File_Stamp (Name_Find);
-- If library file time stamp is earlier, set
-- Need_To_Build_Lib and return. String comparaison is used,
-- otherwise time stamps may be too close and the
-- comparaison would return True, which would trigger
-- an unnecessary rebuild of the library.
if String (Lib_TS) < String (Obj_TS) then
-- Library must be rebuilt
In_Tree.Projects.Table begin
(For_Project).Need_To_Build_Lib := True; if Hostparm.OpenVMS then
exit; B_Start (B_Start'Last) := '$';
end if;
end if; end if;
end loop;
Change_Dir (Current); -- If the library file does not exist, then the time stamp will
end; -- be Empty_Time_Stamp, earlier than any other time stamp.
end if;
end Check_Library;
----------- Change_Dir (Get_Name_String (Data.Object_Directory));
-- Clean -- Open (Dir => Object_Dir, Dir_Name => ".");
-----------
procedure Clean (Directory : Name_Id) is
Current : constant Dir_Name_Str := Get_Current_Dir;
Dir : Dir_Type;
Name : String (1 .. 200); -- For all entries in the object directory
Last : Natural;
Disregard : Boolean; loop
Read (Object_Dir, Name_Buffer, Name_Len);
exit when Name_Len = 0;
begin -- Check if it is an object file, but ignore any binder
Get_Name_String (Directory); -- generated file.
-- Change the working directory to the directory to clean if Is_Obj (Name_Buffer (1 .. Name_Len))
and then Name_Buffer (1 .. B_Start'Length) /= B_Start
then
-- Get the object file time stamp
begin Obj_TS := File_Stamp (Name_Find);
Change_Dir (Name_Buffer (1 .. Name_Len));
exception -- If library file time stamp is earlier, set
when others => -- Need_To_Build_Lib and return. String comparaison is
Com.Fail -- used, otherwise time stamps may be too close and the
("unable to access directory """, -- comparaison would return True, which would trigger
Name_Buffer (1 .. Name_Len), -- an unnecessary rebuild of the library.
"""");
end;
Open (Dir, "."); if String (Lib_TS) < String (Obj_TS) then
-- For each regular file in the directory, make it writable and -- Library must be rebuilt
-- delete the file.
loop In_Tree.Projects.Table
Read (Dir, Name, Last); (For_Project).Need_To_Build_Lib := True;
exit when Last = 0; exit;
end if;
end if;
end loop;
if Is_Regular_File (Name (1 .. Last)) then Close (Object_Dir);
Set_Writable (Name (1 .. Last)); end;
Delete_File (Name (1 .. Last), Disregard);
end if; end if;
end loop;
Close (Dir);
-- Restore the initial working directory Change_Dir (Current);
end if;
Change_Dir (Current); end Check_Library;
end Clean;
---------------------------- ----------------------------
-- Copy_Interface_Sources -- -- Copy_Interface_Sources --
...@@ -1749,8 +1874,7 @@ package body MLib.Prj is ...@@ -1749,8 +1874,7 @@ package body MLib.Prj is
function Is_Same_Or_Extension function Is_Same_Or_Extension
(Extending : Project_Id; (Extending : Project_Id;
Extended : Project_Id) Extended : Project_Id) return Boolean;
return Boolean;
-- Return True if project Extending is equal to or extends project -- Return True if project Extending is equal to or extends project
-- Extended. -- Extended.
...@@ -1793,8 +1917,7 @@ package body MLib.Prj is ...@@ -1793,8 +1917,7 @@ package body MLib.Prj is
function Is_Same_Or_Extension function Is_Same_Or_Extension
(Extending : Project_Id; (Extending : Project_Id;
Extended : Project_Id) Extended : Project_Id) return Boolean
return Boolean
is is
Ext : Project_Id := Extending; Ext : Project_Id := Extending;
...@@ -2075,4 +2198,27 @@ package body MLib.Prj is ...@@ -2075,4 +2198,27 @@ package body MLib.Prj is
return C_SALs_Init_Using_Constructors /= 0; return C_SALs_Init_Using_Constructors /= 0;
end SALs_Use_Constructors; end SALs_Use_Constructors;
---------------------------
-- Ultimate_Extension_Of --
---------------------------
function Ultimate_Extension_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Project_Id
is
Result : Project_Id := Project;
Data : Project_Data;
begin
if Project /= No_Project then
loop
Data := In_Tree.Projects.Table (Result);
exit when Data.Extended_By = No_Project;
Result := Data.Extended_By;
end loop;
end if;
return Result;
end Ultimate_Extension_Of;
end MLib.Prj; end MLib.Prj;
gcc/ada/mlib.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2005, Ada Core Technologies, Inc. -- -- Copyright (C) 1999-2005, AdaCore --
-- -- -- --
-- 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- --
...@@ -34,6 +34,8 @@ with Namet; use Namet; ...@@ -34,6 +34,8 @@ with Namet; use Namet;
with MLib.Utl; use MLib.Utl; with MLib.Utl; use MLib.Utl;
with Prj.Com;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body MLib is package body MLib is
...@@ -67,24 +69,24 @@ package body MLib is ...@@ -67,24 +69,24 @@ package body MLib is
procedure Check_Library_Name (Name : String) is procedure Check_Library_Name (Name : String) is
begin begin
if Name'Length = 0 then if Name'Length = 0 then
Fail ("library name cannot be empty"); Prj.Com.Fail ("library name cannot be empty");
end if; end if;
if Name'Length > Max_Characters_In_Library_Name then if Name'Length > Max_Characters_In_Library_Name then
Fail ("illegal library name """, Name, """: too long"); Prj.Com.Fail ("illegal library name """, Name, """: too long");
end if; end if;
if not Is_Letter (Name (Name'First)) then if not Is_Letter (Name (Name'First)) then
Fail ("illegal library name """, Prj.Com.Fail ("illegal library name """,
Name, Name,
""": should start with a letter"); """: should start with a letter");
end if; end if;
for Index in Name'Range loop for Index in Name'Range loop
if not Is_Alphanumeric (Name (Index)) then if not Is_Alphanumeric (Name (Index)) then
Fail ("illegal library name """, Prj.Com.Fail ("illegal library name """,
Name, Name,
""": should include only letters and digits"); """: should include only letters and digits");
end if; end if;
end loop; end loop;
end Check_Library_Name; end Check_Library_Name;
...@@ -273,7 +275,7 @@ package body MLib is ...@@ -273,7 +275,7 @@ package body MLib is
end; end;
if not Success then if not Success then
Fail ("could not copy ALI files to library dir"); Prj.Com.Fail ("could not copy ALI files to library dir");
end if; end if;
end loop; end loop;
end if; end if;
......
gcc/ada/prj-attr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2005, 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- --
...@@ -55,7 +55,7 @@ package body Prj.Attr is ...@@ -55,7 +55,7 @@ package body Prj.Attr is
-- insensitive -- insensitive
-- 'c' same as 'b', with optional index -- 'c' same as 'b', with optional index
-- End is indicated by two consecutive '#'. -- End is indicated by two consecutive '#'
Initialization_Data : constant String := Initialization_Data : constant String :=
...@@ -75,6 +75,7 @@ package body Prj.Attr is ...@@ -75,6 +75,7 @@ package body Prj.Attr is
"SVlibrary_auto_init#" & "SVlibrary_auto_init#" &
"LVlibrary_options#" & "LVlibrary_options#" &
"SVlibrary_src_dir#" & "SVlibrary_src_dir#" &
"SVlibrary_ali_dir#" &
"SVlibrary_gcc#" & "SVlibrary_gcc#" &
"SVlibrary_symbol_file#" & "SVlibrary_symbol_file#" &
"SVlibrary_symbol_policy#" & "SVlibrary_symbol_policy#" &
......
gcc/ada/prj-env.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2005, 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- --
...@@ -48,7 +48,7 @@ package body Prj.Env is ...@@ -48,7 +48,7 @@ package body Prj.Env is
-- and ADA_OBJECTS_PATH are stored. -- and ADA_OBJECTS_PATH are stored.
Ada_Path_Length : Natural := 0; Ada_Path_Length : Natural := 0;
-- Index of the last valid character in Ada_Path_Buffer. -- Index of the last valid character in Ada_Path_Buffer
Ada_Prj_Include_File_Set : Boolean := False; Ada_Prj_Include_File_Set : Boolean := False;
Ada_Prj_Objects_File_Set : Boolean := False; Ada_Prj_Objects_File_Set : Boolean := False;
...@@ -270,9 +270,9 @@ package body Prj.Env is ...@@ -270,9 +270,9 @@ package body Prj.Env is
if Data.Library then if Data.Library then
if Data.Object_Directory = No_Name if Data.Object_Directory = No_Name
or else or else
Contains_ALI_Files (Data.Library_Dir) Contains_ALI_Files (Data.Library_ALI_Dir)
then then
Add_To_Path (Get_Name_String (Data.Library_Dir)); Add_To_Path (Get_Name_String (Data.Library_ALI_Dir));
else else
Add_To_Path (Get_Name_String (Data.Object_Directory)); Add_To_Path (Get_Name_String (Data.Object_Directory));
end if; end if;
...@@ -2121,16 +2121,17 @@ package body Prj.Env is ...@@ -2121,16 +2121,17 @@ package body Prj.Env is
and then and then
(not Including_Libraries or else not Data.Library)) (not Including_Libraries or else not Data.Library))
then then
-- For a library project, add the library directory -- For a library project, add the library ALI
-- if there is no object directory or if the library -- directory if there is no object directory or
-- directory contains ALI files; otherwise add the -- if the library ALI directory contains ALI files;
-- object directory. -- otherwise add the object directory.
if Data.Library then if Data.Library then
if Data.Object_Directory = No_Name if Data.Object_Directory = No_Name
or else Contains_ALI_Files (Data.Library_Dir) or else Contains_ALI_Files (Data.Library_ALI_Dir)
then then
Add_To_Object_Path (Data.Library_Dir, In_Tree); Add_To_Object_Path
(Data.Library_ALI_Dir, In_Tree);
else else
Add_To_Object_Path Add_To_Object_Path
(Data.Object_Directory, In_Tree); (Data.Object_Directory, In_Tree);
...@@ -2138,13 +2139,18 @@ package body Prj.Env is ...@@ -2138,13 +2139,18 @@ package body Prj.Env is
-- For a non-library project, add the object -- For a non-library project, add the object
-- directory, if it is not a virtual project, and -- directory, if it is not a virtual project, and
-- if there are Ada sources. If there are no Ada -- if there are Ada sources or if the project is an
-- sources, adding the object directory could -- extending project. if There Are No Ada sources,
-- disrupt the order of the object dirs in the path. -- adding the object directory could disrupt
-- the order of the object dirs in the path.
elsif not Data.Virtual elsif not Data.Virtual
and then In_Tree.Projects.Table and then (In_Tree.Projects.Table
(Project).Ada_Sources_Present (Project).Ada_Sources_Present
or else
(Data.Extends /= No_Project
and then
Data.Object_Directory /= No_Name))
then then
Add_To_Object_Path Add_To_Object_Path
(Data.Object_Directory, In_Tree); (Data.Object_Directory, In_Tree);
...@@ -2230,7 +2236,7 @@ package body Prj.Env is ...@@ -2230,7 +2236,7 @@ package body Prj.Env is
Add (Project); Add (Project);
end if; end if;
-- Write and close any file that has been created. -- Write and close any file that has been created
if Source_FD /= Invalid_FD then if Source_FD /= Invalid_FD then
for Index in Source_Path_Table.First .. for Index in Source_Path_Table.First ..
......
gcc/ada/prj-nmsc.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2005 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2005, 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- --
...@@ -1383,12 +1383,16 @@ package body Prj.Nmsc is ...@@ -1383,12 +1383,16 @@ package body Prj.Nmsc is
Lib_Name : constant Prj.Variable_Value := Lib_Name : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Name, Attributes, In_Tree); (Snames.Name_Library_Name, Attributes, In_Tree);
Lib_Version : constant Prj.Variable_Value := Lib_Version : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Version, Attributes, In_Tree); (Snames.Name_Library_Version, Attributes, In_Tree);
Lib_ALI_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
The_Lib_Kind : constant Prj.Variable_Value := The_Lib_Kind : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Snames.Name_Library_Kind, Attributes, In_Tree); (Snames.Name_Library_Kind, Attributes, In_Tree);
...@@ -1488,14 +1492,78 @@ package body Prj.Nmsc is ...@@ -1488,14 +1492,78 @@ package body Prj.Nmsc is
Data.Library_Dir := No_Name; Data.Library_Dir := No_Name;
Data.Display_Library_Dir := No_Name; Data.Display_Library_Dir := No_Name;
-- Display the Library directory in high verbosity
else else
if Current_Verbosity = High then declare
Write_Str ("Library directory ="""); OK : Boolean := True;
Write_Str (Get_Name_String (Data.Display_Library_Dir)); Dirs_Id : String_List_Id;
Write_Line (""""); Dir_Elem : String_Element;
end if;
begin
-- The library directory cannot be the same as a source
-- directory of the current project.
Dirs_Id := Data.Source_Dirs;
while Dirs_Id /= Nil_String loop
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
if Data.Library_Dir = Dir_Elem.Value then
Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
Error_Msg
(Project, In_Tree,
"library directory cannot be the same " &
"as source directory {",
Lib_Dir.Location);
OK := False;
exit;
end if;
end loop;
if OK then
-- The library directory cannot be the same as a source
-- directory of another project either.
Project_Loop :
for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
if Pid /= Project then
Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
Dir_Loop : while Dirs_Id /= Nil_String loop
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
if Data.Library_Dir = Dir_Elem.Value then
Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
Err_Vars.Error_Msg_Name_2 :=
In_Tree.Projects.Table (Pid).Name;
Error_Msg
(Project, In_Tree,
"library directory cannot be the same " &
"as source directory { of project {",
Lib_Dir.Location);
OK := False;
exit Project_Loop;
end if;
end loop Dir_Loop;
end if;
end loop Project_Loop;
end if;
if not OK then
Data.Library_Dir := No_Name;
Data.Display_Library_Dir := No_Name;
elsif Current_Verbosity = High then
-- Display the Library directory in high verbosity
Write_Str ("Library directory =""");
Write_Str (Get_Name_String (Data.Display_Library_Dir));
Write_Line ("""");
end if;
end;
end if; end if;
end if; end if;
...@@ -1536,6 +1604,158 @@ package body Prj.Nmsc is ...@@ -1536,6 +1604,158 @@ package body Prj.Nmsc is
Data.Library := False; Data.Library := False;
else else
if Lib_ALI_Dir.Value = Empty_String then
if Current_Verbosity = High then
Write_Line ("No library 'A'L'I directory specified");
end if;
Data.Library_ALI_Dir := Data.Library_Dir;
Data.Display_Library_ALI_Dir := Data.Display_Library_Dir;
else
-- Find path name, check that it is a directory
Locate_Directory
(Lib_ALI_Dir.Value, Data.Display_Directory,
Data.Library_ALI_Dir, Data.Display_Library_ALI_Dir);
if Data.Library_ALI_Dir = No_Name then
-- Get the absolute name of the library ALI directory that
-- does not exist, to report an error.
declare
Dir_Name : constant String :=
Get_Name_String (Lib_ALI_Dir.Value);
begin
if Is_Absolute_Path (Dir_Name) then
Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value;
else
Get_Name_String (Data.Display_Directory);
if Name_Buffer (Name_Len) /= Directory_Separator then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Directory_Separator;
end if;
Name_Buffer
(Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
Dir_Name;
Name_Len := Name_Len + Dir_Name'Length;
Err_Vars.Error_Msg_Name_1 := Name_Find;
end if;
-- Report the error
Error_Msg
(Project, In_Tree,
"library 'A'L'I directory { does not exist",
Lib_ALI_Dir.Location);
end;
end if;
if Data.Library_ALI_Dir /= Data.Library_Dir then
-- The library ALI directory cannot be the same as the
-- Object directory.
if Data.Library_ALI_Dir = Data.Object_Directory then
Error_Msg
(Project, In_Tree,
"library 'A'L'I directory cannot be the same " &
"as object directory",
Lib_ALI_Dir.Location);
Data.Library_ALI_Dir := No_Name;
Data.Display_Library_ALI_Dir := No_Name;
else
declare
OK : Boolean := True;
Dirs_Id : String_List_Id;
Dir_Elem : String_Element;
begin
-- The library ALI directory cannot be the same as
-- a source directory of the current project.
Dirs_Id := Data.Source_Dirs;
while Dirs_Id /= Nil_String loop
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
if Data.Library_ALI_Dir = Dir_Elem.Value then
Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
Error_Msg
(Project, In_Tree,
"library 'A'L'I directory cannot be " &
"the same as source directory {",
Lib_ALI_Dir.Location);
OK := False;
exit;
end if;
end loop;
if OK then
-- The library ALI directory cannot be the same as
-- a source directory of another project either.
ALI_Project_Loop :
for
Pid in 1 .. Project_Table.Last (In_Tree.Projects)
loop
if Pid /= Project then
Dirs_Id :=
In_Tree.Projects.Table (Pid).Source_Dirs;
ALI_Dir_Loop :
while Dirs_Id /= Nil_String loop
Dir_Elem :=
In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
if
Data.Library_ALI_Dir = Dir_Elem.Value
then
Err_Vars.Error_Msg_Name_1 :=
Dir_Elem.Value;
Err_Vars.Error_Msg_Name_2 :=
In_Tree.Projects.Table (Pid).Name;
Error_Msg
(Project, In_Tree,
"library 'A'L'I directory cannot " &
"be the same as source directory " &
"{ of project {",
Lib_ALI_Dir.Location);
OK := False;
exit ALI_Project_Loop;
end if;
end loop ALI_Dir_Loop;
end if;
end loop ALI_Project_Loop;
end if;
if not OK then
Data.Library_ALI_Dir := No_Name;
Data.Display_Library_ALI_Dir := No_Name;
elsif Current_Verbosity = High then
-- Display the Library ALI directory in high
-- verbosity.
Write_Str ("Library ALI directory =""");
Write_Str
(Get_Name_String (Data.Display_Library_ALI_Dir));
Write_Line ("""");
end if;
end;
end if;
end if;
end if;
pragma Assert (Lib_Version.Kind = Single); pragma Assert (Lib_Version.Kind = Single);
if Lib_Version.Value = Empty_String then if Lib_Version.Value = Empty_String then
...@@ -2279,18 +2499,19 @@ package body Prj.Nmsc is ...@@ -2279,18 +2499,19 @@ package body Prj.Nmsc is
Lib_Src_Dir.Location); Lib_Src_Dir.Location);
Data.Library_Src_Dir := No_Name; Data.Library_Src_Dir := No_Name;
-- Check if it is same as one of the source directories
else else
declare declare
Src_Dirs : String_List_Id := Data.Source_Dirs; Src_Dirs : String_List_Id;
Src_Dir : String_Element; Src_Dir : String_Element;
begin begin
-- Interface copy directory cannot be one of the source
-- directory of the current project.
Src_Dirs := Data.Source_Dirs;
while Src_Dirs /= Nil_String loop while Src_Dirs /= Nil_String loop
Src_Dir := In_Tree.String_Elements.Table Src_Dir := In_Tree.String_Elements.Table
(Src_Dirs); (Src_Dirs);
Src_Dirs := Src_Dir.Next;
-- Report error if it is one of the source directories -- Report error if it is one of the source directories
...@@ -2303,7 +2524,45 @@ package body Prj.Nmsc is ...@@ -2303,7 +2524,45 @@ package body Prj.Nmsc is
Data.Library_Src_Dir := No_Name; Data.Library_Src_Dir := No_Name;
exit; exit;
end if; end if;
Src_Dirs := Src_Dir.Next;
end loop; end loop;
if Data.Library_Src_Dir /= No_Name then
-- It cannot be a source directory of any other
-- project either.
Project_Loop : for Pid in 1 ..
Project_Table.Last (In_Tree.Projects)
loop
Src_Dirs :=
In_Tree.Projects.Table (Pid).Source_Dirs;
Dir_Loop : while Src_Dirs /= Nil_String loop
Src_Dir :=
In_Tree.String_Elements.Table (Src_Dirs);
-- Report error if it is one of the source
-- directories
if Data.Library_Src_Dir = Src_Dir.Value then
Error_Msg_Name_1 := Src_Dir.Value;
Error_Msg_Name_2 :=
In_Tree.Projects.Table (Pid).Name;
Error_Msg
(Project, In_Tree,
"directory to copy interfaces cannot " &
"be the same as source directory { of " &
"project {",
Lib_Src_Dir.Location);
Data.Library_Src_Dir := No_Name;
exit Project_Loop;
end if;
Src_Dirs := Src_Dir.Next;
end loop Dir_Loop;
end loop Project_Loop;
end if;
end; end;
-- In high verbosity, if there is a valid Library_Src_Dir, -- In high verbosity, if there is a valid Library_Src_Dir,
......
gcc/ada/prj.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2005, 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- --
...@@ -102,6 +102,8 @@ package body Prj is ...@@ -102,6 +102,8 @@ package body Prj is
Display_Library_Dir => No_Name, Display_Library_Dir => No_Name,
Library_Src_Dir => No_Name, Library_Src_Dir => No_Name,
Display_Library_Src_Dir => No_Name, Display_Library_Src_Dir => No_Name,
Library_ALI_Dir => No_Name,
Display_Library_ALI_Dir => No_Name,
Library_Name => No_Name, Library_Name => No_Name,
Library_Kind => Static, Library_Kind => Static,
Lib_Internal_Name => No_Name, Lib_Internal_Name => No_Name,
...@@ -121,6 +123,7 @@ package body Prj is ...@@ -121,6 +123,7 @@ package body Prj is
Known_Order_Of_Source_Dirs => True, Known_Order_Of_Source_Dirs => True,
Object_Directory => No_Name, Object_Directory => No_Name,
Display_Object_Dir => No_Name, Display_Object_Dir => No_Name,
Library_TS => Empty_Time_Stamp,
Exec_Directory => No_Name, Exec_Directory => No_Name,
Display_Exec_Dir => No_Name, Display_Exec_Dir => No_Name,
Extends => No_Project, Extends => No_Project,
...@@ -132,6 +135,7 @@ package body Prj is ...@@ -132,6 +135,7 @@ package body Prj is
Default_Linker_Path => No_Name, Default_Linker_Path => No_Name,
Decl => No_Declarations, Decl => No_Declarations,
Imported_Projects => Empty_Project_List, Imported_Projects => Empty_Project_List,
All_Imported_Projects => Empty_Project_List,
Ada_Include_Path => null, Ada_Include_Path => null,
Ada_Objects_Path => null, Ada_Objects_Path => null,
Include_Path_File => No_Name, Include_Path_File => No_Name,
...@@ -485,7 +489,7 @@ package body Prj is ...@@ -485,7 +489,7 @@ package body Prj is
end if; end if;
end loop; end loop;
-- If none can be found, create a new one. -- If none can be found, create a new one
if not Found then if not Found then
Element := Element :=
...@@ -526,7 +530,7 @@ package body Prj is ...@@ -526,7 +530,7 @@ package body Prj is
end if; end if;
end loop; end loop;
-- If none can be found, create a new one. -- If none can be found, create a new one
if not Found then if not Found then
Element := Element :=
......
gcc/ada/prj.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2005, 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- --
...@@ -73,9 +73,11 @@ package Prj is ...@@ -73,9 +73,11 @@ package Prj is
-- Canonical_Case_File_Name is called on this variable in the body of Prj. -- Canonical_Case_File_Name is called on this variable in the body of Prj.
----------------------------------------------------- -----------------------------------------------------
-- Multi-language stuff that will be modified soon -- -- Multi-language Stuff That Will be Modified Soon --
----------------------------------------------------- -----------------------------------------------------
-- Still should be properly commented ???
type Language_Index is new Nat; type Language_Index is new Nat;
No_Language_Index : constant Language_Index := 0; No_Language_Index : constant Language_Index := 0;
...@@ -232,6 +234,7 @@ package Prj is ...@@ -232,6 +234,7 @@ package Prj is
type Other_Source_Id is new Nat; type Other_Source_Id is new Nat;
No_Other_Source : constant Other_Source_Id := 0; No_Other_Source : constant Other_Source_Id := 0;
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 : Name_Id; -- source file simple name
...@@ -273,10 +276,10 @@ package Prj is ...@@ -273,10 +276,10 @@ package Prj is
type Policy is (Autonomous, Compliant, Controlled, Restricted); type Policy is (Autonomous, Compliant, Controlled, Restricted);
-- 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
type Symbol_Record is record type Symbol_Record is record
Symbol_File : Name_Id := No_Name; Symbol_File : Name_Id := No_Name;
...@@ -301,12 +304,12 @@ package Prj is ...@@ -301,12 +304,12 @@ package Prj is
type String_List_Id is new Nat; type String_List_Id is new Nat;
Nil_String : constant String_List_Id := 0; Nil_String : constant String_List_Id := 0;
type String_Element is record type String_Element is record
Value : Name_Id := No_Name; Value : Name_Id := No_Name;
Index : Int := 0; Index : Int := 0;
Display_Value : Name_Id := No_Name; Display_Value : Name_Id := No_Name;
Location : Source_Ptr := No_Location; Location : Source_Ptr := No_Location;
Flag : Boolean := False; Flag : Boolean := False;
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 -- Component Flag may be used for various purposes. For source
...@@ -353,9 +356,9 @@ package Prj is ...@@ -353,9 +356,9 @@ package Prj is
type Variable_Id is new Nat; type Variable_Id is new Nat;
No_Variable : constant Variable_Id := 0; No_Variable : constant Variable_Id := 0;
type Variable is record type Variable is record
Next : Variable_Id := No_Variable; Next : Variable_Id := No_Variable;
Name : Name_Id; Name : Name_Id;
Value : Variable_Value; Value : Variable_Value;
end record; end record;
-- To hold the list of variables in a project file and in packages -- To hold the list of variables in a project file and in packages
...@@ -430,7 +433,7 @@ package Prj is ...@@ -430,7 +433,7 @@ package Prj is
Parent : Package_Id := No_Package; Parent : Package_Id := No_Package;
Next : Package_Id := No_Package; Next : Package_Id := No_Package;
end record; end record;
-- A package. Includes declarations that may include other packages -- A package (includes declarations that may include other packages)
package Package_Table is new GNAT.Dynamic_Tables package Package_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Package_Element, (Table_Component_Type => Package_Element,
...@@ -473,8 +476,8 @@ package Prj is ...@@ -473,8 +476,8 @@ package Prj is
-- The position in the project file source where -- The position in the project file source where
-- Ada_Spec_Suffix is defined. -- Ada_Spec_Suffix is defined.
Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes; Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes;
Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index; Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index;
-- The source suffixes of the different languages -- The source suffixes of the different languages
Body_Suffix : Array_Element_Id := No_Array_Element; Body_Suffix : Array_Element_Id := No_Array_Element;
...@@ -553,7 +556,7 @@ package Prj is ...@@ -553,7 +556,7 @@ package Prj is
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
-- Indicate the different languages of the source of this project -- Indicate the different languages of the source of this project
First_Referred_By : Project_Id := No_Project; First_Referred_By : Project_Id := No_Project;
-- The project, if any, that was the first to be known as importing or -- The project, if any, that was the first to be known as importing or
-- extending this project. Set by Prj.Proc.Process. -- extending this project. Set by Prj.Proc.Process.
...@@ -585,6 +588,7 @@ package Prj is ...@@ -585,6 +588,7 @@ package Prj is
-- 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 : Name_Id := No_Name;
-- comment ???
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
...@@ -603,18 +607,31 @@ package Prj is ...@@ -603,18 +607,31 @@ package Prj is
-- 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.
Library_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- The timestamp of a library file in a library project.
-- Set by MLib.Prj.Check_Library.
Library_Src_Dir : Name_Id := No_Name; Library_Src_Dir : Name_Id := No_Name;
-- If a library project, directory where the sources and the ALI files -- If a Stand-Alone Library project, directory where the sources
-- of the library are copied. By default, if attribute Library_Src_Dir -- of the interfaces of the library are copied. By default, if
-- is not specified, sources are not copied anywhere and ALI files are -- attribute Library_Src_Dir is not specified, sources of the interfaces
-- copied in the Library Directory. Set by -- are not copied anywhere. Set by Prj.Nmsc.Check_Stand_Alone_Library.
-- Prj.Nmsc.Language_Independent_Check.
Display_Library_Src_Dir : Name_Id := No_Name; Display_Library_Src_Dir : Name_Id := No_Name;
-- 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;
-- In a library project, directory where the ALI files are copied.
-- If attribute Library_ALI_Dir is not specified, ALI files are
-- copied in the Library_Dir. Set by Prj.Nmsc.Check_Library_Attributes.
Display_Library_ALI_Dir : Name_Id := No_Name;
-- The name of the library ALI directory, for display purposes. May be
-- different from Library_ALI_Dir for platforms where the file names are
-- case-insensitive.
Library_Name : Name_Id := No_Name; Library_Name : Name_Id := No_Name;
-- 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.
...@@ -653,8 +670,8 @@ package Prj is ...@@ -653,8 +670,8 @@ package Prj is
-- A flag that indicates that there are non-Ada sources in this project -- A flag that indicates that there are non-Ada sources in this project
Sources : String_List_Id := Nil_String; Sources : String_List_Id := Nil_String;
-- The list of all the source file names. Set by -- The list of all the source file names.
-- Prj.Nmsc.Check_Ada_Naming_Scheme. -- Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
First_Other_Source : Other_Source_Id := No_Other_Source; First_Other_Source : Other_Source_Id := No_Other_Source;
Last_Other_Source : Other_Source_Id := No_Other_Source; Last_Other_Source : Other_Source_Id := No_Other_Source;
...@@ -711,13 +728,14 @@ package Prj is ...@@ -711,13 +728,14 @@ package Prj is
-- Set by Prj.Nmsc.Check_Naming_Scheme. -- Set by Prj.Nmsc.Check_Naming_Scheme.
First_Language_Processing : First_Language_Processing_Data := First_Language_Processing : First_Language_Processing_Data :=
Default_First_Language_Processing_Data; Default_First_Language_Processing_Data;
-- Comment needed ???
Supp_Language_Processing : Supp_Language_Index := Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index;
No_Supp_Language_Index; -- Comment needed
Default_Linker : Name_Id := No_Name; Default_Linker : Name_Id := No_Name;
Default_Linker_Path : Name_Id := No_Name; Default_Linker_Path : Name_Id := No_Name;
Decl : Declarations := No_Declarations; Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages) of this -- The declarations (variables, attributes and packages) of this
...@@ -727,6 +745,10 @@ package Prj is ...@@ -727,6 +745,10 @@ package Prj is
-- The list of all directly imported projects, if any. Set by -- The list of all directly imported projects, if any. Set by
-- Prj.Proc.Process. -- Prj.Proc.Process.
All_Imported_Projects : Project_List := Empty_Project_List;
-- The list of all projects imported directly or indirectly, if any.
-- Set by Make.Initialize.
Ada_Include_Path : String_Access := null; Ada_Include_Path : String_Access := null;
-- The cached value of ADA_INCLUDE_PATH for this project file. Do not -- The cached value of ADA_INCLUDE_PATH for this project file. Do not
-- use this field directly outside of the compiler, use -- use this field directly outside of the compiler, use
...@@ -771,7 +793,7 @@ package Prj is ...@@ -771,7 +793,7 @@ package Prj is
-- A flag to avoid checking repetitively the naming scheme of -- A flag to avoid checking repetitively the naming scheme of
-- this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme. -- this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
Seen : Boolean := False; Seen : Boolean := False;
-- A flag to mark a project as "visited" to avoid processing the same -- A flag to mark a project as "visited" to avoid processing the same
-- project several time. -- project several time.
...@@ -943,14 +965,14 @@ package Prj is ...@@ -943,14 +965,14 @@ package Prj is
In_Project : Project_Data; In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Boolean; In_Tree : Project_Tree_Ref) return Boolean;
-- Return True when Language is one of the languages used in -- Return True when Language is one of the languages used in
-- project Project. -- project In_Project.
procedure Set procedure Set
(Language : Language_Index; (Language : Language_Index;
Present : Boolean; Present : Boolean;
In_Project : in out Project_Data; In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
-- Indicate if Language is or not a language used in project Project -- Indicate if Language is or not a language used in project In_Project
function Language_Processing_Data_Of function Language_Processing_Data_Of
(Language : Language_Index; (Language : Language_Index;
...@@ -1018,6 +1040,7 @@ private ...@@ -1018,6 +1040,7 @@ private
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 5, Table_Initial => 5,
Table_Increment => 100); Table_Increment => 100);
-- 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 => Name_Id,
...@@ -1045,10 +1068,11 @@ private ...@@ -1045,10 +1068,11 @@ private
-- A table to store the object dirs, before creating the object path file -- A table to store the object dirs, before creating the object path file
type Private_Project_Tree_Data is record type Private_Project_Tree_Data is record
Namings : Naming_Table.Instance; Namings : Naming_Table.Instance;
Path_Files : Path_File_Table.Instance; Path_Files : Path_File_Table.Instance;
Source_Paths : Source_Path_Table.Instance; Source_Paths : Source_Path_Table.Instance;
Object_Paths : Object_Path_Table.Instance; Object_Paths : Object_Path_Table.Instance;
Default_Naming : Naming_Data; Default_Naming : Naming_Data;
end record; end record;
-- Comment ???
end Prj; end Prj;
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