From dc1bb934301e0bd0d5217928be4cb61f54def480 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Mon, 17 Jun 2024 17:25:34 +0200 Subject: [PATCH] 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 | 153 ++++++++++-------- testsuite/drivers/builds.py | 6 +- .../gnat_external/gnat_external-external.toml | 6 +- .../gnat_external/gnat_external-external.toml | 6 +- .../gnat_external/gnat_external-external.toml | 1 + testsuite/tests/pin/dir-mismatch/test.py | 1 - 6 files changed, 97 insertions(+), 76 deletions(-) diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index ec7741ed1..4c8142ce6 100644 --- a/src/alire/alire-directories.adb +++ b/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); diff --git a/testsuite/drivers/builds.py b/testsuite/drivers/builds.py index f83448a04..48ff323d9 100644 --- a/testsuite/drivers/builds.py +++ b/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, "/") diff --git a/testsuite/fixtures/basic_index/gn/gnat_external/gnat_external-external.toml b/testsuite/fixtures/basic_index/gn/gnat_external/gnat_external-external.toml index f1171a6ba..b52e5b9b9 100644 --- a/testsuite/fixtures/basic_index/gn/gnat_external/gnat_external-external.toml +++ b/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" diff --git a/testsuite/fixtures/compiler_only_index/gn/gnat_external/gnat_external-external.toml b/testsuite/fixtures/compiler_only_index/gn/gnat_external/gnat_external-external.toml index f1171a6ba..b52e5b9b9 100644 --- a/testsuite/fixtures/compiler_only_index/gn/gnat_external/gnat_external-external.toml +++ b/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" diff --git a/testsuite/fixtures/gnat_toolchain_index/gn/gnat_external/gnat_external-external.toml b/testsuite/fixtures/gnat_toolchain_index/gn/gnat_external/gnat_external-external.toml index 6a899f8d1..b52e5b9b9 100644 --- a/testsuite/fixtures/gnat_toolchain_index/gn/gnat_external/gnat_external-external.toml +++ b/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\\.]+).*" diff --git a/testsuite/tests/pin/dir-mismatch/test.py b/testsuite/tests/pin/dir-mismatch/test.py index bdb61bbf3..43a2c54ca 100644 --- a/testsuite/tests/pin/dir-mismatch/test.py +++ b/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