-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2011, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Ada.Command_Line; use Ada.Command_Line;
-
with ALI; use ALI;
with Csets;
-with Gnatvsn;
-with Hostparm;
with Makeutl; use Makeutl;
with MLib.Tgt; use MLib.Tgt;
with Namet; use Namet;
with Osint; use Osint;
with Osint.M; use Osint.M;
with Prj; use Prj;
-with Prj.Com;
with Prj.Env;
with Prj.Ext;
with Prj.Pars;
+with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
+with Sdefault;
with Snames;
-with System;
+with Switch; use Switch;
with Table;
+with Targparm; use Targparm;
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;
Assembly_Suffix : constant String := ".s";
ALI_Suffix : constant String := ".ali";
Tree_Suffix : constant String := ".adt";
- Object_Suffix : constant String := Get_Object_Suffix.all;
+ Object_Suffix : constant String := Get_Target_Object_Suffix.all;
Debug_Suffix : String := ".dg";
-- Changed to "_dg" for VMS in the body of the package
- Repinfo_Suffix : String := ".rep";
+ Repinfo_Suffix : String := ".rep";
-- Changed to "_rep" for VMS in the body of the package
- B_Start : String := "b~";
- -- Prefix of binder generated file.
- -- Changed to "b$" for VMS in the body of the package.
+ B_Start : String_Ptr := new String'("b~");
+ -- Prefix of binder generated file, and number of actual characters used.
+ -- Changed to "b__" for VMS in the body of the package.
+
+ Project_Tree : constant Project_Tree_Ref :=
+ new Project_Tree_Data (Is_Root_Tree => True);
+ -- The project tree
Object_Directory_Path : String_Access := null;
-- The path name of the object directory, set with switch -D
+ Force_Deletions : Boolean := False;
+ -- Set to True by switch -f. When True, attempts to delete non writable
+ -- files will be done.
+
Do_Nothing : Boolean := False;
- -- Set to True when switch -n is specified.
- -- When True, no file is deleted. gnatclean only lists the files that
- -- would have been deleted if the switch -n had not been specified.
+ -- Set to True when switch -n is specified. When True, no file is deleted.
+ -- gnatclean only lists the files that would have been deleted if the
+ -- switch -n had not been specified.
File_Deleted : Boolean := False;
-- Set to True if at least one file has been deleted
Project_File_Name : String_Access := null;
+ Project_Node_Tree : Project_Node_Tree_Ref;
+
+ Root_Environment : Prj.Tree.Environment;
+
Main_Project : Prj.Project_Id := Prj.No_Project;
All_Projects : Boolean := False;
- -- Packages of project files where unknown attributes are errors.
+ -- Packages of project files where unknown attributes are errors
Naming_String : aliased String := "naming";
Builder_String : aliased String := "builder";
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 10,
- Table_Increment => 10,
+ Table_Increment => 100,
Table_Name => "Clean.Processed_Projects");
-- Table to keep track of what project files have been processed, when
-- switch -r is specified.
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 10,
- Table_Increment => 10,
+ Table_Increment => 100,
Table_Name => "Clean.Processed_Projects");
-- Table to store all the source files of a library unit: spec, body and
-- subunits, to detect .dg files and delete them.
- ----------------------------
- -- Queue (Q) manipulation --
- ----------------------------
-
- procedure Init_Q;
- -- Must be called to initialize the Q
-
- procedure Insert_Q (Lib_File : File_Name_Type);
- -- If Lib_File is not marked, inserts it at the end of Q and mark it
-
- function Empty_Q return Boolean;
- -- Returns True if Q is empty.
-
- procedure Extract_From_Q (Lib_File : out File_Name_Type);
- -- Extracts the first element from the Q.
-
- Q_Front : Natural;
- -- Points to the first valid element in the Q.
-
- package Q is new Table.Table (
- Table_Component_Type => File_Name_Type,
- Table_Index_Type => Natural,
- Table_Low_Bound => 0,
- Table_Initial => 4000,
- Table_Increment => 100,
- Table_Name => "Clean.Q");
- -- This is the actual queue
-
-----------------------------
-- Other local subprograms --
-----------------------------
procedure Add_Source_Dir (N : String);
- -- Call Add_Src_Search_Dir.
- -- Output one line when in verbose mode.
+ -- Call Add_Src_Search_Dir and output one line when in verbose mode
procedure Add_Source_Directories is
new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
procedure Add_Object_Dir (N : String);
- -- Call Add_Lib_Search_Dir.
- -- Output one line when in verbose mode.
+ -- Call Add_Lib_Search_Dir and output one line when in verbose mode
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);
- -- 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_Archive (Project : Project_Id; Global : Boolean);
+ -- Delete a global archive or library project archive and the dependency
+ -- file, if they exist.
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 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 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
- -- project files in the tree rooted at the main project file and switch -r
- -- has been specified.
+ -- Do the cleaning work when a project file is specified. This procedure
+ -- calls itself recursively when there are several 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
-- an extension of Prj.
procedure Usage;
- -- Display the usage.
- -- If called several times, the usage is displayed only the first time.
+ -- Display the usage. If called several times, the usage is displayed only
+ -- the first time.
--------------------
-- Add_Object_Dir --
-- 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
-- Clean_Archive --
-------------------
- procedure Clean_Archive (Project : Project_Id) is
+ procedure Clean_Archive (Project : Project_Id; Global : Boolean) is
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
- Data : constant Project_Data := Projects.Table (Project);
- Archive_Name : constant String :=
- "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
+ Lib_Prefix : String_Access;
+ Archive_Name : String_Access;
-- The name of the archive file for this project
- Archive_Dep_Name : constant String :=
- "lib" & Get_Name_String (Data.Name) & ".deps";
+ Archive_Dep_Name : String_Access;
-- 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 (Project.Object_Directory.Display_Name);
begin
Change_Dir (Obj_Dir);
- if Is_Regular_File (Archive_Name) then
- Delete (Obj_Dir, Archive_Name);
- end if;
+ -- First, get the lib prefix, the archive file name and the archive
+ -- dependency file name.
- if Is_Regular_File (Archive_Dep_Name) then
- Delete (Obj_Dir, Archive_Dep_Name);
+ if Global then
+ Lib_Prefix :=
+ new String'("lib" & Get_Name_String (Project.Display_Name));
+ else
+ Lib_Prefix :=
+ new String'("lib" & Get_Name_String (Project.Library_Name));
end if;
- 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;
-
- procedure Set_Writable (Name : System.Address);
- pragma Import (C, Set_Writable, "__gnat_set_writable");
+ Archive_Name := new String'(Lib_Prefix.all & '.' & Archive_Ext);
+ Archive_Dep_Name := new String'(Lib_Prefix.all & ".deps");
- 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
- Name (Last + 1) := ASCII.NUL;
- Set_Writable (Name (1)'Address);
- end if;
+ -- Delete the archive file and the archive dependency file, if they
+ -- exist.
- Delete (Directory, Name (1 .. Last));
- end if;
- end loop;
-
- Close (Direc);
+ if Is_Regular_File (Archive_Name.all) then
+ Delete (Obj_Dir, Archive_Name.all);
+ end if;
- -- Restore the initial working directory
+ if Is_Regular_File (Archive_Dep_Name.all) then
+ Delete (Obj_Dir, Archive_Dep_Name.all);
+ end if;
- Change_Dir (Current);
- end Clean_Directory;
+ Change_Dir (Current_Dir);
+ end Clean_Archive;
-----------------------
-- Clean_Executables --
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;
+ Found : Boolean;
+ Source : Queue.Source_Info;
begin
- Init_Q;
+ Queue.Initialize (Queue_Per_Obj_Dir => False);
-- It does not really matter if there is or not an object file
-- corresponding to an ALI file: if there is one, it will be deleted.
for N_File in 1 .. Osint.Number_Of_Files loop
Main_Source_File := Next_Main_Source;
- Main_Lib_File := Osint.Lib_File_Name
- (Main_Source_File, Current_File_Index);
- Insert_Q (Main_Lib_File);
+ Main_Lib_File :=
+ Osint.Lib_File_Name (Main_Source_File, Current_File_Index);
+
+ if Main_Lib_File /= No_File then
+ Queue.Insert
+ ((Format => Format_Gnatmake,
+ File => Main_Lib_File,
+ Unit => No_Unit_Name,
+ Index => 0,
+ Project => No_Project));
+ end if;
- while not Empty_Q loop
+ while not Queue.Is_Empty loop
Sources.Set_Last (0);
- Extract_From_Q (Lib_File);
+ Queue.Extract (Found, Source);
+ pragma Assert (Found);
+ pragma Assert (Source.File /= No_File);
+ Lib_File := Source.File;
Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
-- If we have existing ALI file that is not read-only, process it
for K in ALI.Units.Table (J).First_With ..
ALI.Units.Table (J).Last_With
loop
- Insert_Q (Withs.Table (K).Afile);
+ if Withs.Table (K).Afile /= No_File then
+ Queue.Insert
+ ((Format => Format_Gnatmake,
+ File => Withs.Table (K).Afile,
+ Unit => No_Unit_Name,
+ Index => 0,
+ Project => No_Project));
+ end if;
end loop;
end loop;
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);
end loop;
end Clean_Executables;
+ ------------------------------------
+ -- Clean_Interface_Copy_Directory --
+ ------------------------------------
+
+ procedure Clean_Interface_Copy_Directory (Project : Project_Id) is
+ Current : constant String := Get_Current_Dir;
+
+ Direc : Dir_Type;
+
+ Name : String (1 .. 200);
+ Last : Natural;
+
+ Delete_File : Boolean;
+ Unit : Unit_Index;
+
+ begin
+ if Project.Library
+ and then Project.Library_Src_Dir /= No_Path_Information
+ then
+ declare
+ Directory : constant String :=
+ Get_Name_String (Project.Library_Src_Dir.Display_Name);
+
+ 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 if it is
+ -- a copy of a source of the project.
+
+ loop
+ Read (Direc, Name, Last);
+ exit when Last = 0;
+
+ declare
+ Filename : constant String := Name (1 .. Last);
+
+ begin
+ if Is_Regular_File (Filename) then
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete_File := False;
+
+ Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
+
+ -- Compare with source file names of the project
+
+ while Unit /= No_Unit_Index loop
+ if Unit.File_Names (Impl) /= null
+ and then Ultimate_Extending_Project_Of
+ (Unit.File_Names (Impl).Project) = Project
+ and then
+ Get_Name_String (Unit.File_Names (Impl).File) =
+ Name (1 .. Last)
+ then
+ Delete_File := True;
+ exit;
+ end if;
+
+ if Unit.File_Names (Spec) /= null
+ and then Ultimate_Extending_Project_Of
+ (Unit.File_Names (Spec).Project) = Project
+ and then
+ Get_Name_String
+ (Unit.File_Names (Spec).File) = Name (1 .. Last)
+ then
+ Delete_File := True;
+ exit;
+ end if;
+
+ Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
+ end loop;
+
+ if Delete_File then
+ if not Do_Nothing then
+ Set_Writable (Filename);
+ end if;
+
+ Delete (Directory, Filename);
+ end if;
+ end if;
+ end;
+ end loop;
+
+ Close (Direc);
+
+ -- Restore the initial working directory
+
+ Change_Dir (Current);
+ end;
+ end if;
+ end Clean_Interface_Copy_Directory;
+
+ -----------------------------
+ -- Clean_Library_Directory --
+ -----------------------------
+
+ Empty_String : aliased String := "";
+
+ procedure Clean_Library_Directory (Project : Project_Id) is
+ Current : constant String := Get_Current_Dir;
+
+ Lib_Filename : constant String := Get_Name_String (Project.Library_Name);
+ DLL_Name : String :=
+ DLL_Prefix & Lib_Filename & "." & DLL_Ext;
+ Archive_Name : String :=
+ "lib" & Lib_Filename & "." & Archive_Ext;
+ Direc : Dir_Type;
+
+ Name : String (1 .. 200);
+ Last : Natural;
+
+ Delete_File : Boolean;
+
+ Minor : String_Access := Empty_String'Access;
+ Major : String_Access := Empty_String'Access;
+
+ begin
+ if Project.Library then
+ if Project.Library_Kind /= Static
+ and then MLib.Tgt.Library_Major_Minor_Id_Supported
+ and then Project.Lib_Internal_Name /= No_Name
+ then
+ Minor := new String'(Get_Name_String (Project.Lib_Internal_Name));
+ Major := new String'(MLib.Major_Id_Name (DLL_Name, Minor.all));
+ end if;
+
+ declare
+ Lib_Directory : constant String :=
+ Get_Name_String
+ (Project.Library_Dir.Display_Name);
+ Lib_ALI_Directory : constant String :=
+ Get_Name_String
+ (Project.Library_ALI_Dir.Display_Name);
+
+ begin
+ Canonical_Case_File_Name (Archive_Name);
+ Canonical_Case_File_Name (DLL_Name);
+
+ 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;
+
+ declare
+ Filename : constant String := Name (1 .. Last);
+
+ begin
+ if Is_Regular_File (Filename)
+ or else Is_Symbolic_Link (Filename)
+ then
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete_File := False;
+
+ if (Project.Library_Kind = Static
+ and then Name (1 .. Last) = Archive_Name)
+ or else
+ ((Project.Library_Kind = Dynamic
+ or else
+ Project.Library_Kind = Relocatable)
+ and then
+ (Name (1 .. Last) = DLL_Name
+ or else
+ Name (1 .. Last) = Minor.all
+ or else
+ Name (1 .. Last) = Major.all))
+ then
+ if not Do_Nothing then
+ Set_Writable (Filename);
+ end if;
+
+ Delete (Lib_Directory, Filename);
+ end if;
+ end if;
+ end;
+ 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;
+
+ 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_Index;
+ begin
+ -- Compare with ALI file names of the project
+
+ Unit := Units_Htable.Get_First
+ (Project_Tree.Units_HT);
+ while Unit /= No_Unit_Index loop
+ if Unit.File_Names (Impl) /= null
+ and then Unit.File_Names (Impl).Project /=
+ No_Project
+ then
+ if Ultimate_Extending_Project_Of
+ (Unit.File_Names (Impl).Project) =
+ Project
+ then
+ Get_Name_String
+ (Unit.File_Names (Impl).File);
+ 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 Unit.File_Names (Spec) /= null
+ and then Ultimate_Extending_Project_Of
+ (Unit.File_Names (Spec).Project) =
+ Project
+ then
+ Get_Name_String
+ (Unit.File_Names (Spec).File);
+ 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;
+
+ Unit :=
+ Units_Htable.Get_Next (Project_Tree.Units_HT);
+ end loop;
+ end;
+ end if;
+
+ if Delete_File then
+ if not Do_Nothing then
+ Set_Writable (Filename);
+ end if;
+
+ Delete (Lib_ALI_Directory, Filename);
+ end if;
+ end if;
+ end;
+ end loop;
+
+ Close (Direc);
+
+ -- Restore the initial working directory
+
+ Change_Dir (Current);
+ end;
+ end if;
+ end Clean_Library_Directory;
+
-------------------
-- Clean_Project --
-------------------
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 := Projects.Table (Project);
- U_Data : Prj.Com.Unit_Data;
- File_Name1 : Name_Id;
+ Unit : Unit_Index;
+ File_Name1 : File_Name_Type;
Index1 : Int;
- File_Name2 : Name_Id;
+ File_Name2 : File_Name_Type;
Index2 : Int;
Lib_File : File_Name_Type;
- Source_Id : Other_Source_Id;
- Source : Other_Source;
-
Global_Archive : Boolean := False;
- use Prj.Com;
-
begin
-- Check that we don't specify executable on the command line for
-- a main library project.
if Project = Main_Project
and then Osint.Number_Of_Files /= 0
- and then Data.Library
+ and then Project.Library
then
Osint.Fail
("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 proceesed projects
+ if Project.Externally_Built then
+ if Verbose_Mode then
+ Put ("Nothing to do to clean externally built project """);
+ Put (Get_Name_String (Project.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 (Project.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 Project.Object_Directory /= No_Path_Information then
+ declare
+ Obj_Dir : constant String :=
+ Get_Name_String
+ (Project.Object_Directory.Display_Name);
- -- Look through the units to find those that are either immediate
- -- sources or inherited sources of the project.
+ begin
+ Change_Dir (Obj_Dir);
+
+ -- First, deal with Ada
+
+ -- 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 Has_Ada_Sources (Project)
+ or else Project.Extends /= No_Project
+ then
+ Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
+ while Unit /= No_Unit_Index loop
+ 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
+ -- object directory.
+
+ if (Unit.File_Names (Impl) /= null
+ and then
+ In_Extension_Chain
+ (Unit.File_Names (Impl).Project, Project))
+ or else
+ (Unit.File_Names (Spec) /= null
+ and then In_Extension_Chain
+ (Unit.File_Names (Spec).Project, Project))
+ then
+ if Unit.File_Names (Impl) /= null then
+ File_Name1 := Unit.File_Names (Impl).File;
+ Index1 := Unit.File_Names (Impl).Index;
+ else
+ File_Name1 := No_File;
+ Index1 := 0;
+ end if;
- if Data.Languages (Lang_Ada) then
- for Unit in 1 .. Prj.Com.Units.Last loop
- U_Data := Prj.Com.Units.Table (Unit);
- File_Name1 := No_Name;
- File_Name2 := No_Name;
+ if Unit.File_Names (Spec) /= null then
+ File_Name2 := Unit.File_Names (Spec).File;
+ Index2 := Unit.File_Names (Spec).Index;
+ else
+ File_Name2 := No_File;
+ Index2 := 0;
+ end if;
- -- If either the spec or the body is a source of the
- -- project, check for the corresponding ALI file in the
- -- object directory.
+ -- If there is no body file name, then there may be
+ -- only a spec.
- 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 File_Name1 = No_File then
+ File_Name1 := File_Name2;
+ Index1 := Index2;
+ File_Name2 := No_File;
+ 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_File 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;
-
- -- Second expanded source file
-
- if File_Name2 /= No_Name then
- declare
- Deb : constant String :=
- Debug_File_Name (File_Name2);
- Rep : constant String :=
- Repinfo_File_Name (File_Name2);
- begin
- if Is_Regular_File (Deb) then
- Delete (Obj_Dir, Deb);
- end if;
+ if Is_Regular_File (Rep) then
+ Delete (Obj_Dir, Rep);
+ end if;
- if Is_Regular_File (Rep) then
- Delete (Obj_Dir, Rep);
- end if;
- end;
- end if;
- end if;
- end;
- end if;
- end loop;
- end if;
+ -- Second expanded source file
- -- Check if a global archive and it dependency file could have
- -- been created and, if they exist, delete them.
+ if File_Name2 /= No_File then
+ declare
+ Deb : constant String :=
+ Debug_File_Name (File_Name2);
+ Rep : constant String :=
+ Repinfo_File_Name (File_Name2);
- if Project = Main_Project and then not Data.Library then
- Global_Archive := False;
+ begin
+ if Is_Regular_File (Deb) then
+ Delete (Obj_Dir, Deb);
+ end if;
- for Proj in 1 .. Projects.Last loop
- if Projects.Table (Proj).Other_Sources_Present then
- Global_Archive := True;
- exit;
- end if;
- end loop;
+ if Is_Regular_File (Rep) then
+ Delete (Obj_Dir, Rep);
+ end if;
+ end;
+ end if;
+ end if;
+ end;
+ end if;
- if Global_Archive then
- Clean_Archive (Project);
+ Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
+ end loop;
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.
-
- Source_Id := Data.First_Other_Source;
+ -- 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 Project.Library then
+ Global_Archive := False;
+
+ declare
+ Proj : Project_List;
+
+ begin
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+
+ -- For gnatmake, when the project specifies more than
+ -- just Ada as a language (even if course we could not
+ -- find any source file for the other languages), we
+ -- will take all the object files found in the object
+ -- directories. Since we know the project supports at
+ -- least Ada, we just have to test whether it has at
+ -- least two languages, and we do not care about the
+ -- sources.
+
+ if Proj.Project.Languages /= null
+ and then Proj.Project.Languages.Next /= null
+ then
+ Global_Archive := True;
+ exit;
+ end if;
- while Source_Id /= No_Other_Source loop
- Source := Other_Sources.Table (Source_Id);
+ Proj := Proj.Next;
+ end loop;
+ end;
- if Is_Regular_File
- (Get_Name_String (Source.Object_Name))
- then
- Delete (Obj_Dir, Get_Name_String (Source.Object_Name));
+ if Global_Archive then
+ Clean_Archive (Project, Global => True);
end if;
+ end if;
- if Is_Regular_File (Get_Name_String (Source.Dep_Name)) then
- Delete (Obj_Dir, Get_Name_String (Source.Dep_Name));
- end if;
+ end;
+ end if;
- Source_Id := Source.Next;
- end loop;
+ -- 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 it is a library with only non Ada sources, delete
- -- the fake archive and the dependency file, if they exist.
+ -- The directories are cleaned only if switch -c is not specified
- if Data.Library and then not Data.Languages (Lang_Ada) then
- Clean_Archive (Project);
+ if Project.Library then
+ if not Compile_Only then
+ Clean_Library_Directory (Project);
+
+ if Project.Library_Src_Dir /= No_Path_Information then
+ Clean_Interface_Copy_Directory (Project);
end if;
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.
-
- -- 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_Src_Dir /= No_Name
- and then Data.Library_Src_Dir /= Data.Library_Dir
+ if Project.Standalone_Library /= No
+ and then Project.Object_Directory /= No_Path_Information
then
- Clean_Directory (Data.Library_Src_Dir);
+ Delete_Binder_Generated_Files
+ (Get_Name_String (Project.Object_Directory.Display_Name),
+ File_Name_Type (Project.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.
if All_Projects then
declare
- Imported : Project_List := Data.Imported_Projects;
- Element : Project_Element;
+ Imported : Project_List;
Process : Boolean;
begin
-- For each imported project, call Clean_Project if the project
-- has not been processed already.
- while Imported /= Empty_Project_List loop
- Element := Project_Lists.Table (Imported);
- Imported := Element.Next;
+ Imported := Project.Imported_Projects;
+ while Imported /= null loop
Process := True;
for
J in Processed_Projects.First .. Processed_Projects.Last
loop
- if Element.Project = Processed_Projects.Table (J) then
+ if Imported.Project = Processed_Projects.Table (J) then
Process := False;
exit;
end if;
end loop;
if Process then
- Clean_Project (Element.Project);
+ Clean_Project (Imported.Project);
end if;
+
+ Imported := Imported.Next;
end loop;
-- If this project extends another project, call Clean_Project for
-- called before, because no other project may import or extend
-- this project.
- if Data.Extends /= No_Project then
- Clean_Project (Data.Extends);
+ if Project.Extends /= No_Project then
+ Clean_Project (Project.Extends);
end if;
end;
end if;
- -- For the main project, delete the executables and the
- -- binder generated files.
+ -- For the main project, delete the executables and the binder
+ -- generated files.
- -- The executables are deleted only if switch -c is not specified.
+ -- 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 Project.Exec_Directory /= No_Path_Information
+ then
declare
Exec_Dir : constant String :=
- Get_Name_String (Data.Exec_Directory);
+ Get_Name_String (Project.Exec_Directory.Display_Name);
+
begin
Change_Dir (Exec_Dir);
Executable :=
Executable_Of
(Main_Project,
+ Project_Tree.Shared,
Main_Source_File,
Current_File_Index);
- if Is_Regular_File (Get_Name_String (Executable)) then
- Delete (Exec_Dir, Get_Name_String (Executable));
- end if;
+ declare
+ Exec_File_Name : constant String :=
+ Get_Name_String (Executable);
+
+ begin
+ if Is_Absolute_Path (Name => Exec_File_Name) then
+ if Is_Regular_File (Exec_File_Name) then
+ Delete ("", Exec_File_Name);
+ end if;
+
+ else
+ if Is_Regular_File (Exec_File_Name) then
+ Delete (Exec_Dir, Exec_File_Name);
+ end if;
+ end if;
+ end;
end if;
- if Data.Object_Directory /= No_Name then
+ if Project.Object_Directory /= No_Path_Information then
Delete_Binder_Generated_Files
- (Get_Name_String
- (Data.Object_Directory),
+ (Get_Name_String (Project.Object_Directory.Display_Name),
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
if Do_Nothing then
Put_Line (Full_Name (1 .. Last));
- -- Otherwise, delete the file
+ -- Otherwise, delete the file if it is writable
else
- Delete_File (Full_Name (1 .. Last), Success);
+ if Force_Deletions
+ or else Is_Writable_File (Full_Name (1 .. Last))
+ or else Is_Symbolic_Link (Full_Name (1 .. Last))
+ then
+ Delete_File (Full_Name (1 .. Last), Success);
+ else
+ Success := False;
+ end if;
- if not Success then
- Put ("Warning: """);
- Put (Full_Name (1 .. Last));
- Put_Line (""" could not be deleted");
+ if Verbose_Mode or else not Quiet_Output then
+ if not Success then
+ Put ("Warning: """);
+ Put (Full_Name (1 .. Last));
+ Put_Line (""" could not be deleted");
- elsif Verbose_Mode or else not Quiet_Output then
- Put ("""");
- Put (Full_Name (1 .. Last));
- Put_Line (""" has been deleted");
+ else
+ Put ("""");
+ Put (Full_Name (1 .. Last));
+ Put_Line (""" has been deleted");
+ end if;
end if;
end if;
end Delete;
-- Delete_Binder_Generated_Files --
-----------------------------------
- procedure Delete_Binder_Generated_Files (Dir : String; Source : Name_Id) is
- Source_Name : constant String := Get_Name_String (Source);
- Current : constant String := Get_Current_Dir;
+ 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;
File_Name : String (1 .. Last + 4);
-- Build the file name (before the extension)
- File_Name (1 .. B_Start'Length) := B_Start;
+ File_Name (1 .. B_Start'Length) := B_Start.all;
File_Name (B_Start'Length + 1 .. Last) := Source_Name;
-- Spec
begin
if not Copyright_Displayed then
Copyright_Displayed := True;
- Put_Line ("GNATCLEAN " & Gnatvsn.Gnat_Version_String
- & " Copyright 2003-2004 Free Software Foundation, Inc.");
+ Display_Version ("GNATCLEAN", "2003");
end if;
end Display_Copyright;
- -------------
- -- Empty_Q --
- -------------
-
- function Empty_Q return Boolean is
- begin
- return Q_Front >= Q.Last;
- end Empty_Q;
-
- --------------------
- -- Extract_From_Q --
- --------------------
-
- procedure Extract_From_Q (Lib_File : out File_Name_Type) is
- Lib : constant File_Name_Type := Q.Table (Q_Front);
-
- begin
- Q_Front := Q_Front + 1;
- Lib_File := Lib;
- end Extract_From_Q;
-
---------------
-- Gnatclean --
---------------
-- Set the project parsing verbosity to whatever was specified
-- by a possible -vP switch.
- Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity);
+ Prj.Pars.Set_Verbosity (To => Current_Verbosity);
-- Parse the project file. If there is an error, Main_Project
-- will still be No_Project.
Prj.Pars.Parse
(Project => Main_Project,
+ In_Tree => Project_Tree,
+ In_Node_Tree => Project_Node_Tree,
Project_File_Name => Project_File_Name.all,
- Packages_To_Check => Packages_To_Check_By_Gnatmake,
- Process_Languages => All_Languages);
+ Env => Root_Environment,
+ Packages_To_Check => Packages_To_Check_By_Gnatmake);
if Main_Project = No_Project then
Fail ("""" & Project_File_Name.all & """ processing failed");
New_Line;
end if;
- -- We add the source directories and the object directories
- -- to the search paths.
-
- Add_Source_Directories (Main_Project);
- Add_Object_Directories (Main_Project);
+ -- Add source directories and object directories to the search paths
+ Add_Source_Directories (Main_Project, Project_Tree);
+ Add_Object_Directories (Main_Project, Project_Tree);
end if;
Osint.Add_Default_Search_Dirs;
if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
declare
- Value : String_List_Id := Projects.Table (Main_Project).Mains;
Main : String_Element;
+ Value : String_List_Id := Main_Project.Mains;
begin
while Value /= Prj.Nil_String loop
- Main := String_Elements.Table (Value);
+ Main := Project_Tree.Shared.String_Elements.Table (Value);
Osint.Add_File
(File_Name => Get_Name_String (Main.Value),
Index => Main.Index);
end;
end if;
- -- If neither a project file nor an executable were specified,
- -- output the usage and exit.
+ -- If neither a project file nor an executable were specified, output
+ -- the usage and exit.
if Main_Project = No_Project and then Osint.Number_Of_Files = 0 then
Usage;
Clean_Executables;
end if;
- -- In verbose mode, if Delete has not been called, indicate that
- -- no file needs to be deleted.
+ -- In verbose mode, if Delete has not been called, indicate that no file
+ -- needs to be deleted.
if Verbose_Mode and (not File_Deleted) then
New_Line;
(Of_Project : Project_Id;
Prj : Project_Id) return Boolean
is
- Data : Project_Data;
+ Proj : Project_Id;
begin
+ if Prj = No_Project or else Of_Project = No_Project then
+ return False;
+ end if;
+
if Of_Project = Prj then
return True;
end if;
- Data := Projects.Table (Of_Project);
-
- while Data.Extends /= No_Project loop
- if Data.Extends = Prj then
+ Proj := Of_Project;
+ while Proj.Extends /= No_Project loop
+ if Proj.Extends = Prj then
return True;
end if;
- Data := Projects.Table (Data.Extends);
+ Proj := Proj.Extends;
end loop;
- Data := Projects.Table (Prj);
-
- while Data.Extends /= No_Project loop
- if Data.Extends = Of_Project then
+ Proj := Prj;
+ while Proj.Extends /= No_Project loop
+ if Proj.Extends = Of_Project then
return True;
end if;
- Data := Projects.Table (Data.Extends);
+ Proj := Proj.Extends;
end loop;
return False;
end In_Extension_Chain;
- ------------
- -- Init_Q --
- ------------
-
- procedure Init_Q is
- begin
- Q_Front := Q.First;
- Q.Set_Last (Q.First);
- end Init_Q;
-
----------------
-- Initialize --
----------------
if not Initialized then
Initialized := True;
+ -- Get default search directories to locate system.ads when calling
+ -- Targparm.Get_Target_Parameters.
+
+ Osint.Add_Default_Search_Dirs;
+
-- Initialize some packages
Csets.Initialize;
- Namet.Initialize;
Snames.Initialize;
- Prj.Initialize;
+
+ Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
+ Prj.Env.Initialize_Default_Project_Path
+ (Root_Environment.Project_Path,
+ Target_Name => Sdefault.Target_Name.all);
+
+ Project_Node_Tree := new Project_Node_Tree_Data;
+ Prj.Tree.Initialize (Project_Node_Tree);
+
+ Prj.Initialize (Project_Tree);
+
+ -- Check if the platform is VMS and, if it is, change some variables
+
+ Targparm.Get_Target_Parameters;
+
+ if OpenVMS_On_Target then
+ Debug_Suffix (Debug_Suffix'First) := '_';
+ Repinfo_Suffix (Repinfo_Suffix'First) := '_';
+ B_Start := new String'("b__");
+ end if;
end if;
-- Reset global variables
All_Projects := False;
end Initialize;
- --------------
- -- Insert_Q --
- --------------
-
- procedure Insert_Q (Lib_File : File_Name_Type) is
- begin
- -- Do not insert an empty name or an already marked source
-
- if Lib_File /= No_Name and then not Is_Marked (Lib_File) then
- Q.Table (Q.Last) := Lib_File;
- Q.Increment_Last;
-
- -- Mark the source that has been just added to the Q
-
- Mark (Lib_File);
- end if;
- end Insert_Q;
-
----------------------
-- 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;
+
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
begin
+ -- First, check for --version and --help
+
+ Check_Version_And_Help ("GNATCLEAN", "2003");
+
+ Index := 1;
while Index <= Last loop
declare
Arg : constant String := Argument (Index);
procedure Bad_Argument is
begin
- Fail ("invalid argument """, Arg, """");
+ Fail ("invalid argument """ & Arg & """");
end Bad_Argument;
begin
end if;
case Arg (2) is
+ when '-' =>
+ if Arg'Length > Subdirs_Option'Length and then
+ Arg (1 .. Subdirs_Option'Length) = Subdirs_Option
+ then
+ Subdirs :=
+ new String'
+ (Arg (Subdirs_Option'Length + 1 .. Arg'Last));
+
+ elsif Arg = Makeutl.Unchecked_Shared_Lib_Imports then
+ Opt.Unchecked_Shared_Lib_Imports := True;
+
+ else
+ Bad_Argument;
+ end if;
+
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.Env.Add_Directories
+ (Root_Environment.Project_Path,
+ Arg (4 .. Arg'Last));
+
+ else
+ Bad_Argument;
+ end if;
when 'c' =>
Compile_Only := True;
Dir : constant String := Arg (3 .. Arg'Last);
begin
if not Is_Directory (Dir) then
- Fail (Dir, " is not a directory");
+ Fail (Dir & " is not a directory");
else
Add_Lib_Search_Dir (Dir);
end if;
Dir : constant String := Argument (Index);
begin
if not Is_Directory (Dir) then
- Fail (Dir, " is not a directory");
+ Fail (Dir & " is not a directory");
else
Add_Lib_Search_Dir (Dir);
end if;
end;
end if;
+ when 'e' =>
+ if Arg = "-eL" then
+ Follow_Links_For_Files := True;
+ Follow_Links_For_Dirs := True;
+
+ else
+ Bad_Argument;
+ end if;
+
+ when 'f' =>
+ Force_Deletions := True;
+
when 'F' =>
Full_Path_Name_For_Brief_Errors := True;
Verbose_Mode := True;
elsif Arg = "-vP0" then
- Prj.Com.Current_Verbosity := Prj.Default;
+ Current_Verbosity := Prj.Default;
elsif Arg = "-vP1" then
- Prj.Com.Current_Verbosity := Prj.Medium;
+ Current_Verbosity := Prj.Medium;
elsif Arg = "-vP2" then
- Prj.Com.Current_Verbosity := Prj.High;
+ Current_Verbosity := Prj.High;
else
Bad_Argument;
Ext_Asgn : constant String := Arg (3 .. Arg'Last);
Start : Positive := Ext_Asgn'First;
Stop : Natural := Ext_Asgn'Last;
- Equal_Pos : Natural;
OK : Boolean := True;
begin
end if;
end if;
- Equal_Pos := Start;
-
- while Equal_Pos <= Stop
- and then Ext_Asgn (Equal_Pos) /= '='
- loop
- Equal_Pos := Equal_Pos + 1;
- end loop;
-
- if Equal_Pos = Start or else Equal_Pos > Stop then
- OK := False;
- end if;
-
- if OK then
- Prj.Ext.Add
- (External_Name =>
- Ext_Asgn (Start .. Equal_Pos - 1),
- Value =>
- Ext_Asgn (Equal_Pos + 1 .. Stop));
-
- else
+ if not OK
+ or else not
+ Prj.Ext.Check (Root_Environment.External,
+ Ext_Asgn (Start .. Stop))
+ then
Fail
- ("illegal external assignment '",
- Ext_Asgn, "'");
+ ("illegal external assignment '"
+ & Ext_Asgn
+ & "'");
end if;
end;
-- 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
- -- If the source name has an extension, then replace it with
- -- the tree suffix.
+ -- If source name has an extension, then replace it with the tree suffix
for Index in reverse Src'First + 1 .. Src'Last loop
if Src (Index) = '.' then
Put_Line ("Usage: gnatclean [switches] {[-innn] name}");
New_Line;
+ Display_Usage_Version_And_Help;
+
Put_Line (" names is one or more file names from which " &
"the .adb or .ads suffix may be omitted");
Put_Line (" names may be omitted if -P<project> is specified");
New_Line;
+ Put_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs");
+ Put_Line (" " & Makeutl.Unchecked_Shared_Lib_Imports);
+ Put_Line (" Allow shared libraries to import static libraries");
+ New_Line;
+
Put_Line (" -c Only delete compiler generated files");
Put_Line (" -D dir Specify dir as the object library");
+ Put_Line (" -eL Follow symbolic links when processing " &
+ "project files");
+ Put_Line (" -f Force deletions of unwritable files");
Put_Line (" -F Full project path name " &
"in brief error messages");
Put_Line (" -h Display this message");
"for GNAT Project Files");
New_Line;
+ Put_Line (" -aPdir Add directory dir to project search path");
+ New_Line;
+
Put_Line (" -aOdir Specify ALI/object files search path");
Put_Line (" -Idir Like -aOdir");
Put_Line (" -I- Don't look for source/library files " &
end if;
end Usage;
-begin
- if Hostparm.OpenVMS then
- Debug_Suffix (Debug_Suffix'First) := '_';
- Repinfo_Suffix (Repinfo_Suffix'First) := '_';
- B_Start (B_Start'Last) := '$';
- end if;
end Clean;
OSDN Git Service
