1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . E N V I R O N M E N T _ V A R I A B L E S --
9 -- Copyright (C) 2005, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
35 with Interfaces.C.Strings;
36 with Ada.Unchecked_Deallocation;
38 package body Ada.Environment_Variables is
44 procedure Clear (Name : String) is
45 procedure Clear_Env_Var (Name : System.Address);
46 pragma Import (C, Clear_Env_Var, "__gnat_unsetenv");
48 F_Name : String (1 .. Name'Length + 1);
51 F_Name (1 .. Name'Length) := Name;
52 F_Name (F_Name'Last) := ASCII.NUL;
54 Clear_Env_Var (F_Name'Address);
63 pragma Import (C, Clear_Env, "__gnat_clearenv");
72 function Exists (Name : String) return Boolean is
75 procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
76 pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
78 Env_Value_Ptr : aliased Address;
79 Env_Value_Length : aliased Integer;
80 F_Name : aliased String (1 .. Name'Length + 1);
83 F_Name (1 .. Name'Length) := Name;
84 F_Name (F_Name'Last) := ASCII.NUL;
87 (F_Name'Address, Env_Value_Length'Address, Env_Value_Ptr'Address);
89 if Env_Value_Ptr = System.Null_Address then
101 (Process : not null access procedure (Name, Value : String))
103 use Interfaces.C.Strings;
104 type C_String_Array is array (Natural) of aliased chars_ptr;
105 type C_String_Array_Access is access C_String_Array;
107 function Get_Env return C_String_Array_Access;
108 pragma Import (C, Get_Env, "__gnat_environ");
110 type String_Access is access all String;
111 procedure Free is new Ada.Unchecked_Deallocation (String, String_Access);
113 Env_Length : Natural := 0;
114 Env : constant C_String_Array_Access := Get_Env;
117 -- If the environment is null return directly
123 -- First get the number of environment variables
126 exit when Env (Env_Length) = Null_Ptr;
127 Env_Length := Env_Length + 1;
131 Env_Copy : array (1 .. Env_Length) of String_Access;
134 -- Copy the environment
136 for Iterator in 1 .. Env_Length loop
137 Env_Copy (Iterator) := new String'(Value (Env (Iterator - 1)));
140 -- Iterate on the environment copy
142 for Iterator in 1 .. Env_Length loop
144 Current_Var : constant String := Env_Copy (Iterator).all;
145 Value_Index : Natural := Env_Copy (Iterator)'First;
149 exit when Current_Var (Value_Index) = '=';
150 Value_Index := Value_Index + 1;
154 (Current_Var (Current_Var'First .. Value_Index - 1),
155 Current_Var (Value_Index + 1 .. Current_Var'Last));
159 -- Free the copy of the environment
161 for Iterator in 1 .. Env_Length loop
162 Free (Env_Copy (Iterator));
171 procedure Set (Name : String; Value : String) is
172 F_Name : String (1 .. Name'Length + 1);
173 F_Value : String (1 .. Value'Length + 1);
175 procedure Set_Env_Value (Name, Value : System.Address);
176 pragma Import (C, Set_Env_Value, "__gnat_setenv");
179 F_Name (1 .. Name'Length) := Name;
180 F_Name (F_Name'Last) := ASCII.NUL;
182 F_Value (1 .. Value'Length) := Value;
183 F_Value (F_Value'Last) := ASCII.NUL;
185 Set_Env_Value (F_Name'Address, F_Value'Address);
192 function Value (Name : String) return String is
195 procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
196 pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
198 procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer);
199 pragma Import (C, Strncpy, "strncpy");
201 Env_Value_Ptr : aliased Address;
202 Env_Value_Length : aliased Integer;
203 F_Name : aliased String (1 .. Name'Length + 1);
206 F_Name (1 .. Name'Length) := Name;
207 F_Name (F_Name'Last) := ASCII.NUL;
210 (F_Name'Address, Env_Value_Length'Address, Env_Value_Ptr'Address);
212 if Env_Value_Ptr = System.Null_Address then
213 raise Constraint_Error;
216 if Env_Value_Length > 0 then
218 Result : aliased String (1 .. Env_Value_Length);
220 Strncpy (Result'Address, Env_Value_Ptr, Env_Value_Length);
228 end Ada.Environment_Variables;