From 9f1621753772745306133818df81270a1d758a88 Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Wed, 27 Oct 2004 14:29:44 +0200 Subject: [PATCH] clean.adb (Delete): Do not output warnings when in quiet output and not in verbose mode. 2004-10-26 Vincent Celier * clean.adb (Delete): Do not output warnings when in quiet output and not in verbose mode. (Force_Deletions): New Boolean flag, defaulted to False (Delete): Only delete a file if it is writable, and when Force_Deletions is True. (Parse_Cmd_Line): New switch -f: set Force_Deletions to True (Usage): Line for new switch -f (Clean_Directory): Use GNAT.OS_Lib.Set_Writable instead of rolling our own. From-SVN: r89646 --- gcc/ada/clean.adb | 59 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 24 deletions(-) diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 3f82937..1abfc80 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -43,7 +43,6 @@ with Prj.Ext; with Prj.Pars; with Prj.Util; use Prj.Util; with Snames; -with System; with Table; with Types; use Types; @@ -66,7 +65,7 @@ package body Clean is 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~"; @@ -76,6 +75,10 @@ package body Clean is 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 @@ -93,7 +96,7 @@ package body Clean is 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"; @@ -142,10 +145,10 @@ package body Clean is -- 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. + -- Returns True if Q is empty procedure Extract_From_Q (Lib_File : out File_Name_Type); - -- Extracts the first element from the Q. + -- Extracts the first element from the Q Q_Front : Natural; -- Points to the first valid element in the Q. @@ -364,9 +367,6 @@ package body Clean is Name : String (1 .. 200); Last : Natural; - procedure Set_Writable (Name : System.Address); - pragma Import (C, Set_Writable, "__gnat_set_writable"); - begin Change_Dir (Directory); Open (Direc, "."); @@ -380,8 +380,7 @@ package body Clean is if Is_Regular_File (Name (1 .. Last)) then if not Do_Nothing then - Name (Last + 1) := ASCII.NUL; - Set_Writable (Name (1)'Address); + Set_Writable (Name (1 .. Last)); end if; Delete (Directory, Name (1 .. Last)); @@ -799,7 +798,7 @@ package body Clean is -- 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 @@ -867,10 +866,10 @@ package body Clean is 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 declare @@ -950,20 +949,28 @@ package body Clean is 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)) + 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; @@ -1383,6 +1390,9 @@ package body Clean is end; end if; + when 'f' => + Force_Deletions := True; + when 'F' => Full_Path_Name_For_Brief_Errors := True; @@ -1591,6 +1601,7 @@ package body Clean is Put_Line (" -c Only delete compiler generated files"); Put_Line (" -D dir Specify dir as the object library"); + 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"); -- 2.7.4