PR testsuite/44195
[official-gcc.git] / gcc / ada / gnatsym.adb
blob5a88994a4c4496ef9e96011aebae4ec87d2c1c1f
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T S Y M --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
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 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. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 -- This utility application creates symbol files in a format that is
27 -- platform-dependent.
29 -- A symbol file is a text file that lists the symbols to be exported from
30 -- a shared library. The format of a symbol file depends on the platform;
31 -- it may be a simple enumeration of the symbol (one per line) or a more
32 -- elaborate format (on VMS, for example). A symbol file may be used as an
33 -- input to the platform linker when building a shared library.
35 -- This utility is not available on all platforms. It is currently supported
36 -- only on OpenVMS.
38 -- gnatsym takes as parameters:
39 -- - the name of the symbol file to create
40 -- - (optional) the policy to create the symbol file
41 -- - (optional) the name of the reference symbol file
42 -- - the names of one or more object files where the symbols are found
44 with Gnatvsn; use Gnatvsn;
45 with Osint; use Osint;
46 with Output; use Output;
47 with Symbols; use Symbols;
48 with Table;
50 with Ada.Exceptions; use Ada.Exceptions;
51 with Ada.Text_IO; use Ada.Text_IO;
53 with GNAT.Command_Line; use GNAT.Command_Line;
54 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
55 with GNAT.OS_Lib; use GNAT.OS_Lib;
57 procedure Gnatsym is
59 Empty_String : aliased String := "";
60 Empty : constant String_Access := Empty_String'Unchecked_Access;
61 -- To initialize variables Reference and Version_String
63 Copyright_Displayed : Boolean := False;
64 -- A flag to prevent multiple display of the Copyright notice
66 Success : Boolean := True;
68 Symbol_Policy : Policy := Autonomous;
70 Verbose : Boolean := False;
71 -- True when -v switch is used
73 Quiet : Boolean := False;
74 -- True when -q switch is used
76 Symbol_File_Name : String_Access := null;
77 -- The name of the symbol file
79 Reference_Symbol_File_Name : String_Access := Empty;
80 -- The name of the reference symbol file
82 Version_String : String_Access := Empty;
83 -- The version of the library (used on VMS)
85 type Object_File_Data is record
86 Path : String_Access;
87 Name : String_Access;
88 end record;
90 package Object_Files is new Table.Table
91 (Table_Component_Type => Object_File_Data,
92 Table_Index_Type => Natural,
93 Table_Low_Bound => 0,
94 Table_Initial => 10,
95 Table_Increment => 100,
96 Table_Name => "Gnatsymb.Object_Files");
97 -- A table to store the object file names
99 Object_File : Natural := 0;
100 -- An index to traverse the Object_Files table
102 procedure Display_Copyright;
103 -- Display Copyright notice
105 procedure Parse_Cmd_Line;
106 -- Parse the command line switches and file names
108 procedure Usage;
109 -- Display the usage
111 -----------------------
112 -- Display_Copyright --
113 -----------------------
115 procedure Display_Copyright is
116 begin
117 if not Copyright_Displayed then
118 Write_Eol;
119 Write_Str ("GNATSYMB ");
120 Write_Str (Gnat_Version_String);
121 Write_Eol;
122 Write_Str ("Copyright 2003-2004 Free Software Foundation, Inc");
123 Write_Eol;
124 Copyright_Displayed := True;
125 end if;
126 end Display_Copyright;
128 --------------------
129 -- Parse_Cmd_Line --
130 --------------------
132 procedure Parse_Cmd_Line is
133 begin
134 loop
135 case GNAT.Command_Line.Getopt ("c C D q r: R s: v V:") is
136 when ASCII.NUL =>
137 exit;
139 when 'c' =>
140 Symbol_Policy := Compliant;
142 when 'C' =>
143 Symbol_Policy := Controlled;
145 when 'D' =>
146 Symbol_Policy := Direct;
148 when 'q' =>
149 Quiet := True;
151 when 'r' =>
152 Reference_Symbol_File_Name :=
153 new String'(GNAT.Command_Line.Parameter);
155 when 'R' =>
156 Symbol_Policy := Restricted;
158 when 's' =>
159 Symbol_File_Name := new String'(GNAT.Command_Line.Parameter);
161 when 'v' =>
162 Verbose := True;
164 when 'V' =>
165 Version_String := new String'(GNAT.Command_Line.Parameter);
167 when others =>
168 Fail ("invalid switch: " & Full_Switch);
169 end case;
170 end loop;
172 -- Get the object file names and put them in the table in alphabetical
173 -- order of base names.
175 loop
176 declare
177 S : constant String_Access :=
178 new String'(GNAT.Command_Line.Get_Argument);
180 begin
181 exit when S'Length = 0;
183 Object_Files.Increment_Last;
185 declare
186 Base : constant String := Base_Name (S.all);
187 Last : constant Positive := Object_Files.Last;
188 J : Positive;
190 begin
191 J := 1;
192 while J < Last loop
193 if Object_Files.Table (J).Name.all > Base then
194 Object_Files.Table (J + 1 .. Last) :=
195 Object_Files.Table (J .. Last - 1);
196 exit;
197 end if;
199 J := J + 1;
200 end loop;
202 Object_Files.Table (J) := (S, new String'(Base));
203 end;
204 end;
205 end loop;
206 exception
207 when Invalid_Switch =>
208 Usage;
209 Fail ("invalid switch : " & Full_Switch);
210 end Parse_Cmd_Line;
212 -----------
213 -- Usage --
214 -----------
216 procedure Usage is
217 begin
218 Write_Line ("gnatsym [options] object_file {object_file}");
219 Write_Eol;
220 Write_Line (" -c Compliant symbol policy");
221 Write_Line (" -C Controlled symbol policy");
222 Write_Line (" -q Quiet mode");
223 Write_Line (" -r<ref> Reference symbol file name");
224 Write_Line (" -R Restricted symbol policy");
225 Write_Line (" -s<sym> Symbol file name");
226 Write_Line (" -v Verbose mode");
227 Write_Line (" -V<ver> Version");
228 Write_Eol;
229 Write_Line ("Specifying a symbol file with -s<sym> is compulsory");
230 Write_Eol;
231 end Usage;
233 -- Start of processing of Gnatsym
235 begin
236 -- Initialize Object_Files table
238 Object_Files.Set_Last (0);
240 -- Parse the command line
242 Parse_Cmd_Line;
244 if Verbose then
245 Display_Copyright;
246 end if;
248 -- If there is no symbol file or no object files on the command line,
249 -- display the usage and exit with an error status.
251 if Symbol_File_Name = null or else Object_Files.Last = 0 then
252 Usage;
253 OS_Exit (1);
255 -- When symbol policy is direct, simply copy the reference symbol file to
256 -- the symbol file.
258 elsif Symbol_Policy = Direct then
259 declare
260 File_In : Ada.Text_IO.File_Type;
261 File_Out : Ada.Text_IO.File_Type;
262 Line : String (1 .. 1_000);
263 Last : Natural;
265 begin
266 begin
267 Open (File_In, In_File, Reference_Symbol_File_Name.all);
269 exception
270 when X : others =>
271 if not Quiet then
272 Put_Line
273 ("could not open """ &
274 Reference_Symbol_File_Name.all
275 & """");
276 Put_Line (Exception_Message (X));
277 end if;
279 OS_Exit (1);
280 end;
282 begin
283 Create (File_Out, Out_File, Symbol_File_Name.all);
285 exception
286 when X : others =>
287 if not Quiet then
288 Put_Line
289 ("could not create """ & Symbol_File_Name.all & """");
290 Put_Line (Exception_Message (X));
291 end if;
293 OS_Exit (1);
294 end;
296 while not End_Of_File (File_In) loop
297 Get_Line (File_In, Line, Last);
298 Put_Line (File_Out, Line (1 .. Last));
299 end loop;
301 Close (File_In);
302 Close (File_Out);
303 end;
305 else
306 if Verbose then
307 Write_Str ("Initializing symbol file """);
308 Write_Str (Symbol_File_Name.all);
309 Write_Line ("""");
310 end if;
312 -- Initialize symbol file and, if specified, read reference file
314 Symbols.Initialize
315 (Symbol_File => Symbol_File_Name.all,
316 Reference => Reference_Symbol_File_Name.all,
317 Symbol_Policy => Symbol_Policy,
318 Quiet => Quiet,
319 Version => Version_String.all,
320 Success => Success);
322 -- Process the object files in order. Stop as soon as there is
323 -- something wrong.
325 Object_File := 0;
327 while Success and then Object_File < Object_Files.Last loop
328 Object_File := Object_File + 1;
330 if Verbose then
331 Write_Str ("Processing object file """);
332 Write_Str (Object_Files.Table (Object_File).Path.all);
333 Write_Line ("""");
334 end if;
336 Processing.Process
337 (Object_Files.Table (Object_File).Path.all,
338 Success);
339 end loop;
341 -- Finalize the symbol file
343 if Success then
344 if Verbose then
345 Write_Str ("Finalizing """);
346 Write_Str (Symbol_File_Name.all);
347 Write_Line ("""");
348 end if;
350 Finalize (Quiet, Success);
351 end if;
353 -- Fail if there was anything wrong
355 if not Success then
356 Fail ("unable to build symbol file");
357 end if;
358 end if;
359 end Gnatsym;