... 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 <hain...@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.
Index: a-direct.adb
===================================================================
--- a-direct.adb (revision 235706)
+++ a-direct.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2015, Free Software Foundation, Inc. --
+-- 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
