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