-- --
------------------------------------------------------------------------------
-with Ada.Command_Line; use Ada.Command_Line;
-
with ALI; use ALI;
with Csets;
with Gnatvsn;
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;
-- 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
-- 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.
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 --
-----------------------
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 --
-------------------
("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.
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 --
-----------
-- --
-- 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- --
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;
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,
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,
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;
-- 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 --
------------------
-- 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)
declare
DLL_Name : aliased String :=
- Lib_Dirpath.all & "/lib" &
+ Lib_Dirpath.all & '/' & DLL_Prefix &
Lib_Filename.all & "." & DLL_Ext;
Archive_Name : aliased String :=
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
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.
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
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;
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 --
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.
function Is_Same_Or_Extension
(Extending : Project_Id;
- Extended : Project_Id)
- return Boolean
+ Extended : Project_Id) return Boolean
is
Ext : Project_Id := Extending;
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;
-- --
-- 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- --
with MLib.Utl; use MLib.Utl;
+with Prj.Com;
+
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
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;
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;
-- --
-- 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- --
-- insensitive
-- 'c' same as 'b', with optional index
- -- End is indicated by two consecutive '#'.
+ -- End is indicated by two consecutive '#'
Initialization_Data : constant String :=
"SVlibrary_auto_init#" &
"LVlibrary_options#" &
"SVlibrary_src_dir#" &
+ "SVlibrary_ali_dir#" &
"SVlibrary_gcc#" &
"SVlibrary_symbol_file#" &
"SVlibrary_symbol_policy#" &
-- --
-- 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- --
-- 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;
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;
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);
-- 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);
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 ..
-- --
-- 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- --
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);
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;
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
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
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,
-- --
-- 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- --
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,
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,
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,
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 :=
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 :=
-- --
-- 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- --
-- 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;
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
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;
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
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
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,
-- 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;
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.
-- 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
-- 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.
-- 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;
-- 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
-- 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
-- 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.
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;
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,
-- 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;
OSDN Git Service
