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

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                 M L I B                                  --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--           Copyright (C) 1999-2003, Ada Core Technologies, 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 Ada.Characters.Handling; use Ada.Characters.Handling;

with Hostparm;
with Opt;
with Output; use Output;
with Namet;  use Namet;

with MLib.Utl; use MLib.Utl;

with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib;               use GNAT.OS_Lib;

with System;

package body MLib is

   -------------------
   -- Build_Library --
   -------------------

   procedure Build_Library
     (Ofiles      : Argument_List;
      Afiles      : Argument_List;
      Output_File : String;
      Output_Dir  : String)
   is
      pragma Warnings (Off, Afiles);

      use GNAT.OS_Lib;

   begin
      if not Opt.Quiet_Output then
         Write_Line ("building a library...");
         Write_Str  ("   make ");
         Write_Line (Output_File);
      end if;

      Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
   end Build_Library;

   ------------------------
   -- Check_Library_Name --
   ------------------------

   procedure Check_Library_Name (Name : String) is
   begin
      if Name'Length = 0 then
         Fail ("library name cannot be empty");
      end if;

      if Name'Length > Max_Characters_In_Library_Name then
         Fail ("illegal library name """, Name, """: too long");
      end if;

      if not Is_Letter (Name (Name'First)) then
         Fail ("illegal library name """,
               Name,
               """: should start with a letter");
      end if;

      for Index in Name'Range loop
         if not Is_Alphanumeric (Name (Index)) then
            Fail ("illegal library name """,
                  Name,
                  """: should include only letters and digits");
         end if;
      end loop;
   end Check_Library_Name;

   --------------------
   -- Copy_ALI_Files --
   --------------------

   procedure Copy_ALI_Files
     (Files      : Argument_List;
      To         : Name_Id;
      Interfaces : String_List)
   is
      Success   : Boolean := False;
      To_Dir    : constant String := Get_Name_String (To);
      Interface : Boolean := False;

      procedure Set_Readonly (Name : System.Address);
      pragma Import (C, Set_Readonly, "__gnat_set_readonly");

      procedure Verbose_Copy (Index : Positive);
      --  In verbose mode, output a message that the indexed file is copied
      --  to the destination directory.

      ------------------
      -- Verbose_Copy --
      ------------------

      procedure Verbose_Copy (Index : Positive) is
      begin
         if Opt.Verbose_Mode then
            Write_Str ("Copying """);
            Write_Str (Files (Index).all);
            Write_Str (""" to """);
            Write_Str (To_Dir);
            Write_Line ("""");
         end if;
      end Verbose_Copy;

   begin
      if Interfaces'Length = 0 then

         --  If there are no Interfaces, copy all the ALI files as is

         for Index in Files'Range loop
            Verbose_Copy (Index);
            Copy_File
              (Files (Index).all,
               To_Dir,
               Success,
               Mode => Overwrite,
               Preserve => Preserve);

            exit when not Success;
         end loop;

      else
         --  Copy only the interface ALI file, and put the special indicator
         --  "SL" on the P line.

         for Index in Files'Range loop

            declare
               File_Name : String := Base_Name (Files (Index).all);
            begin
               Canonical_Case_File_Name (File_Name);

               --  Check if this is one of the interface ALIs

               Interface := False;

               for Index in Interfaces'Range loop
                  if File_Name = Interfaces (Index).all then
                     Interface := True;
                     exit;
                  end if;
               end loop;

               --  If it is an interface ALI, copy line by line. Insert
               --  the interface indication at the end of the P line.
               --  Do not copy ALI files that are not Interfaces.

               if Interface then
                  Success := False;
                  Verbose_Copy (Index);

                  declare
                     FD         : File_Descriptor;
                     Len        : Integer;
                     Actual_Len : Integer;
                     S          : String_Access;
                     Curr       : Natural;
                     P_Line_Found : Boolean;
                     Status     : Boolean;

                  begin
                     --  Open the file

                     Name_Len := Files (Index)'Length;
                     Name_Buffer (1 .. Name_Len) := Files (Index).all;
                     Name_Len := Name_Len + 1;
                     Name_Buffer (Name_Len) := ASCII.NUL;

                     FD := Open_Read (Name_Buffer'Address, Binary);

                     if FD /= Invalid_FD then
                        Len := Integer (File_Length (FD));

                        S := new String (1 .. Len + 3);

                        --  Read the file. Note that the loop is not necessary
                        --  since the whole file is read at once except on VMS.

                        Curr := 1;
                        Actual_Len := Len;

                        while Actual_Len /= 0 loop
                           Actual_Len := Read (FD, S (Curr)'Address, Len);
                           Curr := Curr + Actual_Len;
                        end loop;

                        --  We are done with the input file, so we close it

                        Close (FD, Status);
                        --  We simply ignore any bad status

                        P_Line_Found := False;

                        --  Look for the P line. When found, add marker SL
                        --  at the beginning of the P line.

                        for Index in 1 .. Len - 3 loop
                           if (S (Index) = ASCII.LF or else
                                 S (Index) = ASCII.CR)
                             and then
                               S (Index + 1) = 'P'
                           then
                              S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
                              S (Index + 2 .. Index + 4) := " SL";
                              P_Line_Found := True;
                              exit;
                           end if;
                        end loop;

                        if P_Line_Found then

                           --  Create new modified ALI file

                           Name_Len := To_Dir'Length;
                           Name_Buffer (1 .. Name_Len) := To_Dir;
                           Name_Len := Name_Len + 1;
                           Name_Buffer (Name_Len) := Directory_Separator;
                           Name_Buffer
                             (Name_Len + 1 .. Name_Len + File_Name'Length) :=
                                File_Name;
                           Name_Len := Name_Len + File_Name'Length + 1;
                           Name_Buffer (Name_Len) := ASCII.NUL;

                           FD := Create_File (Name_Buffer'Address, Binary);

                           --  Write the modified text and close the newly
                           --  created file.

                           if FD /= Invalid_FD then
                              Actual_Len := Write (FD, S (1)'Address, Len + 3);

                              Close (FD, Status);

                              --  Set Success to True only if the newly
                              --  created file has been correctly written.

                              Success := Status and Actual_Len = Len + 3;

                              if Success then
                                 Set_Readonly (Name_Buffer'Address);
                              end if;
                           end if;
                        end if;
                     end if;
                  end;

               else
                  --  This is not an interface ALI

                  Success := True;

               end if;
            end;

            if not Success then
               Fail ("could not copy ALI files to library dir");
            end if;
         end loop;
      end if;
   end Copy_ALI_Files;

--  Package elaboration

begin
   if Hostparm.OpenVMS then

      --  Copy_Attributes always fails on VMS

      Preserve := None;
   end if;
end MLib;
Commit	Line	Data
84481f76 RK	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT COMPILER COMPONENTS --
	4	-- --
	5	-- M L I B --
	6	-- --
	7	-- B o d y --
84481f76	8	-- --
fbf5a39b	9	-- Copyright (C) 1999-2003, Ada Core Technologies, Inc. --
84481f76 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. --
fbf5a39b	23	-- Extensive contributions were provided by Ada Core Technologies Inc. --
84481f76 RK	24	-- --
	25	------------------------------------------------------------------------------
	26
	27	with Ada.Characters.Handling; use Ada.Characters.Handling;
fbf5a39b AC	28
fbf5a39b AC	29	with Hostparm;
84481f76	30	with Opt;
fbf5a39b AC	31	with Output; use Output;
fbf5a39b AC	32	with Namet; use Namet;
84481f76	33
fbf5a39b AC	34	with MLib.Utl; use MLib.Utl;
	35
	36	with GNAT.Directory_Operations; use GNAT.Directory_Operations;
	37	with GNAT.OS_Lib; use GNAT.OS_Lib;
	38
	39	with System;
84481f76	40
fbf5a39b	41	package body MLib is
84481f76 RK	42
	43	-------------------
	44	-- Build_Library --
	45	-------------------
	46
	47	procedure Build_Library
	48	(Ofiles : Argument_List;
	49	Afiles : Argument_List;
	50	Output_File : String;
	51	Output_Dir : String)
	52	is
07fc65c4 GB	53	pragma Warnings (Off, Afiles);
07fc65c4 GB	54
84481f76 RK	55	use GNAT.OS_Lib;
	56
	57	begin
	58	if not Opt.Quiet_Output then
	59	Write_Line ("building a library...");
	60	Write_Str (" make ");
	61	Write_Line (Output_File);
	62	end if;
	63
fbf5a39b	64	Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
84481f76 RK	65	end Build_Library;
	66
	67	------------------------
	68	-- Check_Library_Name --
	69	------------------------
	70
	71	procedure Check_Library_Name (Name : String) is
	72	begin
	73	if Name'Length = 0 then
	74	Fail ("library name cannot be empty");
	75	end if;
	76
	77	if Name'Length > Max_Characters_In_Library_Name then
fbf5a39b	78	Fail ("illegal library name """, Name, """: too long");
84481f76 RK	79	end if;
	80
	81	if not Is_Letter (Name (Name'First)) then
	82	Fail ("illegal library name """,
	83	Name,
	84	""": should start with a letter");
	85	end if;
	86
	87	for Index in Name'Range loop
	88	if not Is_Alphanumeric (Name (Index)) then
	89	Fail ("illegal library name """,
	90	Name,
	91	""": should include only letters and digits");
	92	end if;
	93	end loop;
	94	end Check_Library_Name;
	95
fbf5a39b AC	96	--------------------
	97	-- Copy_ALI_Files --
	98	--------------------
	99
	100	procedure Copy_ALI_Files
	101	(Files : Argument_List;
	102	To : Name_Id;
	103	Interfaces : String_List)
	104	is
	105	Success : Boolean := False;
	106	To_Dir : constant String := Get_Name_String (To);
	107	Interface : Boolean := False;
	108
	109	procedure Set_Readonly (Name : System.Address);
	110	pragma Import (C, Set_Readonly, "__gnat_set_readonly");
	111
	112	procedure Verbose_Copy (Index : Positive);
	113	-- In verbose mode, output a message that the indexed file is copied
	114	-- to the destination directory.
	115
	116	------------------
	117	-- Verbose_Copy --
	118	------------------
	119
	120	procedure Verbose_Copy (Index : Positive) is
	121	begin
	122	if Opt.Verbose_Mode then
	123	Write_Str ("Copying """);
	124	Write_Str (Files (Index).all);
	125	Write_Str (""" to """);
	126	Write_Str (To_Dir);
	127	Write_Line ("""");
	128	end if;
	129	end Verbose_Copy;
	130
	131	begin
	132	if Interfaces'Length = 0 then
	133
	134	-- If there are no Interfaces, copy all the ALI files as is
	135
	136	for Index in Files'Range loop
	137	Verbose_Copy (Index);
	138	Copy_File
	139	(Files (Index).all,
	140	To_Dir,
	141	Success,
	142	Mode => Overwrite,
	143	Preserve => Preserve);
	144
	145	exit when not Success;
	146	end loop;
	147
	148	else
	149	-- Copy only the interface ALI file, and put the special indicator
	150	-- "SL" on the P line.
	151
	152	for Index in Files'Range loop
	153
	154	declare
	155	File_Name : String := Base_Name (Files (Index).all);
	156	begin
	157	Canonical_Case_File_Name (File_Name);
	158
	159	-- Check if this is one of the interface ALIs
160
161	Interface := False;
162
163	for Index in Interfaces'Range loop
164	if File_Name = Interfaces (Index).all then
165	Interface := True;
166	exit;
167	end if;
168	end loop;
169
170	-- If it is an interface ALI, copy line by line. Insert
171	-- the interface indication at the end of the P line.
172	-- Do not copy ALI files that are not Interfaces.
173
174	if Interface then
175	Success := False;
176	Verbose_Copy (Index);
177
178	declare
179	FD : File_Descriptor;
180	Len : Integer;
181	Actual_Len : Integer;
182	S : String_Access;
183	Curr : Natural;
184	P_Line_Found : Boolean;
185	Status : Boolean;
186
187	begin
188	-- Open the file
189
190	Name_Len := Files (Index)'Length;
191	Name_Buffer (1 .. Name_Len) := Files (Index).all;
192	Name_Len := Name_Len + 1;
193	Name_Buffer (Name_Len) := ASCII.NUL;
194
195	FD := Open_Read (Name_Buffer'Address, Binary);
196
197	if FD /= Invalid_FD then
198	Len := Integer (File_Length (FD));
199
200	S := new String (1 .. Len + 3);
201
202	-- Read the file. Note that the loop is not necessary
203	-- since the whole file is read at once except on VMS.
204
205	Curr := 1;
206	Actual_Len := Len;
207
208	while Actual_Len /= 0 loop
209	Actual_Len := Read (FD, S (Curr)'Address, Len);
210	Curr := Curr + Actual_Len;
211	end loop;
212
213	-- We are done with the input file, so we close it
214
215	Close (FD, Status);
216	-- We simply ignore any bad status
217
218	P_Line_Found := False;
219
220	-- Look for the P line. When found, add marker SL
221	-- at the beginning of the P line.
222
223	for Index in 1 .. Len - 3 loop
224	if (S (Index) = ASCII.LF or else
225	S (Index) = ASCII.CR)
226	and then
227	S (Index + 1) = 'P'
228	then
229	S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
230	S (Index + 2 .. Index + 4) := " SL";
231	P_Line_Found := True;
232	exit;
233	end if;
234	end loop;
235
236	if P_Line_Found then
237
238	-- Create new modified ALI file
239
240	Name_Len := To_Dir'Length;
241	Name_Buffer (1 .. Name_Len) := To_Dir;
242	Name_Len := Name_Len + 1;
243	Name_Buffer (Name_Len) := Directory_Separator;
244	Name_Buffer
245	(Name_Len + 1 .. Name_Len + File_Name'Length) :=
246	File_Name;
247	Name_Len := Name_Len + File_Name'Length + 1;
248	Name_Buffer (Name_Len) := ASCII.NUL;
249
250	FD := Create_File (Name_Buffer'Address, Binary);
251
252	-- Write the modified text and close the newly
253	-- created file.
254
255	if FD /= Invalid_FD then
256	Actual_Len := Write (FD, S (1)'Address, Len + 3);
257
258	Close (FD, Status);
259
260	-- Set Success to True only if the newly
261	-- created file has been correctly written.
262
263	Success := Status and Actual_Len = Len + 3;
264
265	if Success then
266	Set_Readonly (Name_Buffer'Address);
267	end if;
268	end if;
269	end if;
270	end if;
271	end;
272
273	else
274	-- This is not an interface ALI
275
276	Success := True;
277
278	end if;
279	end;
280
281	if not Success then
282	Fail ("could not copy ALI files to library dir");
283	end if;
284	end loop;
285	end if;
286	end Copy_ALI_Files;
287
288	-- Package elaboration
289
290	begin
291	if Hostparm.OpenVMS then
292
293	-- Copy_Attributes always fails on VMS
294
295	Preserve := None;
296	end if;
84481f76	297	end MLib;