Patchwork [Ada] gnatclean -f ignores nonexistent directories

login
register
mail settings
Submitter Arnaud Charlet
Date April 12, 2013, 1:42 p.m.
Message ID <20130412134245.GA29330@adacore.com>
Download mbox | patch
Permalink /patch/236096/
State New
Headers show

Comments

Arnaud Charlet - April 12, 2013, 1:42 p.m.
When gnatclean is invoked with a project file and the switch -f, if there
are nonexistent object, exec or library directories, these directories
are ignored and gnatclean does not fail.

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-04-12  Vincent Celier  <celier@adacore.com>

	* clean.adb (Parse_Cmd_Line): Set Directories_Must_Exist_In_Projects
	to False if switch is specified.
	* makeutl.adb (Initialize_Source_Record): Do not look for the
	object file if there is no object directory.
	* opt.ads (Directories_Must_Exist_In_Projects): New Boolean
	variable, defaulted to True.
	* prj-nmsc.adb (Check_Library_Attributes): Do not fail if library
	directory does not exist when Directories_Must_Exist_In_Projects is
	False.
	(Get_Directories): Do not fail when the object or the exec directory
	do not exist when Directories_Must_Exist_In_Projects is False.

Patch

Index: makeutl.adb
===================================================================
--- makeutl.adb	(revision 197899)
+++ makeutl.adb	(working copy)
@@ -1256,43 +1256,46 @@ 
          Obj_Proj := Source.Project;
 
          while Obj_Proj /= No_Project loop
-            declare
-               Dir  : constant String :=
-                        Get_Name_String
-                          (Obj_Proj.Object_Directory.Display_Name);
+            if Obj_Proj.Object_Directory /= No_Path_Information then
+               declare
+                  Dir  : constant String :=
+                    Get_Name_String
+                      (Obj_Proj.Object_Directory.Display_Name);
 
-               Object_Path : constant String :=
-                               Normalize_Pathname
-                                 (Name          =>
-                                    Get_Name_String (Source.Object),
-                                  Resolve_Links => Opt.Follow_Links_For_Files,
-                                  Directory     => Dir);
+                  Object_Path : constant String :=
+                    Normalize_Pathname
+                      (Name          =>
+                           Get_Name_String (Source.Object),
+                       Resolve_Links => Opt.Follow_Links_For_Files,
+                       Directory     => Dir);
 
-               Obj_Path : constant Path_Name_Type := Create_Name (Object_Path);
-               Stamp    : Time_Stamp_Type := Empty_Time_Stamp;
+                  Obj_Path : constant Path_Name_Type :=
+                    Create_Name (Object_Path);
+                  Stamp    : Time_Stamp_Type := Empty_Time_Stamp;
 
-            begin
-               --  For specs, we do not check object files if there is a body.
-               --  This saves a system call. On the other hand, we do need to
-               --  know the object_path, in case the user has passed the .ads
-               --  on the command line to compile the spec only.
+               begin
+                  --  For specs, we do not check object files if there is a
+                  --  body. This saves a system call. On the other hand, we do
+                  --  need to know the object_path, in case the user has passed
+                  --  the .ads on the command line to compile the spec only.
 
-               if Source.Kind /= Spec
-                 or else Source.Unit = No_Unit_Index
-                 or else Source.Unit.File_Names (Impl) = No_Source
-               then
-                  Stamp := File_Stamp (Obj_Path);
-               end if;
+                  if Source.Kind /= Spec
+                    or else Source.Unit = No_Unit_Index
+                    or else Source.Unit.File_Names (Impl) = No_Source
+                  then
+                     Stamp := File_Stamp (Obj_Path);
+                  end if;
 
-               if Stamp /= Empty_Time_Stamp
-                 or else (Obj_Proj.Extended_By = No_Project
-                          and then Source.Object_Project = No_Project)
-               then
-                  Set_Object_Project (Dir, Obj_Proj, Obj_Path, Stamp);
-               end if;
+                  if Stamp /= Empty_Time_Stamp
+                    or else (Obj_Proj.Extended_By = No_Project
+                              and then Source.Object_Project = No_Project)
+                  then
+                     Set_Object_Project (Dir, Obj_Proj, Obj_Path, Stamp);
+                  end if;
+               end;
+            end if;
 
-               Obj_Proj := Obj_Proj.Extended_By;
-            end;
+            Obj_Proj := Obj_Proj.Extended_By;
          end loop;
 
       elsif Source.Language.Config.Dependency_Kind = Makefile then
Index: clean.adb
===================================================================
--- clean.adb	(revision 197899)
+++ clean.adb	(working copy)
@@ -1729,6 +1729,7 @@ 
 
                      when 'f' =>
                         Force_Deletions := True;
+                        Directories_Must_Exist_In_Projects := False;
 
                      when 'F' =>
                         Full_Path_Name_For_Brief_Errors := True;
Index: prj-nmsc.adb
===================================================================
--- prj-nmsc.adb	(revision 197917)
+++ prj-nmsc.adb	(working copy)
@@ -3155,16 +3155,19 @@ 
             end if;
 
             if not Dir_Exists then
+               if Directories_Must_Exist_In_Projects then
+                  --  Get the absolute name of the library directory that does
+                  --  not exist, to report an error.
 
-               --  Get the absolute name of the library directory that
-               --  does not exist, to report an error.
+                  Err_Vars.Error_Msg_File_1 :=
+                    File_Name_Type (Project.Library_Dir.Display_Name);
+                  Error_Msg
+                    (Data.Flags,
+                     "library directory { does not exist",
+                     Lib_Dir.Location, Project);
+               end if;
 
-               Err_Vars.Error_Msg_File_1 :=
-                 File_Name_Type (Project.Library_Dir.Display_Name);
-               Error_Msg
-                 (Data.Flags,
-                  "library directory { does not exist",
-                  Lib_Dir.Location, Project);
+               Project.Library_Dir := No_Path_Information;
 
             --  Checks for object/source directories
 
@@ -5407,15 +5410,20 @@ 
                Externally_Built => Project.Externally_Built);
 
             if not Dir_Exists and then not Project.Externally_Built then
+               if Opt.Directories_Must_Exist_In_Projects then
+                  --  The object directory does not exist, report an error if
+                  --  the project is not externally built.
 
-               --  The object directory does not exist, report an error if the
-               --  project is not externally built.
+                  Err_Vars.Error_Msg_File_1 :=
+                    File_Name_Type (Object_Dir.Value);
+                  Error_Or_Warning
+                    (Data.Flags, Data.Flags.Require_Obj_Dirs,
+                     "object directory { not found",
+                     Project.Location, Project);
+               end if;
 
-               Err_Vars.Error_Msg_File_1 :=
-                 File_Name_Type (Object_Dir.Value);
-               Error_Or_Warning
-                 (Data.Flags, Data.Flags.Require_Obj_Dirs,
-                  "object directory { not found", Project.Location, Project);
+               Project.Object_Directory := No_Path_Information;
+
             end if;
          end if;
 
@@ -5488,10 +5496,14 @@ 
                Externally_Built => Project.Externally_Built);
 
             if not Dir_Exists then
-               Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
-               Error_Or_Warning
-                 (Data.Flags, Data.Flags.Missing_Source_Files,
-                  "exec directory { not found", Project.Location, Project);
+               if Opt.Directories_Must_Exist_In_Projects then
+                  Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
+                  Error_Or_Warning
+                    (Data.Flags, Data.Flags.Missing_Source_Files,
+                     "exec directory { not found", Project.Location, Project);
+               end if;
+
+               Project.Exec_Directory := No_Path_Information;
             end if;
          end if;
       end if;
Index: opt.ads
===================================================================
--- opt.ads	(revision 197915)
+++ opt.ads	(working copy)
@@ -436,6 +436,10 @@ 
    --  Set True to force the run time to raise Program_Error if calls to
    --  potentially blocking operations are detected from protected actions.
 
+   Directories_Must_Exist_In_Projects : Boolean := True;
+   --  PROJECT MANAGER
+   --  Set to False with switch -f of gnatclean and gprclean
+
    Display_Compilation_Progress : Boolean := False;
    --  GNATMAKE, GPRMAKE, GPRBUILD
    --  Set True (-d switch) to display information on progress while compiling