Trivial safeguard in Force_Delete

src/alire/alire-directories.adb

@@ -238,9 +238,17 @@ package body Alire.Directories is
    -- Force_Delete --
    ------------------
 
-   procedure Force_Delete (Path : Any_Path) is
+   procedure Force_Delete (Path : Absolute_Path) is
       use Ada.Directories;
    begin
+
+      --  Given that we never delete anything outside one of our folders, the
+      --  conservatively shortest thing we can be asked to delete is something
+      --  like "/c/alire". This is for peace of mind.
+      if Path'Length < 8 then
+         Recoverable_Error ("Suspicious deletion request for path: " & Path);
+      end if;
+
       if Exists (Path) then
          if Kind (Path) = Ordinary_File then
             Trace.Debug ("Deleting file " & Path & "...");

src/alire/alire-directories.ads

@@ -51,10 +51,10 @@ package Alire.Directories is
    --  In Windows, git checkouts are created with read-only file that do not
    --  sit well with Ada.Directories.Delete_Tree.
 
-   procedure Force_Delete (Path : Any_Path);
+   procedure Force_Delete (Path : Absolute_Path);
    --  Calls Ensure_Deletable and then uses GNATCOLL.VFS deletion
 
-   procedure Delete_Tree (Path : Any_Path) renames Force_Delete;
+   procedure Delete_Tree (Path : Absolute_Path) renames Force_Delete;
    --  Delete Path, and anythin below if it was a dir
 
    function Find_Files_Under (Folder    : String;

src/alr/alr-commands-clean.adb

@@ -27,7 +27,7 @@ package body Alr.Commands.Clean is
       -- Delete --
       ------------
 
-      procedure Delete (Path : String)
+      procedure Delete (Path : Alire.Absolute_Path)
       is
          use type Ada.Directories.File_Size;
       begin
@@ -59,7 +59,7 @@ package body Alr.Commands.Clean is
       --  Current workspace
 
       Alire.Directories.Traverse_Tree
-        (Start   => ".",
+        (Start   => Alire.Directories.Current,
          Doing   => Add_Target'Access,
          Recurse => True);