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