===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2004-2016, 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- --
@@ -597,7 +597,6 @@
-----------------
procedure Delete_Tree (Directory : String) is
- Current_Dir : constant String := Current_Directory;
Search : Search_Type;
Dir_Ent : Directory_Entry_Type;
begin
@@ -611,28 +610,32 @@
raise Name_Error with '"' & Directory & """ not a directory";
else
- Set_Directory (Directory);
- Start_Search (Search, Directory => ".", Pattern => "");
+ -- We used to change the current directory to Directory here,
+ -- allowing the use of a local Simple_Name for all references. This
+ -- turned out unfriendly to multitasking programs, where tasks
+ -- running in parallel of this Delete_Tree could see their current
+ -- directory change unpredictably. We now resort to Full_Name
+ -- computations to reach files and subdirs instead.
+
+ Start_Search (Search, Directory => Directory, Pattern => "");
while More_Entries (Search) loop
Get_Next_Entry (Search, Dir_Ent);
declare
- File_Name : constant String := Simple_Name (Dir_Ent);
-
+ Sname : constant String := Simple_Name (Dir_Ent);
+ Fname : constant String := Full_Name (Dir_Ent);
begin
- if OS_Lib.Is_Directory (File_Name) then
- if File_Name /= "." and then File_Name /= ".." then
- Delete_Tree (File_Name);
+ if OS_Lib.Is_Directory (Fname) then
+ if Sname /= "." and then Sname /= ".." then
+ Delete_Tree (Fname);
end if;
-
else
- Delete_File (File_Name);
+ Delete_File (Fname);
end if;
end;
end loop;
- Set_Directory (Current_Dir);
End_Search (Search);
declare
... which is very unfriendly to tasking programs, where a task running Delete_Tree could cause a unexpected change of current directory in another task running concurrently. The program below is expected to display No directory change observed -- with Ada.Text_IO; use Ada.Text_IO; with Ada.Directories; procedure P0 is Root_Directory : constant String := Ada.Directories.Current_Directory; Temp_Path : constant String := Root_Directory & "/tmp/"; -- The idea is to have 2 tasks: -- One which repeteadly creates and deletes a dir until requested to stop. -- and -- Another which monitors changes to its current directory. -- The two tasks aren't explicitly synchronized, except for the monitor -- requesting the creation/deletion task to stop when it's done monitoring -- for a while (fixed number of iterations). -- We expect the OS scheduler to let the monitor run concurrently with the -- creation/deletion task, hopefully while the latter is performing -- Delete_Tree, so a change of current directory there would be observed. -- This is not full proof but was showing the problem consistently on -- at least a couple of native Linux and Windows platforms before the -- correction was applied. task Create_Delete_Dir is entry Stop; end; task Monitor_Current_Dir; task body Create_Delete_Dir is Stop_Requested : Boolean := False; begin while not Stop_Requested loop select accept Stop; Stop_Requested := True; else Ada.Directories.Create_Path (Temp_Path); Ada.Directories.Delete_Tree (Temp_Path); end select; end loop; end; task body Monitor_Current_Dir is Dir_Change_Iteration : Integer := 0; begin for I in 1 .. 100000 loop if Ada.Directories.Current_Directory /= Root_Directory then Dir_Change_Iteration := I; exit; end if; end loop; if Dir_Change_Iteration > 0 then Put_Line ("Directory change at " & Integer'Image(Dir_Change_Iteration)); else Put_Line ("No directory change observed"); end if; -- Done monitoring, request the creation/deletion task -- to stop and exit. Create_Delete_Dir.Stop; end; begin null; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-05-02 Olivier Hainque <hainque@adacore.com> * a-direct.adb (Delete_Tree): Use full names to designate subdirs and files therein, instead of local names after a change of current directory.