1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2000 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
29 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
30 with Namet
; use Namet
;
31 with Prj
.Com
; use Prj
.Com
;
32 with Stringt
; use Stringt
;
33 with Types
; use Types
;
35 package body Prj
.Ext
is
37 package Htable
is new GNAT
.HTable
.Simple_HTable
38 (Header_Num
=> Header_Num
,
40 No_Element
=> No_String
,
50 (External_Name
: String;
54 The_Value
: String_Id
;
58 Store_String_Chars
(Value
);
59 The_Value
:= End_String
;
60 Name_Len
:= External_Name
'Length;
61 Name_Buffer
(1 .. Name_Len
) := External_Name
;
63 Htable
.Set
(The_Key
, The_Value
);
70 function Check
(Declaration
: String) return Boolean is
72 for Equal_Pos
in Declaration
'Range loop
74 if Declaration
(Equal_Pos
) = '=' then
75 exit when Equal_Pos
= Declaration
'First;
76 exit when Equal_Pos
= Declaration
'Last;
79 Declaration
(Declaration
'First .. Equal_Pos
- 1),
81 Declaration
(Equal_Pos
+ 1 .. Declaration
'Last));
95 (External_Name
: Name_Id
;
96 With_Default
: String_Id
:= No_String
)
99 The_Value
: String_Id
;
102 The_Value
:= Htable
.Get
(External_Name
);
104 if The_Value
/= No_String
then
108 -- Find if it is an environment.
109 -- If it is, put the value in the hash table.
112 Env_Value
: constant String_Access
:=
113 Getenv
(Get_Name_String
(External_Name
));
116 if Env_Value
/= null and then Env_Value
'Length > 0 then
118 Store_String_Chars
(Env_Value
.all);
119 The_Value
:= End_String
;
120 Htable
.Set
(External_Name
, The_Value
);