1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1999-2009, AdaCore --
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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Ada.Characters.Handling; use Ada.Characters.Handling;
27 with Interfaces.C.Strings;
32 with Output; use Output;
34 with MLib.Utl; use MLib.Utl;
38 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
46 procedure Build_Library
47 (Ofiles : Argument_List;
52 if Opt.Verbose_Mode and not Opt.Quiet_Output then
53 Write_Line ("building a library...");
55 Write_Line (Output_File);
59 "lib" & Output_File & ".a", Objects => Ofiles);
62 ------------------------
63 -- Check_Library_Name --
64 ------------------------
66 procedure Check_Library_Name (Name : String) is
68 if Name'Length = 0 then
69 Prj.Com.Fail ("library name cannot be empty");
72 if Name'Length > Max_Characters_In_Library_Name then
73 Prj.Com.Fail ("illegal library name """
78 if not Is_Letter (Name (Name'First)) then
79 Prj.Com.Fail ("illegal library name """
81 & """: should start with a letter");
84 for Index in Name'Range loop
85 if not Is_Alphanumeric (Name (Index)) then
86 Prj.Com.Fail ("illegal library name """
88 & """: should include only letters and digits");
91 end Check_Library_Name;
97 procedure Copy_ALI_Files
98 (Files : Argument_List;
100 Interfaces : String_List)
102 Success : Boolean := False;
103 To_Dir : constant String := Get_Name_String (To);
104 Is_Interface : Boolean := False;
106 procedure Verbose_Copy (Index : Positive);
107 -- In verbose mode, output a message that the indexed file is copied
108 -- to the destination directory.
114 procedure Verbose_Copy (Index : Positive) is
116 if Opt.Verbose_Mode then
117 Write_Str ("Copying """);
118 Write_Str (Files (Index).all);
119 Write_Str (""" to """);
125 -- Start of processing for Copy_ALI_Files
128 if Interfaces'Length = 0 then
130 -- If there are no Interfaces, copy all the ALI files as is
132 for Index in Files'Range loop
133 Verbose_Copy (Index);
136 Directory_Separator &
137 Base_Name (Files (Index).all));
143 Preserve => Preserve);
145 exit when not Success;
149 -- Copy only the interface ALI file, and put the special indicator
150 -- "SL" on the P line.
152 for Index in Files'Range loop
155 File_Name : String := Base_Name (Files (Index).all);
158 Canonical_Case_File_Name (File_Name);
160 -- Check if this is one of the interface ALIs
162 Is_Interface := False;
164 for Index in Interfaces'Range loop
165 if File_Name = Interfaces (Index).all then
166 Is_Interface := True;
171 -- If it is an interface ALI, copy line by line. Insert
172 -- the interface indication at the end of the P line.
173 -- Do not copy ALI files that are not Interfaces.
177 Verbose_Copy (Index);
180 Directory_Separator &
181 Base_Name (Files (Index).all));
184 FD : File_Descriptor;
186 Actual_Len : Integer;
189 P_Line_Found : Boolean;
195 Name_Len := Files (Index)'Length;
196 Name_Buffer (1 .. Name_Len) := Files (Index).all;
197 Name_Len := Name_Len + 1;
198 Name_Buffer (Name_Len) := ASCII.NUL;
200 FD := Open_Read (Name_Buffer'Address, Binary);
202 if FD /= Invalid_FD then
203 Len := Integer (File_Length (FD));
207 S := new String (1 .. Len + 3);
209 -- Read the file. Note that the loop is not necessary
210 -- since the whole file is read at once except on VMS.
213 while Curr <= Len loop
214 Actual_Len := Read (FD, S (Curr)'Address, Len);
216 -- Exit if we could not read for some reason
218 exit when Actual_Len = 0;
220 Curr := Curr + Actual_Len;
223 -- We are done with the input file, so we close it
224 -- ignoring any bad status.
228 P_Line_Found := False;
230 -- Look for the P line. When found, add marker SL
231 -- at the beginning of the P line.
233 for Index in 1 .. Len - 3 loop
234 if (S (Index) = ASCII.LF
236 S (Index) = ASCII.CR)
237 and then S (Index + 1) = 'P'
239 S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
240 S (Index + 2 .. Index + 4) := " SL";
241 P_Line_Found := True;
248 -- Create new modified ALI file
250 Name_Len := To_Dir'Length;
251 Name_Buffer (1 .. Name_Len) := To_Dir;
252 Name_Len := Name_Len + 1;
253 Name_Buffer (Name_Len) := Directory_Separator;
255 (Name_Len + 1 .. Name_Len + File_Name'Length) :=
257 Name_Len := Name_Len + File_Name'Length + 1;
258 Name_Buffer (Name_Len) := ASCII.NUL;
260 FD := Create_File (Name_Buffer'Address, Binary);
262 -- Write the modified text and close the newly
265 if FD /= Invalid_FD then
266 Actual_Len := Write (FD, S (1)'Address, Len + 3);
270 -- Set Success to True only if the newly
271 -- created file has been correctly written.
273 Success := Status and then Actual_Len = Len + 3;
277 -- Set_Read_Only is used here, rather than
278 -- Set_Non_Writable, so that gprbuild can
279 -- he compiled with older compilers.
282 (Name_Buffer (1 .. Name_Len - 1));
289 -- This is not an interface ALI
297 Prj.Com.Fail ("could not copy ALI files to library dir");
303 ----------------------
304 -- Create_Sym_Links --
305 ----------------------
307 procedure Create_Sym_Links
309 Lib_Version : String;
311 Maj_Version : String)
314 (Oldpath : System.Address;
315 Newpath : System.Address) return Integer;
316 pragma Import (C, Symlink, "__gnat_symlink");
318 Version_Path : String_Access;
322 pragma Unreferenced (Success, Result);
325 Version_Path := new String (1 .. Lib_Version'Length + 1);
326 Version_Path (1 .. Lib_Version'Length) := Lib_Version;
327 Version_Path (Version_Path'Last) := ASCII.NUL;
329 if Maj_Version'Length = 0 then
331 Newpath : String (1 .. Lib_Path'Length + 1);
333 Newpath (1 .. Lib_Path'Length) := Lib_Path;
334 Newpath (Newpath'Last) := ASCII.NUL;
335 Delete_File (Lib_Path, Success);
336 Result := Symlink (Version_Path (1)'Address, Newpath'Address);
341 Newpath1 : String (1 .. Lib_Path'Length + 1);
342 Maj_Path : constant String :=
343 Lib_Dir & Directory_Separator & Maj_Version;
344 Newpath2 : String (1 .. Maj_Path'Length + 1);
345 Maj_Ver : String (1 .. Maj_Version'Length + 1);
348 Newpath1 (1 .. Lib_Path'Length) := Lib_Path;
349 Newpath1 (Newpath1'Last) := ASCII.NUL;
351 Newpath2 (1 .. Maj_Path'Length) := Maj_Path;
352 Newpath2 (Newpath2'Last) := ASCII.NUL;
354 Maj_Ver (1 .. Maj_Version'Length) := Maj_Version;
355 Maj_Ver (Maj_Ver'Last) := ASCII.NUL;
357 Delete_File (Maj_Path, Success);
359 Result := Symlink (Version_Path (1)'Address, Newpath2'Address);
361 Delete_File (Lib_Path, Success);
363 Result := Symlink (Maj_Ver'Address, Newpath1'Address);
366 end Create_Sym_Links;
368 --------------------------------
369 -- Linker_Library_Path_Option --
370 --------------------------------
372 function Linker_Library_Path_Option return String_Access is
374 Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
375 pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
376 -- Pointer to string representing the native linker option which
377 -- specifies the path where the dynamic loader should find shared
378 -- libraries. Equal to null string if this system doesn't support it.
380 S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr);
386 return new String'(S);
388 end Linker_Library_Path_Option;
394 function Major_Id_Name
395 (Lib_Filename : String;
396 Lib_Version : String)
399 Maj_Version : constant String := Lib_Version;
402 Ok_Maj : Boolean := False;
405 Last_Maj := Maj_Version'Last;
406 while Last_Maj > Maj_Version'First loop
407 if Maj_Version (Last_Maj) in '0' .. '9' then
408 Last_Maj := Last_Maj - 1;
411 Ok_Maj := Last_Maj /= Maj_Version'Last and then
412 Maj_Version (Last_Maj) = '.';
415 Last_Maj := Last_Maj - 1;
424 while Last > Maj_Version'First loop
425 if Maj_Version (Last) in '0' .. '9' then
429 Ok_Maj := Last /= Last_Maj and then
430 Maj_Version (Last) = '.';
435 Maj_Version (Maj_Version'First .. Last) = Lib_Filename;
444 return Maj_Version (Maj_Version'First .. Last_Maj);
450 -------------------------------
451 -- Separate_Run_Path_Options --
452 -------------------------------
454 function Separate_Run_Path_Options return Boolean is
455 Separate_Paths : Boolean;
456 for Separate_Paths'Size use Character'Size;
457 pragma Import (C, Separate_Paths, "__gnat_separate_run_path_options");
459 return Separate_Paths;
460 end Separate_Run_Path_Options;
462 -- Package elaboration
465 -- Copy_Attributes always fails on VMS
467 if Hostparm.OpenVMS then