1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2017, 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 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
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
.Command_Line
; use Ada
.Command_Line
;
42 with Ada
.Text_IO
; use Ada
.Text_IO
;
44 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
45 with GNAT
.Command_Line
;
46 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
48 with System
.OS_Lib
; use System
.OS_Lib
;
52 Copyright_Displayed
: Boolean := False;
53 -- Used to prevent multiple displays of the copyright notice
55 ------------------------
56 -- Argument Line Data --
57 ------------------------
59 Unix_Line_Terminators
: Boolean := False;
60 -- Set to True with option -T
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"));
67 Infile_Name
: Name_Id
:= No_Name
;
68 Outfile_Name
: Name_Id
:= No_Name
;
69 Deffile_Name
: Name_Id
:= No_Name
;
71 Output_Directory
: Name_Id
:= No_Name
;
72 -- Used when the specified output is an existing directory
74 Input_Directory
: Name_Id
:= No_Name
;
75 -- Used when the specified input and output are existing directories
77 Source_Ref_Pragma
: Boolean := False;
78 -- Record command line options (set if -r switch set)
80 Text_Outfile
: aliased Ada
.Text_IO
.File_Type
;
81 Outfile
: constant File_Access
:= Text_Outfile
'Access;
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
92 procedure Display_Copyright
;
93 -- Display the copyright notice
96 -- Null procedure, needed by instantiation of Scng below
98 package Scanner
is new Scng
102 Errutil
.Error_Msg_SC
,
103 Errutil
.Error_Msg_SP
,
105 -- The scanner for the preprocessor
107 function Is_ASCII_Letter
(C
: Character) return Boolean;
108 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
110 procedure Double_File_Name_Buffer
;
111 -- Double the size of the file name buffer
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.
117 procedure Process_Files
;
118 -- Process the single input file or all the files in the directory tree
119 -- rooted at the input directory.
121 procedure Process_Command_Line_Symbol_Definition
(S
: String);
122 -- Process a -D switch on the command line
124 procedure Put_Char_To_Outfile
(C
: Character);
125 -- Output one character to the output file. Used to initialize the
128 procedure New_EOL_To_Outfile
;
129 -- Output a new line to the output file. Used to initialize the
132 procedure Scan_Command_Line
;
133 -- Scan the switches and the file names
138 -----------------------
139 -- Display_Copyright --
140 -----------------------
142 procedure Display_Copyright
is
144 if not Copyright_Displayed
then
145 Display_Version
("GNAT Preprocessor", "1996");
146 Copyright_Displayed
:= True;
148 end Display_Copyright
;
150 -----------------------------
151 -- Double_File_Name_Buffer --
152 -----------------------------
154 procedure Double_File_Name_Buffer
is
155 New_Buffer
: constant String_Access
:=
156 new String (1 .. 2 * File_Name_Buffer
'Length);
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
;
167 procedure Gnatprep
is
169 -- Do some initializations (order is important here)
176 -- Initialize the preprocessor
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);
185 -- Set the scanner characteristics for the preprocessor
187 Scanner
.Set_Special_Character
('#');
188 Scanner
.Set_Special_Character
('$');
189 Scanner
.Set_End_Of_Line_As_Token
(True);
191 -- Initialize the mapping table of symbols to values
193 Prep
.Symbol_Table
.Init
(Prep
.Mapping
);
195 -- Parse the switches and arguments
199 if Opt
.Verbose_Mode
then
203 -- Test we had all the arguments needed
205 if Infile_Name
= No_Name
then
207 -- No input file specified, just output the usage and exit
209 if Argument_Count
= 0 then
212 GNAT
.Command_Line
.Try_Help
;
217 elsif Outfile_Name
= No_Name
then
219 -- No output file specified, exit
221 GNAT
.Command_Line
.Try_Help
;
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
229 if Source_Ref_Pragma
and (not Opt
.Comment_Deleted_Lines
) then
230 Opt
.Blank_Deleted_Lines
:= True;
233 -- If we have a definition file, parse it
235 if Deffile_Name
/= No_Name
then
237 Deffile
: Source_File_Index
;
241 Deffile
:= Sinput
.C
.Load_File
(Get_Name_String
(Deffile_Name
));
243 -- Set Main_Source_File to the definition file for the benefit of
246 Sinput
.Main_Source_File
:= Deffile
;
248 if Deffile
= No_Source_File
then
249 Fail
("unable to find definition file """
250 & Get_Name_String
(Deffile_Name
)
252 elsif Deffile
= No_Access_To_Source_File
then
253 Fail
("unabled to read definition file """
254 & Get_Name_String
(Deffile_Name
)
258 Scanner
.Initialize_Scanner
(Deffile
);
260 -- Parse the definition file without "replace in comments"
263 Replace
: constant Boolean := Opt
.Replace_In_Comments
;
265 Opt
.Replace_In_Comments
:= False;
267 Opt
.Replace_In_Comments
:= Replace
;
272 -- If there are errors in the definition file, output them and exit
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
)
281 -- If -s switch was specified, print a sorted list of symbol names and
284 if Opt
.List_Preprocessing_Symbols
then
285 Prep
.List_Symbols
(Foreword
=> "");
288 Output_Directory
:= No_Name
;
289 Input_Directory
:= No_Name
;
291 -- Check if the specified output is an existing directory
293 if Is_Directory
(Get_Name_String
(Outfile_Name
)) then
294 Output_Directory
:= Outfile_Name
;
296 -- As the output is an existing directory, check if the input too
299 if Is_Directory
(Get_Name_String
(Infile_Name
)) then
300 Input_Directory
:= Infile_Name
;
304 -- And process the single input or the files in the directory tree
305 -- rooted at the input directory.
310 ---------------------
311 -- Is_ASCII_Letter --
312 ---------------------
314 function Is_ASCII_Letter
(C
: Character) return Boolean is
316 return C
in 'A' .. 'Z' or else C
in 'a' .. 'z';
319 ------------------------
320 -- New_EOL_To_Outfile --
321 ------------------------
323 procedure New_EOL_To_Outfile
is
325 New_Line
(Outfile
.all);
326 end New_EOL_To_Outfile
;
332 procedure Post_Scan
is
337 ----------------------------
338 -- Preprocess_Infile_Name --
339 ----------------------------
341 procedure Preprocess_Infile_Name
is
349 -- Initialize the buffer with the name of the input file
351 Get_Name_String
(Infile_Name
);
354 while File_Name_Buffer
'Length < Len
loop
355 Double_File_Name_Buffer
;
358 File_Name_Buffer
(1 .. Len
) := Name_Buffer
(1 .. Len
);
360 -- Look for possible symbols in the file name
363 while First
< Len
loop
365 -- A symbol starts with a dollar sign followed by a letter
367 if File_Name_Buffer
(First
) = '$' and then
368 Is_ASCII_Letter
(File_Name_Buffer
(First
+ 1))
372 -- Find the last letter of the symbol
374 while Last
< Len
and then
375 Is_ASCII_Letter
(File_Name_Buffer
(Last
+ 1))
380 -- Get the symbol name id
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
));
388 -- And look for this symbol name in the symbol table
390 for Index
in 1 .. Symbol_Table
.Last
(Mapping
) loop
391 Data
:= Mapping
.Table
(Index
);
393 if Data
.Symbol
= Symbol
then
395 -- We found the symbol. If its value is not a string,
396 -- replace the symbol in the file name with the value of
399 if not Data
.Is_A_String
then
400 String_To_Name_Buffer
(Data
.Value
);
403 Sym_Len
: constant Positive := Last
- First
+ 1;
404 Offset
: constant Integer := Name_Len
- Sym_Len
;
405 New_Len
: constant Natural := Len
+ Offset
;
408 while New_Len
> File_Name_Buffer
'Length loop
409 Double_File_Name_Buffer
;
412 File_Name_Buffer
(Last
+ 1 + Offset
.. New_Len
) :=
413 File_Name_Buffer
(Last
+ 1 .. Len
);
415 Last
:= Last
+ Offset
;
416 File_Name_Buffer
(First
.. Last
) :=
417 Name_Buffer
(1 .. Name_Len
);
425 -- Skip over the symbol name or its value: we are not checking
426 -- for another symbol name in the value.
435 -- We now have the output file name in the buffer. Get the output
436 -- path and put it in Outfile_Name.
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
;
444 --------------------------------------------
445 -- Process_Command_Line_Symbol_Definition --
446 --------------------------------------------
448 procedure Process_Command_Line_Symbol_Definition
(S
: String) is
453 -- Check the symbol definition and get the symbol and its value.
454 -- Fail if symbol definition is illegal.
456 Check_Command_Line_Symbol_Definition
(S
, Data
);
458 Symbol
:= Index_Of
(Data
.Symbol
);
460 -- If symbol does not already exist, create a new entry in the mapping
463 if Symbol
= No_Symbol
then
464 Symbol_Table
.Increment_Last
(Mapping
);
465 Symbol
:= Symbol_Table
.Last
(Mapping
);
468 Mapping
.Table
(Symbol
) := Data
;
469 end Process_Command_Line_Symbol_Definition
;
475 procedure Process_Files
is
477 procedure Process_One_File
;
478 -- Process input file Infile_Name and put the result in file
481 procedure Recursive_Process
(In_Dir
: String; Out_Dir
: String);
482 -- Process recursively files in In_Dir. Results go to Out_Dir
484 ----------------------
485 -- Process_One_File --
486 ----------------------
488 procedure Process_One_File
is
489 Infile
: Source_File_Index
;
492 pragma Warnings
(Off
, Modified
);
495 -- Create the output file (fails if this does not work)
499 (File
=> Text_Outfile
,
501 Name
=> Get_Name_String
(Outfile_Name
),
502 Form
=> "Text_Translation=" &
503 Yes_No
(Unix_Line_Terminators
).all);
508 ("unable to create output file """
509 & Get_Name_String
(Outfile_Name
)
513 -- Load the input file
515 Infile
:= Sinput
.C
.Load_File
(Get_Name_String
(Infile_Name
));
517 if Infile
= No_Source_File
then
518 Fail
("unable to find input file """
519 & Get_Name_String
(Infile_Name
)
521 elsif Infile
= No_Access_To_Source_File
then
522 Fail
("unable to read input file """
523 & Get_Name_String
(Infile_Name
)
527 -- Set Main_Source_File to the input file for the benefit of
530 Sinput
.Main_Source_File
:= Infile
;
532 Scanner
.Initialize_Scanner
(Infile
);
534 -- Output the pragma Source_Reference if asked to
536 if Source_Ref_Pragma
then
539 "pragma Source_Reference (1, """ &
540 Get_Name_String
(Sinput
.Full_File_Name
(Infile
)) & """);");
543 -- Preprocess the input file
545 Prep
.Preprocess
(Modified
);
547 -- In verbose mode, if there is no error, report it
549 if Opt
.Verbose_Mode
and then Total_Errors_Detected
= 0 then
550 Errutil
.Finalize
(Source_Type
=> "input");
553 -- If we had some errors, delete the output file, and report them
555 if Total_Errors_Detected
> 0 then
556 if Outfile
/= Standard_Output
then
557 Delete
(Text_Outfile
);
560 Errutil
.Finalize
(Source_Type
=> "input");
564 -- Otherwise, close the output file, and we are done
566 elsif Outfile
/= Standard_Output
then
567 Close
(Text_Outfile
);
569 end Process_One_File
;
571 -----------------------
572 -- Recursive_Process --
573 -----------------------
575 procedure Recursive_Process
(In_Dir
: String; Out_Dir
: String) is
577 Name
: String (1 .. 255);
579 In_Dir_Name
: Name_Id
;
580 Out_Dir_Name
: Name_Id
;
582 procedure Set_Directory_Names
;
583 -- Establish or reestablish the current input and output directories
585 -------------------------
586 -- Set_Directory_Names --
587 -------------------------
589 procedure Set_Directory_Names
is
591 Input_Directory
:= In_Dir_Name
;
592 Output_Directory
:= Out_Dir_Name
;
593 end Set_Directory_Names
;
595 -- Start of processing for Recursive_Process
598 -- Open the current input directory
601 Open
(Dir_In
, In_Dir
);
604 when Directory_Error
=>
605 Fail
("could not read directory " & In_Dir
);
608 -- Set the new input and output directory names
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
;
619 -- Traverse the input directory
621 Read
(Dir_In
, Name
, Last
);
624 if Name
(1 .. Last
) /= "." and then Name
(1 .. Last
) /= ".." then
626 Input
: constant String :=
627 In_Dir
& Directory_Separator
& Name
(1 .. Last
);
628 Output
: constant String :=
629 Out_Dir
& Directory_Separator
& Name
(1 .. Last
);
632 -- If input is an ordinary file, process it
634 if Is_Regular_File
(Input
) then
635 -- First get the output file name
638 Name_Buffer
(1 .. Name_Len
) := Name
(1 .. Last
);
639 Infile_Name
:= Name_Find
;
640 Preprocess_Infile_Name
;
642 -- Set the input file name and process the file
644 Name_Len
:= Input
'Length;
645 Name_Buffer
(1 .. Name_Len
) := Input
;
646 Infile_Name
:= Name_Find
;
649 elsif Is_Directory
(Input
) then
650 -- Input is a directory. If the corresponding output
651 -- directory does not already exist, create it.
653 if not Is_Directory
(Output
) then
655 Make_Dir
(Dir_Name
=> Output
);
658 when Directory_Error
=>
659 Fail
("could not create directory """
665 -- And process this new input directory
667 Recursive_Process
(Input
, Output
);
669 -- Reestablish the input and output directory names
670 -- that have been modified by the recursive call.
677 end Recursive_Process
;
679 -- Start of processing for Process_Files
682 if Output_Directory
= No_Name
then
684 -- If the output is not a directory, fail if the input is
685 -- an existing directory, to avoid possible problems.
687 if Is_Directory
(Get_Name_String
(Infile_Name
)) then
688 Fail
("input file """ & Get_Name_String
(Infile_Name
) &
689 """ is a directory");
692 -- Just process the single input file
696 elsif Input_Directory
= No_Name
then
698 -- Get the output file name from the input file name, and process
699 -- the single input file.
701 Preprocess_Infile_Name
;
705 -- Recursively process files in the directory tree rooted at the
709 (In_Dir
=> Get_Name_String
(Input_Directory
),
710 Out_Dir
=> Get_Name_String
(Output_Directory
));
714 -------------------------
715 -- Put_Char_To_Outfile --
716 -------------------------
718 procedure Put_Char_To_Outfile
(C
: Character) is
720 Put
(Outfile
.all, C
);
721 end Put_Char_To_Outfile
;
723 -----------------------
724 -- Scan_Command_Line --
725 -----------------------
727 procedure Scan_Command_Line
is
730 procedure Check_Version_And_Help
is new Check_Version_And_Help_G
(Usage
);
732 -- Start of processing for Scan_Command_Line
735 -- First check for --version or --help
737 Check_Version_And_Help
("GNATPREP", "1996");
739 -- Now scan the other switches
741 GNAT
.Command_Line
.Initialize_Option_Scan
;
745 Switch
:= GNAT
.Command_Line
.Getopt
("D: a b c C r s T u v");
752 Process_Command_Line_Symbol_Definition
753 (S
=> GNAT
.Command_Line
.Parameter
);
756 Opt
.No_Deletion
:= True;
757 Opt
.Undefined_Symbols_Are_False
:= True;
760 Opt
.Blank_Deleted_Lines
:= True;
763 Opt
.Comment_Deleted_Lines
:= True;
766 Opt
.Replace_In_Comments
:= True;
769 Source_Ref_Pragma
:= True;
772 Opt
.List_Preprocessing_Symbols
:= True;
775 Unix_Line_Terminators
:= True;
778 Opt
.Undefined_Symbols_Are_False
:= True;
781 Opt
.Verbose_Mode
:= True;
784 Fail
("Invalid Switch: -" & Switch
);
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
;
796 -- Get the file names
800 S
: constant String := GNAT
.Command_Line
.Get_Argument
;
803 exit when S
'Length = 0;
805 Name_Len
:= S
'Length;
806 Name_Buffer
(1 .. Name_Len
) := S
;
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
;
815 Fail
("too many arguments specified");
819 end Scan_Command_Line
;
828 Write_Line
("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
829 "infile outfile [deffile]");
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");
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");