-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
procedure Add_Object_Directories is
new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
- function ALI_File_Name (Source : Name_Id) return String;
+ function ALI_File_Name (Source : File_Name_Type) return String;
-- Returns the name of the ALI file corresponding to Source
- function Assembly_File_Name (Source : Name_Id) return String;
+ function Assembly_File_Name (Source : File_Name_Type) return String;
-- Returns the assembly file name corresponding to Source
procedure Clean_Archive (Project : Project_Id);
-- 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.
+ -- Delete files in an interface copy 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
-- project files in the tree rooted at the main project file and switch -r
-- has been specified.
- function Debug_File_Name (Source : Name_Id) return String;
+ function Debug_File_Name (Source : File_Name_Type) return String;
-- Name of the expanded source file corresponding to Source
procedure Delete (In_Directory : String; File : String);
-- Delete one file, or list the file name if switch -n is specified
- procedure Delete_Binder_Generated_Files (Dir : String; Source : Name_Id);
+ procedure Delete_Binder_Generated_Files
+ (Dir : String;
+ Source : File_Name_Type);
-- Delete the binder generated file in directory Dir for Source, if they
-- exist: for Unix these are b~<source>.ads, b~<source>.adb,
-- b~<source>.ali and b~<source>.o.
procedure Display_Copyright;
- -- Display the Copyright notice.
- -- If called several times, display the Copyright notice only the first
- -- time.
+ -- Display the Copyright notice. If called several times, display the
+ -- Copyright notice only the first time.
procedure Initialize;
-- Call the necessary package initializations
- function Object_File_Name (Source : Name_Id) return String;
+ function Object_File_Name (Source : File_Name_Type) return String;
-- Returns the object file name corresponding to Source
procedure Parse_Cmd_Line;
-- Parse the command line
- function Repinfo_File_Name (Source : Name_Id) return String;
+ function Repinfo_File_Name (Source : File_Name_Type) return String;
-- Returns the repinfo file name corresponding to Source
- function Tree_File_Name (Source : Name_Id) return String;
+ function Tree_File_Name (Source : File_Name_Type) return String;
-- Returns the tree file name corresponding to Source
function In_Extension_Chain
-- ALI_File_Name --
-------------------
- function ALI_File_Name (Source : Name_Id) return String is
+ function ALI_File_Name (Source : File_Name_Type) return String is
Src : constant String := Get_Name_String (Source);
begin
-- Assembly_File_Name --
------------------------
- function Assembly_File_Name (Source : Name_Id) return String is
+ function Assembly_File_Name (Source : File_Name_Type) return String is
Src : constant String := Get_Name_String (Source);
begin
-------------------
procedure Clean_Archive (Project : Project_Id) is
- Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
- Data : constant Project_Data :=
- Project_Tree.Projects.Table (Project);
+ Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
+ Data : constant Project_Data :=
+ Project_Tree.Projects.Table (Project);
+ Lib_Prefix : constant String :=
+ "lib" & Get_Name_String (Data.Display_Name);
Archive_Name : constant String :=
- "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
+ Lib_Prefix & '.' & Archive_Ext;
-- The name of the archive file for this project
Archive_Dep_Name : constant String :=
- "lib" & Get_Name_String (Data.Name) & ".deps";
+ Lib_Prefix & ".deps";
-- The name of the archive dependency file for this project
- Obj_Dir : constant String := Get_Name_String (Data.Object_Directory);
+ Obj_Dir : constant String :=
+ Get_Name_String (Data.Display_Object_Dir);
begin
Change_Dir (Obj_Dir);
Full_Lib_File : File_Name_Type;
-- Full name of the current ALI file
- Text : Text_Buffer_Ptr;
+ Text : Text_Buffer_Ptr;
The_ALI : ALI_Id;
begin
if not Compile_Only then
declare
- Source : constant Name_Id := Strip_Suffix (Main_Lib_File);
- Executable : constant String := Get_Name_String
- (Executable_Name (Source));
+ Source : constant File_Name_Type :=
+ Strip_Suffix (Main_Lib_File);
+ Executable : constant String :=
+ Get_Name_String (Executable_Name (Source));
begin
if Is_Regular_File (Executable) then
Delete ("", Executable);
Unit : Unit_Data;
begin
- if Data.Library and then Data.Library_Src_Dir /= No_Name then
+ if Data.Library and then Data.Library_Src_Dir /= No_Path then
declare
Directory : constant String :=
- Get_Name_String (Data.Library_Src_Dir);
+ Get_Name_String (Data.Display_Library_Src_Dir);
begin
- Change_Dir (Get_Name_String (Data.Library_Src_Dir));
+ Change_Dir (Directory);
Open (Direc, ".");
-- For each regular file in the directory, if switch -n has not
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;
+ declare
+ Filename : constant String := Name (1 .. Last);
- -- Compare with source file names of the project
+ begin
+ if Is_Regular_File (Filename) then
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete_File := False;
- for Index in 1 .. Unit_Table.Last (Project_Tree.Units) loop
- Unit := Project_Tree.Units.Table (Index);
+ -- Compare with source file names of the project
- 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;
+ 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 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;
+ if Delete_File then
+ if not Do_Nothing then
+ Set_Writable (Filename);
+ end if;
- Delete (Directory, Name (1 .. Last));
+ Delete (Directory, Filename);
+ end if;
end if;
- end if;
+ end;
end loop;
Close (Direc);
Data : constant Project_Data := Project_Tree.Projects.Table (Project);
Lib_Filename : constant String := Get_Name_String (Data.Library_Name);
- DLL_Name : constant String :=
+ DLL_Name : String :=
DLL_Prefix & Lib_Filename & "." & DLL_Ext;
- Archive_Name : constant String :=
+ Archive_Name : String :=
"lib" & Lib_Filename & "." & Archive_Ext;
Direc : Dir_Type;
if Data.Library then
declare
Lib_Directory : constant String :=
- Get_Name_String (Data.Library_Dir);
+ Get_Name_String (Data.Display_Library_Dir);
Lib_ALI_Directory : constant String :=
- Get_Name_String (Data.Library_ALI_Dir);
+ Get_Name_String
+ (Data.Display_Library_ALI_Dir);
begin
+ Canonical_Case_File_Name (Archive_Name);
+ Canonical_Case_File_Name (DLL_Name);
+
Change_Dir (Lib_Directory);
Open (Direc, ".");
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;
+ declare
+ Filename : constant String := Name (1 .. Last);
+ begin
+ if Is_Regular_File (Filename) then
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete_File := False;
- Delete (Lib_Directory, Name (1 .. Last));
- exit;
+ 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 (Filename);
+ end if;
+
+ Delete (Lib_Directory, Filename);
+ exit;
+ end if;
end if;
- end if;
+ end;
end loop;
Close (Direc);
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;
+ declare
+ Filename : constant String := Name (1 .. Last);
+ begin
+ if Is_Regular_File (Filename) 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
+ 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
+ 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 (Body_Part).Name);
+ (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)
+ Name (1 .. Last - 4)
then
Delete_File := True;
exit;
end if;
end if;
+ end loop;
+ end;
+ 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 (Filename);
+ end if;
- if Delete_File then
- if not Do_Nothing then
- Set_Writable (Name (1 .. Last));
+ Delete (Lib_ALI_Directory, Filename);
end if;
-
- Delete (Lib_ALI_Directory, Name (1 .. Last));
end if;
-
- end if;
+ end;
end loop;
Close (Direc);
Main_Source_File : File_Name_Type;
-- Name of executable on the command line without directory info
- Executable : Name_Id;
+ Executable : File_Name_Type;
-- Name of the executable file
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
Data : constant Project_Data :=
Project_Tree.Projects.Table (Project);
U_Data : Unit_Data;
- File_Name1 : Name_Id;
+ File_Name1 : File_Name_Type;
Index1 : Int;
- File_Name2 : Name_Id;
+ File_Name2 : File_Name_Type;
Index2 : Int;
Lib_File : File_Name_Type;
Processed_Projects.Increment_Last;
Processed_Projects.Table (Processed_Projects.Last) := Project;
- if Data.Object_Directory /= No_Name then
+ if Data.Object_Directory /= No_Path then
declare
Obj_Dir : constant String :=
- Get_Name_String (Data.Object_Directory);
+ Get_Name_String (Data.Display_Object_Dir);
begin
Change_Dir (Obj_Dir);
Unit_Table.Last (Project_Tree.Units)
loop
U_Data := Project_Tree.Units.Table (Unit);
- File_Name1 := No_Name;
- File_Name2 := No_Name;
+ File_Name1 := No_File;
+ File_Name2 := No_File;
-- If either the spec or the body is a source of the
-- project, check for the corresponding ALI file in the
-- If there is no body file name, then there may be
-- only a spec.
- if File_Name1 = No_Name then
+ if File_Name1 = No_File then
File_Name1 := File_Name2;
Index1 := Index2;
- File_Name2 := No_Name;
+ File_Name2 := No_File;
Index2 := 0;
end if;
end if;
-- If there is either a spec or a body, look for files
-- in the object directory.
- if File_Name1 /= No_Name then
+ if File_Name1 /= No_File then
Lib_File := Osint.Lib_File_Name (File_Name1, Index1);
declare
Adt : constant String :=
Tree_File_Name (Lib_File);
Deb : constant String :=
- Debug_File_Name (File_Name1);
+ Debug_File_Name (File_Name1);
Rep : constant String :=
- Repinfo_File_Name (File_Name1);
+ Repinfo_File_Name (File_Name1);
Del : Boolean := True;
begin
-- Second expanded source file
- if File_Name2 /= No_Name then
+ if File_Name2 /= No_File then
declare
Deb : constant String :=
Debug_File_Name (File_Name2);
if not Compile_Only then
Clean_Library_Directory (Project);
- if Data.Library_Src_Dir /= No_Name then
+ if Data.Library_Src_Dir /= No_Path then
Clean_Interface_Copy_Directory (Project);
end if;
end if;
if Data.Standalone_Library and then
- Data.Object_Directory /= No_Name
+ Data.Object_Directory /= No_Path
then
Delete_Binder_Generated_Files
- (Get_Name_String (Data.Object_Directory), Data.Library_Name);
+ (Get_Name_String (Data.Display_Object_Dir),
+ Data.Library_Name);
end if;
end if;
-- The executables are deleted only if switch -c is not specified
- if Project = Main_Project and then Data.Exec_Directory /= No_Name then
+ if Project = Main_Project and then Data.Exec_Directory /= No_Path then
declare
Exec_Dir : constant String :=
- Get_Name_String (Data.Exec_Directory);
+ Get_Name_String (Data.Display_Exec_Dir);
begin
Change_Dir (Exec_Dir);
end;
end if;
- if Data.Object_Directory /= No_Name then
+ if Data.Object_Directory /= No_Path then
Delete_Binder_Generated_Files
- (Get_Name_String
- (Data.Object_Directory),
+ (Get_Name_String (Data.Display_Object_Dir),
Strip_Suffix (Main_Source_File));
end if;
end loop;
-- Debug_File_Name --
---------------------
- function Debug_File_Name (Source : Name_Id) return String is
+ function Debug_File_Name (Source : File_Name_Type) return String is
begin
return Get_Name_String (Source) & Debug_Suffix;
end Debug_File_Name;
procedure Delete (In_Directory : String; File : String) is
Full_Name : String (1 .. In_Directory'Length + File'Length + 1);
- Last : Natural := 0;
- Success : Boolean;
+ Last : Natural := 0;
+ Success : Boolean;
begin
-- Indicate that at least one file is deleted or is to be deleted
-- Delete_Binder_Generated_Files --
-----------------------------------
- procedure Delete_Binder_Generated_Files (Dir : String; Source : Name_Id) is
+ procedure Delete_Binder_Generated_Files
+ (Dir : String;
+ Source : File_Name_Type)
+ is
Source_Name : constant String := Get_Name_String (Source);
Current : constant String := Get_Current_Dir;
Last : constant Positive := B_Start'Length + Source_Name'Length;
begin
-- Do not insert an empty name or an already marked source
- if Lib_File /= No_Name and then not Makeutl.Is_Marked (Lib_File) then
+ if Lib_File /= No_File and then not Makeutl.Is_Marked (Lib_File) then
Q.Table (Q.Last) := Lib_File;
Q.Increment_Last;
-- Object_File_Name --
----------------------
- function Object_File_Name (Source : Name_Id) return String is
+ function Object_File_Name (Source : File_Name_Type) return String is
Src : constant String := Get_Name_String (Source);
begin
--------------------
procedure Parse_Cmd_Line is
- Source_Index : Int := 0;
- Index : Positive := 1;
Last : constant Natural := Argument_Count;
+ Source_Index : Int := 0;
+ Index : Positive := 1;
begin
while Index <= Last loop
case Arg (2) is
when 'a' =>
- if Arg'Length < 4 or else Arg (3) /= 'O' then
+ if Arg'Length < 4 then
Bad_Argument;
end if;
- Add_Lib_Search_Dir (Arg (3 .. Arg'Last));
+ if Arg (3) = 'O' then
+ Add_Lib_Search_Dir (Arg (4 .. Arg'Last));
+
+ elsif Arg (3) = 'P' then
+ Prj.Ext.Add_Search_Project_Directory
+ (Arg (4 .. Arg'Last));
+
+ else
+ Bad_Argument;
+ end if;
when 'c' =>
Compile_Only := True;
-- Repinfo_File_Name --
-----------------------
- function Repinfo_File_Name (Source : Name_Id) return String is
+ function Repinfo_File_Name (Source : File_Name_Type) return String is
begin
return Get_Name_String (Source) & Repinfo_Suffix;
end Repinfo_File_Name;
-- Tree_File_Name --
--------------------
- function Tree_File_Name (Source : Name_Id) return String is
+ function Tree_File_Name (Source : File_Name_Type) return String is
Src : constant String := Get_Name_String (Source);
begin
New_Line;
end if;
end Usage;
+
end Clean;
projects / platform / upstream / gcc.git / commitdiff