1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1999-2005, 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;
32 with Output; use Output;
33 with Namet; use Namet;
35 with MLib.Utl; use MLib.Utl;
39 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
47 procedure Build_Library
48 (Ofiles : Argument_List;
49 Afiles : Argument_List;
53 pragma Warnings (Off, Afiles);
56 if not Opt.Quiet_Output then
57 Write_Line ("building a library...");
59 Write_Line (Output_File);
62 Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
65 ------------------------
66 -- Check_Library_Name --
67 ------------------------
69 procedure Check_Library_Name (Name : String) is
71 if Name'Length = 0 then
72 Prj.Com.Fail ("library name cannot be empty");
75 if Name'Length > Max_Characters_In_Library_Name then
76 Prj.Com.Fail ("illegal library name """, Name, """: too long");
79 if not Is_Letter (Name (Name'First)) then
80 Prj.Com.Fail ("illegal library name """,
82 """: should start with a letter");
85 for Index in Name'Range loop
86 if not Is_Alphanumeric (Name (Index)) then
87 Prj.Com.Fail ("illegal library name """,
89 """: should include only letters and digits");
92 end Check_Library_Name;
98 procedure Copy_ALI_Files
99 (Files : Argument_List;
101 Interfaces : String_List)
103 Success : Boolean := False;
104 To_Dir : constant String := Get_Name_String (To);
105 Is_Interface : Boolean := False;
107 procedure Verbose_Copy (Index : Positive);
108 -- In verbose mode, output a message that the indexed file is copied
109 -- to the destination directory.
115 procedure Verbose_Copy (Index : Positive) is
117 if Opt.Verbose_Mode then
118 Write_Str ("Copying """);
119 Write_Str (Files (Index).all);
120 Write_Str (""" to """);
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);
138 Preserve => Preserve);
140 exit when not Success;
144 -- Copy only the interface ALI file, and put the special indicator
145 -- "SL" on the P line.
147 for Index in Files'Range loop
150 File_Name : String := Base_Name (Files (Index).all);
152 Canonical_Case_File_Name (File_Name);
154 -- Check if this is one of the interface ALIs
156 Is_Interface := False;
158 for Index in Interfaces'Range loop
159 if File_Name = Interfaces (Index).all then
160 Is_Interface := True;
165 -- If it is an interface ALI, copy line by line. Insert
166 -- the interface indication at the end of the P line.
167 -- Do not copy ALI files that are not Interfaces.
171 Verbose_Copy (Index);
174 FD : File_Descriptor;
176 Actual_Len : Integer;
179 P_Line_Found : Boolean;
185 Name_Len := Files (Index)'Length;
186 Name_Buffer (1 .. Name_Len) := Files (Index).all;
187 Name_Len := Name_Len + 1;
188 Name_Buffer (Name_Len) := ASCII.NUL;
190 FD := Open_Read (Name_Buffer'Address, Binary);
192 if FD /= Invalid_FD then
193 Len := Integer (File_Length (FD));
195 S := new String (1 .. Len + 3);
197 -- Read the file. Note that the loop is not necessary
198 -- since the whole file is read at once except on VMS.
203 while Actual_Len /= 0 loop
204 Actual_Len := Read (FD, S (Curr)'Address, Len);
205 Curr := Curr + Actual_Len;
208 -- We are done with the input file, so we close it
211 -- We simply ignore any bad status
213 P_Line_Found := False;
215 -- Look for the P line. When found, add marker SL
216 -- at the beginning of the P line.
218 for Index in 1 .. Len - 3 loop
219 if (S (Index) = ASCII.LF or else
220 S (Index) = ASCII.CR)
224 S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
225 S (Index + 2 .. Index + 4) := " SL";
226 P_Line_Found := True;
233 -- Create new modified ALI file
235 Name_Len := To_Dir'Length;
236 Name_Buffer (1 .. Name_Len) := To_Dir;
237 Name_Len := Name_Len + 1;
238 Name_Buffer (Name_Len) := Directory_Separator;
240 (Name_Len + 1 .. Name_Len + File_Name'Length) :=
242 Name_Len := Name_Len + File_Name'Length + 1;
243 Name_Buffer (Name_Len) := ASCII.NUL;
245 FD := Create_File (Name_Buffer'Address, Binary);
247 -- Write the modified text and close the newly
250 if FD /= Invalid_FD then
251 Actual_Len := Write (FD, S (1)'Address, Len + 3);
255 -- Set Success to True only if the newly
256 -- created file has been correctly written.
258 Success := Status and Actual_Len = Len + 3;
262 Name_Buffer (1 .. Name_Len - 1));
270 -- This is not an interface ALI
278 Prj.Com.Fail ("could not copy ALI files to library dir");
284 --------------------------------
285 -- Linker_Library_Path_Option --
286 --------------------------------
288 function Linker_Library_Path_Option return String_Access is
290 Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
291 pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
292 -- Pointer to string representing the native linker option which
293 -- specifies the path where the dynamic loader should find shared
294 -- libraries. Equal to null string if this system doesn't support it.
296 S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr);
302 return new String'(S);
304 end Linker_Library_Path_Option;
306 -- Package elaboration
309 -- Copy_Attributes always fails on VMS
311 if Hostparm.OpenVMS then