1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
27 with Err_Vars
; use Err_Vars
;
29 with Namet
; use Namet
;
31 with Osint
; use Osint
;
32 with Output
; use Output
;
37 with Stringt
; use Stringt
;
38 with Switch
; use Switch
;
39 with Types
; use Types
;
41 with Ada
.Text_IO
; use Ada
.Text_IO
;
43 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
44 with GNAT
.Command_Line
;
45 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
47 with System
.OS_Lib
; use System
.OS_Lib
;
51 Copyright_Displayed
: Boolean := False;
52 -- Used to prevent multiple displays of the copyright notice
54 ------------------------
55 -- Argument Line Data --
56 ------------------------
58 Unix_Line_Terminators
: Boolean := False;
59 -- Set to True with option -T
61 type String_Array
is array (Boolean) of String_Access
;
62 Yes_No
: constant String_Array
:=
63 (False => new String'("YES"),
64 True => new String'("NO"));
66 Infile_Name
: Name_Id
:= No_Name
;
67 Outfile_Name
: Name_Id
:= No_Name
;
68 Deffile_Name
: Name_Id
:= No_Name
;
70 Output_Directory
: Name_Id
:= No_Name
;
71 -- Used when the specified output is an existing directory
73 Input_Directory
: Name_Id
:= No_Name
;
74 -- Used when the specified input and output are existing directories
76 Source_Ref_Pragma
: Boolean := False;
77 -- Record command line options (set if -r switch set)
79 Text_Outfile
: aliased Ada
.Text_IO
.File_Type
;
80 Outfile
: constant File_Access
:= Text_Outfile
'Access;
82 File_Name_Buffer_Initial_Size
: constant := 50;
83 File_Name_Buffer
: String_Access
:=
84 new String (1 .. File_Name_Buffer_Initial_Size
);
85 -- A buffer to build output file names from input file names
91 procedure Display_Copyright
;
92 -- Display the copyright notice
94 procedure Obsolescent_Check
(S
: Source_Ptr
);
95 -- Null procedure, needed by instantiation of Scng below
98 -- Null procedure, needed by instantiation of Scng below
100 package Scanner
is new Scng
104 Errutil
.Error_Msg_SC
,
105 Errutil
.Error_Msg_SP
,
108 -- The scanner for the preprocessor
110 function Is_ASCII_Letter
(C
: Character) return Boolean;
111 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
113 procedure Double_File_Name_Buffer
;
114 -- Double the size of the file name buffer
116 procedure Preprocess_Infile_Name
;
117 -- When the specified output is a directory, preprocess the infile name
118 -- for symbol substitution, to get the output file name.
120 procedure Process_Files
;
121 -- Process the single input file or all the files in the directory tree
122 -- rooted at the input directory.
124 procedure Process_Command_Line_Symbol_Definition
(S
: String);
125 -- Process a -D switch on the command line
127 procedure Put_Char_To_Outfile
(C
: Character);
128 -- Output one character to the output file. Used to initialize the
131 procedure New_EOL_To_Outfile
;
132 -- Output a new line to the output file. Used to initialize the
135 procedure Scan_Command_Line
;
136 -- Scan the switches and the file names
141 -----------------------
142 -- Display_Copyright --
143 -----------------------
145 procedure Display_Copyright
is
147 if not Copyright_Displayed
then
148 Display_Version
("GNAT Preprocessor", "1996");
149 Copyright_Displayed
:= True;
151 end Display_Copyright
;
153 -----------------------------
154 -- Double_File_Name_Buffer --
155 -----------------------------
157 procedure Double_File_Name_Buffer
is
158 New_Buffer
: constant String_Access
:=
159 new String (1 .. 2 * File_Name_Buffer
'Length);
161 New_Buffer
(File_Name_Buffer
'Range) := File_Name_Buffer
.all;
162 Free
(File_Name_Buffer
);
163 File_Name_Buffer
:= New_Buffer
;
164 end Double_File_Name_Buffer
;
170 procedure Gnatprep
is
172 -- Do some initializations (order is important here!)
180 -- Initialize the preprocessor
183 (Error_Msg
=> Errutil
.Error_Msg
'Access,
184 Scan
=> Scanner
.Scan
'Access,
185 Set_Ignore_Errors
=> Errutil
.Set_Ignore_Errors
'Access,
186 Put_Char
=> Put_Char_To_Outfile
'Access,
187 New_EOL
=> New_EOL_To_Outfile
'Access);
189 -- Set the scanner characteristics for the preprocessor
191 Scanner
.Set_Special_Character
('#');
192 Scanner
.Set_Special_Character
('$');
193 Scanner
.Set_End_Of_Line_As_Token
(True);
195 -- Initialize the mapping table of symbols to values
197 Prep
.Symbol_Table
.Init
(Prep
.Mapping
);
199 -- Parse the switches and arguments
203 if Opt
.Verbose_Mode
then
207 -- Test we had all the arguments needed
209 if Infile_Name
= No_Name
then
211 -- No input file specified, just output the usage and exit
216 elsif Outfile_Name
= No_Name
then
218 -- No output file specified, just output the usage and exit
224 -- If a pragma Source_File_Name, we need to keep line numbers. So, if
225 -- the deleted lines are not put as comment, we must output them as
228 if Source_Ref_Pragma
and (not Opt
.Comment_Deleted_Lines
) then
229 Opt
.Blank_Deleted_Lines
:= True;
232 -- If we have a definition file, parse it
234 if Deffile_Name
/= No_Name
then
236 Deffile
: Source_File_Index
;
240 Deffile
:= Sinput
.C
.Load_File
(Get_Name_String
(Deffile_Name
));
242 -- Set Main_Source_File to the definition file for the benefit of
245 Sinput
.Main_Source_File
:= Deffile
;
247 if Deffile
= No_Source_File
then
248 Fail
("unable to find definition file """
249 & Get_Name_String
(Deffile_Name
)
253 Scanner
.Initialize_Scanner
(Deffile
);
259 -- If there are errors in the definition file, output them and exit
261 if Total_Errors_Detected
> 0 then
262 Errutil
.Finalize
(Source_Type
=> "definition");
263 Fail
("errors in definition file """
264 & Get_Name_String
(Deffile_Name
)
268 -- If -s switch was specified, print a sorted list of symbol names and
271 if Opt
.List_Preprocessing_Symbols
then
272 Prep
.List_Symbols
(Foreword
=> "");
275 Output_Directory
:= No_Name
;
276 Input_Directory
:= No_Name
;
278 -- Check if the specified output is an existing directory
280 if Is_Directory
(Get_Name_String
(Outfile_Name
)) then
281 Output_Directory
:= Outfile_Name
;
283 -- As the output is an existing directory, check if the input too
286 if Is_Directory
(Get_Name_String
(Infile_Name
)) then
287 Input_Directory
:= Infile_Name
;
291 -- And process the single input or the files in the directory tree
292 -- rooted at the input directory.
297 ---------------------
298 -- Is_ASCII_Letter --
299 ---------------------
301 function Is_ASCII_Letter
(C
: Character) return Boolean is
303 return C
in 'A' .. 'Z' or else C
in 'a' .. 'z';
306 ------------------------
307 -- New_EOL_To_Outfile --
308 ------------------------
310 procedure New_EOL_To_Outfile
is
312 New_Line
(Outfile
.all);
313 end New_EOL_To_Outfile
;
315 -----------------------
316 -- Obsolescent_Check --
317 -----------------------
319 procedure Obsolescent_Check
(S
: Source_Ptr
) is
320 pragma Warnings
(Off
, S
);
323 end Obsolescent_Check
;
329 procedure Post_Scan
is
334 ----------------------------
335 -- Preprocess_Infile_Name --
336 ----------------------------
338 procedure Preprocess_Infile_Name
is
346 -- Initialize the buffer with the name of the input file
348 Get_Name_String
(Infile_Name
);
351 while File_Name_Buffer
'Length < Len
loop
352 Double_File_Name_Buffer
;
355 File_Name_Buffer
(1 .. Len
) := Name_Buffer
(1 .. Len
);
357 -- Look for possible symbols in the file name
360 while First
< Len
loop
362 -- A symbol starts with a dollar sign followed by a letter
364 if File_Name_Buffer
(First
) = '$' and then
365 Is_ASCII_Letter
(File_Name_Buffer
(First
+ 1))
369 -- Find the last letter of the symbol
371 while Last
< Len
and then
372 Is_ASCII_Letter
(File_Name_Buffer
(Last
+ 1))
377 -- Get the symbol name id
379 Name_Len
:= Last
- First
;
380 Name_Buffer
(1 .. Name_Len
) :=
381 File_Name_Buffer
(First
+ 1 .. Last
);
382 To_Lower
(Name_Buffer
(1 .. Name_Len
));
385 -- And look for this symbol name in the symbol table
387 for Index
in 1 .. Symbol_Table
.Last
(Mapping
) loop
388 Data
:= Mapping
.Table
(Index
);
390 if Data
.Symbol
= Symbol
then
392 -- We found the symbol. If its value is not a string,
393 -- replace the symbol in the file name with the value of
396 if not Data
.Is_A_String
then
397 String_To_Name_Buffer
(Data
.Value
);
400 Sym_Len
: constant Positive := Last
- First
+ 1;
401 Offset
: constant Integer := Name_Len
- Sym_Len
;
402 New_Len
: constant Natural := Len
+ Offset
;
405 while New_Len
> File_Name_Buffer
'Length loop
406 Double_File_Name_Buffer
;
409 File_Name_Buffer
(Last
+ 1 + Offset
.. New_Len
) :=
410 File_Name_Buffer
(Last
+ 1 .. Len
);
412 Last
:= Last
+ Offset
;
413 File_Name_Buffer
(First
.. Last
) :=
414 Name_Buffer
(1 .. Name_Len
);
422 -- Skip over the symbol name or its value: we are not checking
423 -- for another symbol name in the value.
432 -- We now have the output file name in the buffer. Get the output
433 -- path and put it in Outfile_Name.
435 Get_Name_String
(Output_Directory
);
436 Add_Char_To_Name_Buffer
(Directory_Separator
);
437 Add_Str_To_Name_Buffer
(File_Name_Buffer
(1 .. Len
));
438 Outfile_Name
:= Name_Find
;
439 end Preprocess_Infile_Name
;
441 --------------------------------------------
442 -- Process_Command_Line_Symbol_Definition --
443 --------------------------------------------
445 procedure Process_Command_Line_Symbol_Definition
(S
: String) is
450 -- Check the symbol definition and get the symbol and its value.
451 -- Fail if symbol definition is illegal.
453 Check_Command_Line_Symbol_Definition
(S
, Data
);
455 Symbol
:= Index_Of
(Data
.Symbol
);
457 -- If symbol does not already exist, create a new entry in the mapping
460 if Symbol
= No_Symbol
then
461 Symbol_Table
.Increment_Last
(Mapping
);
462 Symbol
:= Symbol_Table
.Last
(Mapping
);
465 Mapping
.Table
(Symbol
) := Data
;
466 end Process_Command_Line_Symbol_Definition
;
472 procedure Process_Files
is
474 procedure Process_One_File
;
475 -- Process input file Infile_Name and put the result in file
478 procedure Recursive_Process
(In_Dir
: String; Out_Dir
: String);
479 -- Process recursively files in In_Dir. Results go to Out_Dir
481 ----------------------
482 -- Process_One_File --
483 ----------------------
485 procedure Process_One_File
is
486 Infile
: Source_File_Index
;
489 pragma Warnings
(Off
, Modified
);
492 -- Create the output file (fails if this does not work)
496 (File
=> Text_Outfile
,
498 Name
=> Get_Name_String
(Outfile_Name
),
499 Form
=> "Text_Translation=" &
500 Yes_No
(Unix_Line_Terminators
).all);
505 ("unable to create output file """
506 & Get_Name_String
(Outfile_Name
)
510 -- Load the input file
512 Infile
:= Sinput
.C
.Load_File
(Get_Name_String
(Infile_Name
));
514 if Infile
= No_Source_File
then
515 Fail
("unable to find input file """
516 & Get_Name_String
(Infile_Name
)
520 -- Set Main_Source_File to the input file for the benefit of
523 Sinput
.Main_Source_File
:= Infile
;
525 Scanner
.Initialize_Scanner
(Infile
);
527 -- Output the pragma Source_Reference if asked to
529 if Source_Ref_Pragma
then
532 "pragma Source_Reference (1, """ &
533 Get_Name_String
(Sinput
.Full_File_Name
(Infile
)) & """);");
536 -- Preprocess the input file
538 Prep
.Preprocess
(Modified
);
540 -- In verbose mode, if there is no error, report it
542 if Opt
.Verbose_Mode
and then Err_Vars
.Total_Errors_Detected
= 0 then
543 Errutil
.Finalize
(Source_Type
=> "input");
546 -- If we had some errors, delete the output file, and report them
548 if Err_Vars
.Total_Errors_Detected
> 0 then
549 if Outfile
/= Standard_Output
then
550 Delete
(Text_Outfile
);
553 Errutil
.Finalize
(Source_Type
=> "input");
557 -- Otherwise, close the output file, and we are done
559 elsif Outfile
/= Standard_Output
then
560 Close
(Text_Outfile
);
562 end Process_One_File
;
564 -----------------------
565 -- Recursive_Process --
566 -----------------------
568 procedure Recursive_Process
(In_Dir
: String; Out_Dir
: String) is
570 Name
: String (1 .. 255);
572 In_Dir_Name
: Name_Id
;
573 Out_Dir_Name
: Name_Id
;
575 procedure Set_Directory_Names
;
576 -- Establish or reestablish the current input and output directories
578 -------------------------
579 -- Set_Directory_Names --
580 -------------------------
582 procedure Set_Directory_Names
is
584 Input_Directory
:= In_Dir_Name
;
585 Output_Directory
:= Out_Dir_Name
;
586 end Set_Directory_Names
;
588 -- Start of processing for Recursive_Process
591 -- Open the current input directory
594 Open
(Dir_In
, In_Dir
);
597 when Directory_Error
=>
598 Fail
("could not read directory " & In_Dir
);
601 -- Set the new input and output directory names
603 Name_Len
:= In_Dir
'Length;
604 Name_Buffer
(1 .. Name_Len
) := In_Dir
;
605 In_Dir_Name
:= Name_Find
;
606 Name_Len
:= Out_Dir
'Length;
607 Name_Buffer
(1 .. Name_Len
) := Out_Dir
;
608 Out_Dir_Name
:= Name_Find
;
612 -- Traverse the input directory
614 Read
(Dir_In
, Name
, Last
);
617 if Name
(1 .. Last
) /= "." and then Name
(1 .. Last
) /= ".." then
619 Input
: constant String :=
620 In_Dir
& Directory_Separator
& Name
(1 .. Last
);
621 Output
: constant String :=
622 Out_Dir
& Directory_Separator
& Name
(1 .. Last
);
625 -- If input is an ordinary file, process it
627 if Is_Regular_File
(Input
) then
628 -- First get the output file name
631 Name_Buffer
(1 .. Name_Len
) := Name
(1 .. Last
);
632 Infile_Name
:= Name_Find
;
633 Preprocess_Infile_Name
;
635 -- Set the input file name and process the file
637 Name_Len
:= Input
'Length;
638 Name_Buffer
(1 .. Name_Len
) := Input
;
639 Infile_Name
:= Name_Find
;
642 elsif Is_Directory
(Input
) then
643 -- Input is a directory. If the corresponding output
644 -- directory does not already exist, create it.
646 if not Is_Directory
(Output
) then
648 Make_Dir
(Dir_Name
=> Output
);
651 when Directory_Error
=>
652 Fail
("could not create directory """
658 -- And process this new input directory
660 Recursive_Process
(Input
, Output
);
662 -- Reestablish the input and output directory names
663 -- that have been modified by the recursive call.
670 end Recursive_Process
;
672 -- Start of processing for Process_Files
675 if Output_Directory
= No_Name
then
677 -- If the output is not a directory, fail if the input is
678 -- an existing directory, to avoid possible problems.
680 if Is_Directory
(Get_Name_String
(Infile_Name
)) then
681 Fail
("input file """ & Get_Name_String
(Infile_Name
) &
682 """ is a directory");
685 -- Just process the single input file
689 elsif Input_Directory
= No_Name
then
691 -- Get the output file name from the input file name, and process
692 -- the single input file.
694 Preprocess_Infile_Name
;
698 -- Recursively process files in the directory tree rooted at the
702 (In_Dir
=> Get_Name_String
(Input_Directory
),
703 Out_Dir
=> Get_Name_String
(Output_Directory
));
707 -------------------------
708 -- Put_Char_To_Outfile --
709 -------------------------
711 procedure Put_Char_To_Outfile
(C
: Character) is
713 Put
(Outfile
.all, C
);
714 end Put_Char_To_Outfile
;
716 -----------------------
717 -- Scan_Command_Line --
718 -----------------------
720 procedure Scan_Command_Line
is
723 procedure Check_Version_And_Help
is new Check_Version_And_Help_G
(Usage
);
725 -- Start of processing for Scan_Command_Line
728 -- First check for --version or --help
730 Check_Version_And_Help
("GNATPREP", "1996");
732 -- Now scan the other switches
734 GNAT
.Command_Line
.Initialize_Option_Scan
;
738 Switch
:= GNAT
.Command_Line
.Getopt
("D: b c C r s T u v");
746 Process_Command_Line_Symbol_Definition
747 (S
=> GNAT
.Command_Line
.Parameter
);
750 Opt
.Blank_Deleted_Lines
:= True;
753 Opt
.Comment_Deleted_Lines
:= True;
756 Opt
.Replace_In_Comments
:= True;
759 Source_Ref_Pragma
:= True;
762 Opt
.List_Preprocessing_Symbols
:= True;
765 Unix_Line_Terminators
:= True;
768 Opt
.Undefined_Symbols_Are_False
:= True;
771 Opt
.Verbose_Mode
:= True;
774 Fail
("Invalid Switch: -" & Switch
);
778 when GNAT
.Command_Line
.Invalid_Switch
=>
779 Write_Str
("Invalid Switch: -");
780 Write_Line
(GNAT
.Command_Line
.Full_Switch
);
786 -- Get the file names
790 S
: constant String := GNAT
.Command_Line
.Get_Argument
;
793 exit when S
'Length = 0;
795 Name_Len
:= S
'Length;
796 Name_Buffer
(1 .. Name_Len
) := S
;
798 if Infile_Name
= No_Name
then
799 Infile_Name
:= Name_Find
;
800 elsif Outfile_Name
= No_Name
then
801 Outfile_Name
:= Name_Find
;
802 elsif Deffile_Name
= No_Name
then
803 Deffile_Name
:= Name_Find
;
805 Fail
("too many arguments specified");
809 end Scan_Command_Line
;
818 Write_Line
("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
819 "infile outfile [deffile]");
821 Write_Line
(" infile Name of the input file");
822 Write_Line
(" outfile Name of the output file");
823 Write_Line
(" deffile Name of the definition file");
825 Write_Line
("gnatprep switches:");
826 Write_Line
(" -b Replace preprocessor lines by blank lines");
827 Write_Line
(" -c Keep preprocessor lines as comments");
828 Write_Line
(" -C Do symbol replacements within comments");
829 Write_Line
(" -D Associate symbol with value");
830 Write_Line
(" -r Generate Source_Reference pragma");
831 Write_Line
(" -s Print a sorted list of symbol names and values");
832 Write_Line
(" -T Use LF as line terminators");
833 Write_Line
(" -u Treat undefined symbols as FALSE");
834 Write_Line
(" -v Verbose mode");