1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2021, 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");