1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1999-2007, 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 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Ada.Characters.Handling; use Ada.Characters.Handling;
28 with Interfaces.C.Strings;
33 with Output; use Output;
35 with MLib.Utl; use MLib.Utl;
39 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
47 procedure Build_Library
48 (Ofiles : Argument_List;
53 if Opt.Verbose_Mode and not Opt.Quiet_Output then
54 Write_Line ("building a library...");
56 Write_Line (Output_File);
59 Ar (Output_Dir & Directory_Separator &
60 "lib" & Output_File & ".a", Objects => Ofiles);
63 ------------------------
64 -- Check_Library_Name --
65 ------------------------
67 procedure Check_Library_Name (Name : String) is
69 if Name'Length = 0 then
70 Prj.Com.Fail ("library name cannot be empty");
73 if Name'Length > Max_Characters_In_Library_Name then
74 Prj.Com.Fail ("illegal library name """, Name, """: too long");
77 if not Is_Letter (Name (Name'First)) then
78 Prj.Com.Fail ("illegal library name """,
80 """: should start with a letter");
83 for Index in Name'Range loop
84 if not Is_Alphanumeric (Name (Index)) then
85 Prj.Com.Fail ("illegal library name """,
87 """: should include only letters and digits");
90 end Check_Library_Name;
96 procedure Copy_ALI_Files
97 (Files : Argument_List;
99 Interfaces : String_List)
101 Success : Boolean := False;
102 To_Dir : constant String := Get_Name_String (To);
103 Is_Interface : Boolean := False;
105 procedure Verbose_Copy (Index : Positive);
106 -- In verbose mode, output a message that the indexed file is copied
107 -- to the destination directory.
113 procedure Verbose_Copy (Index : Positive) is
115 if Opt.Verbose_Mode then
116 Write_Str ("Copying """);
117 Write_Str (Files (Index).all);
118 Write_Str (""" to """);
124 -- Start of processing for Copy_ALI_Files
127 if Interfaces'Length = 0 then
129 -- If there are no Interfaces, copy all the ALI files as is
131 for Index in Files'Range loop
132 Verbose_Copy (Index);
135 Directory_Separator &
136 Base_Name (Files (Index).all));
142 Preserve => Preserve);
144 exit when not Success;
148 -- Copy only the interface ALI file, and put the special indicator
149 -- "SL" on the P line.
151 for Index in Files'Range loop
154 File_Name : String := Base_Name (Files (Index).all);
157 Canonical_Case_File_Name (File_Name);
159 -- Check if this is one of the interface ALIs
161 Is_Interface := False;
163 for Index in Interfaces'Range loop
164 if File_Name = Interfaces (Index).all then
165 Is_Interface := True;
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.
176 Verbose_Copy (Index);
179 Directory_Separator &
180 Base_Name (Files (Index).all));
183 FD : File_Descriptor;
185 Actual_Len : Integer;
188 P_Line_Found : Boolean;
194 Name_Len := Files (Index)'Length;
195 Name_Buffer (1 .. Name_Len) := Files (Index).all;
196 Name_Len := Name_Len + 1;
197 Name_Buffer (Name_Len) := ASCII.NUL;
199 FD := Open_Read (Name_Buffer'Address, Binary);
201 if FD /= Invalid_FD then
202 Len := Integer (File_Length (FD));
204 S := new String (1 .. Len + 3);
206 -- Read the file. Note that the loop is not necessary
207 -- since the whole file is read at once except on VMS.
212 while Actual_Len /= 0 loop
213 Actual_Len := Read (FD, S (Curr)'Address, Len);
214 Curr := Curr + Actual_Len;
217 -- We are done with the input file, so we close it
218 -- ignoring any bad status.
222 P_Line_Found := False;
224 -- Look for the P line. When found, add marker SL
225 -- at the beginning of the P line.
227 for Index in 1 .. Len - 3 loop
228 if (S (Index) = ASCII.LF or else
229 S (Index) = ASCII.CR)
233 S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
234 S (Index + 2 .. Index + 4) := " SL";
235 P_Line_Found := True;
242 -- Create new modified ALI file
244 Name_Len := To_Dir'Length;
245 Name_Buffer (1 .. Name_Len) := To_Dir;
246 Name_Len := Name_Len + 1;
247 Name_Buffer (Name_Len) := Directory_Separator;
249 (Name_Len + 1 .. Name_Len + File_Name'Length) :=
251 Name_Len := Name_Len + File_Name'Length + 1;
252 Name_Buffer (Name_Len) := ASCII.NUL;
254 FD := Create_File (Name_Buffer'Address, Binary);
256 -- Write the modified text and close the newly
259 if FD /= Invalid_FD then
260 Actual_Len := Write (FD, S (1)'Address, Len + 3);
264 -- Set Success to True only if the newly
265 -- created file has been correctly written.
267 Success := Status and Actual_Len = Len + 3;
271 Name_Buffer (1 .. Name_Len - 1));
278 -- This is not an interface ALI
286 Prj.Com.Fail ("could not copy ALI files to library dir");
292 ----------------------
293 -- Create_Sym_Links --
294 ----------------------
296 procedure Create_Sym_Links
298 Lib_Version : String;
300 Maj_Version : String)
303 (Oldpath : System.Address;
304 Newpath : System.Address) return Integer;
305 pragma Import (C, Symlink, "__gnat_symlink");
308 Version_Path : String_Access;
311 pragma Unreferenced (Result);
314 if Is_Absolute_Path (Lib_Version) then
315 Version_Path := new String (1 .. Lib_Version'Length + 1);
316 Version_Path (1 .. Lib_Version'Length) := Lib_Version;
320 new String (1 .. Lib_Dir'Length + 1 + Lib_Version'Length + 1);
321 Version_Path (1 .. Version_Path'Last - 1) :=
322 Lib_Dir & Directory_Separator & Lib_Version;
325 Version_Path (Version_Path'Last) := ASCII.NUL;
327 if Maj_Version'Length = 0 then
329 Newpath : String (1 .. Lib_Path'Length + 1);
331 Newpath (1 .. Lib_Path'Length) := Lib_Path;
332 Newpath (Newpath'Last) := ASCII.NUL;
333 Delete_File (Lib_Path, Success);
334 Result := Symlink (Version_Path (1)'Address, Newpath'Address);
339 Newpath1 : String (1 .. Lib_Path'Length + 1);
340 Maj_Path : constant String :=
341 Lib_Dir & Directory_Separator & Maj_Version;
342 Newpath2 : String (1 .. Maj_Path'Length + 1);
345 Newpath1 (1 .. Lib_Path'Length) := Lib_Path;
346 Newpath1 (Newpath1'Last) := ASCII.NUL;
348 Newpath2 (1 .. Maj_Path'Length) := Maj_Path;
349 Newpath2 (Newpath2'Last) := ASCII.NUL;
351 Delete_File (Maj_Path, Success);
353 Result := Symlink (Version_Path (1)'Address, Newpath2'Address);
355 Delete_File (Lib_Path, Success);
357 Result := Symlink (Newpath2'Address, Newpath1'Address);
360 end Create_Sym_Links;
362 --------------------------------
363 -- Linker_Library_Path_Option --
364 --------------------------------
366 function Linker_Library_Path_Option return String_Access is
368 Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
369 pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
370 -- Pointer to string representing the native linker option which
371 -- specifies the path where the dynamic loader should find shared
372 -- libraries. Equal to null string if this system doesn't support it.
374 S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr);
380 return new String'(S);
382 end Linker_Library_Path_Option;
388 function Major_Id_Name
389 (Lib_Filename : String;
390 Lib_Version : String)
393 Maj_Version : constant String := Lib_Version;
396 Ok_Maj : Boolean := False;
399 Last_Maj := Maj_Version'Last;
400 while Last_Maj > Maj_Version'First loop
401 if Maj_Version (Last_Maj) in '0' .. '9' then
402 Last_Maj := Last_Maj - 1;
405 Ok_Maj := Last_Maj /= Maj_Version'Last and then
406 Maj_Version (Last_Maj) = '.';
409 Last_Maj := Last_Maj - 1;
418 while Last > Maj_Version'First loop
419 if Maj_Version (Last) in '0' .. '9' then
423 Ok_Maj := Last /= Last_Maj and then
424 Maj_Version (Last) = '.';
429 Maj_Version (Maj_Version'First .. Last) = Lib_Filename;
438 return Maj_Version (Maj_Version'First .. Last_Maj);
444 -- Package elaboration
447 -- Copy_Attributes always fails on VMS
449 if Hostparm.OpenVMS then