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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R J . E X T --
-- --
-- B o d y --
-- --
-- --
-- Copyright (C) 2000 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with GNAT.HTable;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
with Prj.Com; use Prj.Com;
with Stringt; use Stringt;
with Types; use Types;
package body Prj.Ext is
package Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => String_Id,
No_Element => No_String,
Key => Name_Id,
Hash => Hash,
Equal => "=");
---------
-- Add --
---------
procedure Add
(External_Name : String;
Value : String)
is
The_Key : Name_Id;
The_Value : String_Id;
begin
Start_String;
Store_String_Chars (Value);
The_Value := End_String;
Name_Len := External_Name'Length;
Name_Buffer (1 .. Name_Len) := External_Name;
The_Key := Name_Find;
Htable.Set (The_Key, The_Value);
end Add;
-----------
-- Check --
-----------
function Check (Declaration : String) return Boolean is
begin
for Equal_Pos in Declaration'Range loop
if Declaration (Equal_Pos) = '=' then
exit when Equal_Pos = Declaration'First;
exit when Equal_Pos = Declaration'Last;
Add
(External_Name =>
Declaration (Declaration'First .. Equal_Pos - 1),
Value =>
Declaration (Equal_Pos + 1 .. Declaration'Last));
return True;
end if;
end loop;
return False;
end Check;
--------------
-- Value_Of --
--------------
function Value_Of
(External_Name : Name_Id;
With_Default : String_Id := No_String)
return String_Id
is
The_Value : String_Id;
begin
The_Value := Htable.Get (External_Name);
if The_Value /= No_String then
return The_Value;
end if;
-- Find if it is an environment.
-- If it is, put the value in the hash table.
declare
Env_Value : constant String_Access :=
Getenv (Get_Name_String (External_Name));
begin
if Env_Value /= null and then Env_Value'Length > 0 then
Start_String;
Store_String_Chars (Env_Value.all);
The_Value := End_String;
Htable.Set (External_Name, The_Value);
return The_Value;
else
return With_Default;
end if;
end;
end Value_Of;
end Prj.Ext;
|
