]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T L B R -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
07fc65c4 | 9 | -- Copyright (C) 1997-2001 Free Software Foundation, Inc. -- |
38cbfe40 RK |
10 | -- -- |
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, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
38cbfe40 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | -- Program to create, set, or delete an alternate runtime library. | |
28 | ||
29 | -- Works by calling an appropriate target specific Makefile residing | |
30 | -- in the default library object (e.g. adalib) directory from the context | |
31 | -- of the new library objects directory. | |
32 | ||
33 | -- Command line arguments are: | |
34 | -- 1st: --[create | set | delete]=<directory_spec> | |
35 | -- --create : Build a library | |
36 | -- --set : Set environment variables to point to a library | |
37 | -- --delete : Delete a library | |
38 | ||
39 | -- 2nd: --config=<file_spec> | |
40 | -- A -gnatg valid file containing desired configuration pragmas | |
41 | ||
42 | -- This program is currently used only on Alpha/VMS | |
43 | ||
44 | with Ada.Command_Line; use Ada.Command_Line; | |
45 | with Ada.Text_IO; use Ada.Text_IO; | |
46 | with GNAT.OS_Lib; use GNAT.OS_Lib; | |
fbf5a39b | 47 | with Gnatvsn; use Gnatvsn; |
38cbfe40 RK |
48 | with Interfaces.C_Streams; use Interfaces.C_Streams; |
49 | with Osint; use Osint; | |
50 | with Sdefault; use Sdefault; | |
51 | with System; | |
52 | ||
53 | procedure GnatLbr is | |
fbf5a39b | 54 | pragma Ident (Gnat_Version_String); |
38cbfe40 RK |
55 | |
56 | type Lib_Mode is (None, Create, Set, Delete); | |
57 | Next_Arg : Integer; | |
58 | Mode : Lib_Mode := None; | |
59 | ADC_File : String_Access := null; | |
60 | Lib_Dir : String_Access := null; | |
61 | Make : constant String := "make"; | |
62 | Make_Path : String_Access; | |
63 | ||
64 | procedure Create_Directory (Name : System.Address; Mode : Integer); | |
65 | pragma Import (C, Create_Directory, "mkdir"); | |
66 | ||
67 | begin | |
68 | if Argument_Count = 0 then | |
69 | Put ("Usage: "); | |
70 | Put_Line | |
71 | ("gnatlbr --[create|set|delete]=<directory> [--config=<file>]"); | |
72 | Exit_Program (E_Fatal); | |
73 | end if; | |
74 | ||
75 | Next_Arg := 1; | |
76 | ||
77 | loop | |
78 | exit when Next_Arg > Argument_Count; | |
79 | ||
80 | Process_One_Arg : declare | |
81 | Arg : String := Argument (Next_Arg); | |
82 | ||
83 | begin | |
84 | ||
85 | if Arg'Length > 9 and then Arg (1 .. 9) = "--create=" then | |
86 | if Mode = None then | |
87 | Mode := Create; | |
88 | Lib_Dir := new String'(Arg (10 .. Arg'Last)); | |
89 | else | |
90 | Put_Line (Standard_Error, "Error: Multiple modes specified"); | |
91 | Exit_Program (E_Fatal); | |
92 | end if; | |
93 | ||
94 | elsif Arg'Length > 6 and then Arg (1 .. 6) = "--set=" then | |
95 | if Mode = None then | |
96 | Mode := Set; | |
97 | Lib_Dir := new String'(Arg (7 .. Arg'Last)); | |
98 | else | |
99 | Put_Line (Standard_Error, "Error: Multiple modes specified"); | |
100 | Exit_Program (E_Fatal); | |
101 | end if; | |
102 | ||
103 | elsif Arg'Length > 9 and then Arg (1 .. 9) = "--delete=" then | |
104 | if Mode = None then | |
105 | Mode := Delete; | |
106 | Lib_Dir := new String'(Arg (10 .. Arg'Last)); | |
107 | else | |
108 | Put_Line (Standard_Error, "Error: Multiple modes specified"); | |
109 | Exit_Program (E_Fatal); | |
110 | end if; | |
111 | ||
112 | elsif Arg'Length > 9 and then Arg (1 .. 9) = "--config=" then | |
113 | if ADC_File /= null then | |
114 | Put_Line (Standard_Error, | |
115 | "Error: Multiple gnat.adc files specified"); | |
116 | Exit_Program (E_Fatal); | |
117 | end if; | |
118 | ||
119 | ADC_File := new String'(Arg (10 .. Arg'Last)); | |
120 | ||
121 | else | |
122 | Put_Line (Standard_Error, "Error: Unrecognized option: " & Arg); | |
123 | Exit_Program (E_Fatal); | |
124 | ||
125 | end if; | |
126 | end Process_One_Arg; | |
127 | ||
128 | Next_Arg := Next_Arg + 1; | |
129 | end loop; | |
130 | ||
131 | case Mode is | |
132 | when Create => | |
133 | ||
134 | -- Validate arguments | |
135 | ||
136 | if Lib_Dir = null then | |
137 | Put_Line (Standard_Error, "Error: No library directory specified"); | |
138 | Exit_Program (E_Fatal); | |
139 | end if; | |
140 | ||
141 | if Is_Directory (Lib_Dir.all) then | |
142 | Put_Line (Standard_Error, | |
143 | "Error:" & Lib_Dir.all & " already exists"); | |
144 | Exit_Program (E_Fatal); | |
145 | end if; | |
146 | ||
147 | if ADC_File = null then | |
148 | Put_Line (Standard_Error, | |
149 | "Error: No configuration file specified"); | |
150 | Exit_Program (E_Fatal); | |
151 | end if; | |
152 | ||
153 | if not Is_Regular_File (ADC_File.all) then | |
154 | Put_Line (Standard_Error, | |
155 | "Error: " & ADC_File.all & " doesn't exist"); | |
156 | Exit_Program (E_Fatal); | |
157 | end if; | |
158 | ||
159 | Create_Block : declare | |
160 | Success : Boolean; | |
161 | Make_Args : Argument_List (1 .. 9); | |
162 | C_Lib_Dir : String := Lib_Dir.all & ASCII.Nul; | |
163 | C_ADC_File : String := ADC_File.all & ASCII.Nul; | |
164 | F_ADC_File : String (1 .. max_path_len); | |
165 | F_ADC_File_Len : Integer := max_path_len; | |
166 | Include_Dirs : Integer; | |
167 | Object_Dirs : Integer; | |
168 | Include_Dir : array (Integer range 1 .. 256) of String_Access; | |
169 | Object_Dir : array (Integer range 1 .. 256) of String_Access; | |
170 | Include_Dir_Name : String_Access; | |
171 | Object_Dir_Name : String_Access; | |
172 | ||
173 | begin | |
174 | -- Create the new top level library directory | |
175 | ||
176 | if not Is_Directory (Lib_Dir.all) then | |
177 | Create_Directory (C_Lib_Dir'Address, 8#755#); | |
178 | end if; | |
179 | ||
180 | full_name (C_ADC_File'Address, F_ADC_File'Address); | |
181 | ||
182 | for I in 1 .. max_path_len loop | |
183 | if F_ADC_File (I) = ASCII.Nul then | |
184 | F_ADC_File_Len := I - 1; | |
185 | exit; | |
186 | end if; | |
187 | end loop; | |
188 | ||
189 | -- | |
190 | -- Make a list of the default library source and object | |
191 | -- directories. Usually only one, except on VMS where | |
192 | -- there are two. | |
193 | -- | |
194 | Include_Dirs := 0; | |
195 | Include_Dir_Name := String_Access (Include_Dir_Default_Name); | |
196 | Get_Next_Dir_In_Path_Init (String_Access (Include_Dir_Name)); | |
197 | ||
198 | loop | |
199 | declare | |
200 | Dir : String_Access := String_Access | |
201 | (Get_Next_Dir_In_Path (String_Access (Include_Dir_Name))); | |
202 | begin | |
203 | exit when Dir = null; | |
204 | Include_Dirs := Include_Dirs + 1; | |
205 | Include_Dir (Include_Dirs) | |
206 | := String_Access (Normalize_Directory_Name (Dir.all)); | |
207 | end; | |
208 | end loop; | |
209 | ||
210 | Object_Dirs := 0; | |
211 | Object_Dir_Name := String_Access (Object_Dir_Default_Name); | |
212 | Get_Next_Dir_In_Path_Init (String_Access (Object_Dir_Name)); | |
213 | ||
214 | loop | |
215 | declare | |
216 | Dir : String_Access := String_Access | |
217 | (Get_Next_Dir_In_Path (String_Access (Object_Dir_Name))); | |
218 | begin | |
219 | exit when Dir = null; | |
220 | Object_Dirs := Object_Dirs + 1; | |
221 | Object_Dir (Object_Dirs) | |
222 | := String_Access (Normalize_Directory_Name (Dir.all)); | |
223 | end; | |
224 | end loop; | |
225 | ||
226 | -- "Make" an alternate sublibrary for each default sublibrary. | |
227 | ||
228 | for Dirs in 1 .. Object_Dirs loop | |
229 | ||
230 | Make_Args (1) := | |
231 | new String'("-C"); | |
232 | ||
233 | Make_Args (2) := | |
234 | new String'(Lib_Dir.all); | |
235 | ||
236 | -- Resolve /gnu on VMS by converting to host format and then | |
237 | -- convert resolved path back to canonical format for the | |
238 | -- make program. This fixes the problem that can occur when | |
239 | -- GNU: is a search path pointing to multiple versions of GNAT. | |
240 | ||
241 | Make_Args (3) := | |
242 | new String'("ADA_INCLUDE_PATH=" & | |
243 | To_Canonical_Dir_Spec | |
244 | (To_Host_Dir_Spec | |
245 | (Include_Dir (Dirs).all, True).all, True).all); | |
246 | ||
247 | Make_Args (4) := | |
248 | new String'("ADA_OBJECTS_PATH=" & | |
249 | To_Canonical_Dir_Spec | |
250 | (To_Host_Dir_Spec | |
251 | (Object_Dir (Dirs).all, True).all, True).all); | |
252 | ||
253 | Make_Args (5) := | |
254 | new String'("GNAT_ADC_FILE=" | |
255 | & F_ADC_File (1 .. F_ADC_File_Len)); | |
256 | ||
257 | Make_Args (6) := | |
258 | new String'("LIBRARY_VERSION=" & '"' & Library_Version & '"'); | |
259 | ||
260 | Make_Args (7) := | |
261 | new String'("-f"); | |
262 | ||
263 | Make_Args (8) := | |
264 | new String'(Object_Dir (Dirs).all & "Makefile.lib"); | |
265 | ||
266 | Make_Args (9) := | |
267 | new String'("create"); | |
268 | ||
269 | Make_Path := Locate_Exec_On_Path (Make); | |
270 | Put (Make); | |
271 | ||
272 | for I in 1 .. Make_Args'Last loop | |
273 | Put (" "); | |
274 | Put (Make_Args (I).all); | |
275 | end loop; | |
276 | ||
277 | New_Line; | |
278 | Spawn (Make_Path.all, Make_Args, Success); | |
279 | if not Success then | |
280 | Put_Line (Standard_Error, "Error: Make failed"); | |
281 | Exit_Program (E_Fatal); | |
282 | end if; | |
283 | end loop; | |
284 | end Create_Block; | |
285 | ||
286 | when Set => | |
287 | ||
288 | -- Validate arguments. | |
289 | ||
290 | if Lib_Dir = null then | |
291 | Put_Line (Standard_Error, | |
292 | "Error: No library directory specified"); | |
293 | Exit_Program (E_Fatal); | |
294 | end if; | |
295 | ||
296 | if not Is_Directory (Lib_Dir.all) then | |
297 | Put_Line (Standard_Error, | |
298 | "Error: " & Lib_Dir.all & " doesn't exist"); | |
299 | Exit_Program (E_Fatal); | |
300 | end if; | |
301 | ||
302 | if ADC_File = null then | |
303 | Put_Line (Standard_Error, | |
304 | "Error: No configuration file specified"); | |
305 | Exit_Program (E_Fatal); | |
306 | end if; | |
307 | ||
308 | if not Is_Regular_File (ADC_File.all) then | |
309 | Put_Line (Standard_Error, | |
310 | "Error: " & ADC_File.all & " doesn't exist"); | |
311 | Exit_Program (E_Fatal); | |
312 | end if; | |
313 | ||
314 | -- Give instructions. | |
315 | ||
316 | Put_Line ("Copy the contents of " | |
317 | & ADC_File.all & " into your GNAT.ADC file"); | |
318 | Put_Line ("and use GNAT Make qualifier /OBJECT_SEARCH=(" | |
319 | & To_Host_Dir_Spec | |
320 | (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/declib", False).all | |
321 | & "," | |
322 | & To_Host_Dir_Spec | |
323 | (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/adalib", False).all | |
324 | & ")"); | |
325 | Put_Line ("or else define ADA_OBJECTS_PATH as " & '"' | |
326 | & To_Host_Dir_Spec | |
327 | (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/declib", False).all | |
328 | & ',' | |
329 | & To_Host_Dir_Spec | |
330 | (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/adalib", False).all | |
331 | & '"'); | |
332 | ||
333 | when Delete => | |
334 | ||
335 | -- Give instructions. | |
336 | ||
337 | Put_Line ("GNAT Librarian DELETE not yet implemented."); | |
338 | Put_Line ("Use appropriate system tools to remove library"); | |
339 | ||
340 | when None => | |
341 | Put_Line (Standard_Error, | |
342 | "Error: No mode (create|set|delete) specified"); | |
343 | Exit_Program (E_Fatal); | |
344 | ||
345 | end case; | |
346 | ||
347 | end GnatLbr; |