[gcc.git] / gcc / ada / gnatlbr.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              G N A T L B R                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1997-2001 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.      --
--                                                                          --
------------------------------------------------------------------------------

--  Program to create, set, or delete an alternate runtime library.

--  Works by calling an appropriate target specific Makefile residing
--  in the default library object (e.g. adalib) directory from the context
--  of the new library objects directory.

--  Command line arguments are:
--  1st:  --[create | set | delete]=<directory_spec>
--    --create : Build a library
--    --set    : Set environment variables to point to a library
--    --delete : Delete a library

--  2nd:  --config=<file_spec>
--  A -gnatg valid file containing desired configuration pragmas

--  This program is currently used only on Alpha/VMS

with Ada.Command_Line;     use Ada.Command_Line;
with Ada.Text_IO;          use Ada.Text_IO;
with GNAT.OS_Lib;          use GNAT.OS_Lib;
with Gnatvsn;              use Gnatvsn;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with Osint;                use Osint;
with Sdefault;             use Sdefault;
with System;

procedure GnatLbr is
   pragma Ident (Gnat_Version_String);

   type Lib_Mode is (None, Create, Set, Delete);
   Next_Arg  : Integer;
   Mode      : Lib_Mode := None;
   ADC_File  : String_Access := null;
   Lib_Dir   : String_Access := null;
   Make      : constant String := "make";
   Make_Path : String_Access;

   procedure Create_Directory (Name : System.Address; Mode : Integer);
   pragma Import (C, Create_Directory, "mkdir");

begin
   if Argument_Count = 0 then
      Put ("Usage: ");
      Put_Line
        ("gnatlbr --[create|set|delete]=<directory> [--config=<file>]");
      Exit_Program (E_Fatal);
   end if;

   Next_Arg := 1;

   loop
      exit when Next_Arg > Argument_Count;

      Process_One_Arg : declare
         Arg : String := Argument (Next_Arg);

      begin

         if Arg'Length > 9 and then Arg (1 .. 9) = "--create=" then
            if Mode = None then
               Mode := Create;
               Lib_Dir := new String'(Arg (10 .. Arg'Last));
            else
               Put_Line (Standard_Error, "Error: Multiple modes specified");
               Exit_Program (E_Fatal);
            end if;

         elsif Arg'Length > 6 and then Arg (1 .. 6) = "--set=" then
            if Mode = None then
               Mode := Set;
               Lib_Dir := new String'(Arg (7 .. Arg'Last));
            else
               Put_Line (Standard_Error, "Error: Multiple modes specified");
               Exit_Program (E_Fatal);
            end if;

         elsif Arg'Length > 9 and then Arg (1 .. 9) = "--delete=" then
            if Mode = None then
               Mode := Delete;
               Lib_Dir := new String'(Arg (10 .. Arg'Last));
            else
               Put_Line (Standard_Error, "Error: Multiple modes specified");
               Exit_Program (E_Fatal);
            end if;

         elsif Arg'Length > 9 and then Arg (1 .. 9) = "--config=" then
            if ADC_File /= null then
               Put_Line (Standard_Error,
                         "Error: Multiple gnat.adc files specified");
               Exit_Program (E_Fatal);
            end if;

            ADC_File := new String'(Arg (10 .. Arg'Last));

         else
            Put_Line (Standard_Error, "Error: Unrecognized option: " & Arg);
            Exit_Program (E_Fatal);

         end if;
      end Process_One_Arg;

      Next_Arg := Next_Arg + 1;
   end loop;

   case Mode is
      when Create =>

         --  Validate arguments

         if Lib_Dir = null then
            Put_Line (Standard_Error, "Error: No library directory specified");
            Exit_Program (E_Fatal);
         end if;

         if Is_Directory (Lib_Dir.all) then
            Put_Line (Standard_Error,
                      "Error:" & Lib_Dir.all & " already exists");
            Exit_Program (E_Fatal);
         end if;

         if ADC_File = null then
            Put_Line (Standard_Error,
                      "Error: No configuration file specified");
            Exit_Program (E_Fatal);
         end if;

         if not Is_Regular_File (ADC_File.all) then
            Put_Line (Standard_Error,
                      "Error: " & ADC_File.all & " doesn't exist");
            Exit_Program (E_Fatal);
         end if;

         Create_Block : declare
            Success        : Boolean;
            Make_Args      : Argument_List (1 .. 9);
            C_Lib_Dir      : String := Lib_Dir.all & ASCII.Nul;
            C_ADC_File     : String := ADC_File.all & ASCII.Nul;
            F_ADC_File     : String (1 .. max_path_len);
            F_ADC_File_Len : Integer := max_path_len;
            Include_Dirs   : Integer;
            Object_Dirs    : Integer;
            Include_Dir    : array (Integer range 1 .. 256) of String_Access;
            Object_Dir     : array (Integer range 1 .. 256) of String_Access;
            Include_Dir_Name : String_Access;
            Object_Dir_Name  : String_Access;

         begin
            --  Create the new top level library directory

            if not Is_Directory (Lib_Dir.all) then
               Create_Directory (C_Lib_Dir'Address, 8#755#);
            end if;

            full_name (C_ADC_File'Address, F_ADC_File'Address);

            for I in 1 .. max_path_len loop
               if F_ADC_File (I) = ASCII.Nul then
                  F_ADC_File_Len := I - 1;
                  exit;
               end if;
            end loop;

            --
            --  Make a list of the default library source and object
            --  directories.  Usually only one, except on VMS where
            --  there are two.
            --
            Include_Dirs := 0;
            Include_Dir_Name := String_Access (Include_Dir_Default_Name);
            Get_Next_Dir_In_Path_Init (String_Access (Include_Dir_Name));

            loop
               declare
                  Dir : String_Access := String_Access
                    (Get_Next_Dir_In_Path (String_Access (Include_Dir_Name)));
               begin
                  exit when Dir = null;
                  Include_Dirs := Include_Dirs + 1;
                  Include_Dir (Include_Dirs)
                    := String_Access (Normalize_Directory_Name (Dir.all));
               end;
            end loop;

            Object_Dirs := 0;
            Object_Dir_Name := String_Access (Object_Dir_Default_Name);
            Get_Next_Dir_In_Path_Init (String_Access (Object_Dir_Name));

            loop
               declare
                  Dir : String_Access := String_Access
                    (Get_Next_Dir_In_Path (String_Access (Object_Dir_Name)));
               begin
                  exit when Dir = null;
                  Object_Dirs := Object_Dirs + 1;
                  Object_Dir (Object_Dirs)
                    := String_Access (Normalize_Directory_Name (Dir.all));
               end;
            end loop;

            --  "Make" an alternate sublibrary for each default sublibrary.

            for Dirs in 1 .. Object_Dirs loop

               Make_Args (1) :=
                 new String'("-C");

               Make_Args (2) :=
                 new String'(Lib_Dir.all);

               --  Resolve /gnu on VMS by converting to host format and then
               --  convert resolved path back to canonical format for the
               --  make program. This fixes the problem that can occur when
               --  GNU: is a search path pointing to multiple versions of GNAT.

               Make_Args (3) :=
                 new String'("ADA_INCLUDE_PATH=" &
                   To_Canonical_Dir_Spec
                     (To_Host_Dir_Spec
                       (Include_Dir (Dirs).all, True).all, True).all);

               Make_Args (4) :=
                 new String'("ADA_OBJECTS_PATH=" &
                   To_Canonical_Dir_Spec
                     (To_Host_Dir_Spec
                       (Object_Dir (Dirs).all, True).all, True).all);

               Make_Args (5) :=
                 new String'("GNAT_ADC_FILE="
                             & F_ADC_File (1 .. F_ADC_File_Len));

               Make_Args (6) :=
                 new String'("LIBRARY_VERSION=" & '"' & Library_Version & '"');

               Make_Args (7) :=
                 new String'("-f");

               Make_Args (8) :=
                 new String'(Object_Dir (Dirs).all & "Makefile.lib");

               Make_Args (9) :=
                 new String'("create");

               Make_Path := Locate_Exec_On_Path (Make);
               Put (Make);

               for I in 1 .. Make_Args'Last loop
                  Put (" ");
                  Put (Make_Args (I).all);
               end loop;

               New_Line;
               Spawn (Make_Path.all, Make_Args, Success);
               if not Success then
                  Put_Line (Standard_Error, "Error: Make failed");
                  Exit_Program (E_Fatal);
               end if;
            end loop;
         end Create_Block;

      when Set =>

         --  Validate arguments.

         if Lib_Dir = null then
            Put_Line (Standard_Error,
                      "Error: No library directory specified");
            Exit_Program (E_Fatal);
         end if;

         if not Is_Directory (Lib_Dir.all) then
            Put_Line (Standard_Error,
                      "Error: " & Lib_Dir.all & " doesn't exist");
            Exit_Program (E_Fatal);
         end if;

         if ADC_File = null then
            Put_Line (Standard_Error,
                      "Error: No configuration file specified");
            Exit_Program (E_Fatal);
         end if;

         if not Is_Regular_File (ADC_File.all) then
            Put_Line (Standard_Error,
                      "Error: " & ADC_File.all & " doesn't exist");
            Exit_Program (E_Fatal);
         end if;

         --  Give instructions.

         Put_Line ("Copy the contents of "
           & ADC_File.all & " into your GNAT.ADC file");
         Put_Line ("and use GNAT Make qualifier /OBJECT_SEARCH=("
           & To_Host_Dir_Spec
               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/declib", False).all
           & ","
           & To_Host_Dir_Spec
               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/adalib", False).all
           & ")");
         Put_Line ("or else define ADA_OBJECTS_PATH as " & '"'
           & To_Host_Dir_Spec
               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/declib", False).all
           & ','
           & To_Host_Dir_Spec
               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/adalib", False).all
           & '"');

      when Delete =>

         --  Give instructions.

         Put_Line ("GNAT Librarian DELETE not yet implemented.");
         Put_Line ("Use appropriate system tools to remove library");

      when None =>
         Put_Line (Standard_Error,
                   "Error: No mode (create|set|delete) specified");
         Exit_Program (E_Fatal);

   end case;

end GnatLbr;
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;