2013-11-13 Jan-Benedict Glaw <jbglaw@lug-owl.de>
[official-gcc.git] / gcc / ada / gprep.adb
blob8eb1465bff47e3a88a7be139ee81d6c97214adca
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G P R E P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2012, 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 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;
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;
49 package body GPrep is
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
87 -----------------
88 -- Subprograms --
89 -----------------
91 procedure Display_Copyright;
92 -- Display the copyright notice
94 procedure Post_Scan;
95 -- Null procedure, needed by instantiation of Scng below
97 package Scanner is new Scng
98 (Post_Scan,
99 Errutil.Error_Msg,
100 Errutil.Error_Msg_S,
101 Errutil.Error_Msg_SC,
102 Errutil.Error_Msg_SP,
103 Errutil.Style);
104 -- The scanner for the preprocessor
106 function Is_ASCII_Letter (C : Character) return Boolean;
107 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
109 procedure Double_File_Name_Buffer;
110 -- Double the size of the file name buffer
112 procedure Preprocess_Infile_Name;
113 -- When the specified output is a directory, preprocess the infile name
114 -- for symbol substitution, to get the output file name.
116 procedure Process_Files;
117 -- Process the single input file or all the files in the directory tree
118 -- rooted at the input directory.
120 procedure Process_Command_Line_Symbol_Definition (S : String);
121 -- Process a -D switch on the command line
123 procedure Put_Char_To_Outfile (C : Character);
124 -- Output one character to the output file. Used to initialize the
125 -- preprocessor.
127 procedure New_EOL_To_Outfile;
128 -- Output a new line to the output file. Used to initialize the
129 -- preprocessor.
131 procedure Scan_Command_Line;
132 -- Scan the switches and the file names
134 procedure Usage;
135 -- Display the usage
137 -----------------------
138 -- Display_Copyright --
139 -----------------------
141 procedure Display_Copyright is
142 begin
143 if not Copyright_Displayed then
144 Display_Version ("GNAT Preprocessor", "1996");
145 Copyright_Displayed := True;
146 end if;
147 end Display_Copyright;
149 -----------------------------
150 -- Double_File_Name_Buffer --
151 -----------------------------
153 procedure Double_File_Name_Buffer is
154 New_Buffer : constant String_Access :=
155 new String (1 .. 2 * File_Name_Buffer'Length);
156 begin
157 New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all;
158 Free (File_Name_Buffer);
159 File_Name_Buffer := New_Buffer;
160 end Double_File_Name_Buffer;
162 --------------
163 -- Gnatprep --
164 --------------
166 procedure Gnatprep is
167 begin
168 -- Do some initializations (order is important here!)
170 Csets.Initialize;
171 Snames.Initialize;
172 Stringt.Initialize;
173 Prep.Initialize;
175 -- Initialize the preprocessor
177 Prep.Setup_Hooks
178 (Error_Msg => Errutil.Error_Msg'Access,
179 Scan => Scanner.Scan'Access,
180 Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
181 Put_Char => Put_Char_To_Outfile'Access,
182 New_EOL => New_EOL_To_Outfile'Access);
184 -- Set the scanner characteristics for the preprocessor
186 Scanner.Set_Special_Character ('#');
187 Scanner.Set_Special_Character ('$');
188 Scanner.Set_End_Of_Line_As_Token (True);
190 -- Initialize the mapping table of symbols to values
192 Prep.Symbol_Table.Init (Prep.Mapping);
194 -- Parse the switches and arguments
196 Scan_Command_Line;
198 if Opt.Verbose_Mode then
199 Display_Copyright;
200 end if;
202 -- Test we had all the arguments needed
204 if Infile_Name = No_Name then
206 -- No input file specified, just output the usage and exit
208 Usage;
209 return;
211 elsif Outfile_Name = No_Name then
213 -- No output file specified, just output the usage and exit
215 Usage;
216 return;
217 end if;
219 -- If a pragma Source_File_Name, we need to keep line numbers. So, if
220 -- the deleted lines are not put as comment, we must output them as
221 -- blank lines.
223 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
224 Opt.Blank_Deleted_Lines := True;
225 end if;
227 -- If we have a definition file, parse it
229 if Deffile_Name /= No_Name then
230 declare
231 Deffile : Source_File_Index;
233 begin
234 Errutil.Initialize;
235 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
237 -- Set Main_Source_File to the definition file for the benefit of
238 -- Errutil.Finalize.
240 Sinput.Main_Source_File := Deffile;
242 if Deffile = No_Source_File then
243 Fail ("unable to find definition file """
244 & Get_Name_String (Deffile_Name)
245 & """");
246 end if;
248 Scanner.Initialize_Scanner (Deffile);
250 Prep.Parse_Def_File;
251 end;
252 end if;
254 -- If there are errors in the definition file, output them and exit
256 if Total_Errors_Detected > 0 then
257 Errutil.Finalize (Source_Type => "definition");
258 Fail ("errors in definition file """
259 & Get_Name_String (Deffile_Name)
260 & """");
261 end if;
263 -- If -s switch was specified, print a sorted list of symbol names and
264 -- values, if any.
266 if Opt.List_Preprocessing_Symbols then
267 Prep.List_Symbols (Foreword => "");
268 end if;
270 Output_Directory := No_Name;
271 Input_Directory := No_Name;
273 -- Check if the specified output is an existing directory
275 if Is_Directory (Get_Name_String (Outfile_Name)) then
276 Output_Directory := Outfile_Name;
278 -- As the output is an existing directory, check if the input too
279 -- is a directory.
281 if Is_Directory (Get_Name_String (Infile_Name)) then
282 Input_Directory := Infile_Name;
283 end if;
284 end if;
286 -- And process the single input or the files in the directory tree
287 -- rooted at the input directory.
289 Process_Files;
290 end Gnatprep;
292 ---------------------
293 -- Is_ASCII_Letter --
294 ---------------------
296 function Is_ASCII_Letter (C : Character) return Boolean is
297 begin
298 return C in 'A' .. 'Z' or else C in 'a' .. 'z';
299 end Is_ASCII_Letter;
301 ------------------------
302 -- New_EOL_To_Outfile --
303 ------------------------
305 procedure New_EOL_To_Outfile is
306 begin
307 New_Line (Outfile.all);
308 end New_EOL_To_Outfile;
310 ---------------
311 -- Post_Scan --
312 ---------------
314 procedure Post_Scan is
315 begin
316 null;
317 end Post_Scan;
319 ----------------------------
320 -- Preprocess_Infile_Name --
321 ----------------------------
323 procedure Preprocess_Infile_Name is
324 Len : Natural;
325 First : Positive;
326 Last : Natural;
327 Symbol : Name_Id;
328 Data : Symbol_Data;
330 begin
331 -- Initialize the buffer with the name of the input file
333 Get_Name_String (Infile_Name);
334 Len := Name_Len;
336 while File_Name_Buffer'Length < Len loop
337 Double_File_Name_Buffer;
338 end loop;
340 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
342 -- Look for possible symbols in the file name
344 First := 1;
345 while First < Len loop
347 -- A symbol starts with a dollar sign followed by a letter
349 if File_Name_Buffer (First) = '$' and then
350 Is_ASCII_Letter (File_Name_Buffer (First + 1))
351 then
352 Last := First + 1;
354 -- Find the last letter of the symbol
356 while Last < Len and then
357 Is_ASCII_Letter (File_Name_Buffer (Last + 1))
358 loop
359 Last := Last + 1;
360 end loop;
362 -- Get the symbol name id
364 Name_Len := Last - First;
365 Name_Buffer (1 .. Name_Len) :=
366 File_Name_Buffer (First + 1 .. Last);
367 To_Lower (Name_Buffer (1 .. Name_Len));
368 Symbol := Name_Find;
370 -- And look for this symbol name in the symbol table
372 for Index in 1 .. Symbol_Table.Last (Mapping) loop
373 Data := Mapping.Table (Index);
375 if Data.Symbol = Symbol then
377 -- We found the symbol. If its value is not a string,
378 -- replace the symbol in the file name with the value of
379 -- the symbol.
381 if not Data.Is_A_String then
382 String_To_Name_Buffer (Data.Value);
384 declare
385 Sym_Len : constant Positive := Last - First + 1;
386 Offset : constant Integer := Name_Len - Sym_Len;
387 New_Len : constant Natural := Len + Offset;
389 begin
390 while New_Len > File_Name_Buffer'Length loop
391 Double_File_Name_Buffer;
392 end loop;
394 File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
395 File_Name_Buffer (Last + 1 .. Len);
396 Len := New_Len;
397 Last := Last + Offset;
398 File_Name_Buffer (First .. Last) :=
399 Name_Buffer (1 .. Name_Len);
400 end;
401 end if;
403 exit;
404 end if;
405 end loop;
407 -- Skip over the symbol name or its value: we are not checking
408 -- for another symbol name in the value.
410 First := Last + 1;
412 else
413 First := First + 1;
414 end if;
415 end loop;
417 -- We now have the output file name in the buffer. Get the output
418 -- path and put it in Outfile_Name.
420 Get_Name_String (Output_Directory);
421 Add_Char_To_Name_Buffer (Directory_Separator);
422 Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
423 Outfile_Name := Name_Find;
424 end Preprocess_Infile_Name;
426 --------------------------------------------
427 -- Process_Command_Line_Symbol_Definition --
428 --------------------------------------------
430 procedure Process_Command_Line_Symbol_Definition (S : String) is
431 Data : Symbol_Data;
432 Symbol : Symbol_Id;
434 begin
435 -- Check the symbol definition and get the symbol and its value.
436 -- Fail if symbol definition is illegal.
438 Check_Command_Line_Symbol_Definition (S, Data);
440 Symbol := Index_Of (Data.Symbol);
442 -- If symbol does not already exist, create a new entry in the mapping
443 -- table.
445 if Symbol = No_Symbol then
446 Symbol_Table.Increment_Last (Mapping);
447 Symbol := Symbol_Table.Last (Mapping);
448 end if;
450 Mapping.Table (Symbol) := Data;
451 end Process_Command_Line_Symbol_Definition;
453 -------------------
454 -- Process_Files --
455 -------------------
457 procedure Process_Files is
459 procedure Process_One_File;
460 -- Process input file Infile_Name and put the result in file
461 -- Outfile_Name.
463 procedure Recursive_Process (In_Dir : String; Out_Dir : String);
464 -- Process recursively files in In_Dir. Results go to Out_Dir
466 ----------------------
467 -- Process_One_File --
468 ----------------------
470 procedure Process_One_File is
471 Infile : Source_File_Index;
473 Modified : Boolean;
474 pragma Warnings (Off, Modified);
476 begin
477 -- Create the output file (fails if this does not work)
479 begin
480 Create
481 (File => Text_Outfile,
482 Mode => Out_File,
483 Name => Get_Name_String (Outfile_Name),
484 Form => "Text_Translation=" &
485 Yes_No (Unix_Line_Terminators).all);
487 exception
488 when others =>
489 Fail
490 ("unable to create output file """
491 & Get_Name_String (Outfile_Name)
492 & """");
493 end;
495 -- Load the input file
497 Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
499 if Infile = No_Source_File then
500 Fail ("unable to find input file """
501 & Get_Name_String (Infile_Name)
502 & """");
503 end if;
505 -- Set Main_Source_File to the input file for the benefit of
506 -- Errutil.Finalize.
508 Sinput.Main_Source_File := Infile;
510 Scanner.Initialize_Scanner (Infile);
512 -- Output the pragma Source_Reference if asked to
514 if Source_Ref_Pragma then
515 Put_Line
516 (Outfile.all,
517 "pragma Source_Reference (1, """ &
518 Get_Name_String (Sinput.Full_File_Name (Infile)) & """);");
519 end if;
521 -- Preprocess the input file
523 Prep.Preprocess (Modified);
525 -- In verbose mode, if there is no error, report it
527 if Opt.Verbose_Mode and then Total_Errors_Detected = 0 then
528 Errutil.Finalize (Source_Type => "input");
529 end if;
531 -- If we had some errors, delete the output file, and report them
533 if Total_Errors_Detected > 0 then
534 if Outfile /= Standard_Output then
535 Delete (Text_Outfile);
536 end if;
538 Errutil.Finalize (Source_Type => "input");
540 OS_Exit (0);
542 -- Otherwise, close the output file, and we are done
544 elsif Outfile /= Standard_Output then
545 Close (Text_Outfile);
546 end if;
547 end Process_One_File;
549 -----------------------
550 -- Recursive_Process --
551 -----------------------
553 procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
554 Dir_In : Dir_Type;
555 Name : String (1 .. 255);
556 Last : Natural;
557 In_Dir_Name : Name_Id;
558 Out_Dir_Name : Name_Id;
560 procedure Set_Directory_Names;
561 -- Establish or reestablish the current input and output directories
563 -------------------------
564 -- Set_Directory_Names --
565 -------------------------
567 procedure Set_Directory_Names is
568 begin
569 Input_Directory := In_Dir_Name;
570 Output_Directory := Out_Dir_Name;
571 end Set_Directory_Names;
573 -- Start of processing for Recursive_Process
575 begin
576 -- Open the current input directory
578 begin
579 Open (Dir_In, In_Dir);
581 exception
582 when Directory_Error =>
583 Fail ("could not read directory " & In_Dir);
584 end;
586 -- Set the new input and output directory names
588 Name_Len := In_Dir'Length;
589 Name_Buffer (1 .. Name_Len) := In_Dir;
590 In_Dir_Name := Name_Find;
591 Name_Len := Out_Dir'Length;
592 Name_Buffer (1 .. Name_Len) := Out_Dir;
593 Out_Dir_Name := Name_Find;
595 Set_Directory_Names;
597 -- Traverse the input directory
598 loop
599 Read (Dir_In, Name, Last);
600 exit when Last = 0;
602 if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
603 declare
604 Input : constant String :=
605 In_Dir & Directory_Separator & Name (1 .. Last);
606 Output : constant String :=
607 Out_Dir & Directory_Separator & Name (1 .. Last);
609 begin
610 -- If input is an ordinary file, process it
612 if Is_Regular_File (Input) then
613 -- First get the output file name
615 Name_Len := Last;
616 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
617 Infile_Name := Name_Find;
618 Preprocess_Infile_Name;
620 -- Set the input file name and process the file
622 Name_Len := Input'Length;
623 Name_Buffer (1 .. Name_Len) := Input;
624 Infile_Name := Name_Find;
625 Process_One_File;
627 elsif Is_Directory (Input) then
628 -- Input is a directory. If the corresponding output
629 -- directory does not already exist, create it.
631 if not Is_Directory (Output) then
632 begin
633 Make_Dir (Dir_Name => Output);
635 exception
636 when Directory_Error =>
637 Fail ("could not create directory """
638 & Output
639 & """");
640 end;
641 end if;
643 -- And process this new input directory
645 Recursive_Process (Input, Output);
647 -- Reestablish the input and output directory names
648 -- that have been modified by the recursive call.
650 Set_Directory_Names;
651 end if;
652 end;
653 end if;
654 end loop;
655 end Recursive_Process;
657 -- Start of processing for Process_Files
659 begin
660 if Output_Directory = No_Name then
662 -- If the output is not a directory, fail if the input is
663 -- an existing directory, to avoid possible problems.
665 if Is_Directory (Get_Name_String (Infile_Name)) then
666 Fail ("input file """ & Get_Name_String (Infile_Name) &
667 """ is a directory");
668 end if;
670 -- Just process the single input file
672 Process_One_File;
674 elsif Input_Directory = No_Name then
676 -- Get the output file name from the input file name, and process
677 -- the single input file.
679 Preprocess_Infile_Name;
680 Process_One_File;
682 else
683 -- Recursively process files in the directory tree rooted at the
684 -- input directory.
686 Recursive_Process
687 (In_Dir => Get_Name_String (Input_Directory),
688 Out_Dir => Get_Name_String (Output_Directory));
689 end if;
690 end Process_Files;
692 -------------------------
693 -- Put_Char_To_Outfile --
694 -------------------------
696 procedure Put_Char_To_Outfile (C : Character) is
697 begin
698 Put (Outfile.all, C);
699 end Put_Char_To_Outfile;
701 -----------------------
702 -- Scan_Command_Line --
703 -----------------------
705 procedure Scan_Command_Line is
706 Switch : Character;
708 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
710 -- Start of processing for Scan_Command_Line
712 begin
713 -- First check for --version or --help
715 Check_Version_And_Help ("GNATPREP", "1996");
717 -- Now scan the other switches
719 GNAT.Command_Line.Initialize_Option_Scan;
721 loop
722 begin
723 Switch := GNAT.Command_Line.Getopt ("D: a b c C r s T u v");
725 case Switch is
727 when ASCII.NUL =>
728 exit;
730 when 'D' =>
731 Process_Command_Line_Symbol_Definition
732 (S => GNAT.Command_Line.Parameter);
734 when 'a' =>
735 Opt.No_Deletion := True;
736 Opt.Undefined_Symbols_Are_False := True;
738 when 'b' =>
739 Opt.Blank_Deleted_Lines := True;
741 when 'c' =>
742 Opt.Comment_Deleted_Lines := True;
744 when 'C' =>
745 Opt.Replace_In_Comments := True;
747 when 'r' =>
748 Source_Ref_Pragma := True;
750 when 's' =>
751 Opt.List_Preprocessing_Symbols := True;
753 when 'T' =>
754 Unix_Line_Terminators := True;
756 when 'u' =>
757 Opt.Undefined_Symbols_Are_False := True;
759 when 'v' =>
760 Opt.Verbose_Mode := True;
762 when others =>
763 Fail ("Invalid Switch: -" & Switch);
764 end case;
766 exception
767 when GNAT.Command_Line.Invalid_Switch =>
768 Write_Str ("Invalid Switch: -");
769 Write_Line (GNAT.Command_Line.Full_Switch);
770 Usage;
771 OS_Exit (1);
772 end;
773 end loop;
775 -- Get the file names
777 loop
778 declare
779 S : constant String := GNAT.Command_Line.Get_Argument;
781 begin
782 exit when S'Length = 0;
784 Name_Len := S'Length;
785 Name_Buffer (1 .. Name_Len) := S;
787 if Infile_Name = No_Name then
788 Infile_Name := Name_Find;
789 elsif Outfile_Name = No_Name then
790 Outfile_Name := Name_Find;
791 elsif Deffile_Name = No_Name then
792 Deffile_Name := Name_Find;
793 else
794 Fail ("too many arguments specified");
795 end if;
796 end;
797 end loop;
798 end Scan_Command_Line;
800 -----------
801 -- Usage --
802 -----------
804 procedure Usage is
805 begin
806 Display_Copyright;
807 Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
808 "infile outfile [deffile]");
809 Write_Eol;
810 Write_Line (" infile Name of the input file");
811 Write_Line (" outfile Name of the output file");
812 Write_Line (" deffile Name of the definition file");
813 Write_Eol;
814 Write_Line ("gnatprep switches:");
815 Display_Usage_Version_And_Help;
816 Write_Line (" -b Replace preprocessor lines by blank lines");
817 Write_Line (" -c Keep preprocessor lines as comments");
818 Write_Line (" -C Do symbol replacements within comments");
819 Write_Line (" -D Associate symbol with value");
820 Write_Line (" -r Generate Source_Reference pragma");
821 Write_Line (" -s Print a sorted list of symbol names and values");
822 Write_Line (" -T Use LF as line terminators");
823 Write_Line (" -u Treat undefined symbols as FALSE");
824 Write_Line (" -v Verbose mode");
825 Write_Eol;
826 end Usage;
828 end GPrep;