spawn_24.0.0_8f4c2fa8/source/spawn/spawn-environments-initialize_default__windows.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
--
--  Copyright (C) 2018-2019, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--

with Ada.Strings.UTF_Encoding.Wide_Strings;
with Interfaces.C;

pragma Warnings (Off);
with System.Win32;
pragma Warnings (On);

with Spawn.Windows_API;
with Spawn.Internal;

separate (Spawn.Environments)
procedure Initialize_Default (Default : out Process_Environment) is
   use type Interfaces.C.size_t;
   use type Interfaces.C.wchar_t;
   use type Windows_API.Environment_Block_Access;
   use type Windows_API.BOOL;

   procedure Append (Name, Value : Interfaces.C.wchar_array);

   ------------
   -- Append --
   ------------

   procedure Append (Name, Value : Interfaces.C.wchar_array) is
   begin
      Default.Map.Include
        (Ada.Strings.UTF_Encoding.Wide_Strings.Encode
           (Interfaces.C.To_Ada (Name, False)),
         Ada.Strings.UTF_Encoding.Wide_Strings.Encode
           (Interfaces.C.To_Ada (Value, False)));
   end Append;

   Env   : constant Windows_API.Environment_Block_Access :=
     Windows_API.GetEnvironmentStringsW;
   Equal : Interfaces.C.size_t := 1;
   From  : Interfaces.C.size_t := 1;
   Index : Interfaces.C.size_t := 1;

begin
   if Env /= null then
      loop
         if Env (Index) = Interfaces.C.wide_nul then
            exit when Index = From;
            Append (Env (From .. Equal - 1), Env (Equal + 1 .. Index - 1));
            From := Index + 1;
         elsif Index /= From and then Env (Index) = '=' then
            Equal := Index;
         end if;

         Index := Index + 1;
      end loop;

      if Windows_API.FreeEnvironmentStringsW (Env) = System.Win32.FALSE then
         raise Program_Error;
      end if;
   end if;
end Initialize_Default;