Merge branch 'mr/improve_win32_env_import' into 'master'

Ensure GNATCOLL.OS.Process_Types.Import does not crash on Win32

See merge request eng/toolchain/gnatcoll-core!161

Author: Nikokrock

core/src/os/gnatcoll-os-process_types__unix.adb

@@ -76,6 +76,7 @@ package body GNATCOLL.OS.Process_Types is
          Set_Variable (Env, Name, Value);
       end Import_Var;
    begin
+      Deallocate (Env);
       Env_Vars.Iterate (Import_Var'Unrestricted_Access);
    end Import;
 

core/src/os/gnatcoll-os-process_types__win32.adb

@@ -25,6 +25,10 @@ with Ada.Strings.UTF_Encoding.Wide_Strings;
 with Ada.Wide_Characters.Handling;
 with Ada.Environment_Variables;
 with GNATCOLL.String_Builders;
+with GNATCOLL.OS.Win32.Process;
+pragma Warnings(Off);
+with System.Address_To_Access_Conversions;
+pragma Warning(On);
 
 package body GNATCOLL.OS.Process_Types is
 
@@ -33,10 +37,27 @@ package body GNATCOLL.OS.Process_Types is
    package Env_Vars renames Ada.Environment_Variables;
    package WCH renames Ada.Wide_Characters.Handling;
 
+   type EnvironW is array (1 .. Integer'Last) of Wide_Character;
+   pragma Suppress_Initialization(EnvironW);
+   type EnvironW_Access is access all EnvironW;
+   for EnvironW_Access'Storage_Size use 0;
+   --  This type is used to map the address returned by GetEnvironmentStrings
+   --  to a Wide_Character array. Initialization is suppressed as only a part
+   --  of the declared object will be used.
+   --  The 0 storage size ensure we cannot call "new"
+
+   package EnvironW_Ops is new System.Address_To_Access_Conversions(EnvironW);
+   use EnvironW_Ops;
+   --  Provides To_Pointer to convert an Address to an EnvironW_Access.
+
    Minimal_Env : Environ;
 
    procedure Add_Minimal_Env (Env : in out Environ);
 
+   ---------------------
+   -- Add_Minimal_Env --
+   ---------------------
+
    procedure Add_Minimal_Env (Env : in out Environ) is
    begin
       if Env_Vars.Exists ("SYSTEMROOT") then
@@ -91,14 +112,55 @@ package body GNATCOLL.OS.Process_Types is
    ------------
 
    procedure Import (Env : in out Environ) is
-      procedure Import_Var (Name, Value : String);
+      use GNATCOLL.OS.Win32.Process;
+      use GNATCOLL.OS.Win32;
 
-      procedure Import_Var (Name, Value : String) is
-      begin
-         Set_Variable (Env, Name, Value);
-      end Import_Var;
+      --  Fetch the current process environment
+      Env_Addr : System.Address := GetEnvironmentStrings;
+      Env_Ptr  : EnvironW_Access := EnvironW_Access(To_Pointer (Env_Addr));
+
+      Free_Result : BOOL;
+
+      --  Start of a variable definition
+      Start    : Integer := 0;
+
+      --  Current position in the environ block
+      Idx      : Integer := 1;
+
+      WNUL     : constant Wide_Character := Wide_Character'Val (0);
+      use all type System.Address;
    begin
-      Env_Vars.Iterate (Import_Var'Unrestricted_Access);
+      --  Start by resetting the environment
+      Env.Inherited := False;
+      WSLB.Deallocate (Env.Env);
+
+      --  Note that the environment may contain invalid UTF-16 strings. We
+      --  should just ignore that and pass the value to our structure.
+      loop
+         if Env_Ptr (Idx) /= WNUL then
+            if Start = 0 then
+               Start := Idx;
+            end if;
+         else
+            --  A NUL character marks the end of a variable definition
+            if Start /= 0 then
+               WSLB.Append (Env.Env, Wide_String (Env_Ptr (Start .. Idx - 1)));
+               Start := 0;
+            end if;
+
+            --  If a NUL character follows the end of a variable definition,
+            --  the end of the environment block has been reached.
+            exit when Env_Ptr (Idx + 1) = WNUL;
+         end if;
+
+         Idx := Idx + 1;
+      end loop;
+
+      Free_Result :=
+         GNATCOLL.OS.Win32.Process.FreeEnvironmentStrings (Env_Addr);
+      if Free_Result = BOOL_FALSE then
+         raise OS_Error with "error while deallocating environment block";
+      end if;
    end Import;
 
    -------------

core/src/os/win32/gnatcoll-os-win32-process.ads

@@ -174,4 +174,14 @@ package GNATCOLL.OS.Win32.Process is
         Convention => Stdcall,
         External_Name => "NtQueryInformationProcess";
 
+   function GetEnvironmentStrings return System.Address
+   with Import => True,
+        Convention => Stdcall,
+        External_Name => "GetEnvironmentStringsW";
+
+   function FreeEnvironmentStrings (Env : System.Address) return Bool
+   with Import => True,
+        Convention => Stdcall,
+        External_Name => "FreeEnvironmentStringsW";
+
 end GNATCOLL.OS.Win32.Process;

gprproject/gprbuild.py

@@ -27,7 +27,7 @@ def get_compiler_info(target: str | None) -> dict[str, str]:
 
     process = run(gprconfig_cmd, capture_output=True)
     if process.returncode != 0:
-        raise GPRError(f"error while trying to capture output of '{cmd}'")
+        raise GPRError(f"error while trying to capture output of '{gprconfig_cmd}'")
     try:
         gprconfig_output = process.stdout.decode("utf-8").strip()
     except Exception:
@@ -97,7 +97,7 @@ def __init__(
         if prefix:
             self.prefix = os.path.abspath(prefix)
         else:
-            self.prefix = re.findall(r" 1 path:(.*)", gprconfig_output)[0]
+            self.prefix = re.findall(r" 1 path:(.*)", gprconfig_output)[0].strip()
             if self.prefix.endswith(os.sep):
                 self.prefix = os.path.dirname(os.path.dirname(self.prefix))
             else:

gprproject/testsuite/__init__.py

@@ -80,7 +80,7 @@ def set_up(self) -> None:
         self.env.default_source_dirs = self.default_source_dirs
 
         # Get some compiler info
-        compiler_info = get_compiler_info(target=self.env.target.platform)
+        compiler_info = get_compiler_info(target=self.env.target.triplet)
         self.env.llvm = "LLVM" in compiler_info.get("name", "GNAT")
         self.env.gcc = compiler_info.get("name", "GNAT") == "GNAT"
 

gprproject/testsuite/drivers/__init__.py

@@ -160,6 +160,12 @@ def bin_check_call(
     if test_name is None:
         test_name = driver.test_name
 
+    # Compute final environment
+    final_env = None
+    if env is not None:
+        final_env = os.environ.copy()
+        final_env.update(env)
+
     if driver.env.is_cross:
         if driver.env.target.os.name == "windows":
             os.environ["WINEDEBUG"] = "-all"
@@ -172,7 +178,7 @@ def bin_check_call(
             subp = subprocess.Popen(
                 cmd,
                 cwd=cwd,
-                env=env,
+                env=final_env,
                 stdin=subprocess.DEVNULL,
                 stdout=subprocess.PIPE,
                 stderr=subprocess.STDOUT,
@@ -218,7 +224,7 @@ def bin_check_call(
         subp = subprocess.Popen(
             cmd,
             cwd=cwd,
-            env=env,
+            env=final_env,
             stdin=subprocess.DEVNULL,
             stdout=subprocess.PIPE,
             stderr=subprocess.STDOUT,
@@ -233,7 +239,7 @@ def bin_check_call(
             "status": process.status,
             "cmd": cmd,
             "timeout": timeout,
-            "env": env,
+            "env": final_env,
             "cwd": cwd,
         }
     )

gprproject/testsuite/drivers/basic.py

@@ -100,6 +100,7 @@ def run(self):
             slot=self.slot,
             copy_files_on_target=copy_files_on_target,
             timeout=self.default_process_timeout,
+            env=self.test_env.get('test_env')
         )
         self.output += process.out.decode("utf-8")
 

testsuite/core/tests/os/process/inherit_env/test.yaml

@@ -1,4 +1,8 @@
 title: GNATCOLL.OS.Process test inherit_env parameter
 data: ["test_data/*.py"]
+# This is mainly done to ensure the test does not crash when environment contains
+# some non ascii value. Note that currently we don't know how to read correctly
+# that value on System such as Windows.
+test_env: {"UNICODE_ENV": "º"}
 control:
-  - [SKIP, "env.is_cross", "Test uses python which is not available on cross targets"]
+  - [SKIP, "env.is_cross", "Test uses python which is not available on cross targets"]

testsuite/drivers/__init__.py

@@ -221,6 +221,11 @@ def bin_check_call(
     if test_name is None:
         test_name = driver.test_name
 
+    final_env = None
+    if env is not None:
+        final_env = os.environ.copy()
+        final_env.update(env)
+
     if driver.env.is_cross:
         if driver.env.target.os.name == "windows":
             os.environ["WINEDEBUG"] = "-all"
@@ -233,7 +238,7 @@ def bin_check_call(
             subp = subprocess.Popen(
                 cmd,
                 cwd=cwd,
-                env=env,
+                env=final_env,
                 stdin=subprocess.DEVNULL,
                 stdout=subprocess.PIPE,
                 stderr=subprocess.STDOUT,
@@ -279,7 +284,7 @@ def bin_check_call(
         subp = subprocess.Popen(
             cmd,
             cwd=cwd,
-            env=env,
+            env=final_env,
             stdin=subprocess.DEVNULL,
             stdout=subprocess.PIPE,
             stderr=subprocess.STDOUT,
@@ -294,7 +299,7 @@ def bin_check_call(
             "status": process.status,
             "cmd": cmd,
             "timeout": timeout,
-            "env": env,
+            "env": final_env,
             "cwd": cwd,
         }
     )

testsuite/drivers/basic.py

@@ -72,7 +72,8 @@ def run(self):
             [os.path.join(self.test_env['working_dir'], test_exe)],
             slot=self.slot,
             copy_files_on_target=copy_files_on_target,
-            timeout=self.default_process_timeout)
+            timeout=self.default_process_timeout,
+            env=self.test_env.get('test_env'))
         self.output += process.out.decode('utf-8')
 
         # Store result output, so the python post test can access it if needed.