bugfix: improvements to temp file name creation (#1700)

* bugfix: improvements to temp file name creation

* fix: harmonize fake GNAT external versions in testsuite

* Self-review

src/alire/alire-directories.adb

@@ -553,91 +553,98 @@ package body Alire.Directories is
    Epoch : constant Ada.Real_Time.Time :=
              Ada.Real_Time.Time_Of (0, Ada.Real_Time.To_Time_Span (0.0));
 
-   -------------
-   -- Counter --
-   -------------
+   ----------------------
+   -- Tempfile_Support --
+   ----------------------
 
-   protected Counter is
-      procedure Get (Value : out Interfaces.Unsigned_32);
+   protected Tempfile_Support is
+      procedure Next_Name (Name  : out String);
    private
-      Next : Interfaces.Unsigned_32 := 0;
-   end Counter;
-
-   protected body Counter is
-      procedure Get (Value : out Interfaces.Unsigned_32) is
+      Next_Seed  : Interfaces.Unsigned_32 := 0;
+      Used_Names : AAA.Strings.Set;
+   end Tempfile_Support;
+
+   protected body Tempfile_Support is
+
+      ---------------
+      -- Next_Name --
+      ---------------
+
+      procedure Next_Name (Name  : out String) is
+         subtype Valid_Character is Character range 'a' .. 'z';
+         package Char_Random is new
+           Ada.Numerics.Discrete_Random (Valid_Character);
+         Gen : Char_Random.Generator;
+
+         --  The default random seed has a granularity of 1 second, which is
+         --  not enough when we run our tests with high parallelism. Increasing
+         --  the resolution to nanoseconds is less collision-prone. On top, we
+         --  add the current working directory path to the hash input, which
+         --  should disambiguate even further for our most usual case which is
+         --  during testsuite execution, and a counter to avoid clashes in the
+         --  same process.
+
+         --  It would be safer to use an atomic OS call that returns a unique
+         --  file name, but we would need native versions for all OSes we
+         --  support and that may be too much hassle? since GNAT.OS_Lib
+         --  doesn't do it either.
+
+         use Ada.Real_Time;
          use type Interfaces.Unsigned_32;
-      begin
-         Value := Next;
-         Next  := Next + 1;
-      end Get;
-   end Counter;
 
-   ----------
-   -- Next --
-   ----------
+         Nano : constant String :=
+                  AAA.Strings.Replace (To_Duration (Clock - Epoch)'Image,
+                                       ".", "");
+         --  This gives us an image without loss of precision and without
+         --  having to be worried about overflows
 
-   function Next return String is
-      Val : Interfaces.Unsigned_32;
-   begin
-      Counter.Get (Val);
-      return Val'Image;
-   end Next;
+         type Hash_Type is mod 2 ** 32;
+         pragma Compile_Time_Error (Hash_Type'Size > Integer'Size,
+                                    "Hash_Type is too large");
 
-   ---------------
-   -- Temp_Name --
-   ---------------
+         function Hash is new GNAT.String_Hash.Hash
+           (Char_Type => Character,
+            Key_Type  => String,
+            Hash_Type => Hash_Type);
 
-   function Temp_Name (Length : Positive := 8) return String is
-      subtype Valid_Character is Character range 'a' .. 'z';
-      package Char_Random is new
-        Ada.Numerics.Discrete_Random (Valid_Character);
-      Gen : Char_Random.Generator;
+         function To_Integer is
+           new Ada.Unchecked_Conversion (Hash_Type, Integer);
+         --  Ensure unsigned -> signed conversion doesn't bite us
 
-      --  The default random seed has a granularity of 1 second, which is not
-      --  enough when we run our tests with high parallelism. Increasing the
-      --  resolution to nanoseconds is less collision-prone. On top, we add
-      --  the current working directory path to the hash input, which should
-      --  disambiguate even further for our most usual case which is during
-      --  testsuite execution, and a counter to avoid clashes in the same
-      --  process.
+         Seed : constant Hash_Type :=
+                  Hash (Nano & " at " & Current & "#" & Next_Seed'Image);
+      begin
+         Next_Seed := Next_Seed + 1;
 
-      --  It would be safer to use an atomic OS call that returns a unique file
-      --  name, but we would need native versions for all OSes we support and
-      --  that may be too much hassle? since GNAT.OS_Lib doesn't do it either.
+         Char_Random.Reset (Gen, To_Integer (Seed));
 
-      use Ada.Real_Time;
+         loop
+            for I in Name'Range loop
+               Name (I) := Char_Random.Random (Gen);
+            end loop;
 
-      Nano : constant String :=
-               AAA.Strings.Replace (To_Duration (Clock - Epoch)'Image,
-                                    ".", "");
-      --  This gives us an image without loss of precision and without
-      --  having to be worried about overflows
+            --  Make totally sure that not even by random chance we are reusing
+            --  a temporary name.
 
-      type Hash_Type is mod 2 ** 32;
-      pragma Compile_Time_Error (Hash_Type'Size > Integer'Size,
-                                 "Hash_Type is too large");
+            exit when not Used_Names.Contains (Name);
+         end loop;
 
-      function Hash is new GNAT.String_Hash.Hash
-        (Char_Type => Character,
-         Key_Type  => String,
-         Hash_Type => Hash_Type);
+         Used_Names.Insert (Name);
+      end Next_Name;
 
-      function To_Integer is new Ada.Unchecked_Conversion (Hash_Type, Integer);
-      --  Ensure unsigned -> signed conversion doesn't bite us
+   end Tempfile_Support;
 
-      Seed : constant Hash_Type := Hash (Nano & " at " & Current & "#" & Next);
+   ---------------
+   -- Temp_Name --
+   ---------------
 
+   function Temp_Name (Length : Positive := 8) return String is
+      Result : String (1 .. Length + 4);
    begin
-
-      Char_Random.Reset (Gen, To_Integer (Seed));
-
-      return Result : String (1 .. Length + 4) do
-         Result (1 .. 4) := "alr-";
-         Result (Length + 1 .. Result'Last) := ".tmp";
-         for I in 5 .. Length loop
-            Result (I) := Char_Random.Random (Gen);
-         end loop;
-      end return;
+      Result (1 .. 4) := "alr-";
+      Result (Length + 1 .. Result'Last) := ".tmp";
+      Tempfile_Support.Next_Name (Result (5 .. Length));
+      return Result;
    end Temp_Name;
 
    ----------------
@@ -682,6 +689,16 @@ package body Alire.Directories is
 
       end if;
 
+      --  Ensure that for some bizarre reason, the temp name does not exist
+      --  already.
+
+      if Adirs.Exists (+This.Name) then
+         Trace.Debug
+           ("Name clash for tempfile: " & (+This.Name) & ", retrying...");
+         This.Initialize;
+         return;
+      end if;
+
       Trace.Debug ("Selected name for tempfile: " & (+This.Name)
                    & " when at dir: " & Current);
 

testsuite/drivers/builds.py

@@ -7,6 +7,7 @@
 from shutil import rmtree
 import subprocess
 from drivers.alr import alr_builds_dir, run_alr
+from drivers.helpers import content_of
 
 
 def clear_builds_dir() -> None:
@@ -40,7 +41,10 @@ def find_dir(crate_name: str) -> str:
     forward slashes in the returned folder path.
     """
     if len(found := glob(f"{path()}/{crate_name}*/*")) != 1:
-        raise AssertionError(f"Unexpected number of dirs for crate {crate_name}: {found}")
+        raise AssertionError(f"Unexpected number of dirs for crate {crate_name}: {found}" + \
+                             str(['\nINPUTS:\n' + content_of(os.path.join(f, "alire", "build_hash_inputs")) \
+                                  for f in found])
+                             )
     return glob(f"{path()}/{crate_name}*/*")[0].replace(os.sep, "/")
 
 

testsuite/fixtures/basic_index/gn/gnat_external/gnat_external-external.toml

@@ -5,8 +5,8 @@ maintainers = ["alejandro@mosteo.com"]
 maintainers-logins = ["mosteo"]
 
 [[external]]
+# Fake GNAT version that cannot conflict with any real one
 kind = "version-output"
-# We look for make instead that should be always installed.
-version-command = ["make", "--version"]
-version-regexp = ".*Make ([\\d\\.]+).*"
+version-command = ["echo", "1.0"]
+version-regexp = "([\\d\\.]+).*"
 provides = "gnat"

testsuite/fixtures/compiler_only_index/gn/gnat_external/gnat_external-external.toml

@@ -5,8 +5,8 @@ maintainers = ["alejandro@mosteo.com"]
 maintainers-logins = ["mosteo"]
 
 [[external]]
+# Fake GNAT version that cannot conflict with any real one
 kind = "version-output"
-# We look for make instead that should be always installed.
-version-command = ["make", "--version"]
-version-regexp = ".*Make ([\\d\\.]+).*"
+version-command = ["echo", "1.0"]
+version-regexp = "([\\d\\.]+).*"
 provides = "gnat"

testsuite/fixtures/gnat_toolchain_index/gn/gnat_external/gnat_external-external.toml

@@ -5,6 +5,7 @@ maintainers = ["alejandro@mosteo.com"]
 maintainers-logins = ["mosteo"]
 
 [[external]]
+# Fake GNAT version that cannot conflict with any real one
 kind = "version-output"
 version-command = ["echo", "1.0"]
 version-regexp = "([\\d\\.]+).*"

testsuite/tests/pin/dir-mismatch/test.py

@@ -3,7 +3,6 @@
 """
 
 import os
-import re
 
 from drivers.alr import run_alr
 from drivers.asserts import assert_match