|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G P R E P --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 2002-2019, Free Software Foundation, Inc. --
|
|
111
|
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 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Atree; use Atree;
|
|
|
27 with Csets;
|
|
|
28 with Errutil;
|
|
|
29 with Namet; use Namet;
|
|
|
30 with Opt;
|
|
|
31 with Osint; use Osint;
|
|
|
32 with Output; use Output;
|
|
|
33 with Prep; use Prep;
|
|
|
34 with Scng;
|
|
|
35 with Sinput.C;
|
|
|
36 with Snames;
|
|
|
37 with Stringt; use Stringt;
|
|
|
38 with Switch; use Switch;
|
|
|
39 with Types; use Types;
|
|
|
40
|
|
|
41 with Ada.Command_Line; use Ada.Command_Line;
|
|
|
42 with Ada.Text_IO; use Ada.Text_IO;
|
|
|
43
|
|
|
44 with GNAT.Case_Util; use GNAT.Case_Util;
|
|
|
45 with GNAT.Command_Line;
|
|
|
46 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
|
|
47
|
|
|
48 with System.OS_Lib; use System.OS_Lib;
|
|
|
49
|
|
|
50 package body GPrep is
|
|
|
51
|
|
|
52 Copyright_Displayed : Boolean := False;
|
|
|
53 -- Used to prevent multiple displays of the copyright notice
|
|
|
54
|
|
|
55 ------------------------
|
|
|
56 -- Argument Line Data --
|
|
|
57 ------------------------
|
|
|
58
|
|
|
59 Unix_Line_Terminators : Boolean := False;
|
|
|
60 -- Set to True with option -T
|
|
|
61
|
|
|
62 type String_Array is array (Boolean) of String_Access;
|
|
|
63 Yes_No : constant String_Array :=
|
|
|
64 (False => new String'("YES"),
|
|
|
65 True => new String'("NO"));
|
|
|
66
|
|
|
67 Infile_Name : Name_Id := No_Name;
|
|
|
68 Outfile_Name : Name_Id := No_Name;
|
|
|
69 Deffile_Name : Name_Id := No_Name;
|
|
|
70
|
|
|
71 Output_Directory : Name_Id := No_Name;
|
|
|
72 -- Used when the specified output is an existing directory
|
|
|
73
|
|
|
74 Input_Directory : Name_Id := No_Name;
|
|
|
75 -- Used when the specified input and output are existing directories
|
|
|
76
|
|
|
77 Source_Ref_Pragma : Boolean := False;
|
|
|
78 -- Record command line options (set if -r switch set)
|
|
|
79
|
|
|
80 Text_Outfile : aliased Ada.Text_IO.File_Type;
|
|
|
81 Outfile : constant File_Access := Text_Outfile'Access;
|
|
|
82
|
|
|
83 File_Name_Buffer_Initial_Size : constant := 50;
|
|
|
84 File_Name_Buffer : String_Access :=
|
|
|
85 new String (1 .. File_Name_Buffer_Initial_Size);
|
|
|
86 -- A buffer to build output file names from input file names
|
|
|
87
|
|
|
88 -----------------
|
|
|
89 -- Subprograms --
|
|
|
90 -----------------
|
|
|
91
|
|
|
92 procedure Display_Copyright;
|
|
|
93 -- Display the copyright notice
|
|
|
94
|
|
|
95 procedure Post_Scan;
|
|
|
96 -- Null procedure, needed by instantiation of Scng below
|
|
|
97
|
|
|
98 package Scanner is new Scng
|
|
|
99 (Post_Scan,
|
|
|
100 Errutil.Error_Msg,
|
|
|
101 Errutil.Error_Msg_S,
|
|
|
102 Errutil.Error_Msg_SC,
|
|
|
103 Errutil.Error_Msg_SP,
|
|
|
104 Errutil.Style);
|
|
|
105 -- The scanner for the preprocessor
|
|
|
106
|
|
|
107 function Is_ASCII_Letter (C : Character) return Boolean;
|
|
|
108 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
|
|
|
109
|
|
|
110 procedure Double_File_Name_Buffer;
|
|
|
111 -- Double the size of the file name buffer
|
|
|
112
|
|
|
113 procedure Preprocess_Infile_Name;
|
|
|
114 -- When the specified output is a directory, preprocess the infile name
|
|
|
115 -- for symbol substitution, to get the output file name.
|
|
|
116
|
|
|
117 procedure Process_Files;
|
|
|
118 -- Process the single input file or all the files in the directory tree
|
|
|
119 -- rooted at the input directory.
|
|
|
120
|
|
|
121 procedure Process_Command_Line_Symbol_Definition (S : String);
|
|
|
122 -- Process a -D switch on the command line
|
|
|
123
|
|
|
124 procedure Put_Char_To_Outfile (C : Character);
|
|
|
125 -- Output one character to the output file. Used to initialize the
|
|
|
126 -- preprocessor.
|
|
|
127
|
|
|
128 procedure New_EOL_To_Outfile;
|
|
|
129 -- Output a new line to the output file. Used to initialize the
|
|
|
130 -- preprocessor.
|
|
|
131
|
|
|
132 procedure Scan_Command_Line;
|
|
|
133 -- Scan the switches and the file names
|
|
|
134
|
|
|
135 procedure Usage;
|
|
|
136 -- Display the usage
|
|
|
137
|
|
|
138 -----------------------
|
|
|
139 -- Display_Copyright --
|
|
|
140 -----------------------
|
|
|
141
|
|
|
142 procedure Display_Copyright is
|
|
|
143 begin
|
|
|
144 if not Copyright_Displayed then
|
|
|
145 Display_Version ("GNAT Preprocessor", "1996");
|
|
|
146 Copyright_Displayed := True;
|
|
|
147 end if;
|
|
|
148 end Display_Copyright;
|
|
|
149
|
|
|
150 -----------------------------
|
|
|
151 -- Double_File_Name_Buffer --
|
|
|
152 -----------------------------
|
|
|
153
|
|
|
154 procedure Double_File_Name_Buffer is
|
|
|
155 New_Buffer : constant String_Access :=
|
|
|
156 new String (1 .. 2 * File_Name_Buffer'Length);
|
|
|
157 begin
|
|
|
158 New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all;
|
|
|
159 Free (File_Name_Buffer);
|
|
|
160 File_Name_Buffer := New_Buffer;
|
|
|
161 end Double_File_Name_Buffer;
|
|
|
162
|
|
|
163 --------------
|
|
|
164 -- Gnatprep --
|
|
|
165 --------------
|
|
|
166
|
|
|
167 procedure Gnatprep is
|
|
|
168 begin
|
|
|
169 -- Do some initializations (order is important here)
|
|
|
170
|
|
|
171 Csets.Initialize;
|
|
|
172 Snames.Initialize;
|
|
|
173 Stringt.Initialize;
|
|
|
174 Prep.Initialize;
|
|
|
175
|
|
|
176 -- Initialize the preprocessor
|
|
|
177
|
|
|
178 Prep.Setup_Hooks
|
|
|
179 (Error_Msg => Errutil.Error_Msg'Access,
|
|
|
180 Scan => Scanner.Scan'Access,
|
|
|
181 Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
|
|
|
182 Put_Char => Put_Char_To_Outfile'Access,
|
|
|
183 New_EOL => New_EOL_To_Outfile'Access);
|
|
|
184
|
|
|
185 -- Set the scanner characteristics for the preprocessor
|
|
|
186
|
|
|
187 Scanner.Set_Special_Character ('#');
|
|
|
188 Scanner.Set_Special_Character ('$');
|
|
|
189 Scanner.Set_End_Of_Line_As_Token (True);
|
|
|
190
|
|
|
191 -- Initialize the mapping table of symbols to values
|
|
|
192
|
|
|
193 Prep.Symbol_Table.Init (Prep.Mapping);
|
|
|
194
|
|
|
195 -- Parse the switches and arguments
|
|
|
196
|
|
|
197 Scan_Command_Line;
|
|
|
198
|
|
|
199 if Opt.Verbose_Mode then
|
|
|
200 Display_Copyright;
|
|
|
201 end if;
|
|
|
202
|
|
|
203 -- Test we had all the arguments needed
|
|
|
204
|
|
|
205 if Infile_Name = No_Name then
|
|
|
206
|
|
|
207 -- No input file specified, just output the usage and exit
|
|
|
208
|
|
|
209 if Argument_Count = 0 then
|
|
|
210 Usage;
|
|
|
211 else
|
|
|
212 GNAT.Command_Line.Try_Help;
|
|
|
213 end if;
|
|
|
214
|
|
|
215 return;
|
|
|
216
|
|
|
217 elsif Outfile_Name = No_Name then
|
|
|
218
|
|
|
219 -- No output file specified, exit
|
|
|
220
|
|
|
221 GNAT.Command_Line.Try_Help;
|
|
|
222 return;
|
|
|
223 end if;
|
|
|
224
|
|
|
225 -- If a pragma Source_File_Name, we need to keep line numbers. So, if
|
|
|
226 -- the deleted lines are not put as comment, we must output them as
|
|
|
227 -- blank lines.
|
|
|
228
|
|
|
229 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
|
|
|
230 Opt.Blank_Deleted_Lines := True;
|
|
|
231 end if;
|
|
|
232
|
|
|
233 -- If we have a definition file, parse it
|
|
|
234
|
|
|
235 if Deffile_Name /= No_Name then
|
|
|
236 declare
|
|
|
237 Deffile : Source_File_Index;
|
|
|
238
|
|
|
239 begin
|
|
|
240 Errutil.Initialize;
|
|
|
241 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
|
|
|
242
|
|
|
243 -- Set Main_Source_File to the definition file for the benefit of
|
|
|
244 -- Errutil.Finalize.
|
|
|
245
|
|
|
246 Sinput.Main_Source_File := Deffile;
|
|
|
247
|
|
|
248 if Deffile = No_Source_File then
|
|
|
249 Fail ("unable to find definition file """
|
|
|
250 & Get_Name_String (Deffile_Name)
|
|
|
251 & """");
|
|
|
252 elsif Deffile = No_Access_To_Source_File then
|
|
|
253 Fail ("unabled to read definition file """
|
|
|
254 & Get_Name_String (Deffile_Name)
|
|
|
255 & """");
|
|
|
256 end if;
|
|
|
257
|
|
|
258 Scanner.Initialize_Scanner (Deffile);
|
|
|
259
|
|
|
260 -- Parse the definition file without "replace in comments"
|
|
|
261
|
|
|
262 declare
|
|
|
263 Replace : constant Boolean := Opt.Replace_In_Comments;
|
|
|
264 begin
|
|
|
265 Opt.Replace_In_Comments := False;
|
|
|
266 Prep.Parse_Def_File;
|
|
|
267 Opt.Replace_In_Comments := Replace;
|
|
|
268 end;
|
|
|
269 end;
|
|
|
270 end if;
|
|
|
271
|
|
|
272 -- If there are errors in the definition file, output them and exit
|
|
|
273
|
|
|
274 if Total_Errors_Detected > 0 then
|
|
|
275 Errutil.Finalize (Source_Type => "definition");
|
|
|
276 Fail ("errors in definition file """
|
|
|
277 & Get_Name_String (Deffile_Name)
|
|
|
278 & """");
|
|
|
279 end if;
|
|
|
280
|
|
|
281 -- If -s switch was specified, print a sorted list of symbol names and
|
|
|
282 -- values, if any.
|
|
|
283
|
|
|
284 if Opt.List_Preprocessing_Symbols then
|
|
|
285 Prep.List_Symbols (Foreword => "");
|
|
|
286 end if;
|
|
|
287
|
|
|
288 Output_Directory := No_Name;
|
|
|
289 Input_Directory := No_Name;
|
|
|
290
|
|
|
291 -- Check if the specified output is an existing directory
|
|
|
292
|
|
|
293 if Is_Directory (Get_Name_String (Outfile_Name)) then
|
|
|
294 Output_Directory := Outfile_Name;
|
|
|
295
|
|
|
296 -- As the output is an existing directory, check if the input too
|
|
|
297 -- is a directory.
|
|
|
298
|
|
|
299 if Is_Directory (Get_Name_String (Infile_Name)) then
|
|
|
300 Input_Directory := Infile_Name;
|
|
|
301 end if;
|
|
|
302 end if;
|
|
|
303
|
|
|
304 -- And process the single input or the files in the directory tree
|
|
|
305 -- rooted at the input directory.
|
|
|
306
|
|
|
307 Process_Files;
|
|
|
308 end Gnatprep;
|
|
|
309
|
|
|
310 ---------------------
|
|
|
311 -- Is_ASCII_Letter --
|
|
|
312 ---------------------
|
|
|
313
|
|
|
314 function Is_ASCII_Letter (C : Character) return Boolean is
|
|
|
315 begin
|
|
|
316 return C in 'A' .. 'Z' or else C in 'a' .. 'z';
|
|
|
317 end Is_ASCII_Letter;
|
|
|
318
|
|
|
319 ------------------------
|
|
|
320 -- New_EOL_To_Outfile --
|
|
|
321 ------------------------
|
|
|
322
|
|
|
323 procedure New_EOL_To_Outfile is
|
|
|
324 begin
|
|
|
325 New_Line (Outfile.all);
|
|
|
326 end New_EOL_To_Outfile;
|
|
|
327
|
|
|
328 ---------------
|
|
|
329 -- Post_Scan --
|
|
|
330 ---------------
|
|
|
331
|
|
|
332 procedure Post_Scan is
|
|
|
333 begin
|
|
|
334 null;
|
|
|
335 end Post_Scan;
|
|
|
336
|
|
|
337 ----------------------------
|
|
|
338 -- Preprocess_Infile_Name --
|
|
|
339 ----------------------------
|
|
|
340
|
|
|
341 procedure Preprocess_Infile_Name is
|
|
|
342 Len : Natural;
|
|
|
343 First : Positive;
|
|
|
344 Last : Natural;
|
|
|
345 Symbol : Name_Id;
|
|
|
346 Data : Symbol_Data;
|
|
|
347
|
|
|
348 begin
|
|
|
349 -- Initialize the buffer with the name of the input file
|
|
|
350
|
|
|
351 Get_Name_String (Infile_Name);
|
|
|
352 Len := Name_Len;
|
|
|
353
|
|
|
354 while File_Name_Buffer'Length < Len loop
|
|
|
355 Double_File_Name_Buffer;
|
|
|
356 end loop;
|
|
|
357
|
|
|
358 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
|
|
|
359
|
|
|
360 -- Look for possible symbols in the file name
|
|
|
361
|
|
|
362 First := 1;
|
|
|
363 while First < Len loop
|
|
|
364
|
|
|
365 -- A symbol starts with a dollar sign followed by a letter
|
|
|
366
|
|
|
367 if File_Name_Buffer (First) = '$' and then
|
|
|
368 Is_ASCII_Letter (File_Name_Buffer (First + 1))
|
|
|
369 then
|
|
|
370 Last := First + 1;
|
|
|
371
|
|
|
372 -- Find the last letter of the symbol
|
|
|
373
|
|
|
374 while Last < Len and then
|
|
|
375 Is_ASCII_Letter (File_Name_Buffer (Last + 1))
|
|
|
376 loop
|
|
|
377 Last := Last + 1;
|
|
|
378 end loop;
|
|
|
379
|
|
|
380 -- Get the symbol name id
|
|
|
381
|
|
|
382 Name_Len := Last - First;
|
|
|
383 Name_Buffer (1 .. Name_Len) :=
|
|
|
384 File_Name_Buffer (First + 1 .. Last);
|
|
|
385 To_Lower (Name_Buffer (1 .. Name_Len));
|
|
|
386 Symbol := Name_Find;
|
|
|
387
|
|
|
388 -- And look for this symbol name in the symbol table
|
|
|
389
|
|
|
390 for Index in 1 .. Symbol_Table.Last (Mapping) loop
|
|
|
391 Data := Mapping.Table (Index);
|
|
|
392
|
|
|
393 if Data.Symbol = Symbol then
|
|
|
394
|
|
|
395 -- We found the symbol. If its value is not a string,
|
|
|
396 -- replace the symbol in the file name with the value of
|
|
|
397 -- the symbol.
|
|
|
398
|
|
|
399 if not Data.Is_A_String then
|
|
|
400 String_To_Name_Buffer (Data.Value);
|
|
|
401
|
|
|
402 declare
|
|
|
403 Sym_Len : constant Positive := Last - First + 1;
|
|
|
404 Offset : constant Integer := Name_Len - Sym_Len;
|
|
|
405 New_Len : constant Natural := Len + Offset;
|
|
|
406
|
|
|
407 begin
|
|
|
408 while New_Len > File_Name_Buffer'Length loop
|
|
|
409 Double_File_Name_Buffer;
|
|
|
410 end loop;
|
|
|
411
|
|
|
412 File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
|
|
|
413 File_Name_Buffer (Last + 1 .. Len);
|
|
|
414 Len := New_Len;
|
|
|
415 Last := Last + Offset;
|
|
|
416 File_Name_Buffer (First .. Last) :=
|
|
|
417 Name_Buffer (1 .. Name_Len);
|
|
|
418 end;
|
|
|
419 end if;
|
|
|
420
|
|
|
421 exit;
|
|
|
422 end if;
|
|
|
423 end loop;
|
|
|
424
|
|
|
425 -- Skip over the symbol name or its value: we are not checking
|
|
|
426 -- for another symbol name in the value.
|
|
|
427
|
|
|
428 First := Last + 1;
|
|
|
429
|
|
|
430 else
|
|
|
431 First := First + 1;
|
|
|
432 end if;
|
|
|
433 end loop;
|
|
|
434
|
|
|
435 -- We now have the output file name in the buffer. Get the output
|
|
|
436 -- path and put it in Outfile_Name.
|
|
|
437
|
|
|
438 Get_Name_String (Output_Directory);
|
|
|
439 Add_Char_To_Name_Buffer (Directory_Separator);
|
|
|
440 Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
|
|
|
441 Outfile_Name := Name_Find;
|
|
|
442 end Preprocess_Infile_Name;
|
|
|
443
|
|
|
444 --------------------------------------------
|
|
|
445 -- Process_Command_Line_Symbol_Definition --
|
|
|
446 --------------------------------------------
|
|
|
447
|
|
|
448 procedure Process_Command_Line_Symbol_Definition (S : String) is
|
|
|
449 Data : Symbol_Data;
|
|
|
450 Symbol : Symbol_Id;
|
|
|
451
|
|
|
452 begin
|
|
|
453 -- Check the symbol definition and get the symbol and its value.
|
|
|
454 -- Fail if symbol definition is illegal.
|
|
|
455
|
|
|
456 Check_Command_Line_Symbol_Definition (S, Data);
|
|
|
457
|
|
|
458 Symbol := Index_Of (Data.Symbol);
|
|
|
459
|
|
|
460 -- If symbol does not already exist, create a new entry in the mapping
|
|
|
461 -- table.
|
|
|
462
|
|
|
463 if Symbol = No_Symbol then
|
|
|
464 Symbol_Table.Increment_Last (Mapping);
|
|
|
465 Symbol := Symbol_Table.Last (Mapping);
|
|
|
466 end if;
|
|
|
467
|
|
|
468 Mapping.Table (Symbol) := Data;
|
|
|
469 end Process_Command_Line_Symbol_Definition;
|
|
|
470
|
|
|
471 -------------------
|
|
|
472 -- Process_Files --
|
|
|
473 -------------------
|
|
|
474
|
|
|
475 procedure Process_Files is
|
|
|
476
|
|
|
477 procedure Process_One_File;
|
|
|
478 -- Process input file Infile_Name and put the result in file
|
|
|
479 -- Outfile_Name.
|
|
|
480
|
|
|
481 procedure Recursive_Process (In_Dir : String; Out_Dir : String);
|
|
|
482 -- Process recursively files in In_Dir. Results go to Out_Dir
|
|
|
483
|
|
|
484 ----------------------
|
|
|
485 -- Process_One_File --
|
|
|
486 ----------------------
|
|
|
487
|
|
|
488 procedure Process_One_File is
|
|
|
489 Infile : Source_File_Index;
|
|
|
490
|
|
|
491 Modified : Boolean;
|
|
|
492 pragma Warnings (Off, Modified);
|
|
|
493
|
|
|
494 begin
|
|
|
495 -- Create the output file (fails if this does not work)
|
|
|
496
|
|
|
497 begin
|
|
|
498 Create
|
|
|
499 (File => Text_Outfile,
|
|
|
500 Mode => Out_File,
|
|
|
501 Name => Get_Name_String (Outfile_Name),
|
|
|
502 Form => "Text_Translation=" &
|
|
|
503 Yes_No (Unix_Line_Terminators).all);
|
|
|
504
|
|
|
505 exception
|
|
|
506 when others =>
|
|
|
507 Fail
|
|
|
508 ("unable to create output file """
|
|
|
509 & Get_Name_String (Outfile_Name)
|
|
|
510 & """");
|
|
|
511 end;
|
|
|
512
|
|
|
513 -- Load the input file
|
|
|
514
|
|
|
515 Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
|
|
|
516
|
|
|
517 if Infile = No_Source_File then
|
|
|
518 Fail ("unable to find input file """
|
|
|
519 & Get_Name_String (Infile_Name)
|
|
|
520 & """");
|
|
|
521 elsif Infile = No_Access_To_Source_File then
|
|
|
522 Fail ("unable to read input file """
|
|
|
523 & Get_Name_String (Infile_Name)
|
|
|
524 & """");
|
|
|
525 end if;
|
|
|
526
|
|
|
527 -- Set Main_Source_File to the input file for the benefit of
|
|
|
528 -- Errutil.Finalize.
|
|
|
529
|
|
|
530 Sinput.Main_Source_File := Infile;
|
|
|
531
|
|
|
532 Scanner.Initialize_Scanner (Infile);
|
|
|
533
|
|
|
534 -- Output the pragma Source_Reference if asked to
|
|
|
535
|
|
|
536 if Source_Ref_Pragma then
|
|
|
537 Put_Line
|
|
|
538 (Outfile.all,
|
|
|
539 "pragma Source_Reference (1, """ &
|
|
|
540 Get_Name_String (Sinput.Full_File_Name (Infile)) & """);");
|
|
|
541 end if;
|
|
|
542
|
|
|
543 -- Preprocess the input file
|
|
|
544
|
|
|
545 Prep.Preprocess (Modified);
|
|
|
546
|
|
|
547 -- In verbose mode, if there is no error, report it
|
|
|
548
|
|
|
549 if Opt.Verbose_Mode and then Total_Errors_Detected = 0 then
|
|
|
550 Errutil.Finalize (Source_Type => "input");
|
|
|
551 end if;
|
|
|
552
|
|
|
553 -- If we had some errors, delete the output file, and report them
|
|
|
554
|
|
|
555 if Total_Errors_Detected > 0 then
|
|
|
556 if Outfile /= Standard_Output then
|
|
|
557 Delete (Text_Outfile);
|
|
|
558 end if;
|
|
|
559
|
|
|
560 Errutil.Finalize (Source_Type => "input");
|
|
|
561
|
|
|
562 OS_Exit (0);
|
|
|
563
|
|
|
564 -- Otherwise, close the output file, and we are done
|
|
|
565
|
|
|
566 elsif Outfile /= Standard_Output then
|
|
|
567 Close (Text_Outfile);
|
|
|
568 end if;
|
|
|
569 end Process_One_File;
|
|
|
570
|
|
|
571 -----------------------
|
|
|
572 -- Recursive_Process --
|
|
|
573 -----------------------
|
|
|
574
|
|
|
575 procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
|
|
|
576 Dir_In : Dir_Type;
|
|
|
577 Name : String (1 .. 255);
|
|
|
578 Last : Natural;
|
|
|
579 In_Dir_Name : Name_Id;
|
|
|
580 Out_Dir_Name : Name_Id;
|
|
|
581
|
|
|
582 procedure Set_Directory_Names;
|
|
|
583 -- Establish or reestablish the current input and output directories
|
|
|
584
|
|
|
585 -------------------------
|
|
|
586 -- Set_Directory_Names --
|
|
|
587 -------------------------
|
|
|
588
|
|
|
589 procedure Set_Directory_Names is
|
|
|
590 begin
|
|
|
591 Input_Directory := In_Dir_Name;
|
|
|
592 Output_Directory := Out_Dir_Name;
|
|
|
593 end Set_Directory_Names;
|
|
|
594
|
|
|
595 -- Start of processing for Recursive_Process
|
|
|
596
|
|
|
597 begin
|
|
|
598 -- Open the current input directory
|
|
|
599
|
|
|
600 begin
|
|
|
601 Open (Dir_In, In_Dir);
|
|
|
602
|
|
|
603 exception
|
|
|
604 when Directory_Error =>
|
|
|
605 Fail ("could not read directory " & In_Dir);
|
|
|
606 end;
|
|
|
607
|
|
|
608 -- Set the new input and output directory names
|
|
|
609
|
|
|
610 Name_Len := In_Dir'Length;
|
|
|
611 Name_Buffer (1 .. Name_Len) := In_Dir;
|
|
|
612 In_Dir_Name := Name_Find;
|
|
|
613 Name_Len := Out_Dir'Length;
|
|
|
614 Name_Buffer (1 .. Name_Len) := Out_Dir;
|
|
|
615 Out_Dir_Name := Name_Find;
|
|
|
616
|
|
|
617 Set_Directory_Names;
|
|
|
618
|
|
|
619 -- Traverse the input directory
|
|
|
620 loop
|
|
|
621 Read (Dir_In, Name, Last);
|
|
|
622 exit when Last = 0;
|
|
|
623
|
|
|
624 if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
|
|
|
625 declare
|
|
|
626 Input : constant String :=
|
|
|
627 In_Dir & Directory_Separator & Name (1 .. Last);
|
|
|
628 Output : constant String :=
|
|
|
629 Out_Dir & Directory_Separator & Name (1 .. Last);
|
|
|
630
|
|
|
631 begin
|
|
|
632 -- If input is an ordinary file, process it
|
|
|
633
|
|
|
634 if Is_Regular_File (Input) then
|
|
|
635 -- First get the output file name
|
|
|
636
|
|
|
637 Name_Len := Last;
|
|
|
638 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
|
|
|
639 Infile_Name := Name_Find;
|
|
|
640 Preprocess_Infile_Name;
|
|
|
641
|
|
|
642 -- Set the input file name and process the file
|
|
|
643
|
|
|
644 Name_Len := Input'Length;
|
|
|
645 Name_Buffer (1 .. Name_Len) := Input;
|
|
|
646 Infile_Name := Name_Find;
|
|
|
647 Process_One_File;
|
|
|
648
|
|
|
649 elsif Is_Directory (Input) then
|
|
|
650 -- Input is a directory. If the corresponding output
|
|
|
651 -- directory does not already exist, create it.
|
|
|
652
|
|
|
653 if not Is_Directory (Output) then
|
|
|
654 begin
|
|
|
655 Make_Dir (Dir_Name => Output);
|
|
|
656
|
|
|
657 exception
|
|
|
658 when Directory_Error =>
|
|
|
659 Fail ("could not create directory """
|
|
|
660 & Output
|
|
|
661 & """");
|
|
|
662 end;
|
|
|
663 end if;
|
|
|
664
|
|
|
665 -- And process this new input directory
|
|
|
666
|
|
|
667 Recursive_Process (Input, Output);
|
|
|
668
|
|
|
669 -- Reestablish the input and output directory names
|
|
|
670 -- that have been modified by the recursive call.
|
|
|
671
|
|
|
672 Set_Directory_Names;
|
|
|
673 end if;
|
|
|
674 end;
|
|
|
675 end if;
|
|
|
676 end loop;
|
|
|
677 end Recursive_Process;
|
|
|
678
|
|
|
679 -- Start of processing for Process_Files
|
|
|
680
|
|
|
681 begin
|
|
|
682 if Output_Directory = No_Name then
|
|
|
683
|
|
|
684 -- If the output is not a directory, fail if the input is
|
|
|
685 -- an existing directory, to avoid possible problems.
|
|
|
686
|
|
|
687 if Is_Directory (Get_Name_String (Infile_Name)) then
|
|
|
688 Fail ("input file """ & Get_Name_String (Infile_Name) &
|
|
|
689 """ is a directory");
|
|
|
690 end if;
|
|
|
691
|
|
|
692 -- Just process the single input file
|
|
|
693
|
|
|
694 Process_One_File;
|
|
|
695
|
|
|
696 elsif Input_Directory = No_Name then
|
|
|
697
|
|
|
698 -- Get the output file name from the input file name, and process
|
|
|
699 -- the single input file.
|
|
|
700
|
|
|
701 Preprocess_Infile_Name;
|
|
|
702 Process_One_File;
|
|
|
703
|
|
|
704 else
|
|
|
705 -- Recursively process files in the directory tree rooted at the
|
|
|
706 -- input directory.
|
|
|
707
|
|
|
708 Recursive_Process
|
|
|
709 (In_Dir => Get_Name_String (Input_Directory),
|
|
|
710 Out_Dir => Get_Name_String (Output_Directory));
|
|
|
711 end if;
|
|
|
712 end Process_Files;
|
|
|
713
|
|
|
714 -------------------------
|
|
|
715 -- Put_Char_To_Outfile --
|
|
|
716 -------------------------
|
|
|
717
|
|
|
718 procedure Put_Char_To_Outfile (C : Character) is
|
|
|
719 begin
|
|
|
720 Put (Outfile.all, C);
|
|
|
721 end Put_Char_To_Outfile;
|
|
|
722
|
|
|
723 -----------------------
|
|
|
724 -- Scan_Command_Line --
|
|
|
725 -----------------------
|
|
|
726
|
|
|
727 procedure Scan_Command_Line is
|
|
|
728 Switch : Character;
|
|
|
729
|
|
|
730 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
|
|
|
731
|
|
|
732 -- Start of processing for Scan_Command_Line
|
|
|
733
|
|
|
734 begin
|
|
|
735 -- First check for --version or --help
|
|
|
736
|
|
|
737 Check_Version_And_Help ("GNATPREP", "1996");
|
|
|
738
|
|
|
739 -- Now scan the other switches
|
|
|
740
|
|
|
741 GNAT.Command_Line.Initialize_Option_Scan;
|
|
|
742
|
|
|
743 loop
|
|
|
744 begin
|
|
|
745 Switch := GNAT.Command_Line.Getopt ("D: a b c C r s T u v");
|
|
|
746
|
|
|
747 case Switch is
|
|
|
748 when ASCII.NUL =>
|
|
|
749 exit;
|
|
|
750
|
|
|
751 when 'D' =>
|
|
|
752 Process_Command_Line_Symbol_Definition
|
|
|
753 (S => GNAT.Command_Line.Parameter);
|
|
|
754
|
|
|
755 when 'a' =>
|
|
|
756 Opt.No_Deletion := True;
|
|
|
757 Opt.Undefined_Symbols_Are_False := True;
|
|
|
758
|
|
|
759 when 'b' =>
|
|
|
760 Opt.Blank_Deleted_Lines := True;
|
|
|
761
|
|
|
762 when 'c' =>
|
|
|
763 Opt.Comment_Deleted_Lines := True;
|
|
|
764
|
|
|
765 when 'C' =>
|
|
|
766 Opt.Replace_In_Comments := True;
|
|
|
767
|
|
|
768 when 'r' =>
|
|
|
769 Source_Ref_Pragma := True;
|
|
|
770
|
|
|
771 when 's' =>
|
|
|
772 Opt.List_Preprocessing_Symbols := True;
|
|
|
773
|
|
|
774 when 'T' =>
|
|
|
775 Unix_Line_Terminators := True;
|
|
|
776
|
|
|
777 when 'u' =>
|
|
|
778 Opt.Undefined_Symbols_Are_False := True;
|
|
|
779
|
|
|
780 when 'v' =>
|
|
|
781 Opt.Verbose_Mode := True;
|
|
|
782
|
|
|
783 when others =>
|
|
|
784 Fail ("Invalid Switch: -" & Switch);
|
|
|
785 end case;
|
|
|
786
|
|
|
787 exception
|
|
|
788 when GNAT.Command_Line.Invalid_Switch =>
|
|
|
789 Write_Str ("Invalid Switch: -");
|
|
|
790 Write_Line (GNAT.Command_Line.Full_Switch);
|
|
|
791 GNAT.Command_Line.Try_Help;
|
|
|
792 OS_Exit (1);
|
|
|
793 end;
|
|
|
794 end loop;
|
|
|
795
|
|
|
796 -- Get the file names
|
|
|
797
|
|
|
798 loop
|
|
|
799 declare
|
|
|
800 S : constant String := GNAT.Command_Line.Get_Argument;
|
|
|
801
|
|
|
802 begin
|
|
|
803 exit when S'Length = 0;
|
|
|
804
|
|
|
805 Name_Len := S'Length;
|
|
|
806 Name_Buffer (1 .. Name_Len) := S;
|
|
|
807
|
|
|
808 if Infile_Name = No_Name then
|
|
|
809 Infile_Name := Name_Find;
|
|
|
810 elsif Outfile_Name = No_Name then
|
|
|
811 Outfile_Name := Name_Find;
|
|
|
812 elsif Deffile_Name = No_Name then
|
|
|
813 Deffile_Name := Name_Find;
|
|
|
814 else
|
|
|
815 Fail ("too many arguments specified");
|
|
|
816 end if;
|
|
|
817 end;
|
|
|
818 end loop;
|
|
|
819 end Scan_Command_Line;
|
|
|
820
|
|
|
821 -----------
|
|
|
822 -- Usage --
|
|
|
823 -----------
|
|
|
824
|
|
|
825 procedure Usage is
|
|
|
826 begin
|
|
|
827 Display_Copyright;
|
|
|
828 Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
|
|
|
829 "infile outfile [deffile]");
|
|
|
830 Write_Eol;
|
|
|
831 Write_Line (" infile Name of the input file");
|
|
|
832 Write_Line (" outfile Name of the output file");
|
|
|
833 Write_Line (" deffile Name of the definition file");
|
|
|
834 Write_Eol;
|
|
|
835 Write_Line ("gnatprep switches:");
|
|
|
836 Display_Usage_Version_And_Help;
|
|
|
837 Write_Line (" -b Replace preprocessor lines by blank lines");
|
|
|
838 Write_Line (" -c Keep preprocessor lines as comments");
|
|
|
839 Write_Line (" -C Do symbol replacements within comments");
|
|
|
840 Write_Line (" -D Associate symbol with value");
|
|
|
841 Write_Line (" -r Generate Source_Reference pragma");
|
|
|
842 Write_Line (" -s Print a sorted list of symbol names and values");
|
|
|
843 Write_Line (" -T Use LF as line terminators");
|
|
|
844 Write_Line (" -u Treat undefined symbols as FALSE");
|
|
|
845 Write_Line (" -v Verbose mode");
|
|
|
846 Write_Eol;
|
|
|
847 end Usage;
|
|
|
848
|
|
|
849 end GPrep;
|
