Fix failure when -fno-rtti test is run in C++17 or later
[official-gcc.git] / gcc / ada / gprep.adb
blobfc97570c4cebefe18879054088f66fe61813947b
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G P R E P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2018, 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.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;
50 package body GPrep is
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
88 -----------------
89 -- Subprograms --
90 -----------------
92 procedure Display_Copyright;
93 -- Display the copyright notice
95 procedure Post_Scan;
96 -- Null procedure, needed by instantiation of Scng below
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
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
126 -- preprocessor.
128 procedure New_EOL_To_Outfile;
129 -- Output a new line to the output file. Used to initialize the
130 -- preprocessor.
132 procedure Scan_Command_Line;
133 -- Scan the switches and the file names
135 procedure Usage;
136 -- Display the usage
138 -----------------------
139 -- Display_Copyright --
140 -----------------------
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;
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);
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;
163 --------------
164 -- Gnatprep --
165 --------------
167 procedure Gnatprep is
168 begin
169 -- Do some initializations (order is important here)
171 Csets.Initialize;
172 Snames.Initialize;
173 Stringt.Initialize;
174 Prep.Initialize;
176 -- Initialize the preprocessor
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);
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
197 Scan_Command_Line;
199 if Opt.Verbose_Mode then
200 Display_Copyright;
201 end if;
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
210 Usage;
211 else
212 GNAT.Command_Line.Try_Help;
213 end if;
215 return;
217 elsif Outfile_Name = No_Name then
219 -- No output file specified, exit
221 GNAT.Command_Line.Try_Help;
222 return;
223 end if;
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.
229 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
230 Opt.Blank_Deleted_Lines := True;
231 end if;
233 -- If we have a definition file, parse it
235 if Deffile_Name /= No_Name then
236 declare
237 Deffile : Source_File_Index;
239 begin
240 Errutil.Initialize;
241 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
243 -- Set Main_Source_File to the definition file for the benefit of
244 -- Errutil.Finalize.
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)
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;
258 Scanner.Initialize_Scanner (Deffile);
260 -- Parse the definition file without "replace in comments"
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;
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)
278 & """");
279 end if;
281 -- If -s switch was specified, print a sorted list of symbol names and
282 -- values, if any.
284 if Opt.List_Preprocessing_Symbols then
285 Prep.List_Symbols (Foreword => "");
286 end if;
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
297 -- is a directory.
299 if Is_Directory (Get_Name_String (Infile_Name)) then
300 Input_Directory := Infile_Name;
301 end if;
302 end if;
304 -- And process the single input or the files in the directory tree
305 -- rooted at the input directory.
307 Process_Files;
308 end Gnatprep;
310 ---------------------
311 -- Is_ASCII_Letter --
312 ---------------------
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;
319 ------------------------
320 -- New_EOL_To_Outfile --
321 ------------------------
323 procedure New_EOL_To_Outfile is
324 begin
325 New_Line (Outfile.all);
326 end New_EOL_To_Outfile;
328 ---------------
329 -- Post_Scan --
330 ---------------
332 procedure Post_Scan is
333 begin
334 null;
335 end Post_Scan;
337 ----------------------------
338 -- Preprocess_Infile_Name --
339 ----------------------------
341 procedure Preprocess_Infile_Name is
342 Len : Natural;
343 First : Positive;
344 Last : Natural;
345 Symbol : Name_Id;
346 Data : Symbol_Data;
348 begin
349 -- Initialize the buffer with the name of the input file
351 Get_Name_String (Infile_Name);
352 Len := Name_Len;
354 while File_Name_Buffer'Length < Len loop
355 Double_File_Name_Buffer;
356 end loop;
358 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
360 -- Look for possible symbols in the file name
362 First := 1;
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))
369 then
370 Last := 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))
376 loop
377 Last := Last + 1;
378 end loop;
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));
386 Symbol := Name_Find;
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
397 -- the symbol.
399 if not Data.Is_A_String then
400 String_To_Name_Buffer (Data.Value);
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;
407 begin
408 while New_Len > File_Name_Buffer'Length loop
409 Double_File_Name_Buffer;
410 end loop;
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;
421 exit;
422 end if;
423 end loop;
425 -- Skip over the symbol name or its value: we are not checking
426 -- for another symbol name in the value.
428 First := Last + 1;
430 else
431 First := First + 1;
432 end if;
433 end loop;
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
449 Data : Symbol_Data;
450 Symbol : Symbol_Id;
452 begin
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
461 -- table.
463 if Symbol = No_Symbol then
464 Symbol_Table.Increment_Last (Mapping);
465 Symbol := Symbol_Table.Last (Mapping);
466 end if;
468 Mapping.Table (Symbol) := Data;
469 end Process_Command_Line_Symbol_Definition;
471 -------------------
472 -- Process_Files --
473 -------------------
475 procedure Process_Files is
477 procedure Process_One_File;
478 -- Process input file Infile_Name and put the result in file
479 -- Outfile_Name.
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;
491 Modified : Boolean;
492 pragma Warnings (Off, Modified);
494 begin
495 -- Create the output file (fails if this does not work)
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);
505 exception
506 when others =>
507 Fail
508 ("unable to create output file """
509 & Get_Name_String (Outfile_Name)
510 & """");
511 end;
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)
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;
527 -- Set Main_Source_File to the input file for the benefit of
528 -- Errutil.Finalize.
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
537 Put_Line
538 (Outfile.all,
539 "pragma Source_Reference (1, """ &
540 Get_Name_String (Sinput.Full_File_Name (Infile)) & """);");
541 end if;
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");
551 end if;
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);
558 end if;
560 Errutil.Finalize (Source_Type => "input");
562 OS_Exit (0);
564 -- Otherwise, close the output file, and we are done
566 elsif Outfile /= Standard_Output then
567 Close (Text_Outfile);
568 end if;
569 end Process_One_File;
571 -----------------------
572 -- Recursive_Process --
573 -----------------------
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;
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
590 begin
591 Input_Directory := In_Dir_Name;
592 Output_Directory := Out_Dir_Name;
593 end Set_Directory_Names;
595 -- Start of processing for Recursive_Process
597 begin
598 -- Open the current input directory
600 begin
601 Open (Dir_In, In_Dir);
603 exception
604 when Directory_Error =>
605 Fail ("could not read directory " & In_Dir);
606 end;
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;
617 Set_Directory_Names;
619 -- Traverse the input directory
620 loop
621 Read (Dir_In, Name, Last);
622 exit when Last = 0;
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);
631 begin
632 -- If input is an ordinary file, process it
634 if Is_Regular_File (Input) then
635 -- First get the output file name
637 Name_Len := Last;
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;
647 Process_One_File;
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
654 begin
655 Make_Dir (Dir_Name => Output);
657 exception
658 when Directory_Error =>
659 Fail ("could not create directory """
660 & Output
661 & """");
662 end;
663 end if;
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.
672 Set_Directory_Names;
673 end if;
674 end;
675 end if;
676 end loop;
677 end Recursive_Process;
679 -- Start of processing for Process_Files
681 begin
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");
690 end if;
692 -- Just process the single input file
694 Process_One_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;
702 Process_One_File;
704 else
705 -- Recursively process files in the directory tree rooted at the
706 -- input directory.
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;
714 -------------------------
715 -- Put_Char_To_Outfile --
716 -------------------------
718 procedure Put_Char_To_Outfile (C : Character) is
719 begin
720 Put (Outfile.all, C);
721 end Put_Char_To_Outfile;
723 -----------------------
724 -- Scan_Command_Line --
725 -----------------------
727 procedure Scan_Command_Line is
728 Switch : Character;
730 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
732 -- Start of processing for Scan_Command_Line
734 begin
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;
743 loop
744 begin
745 Switch := GNAT.Command_Line.Getopt ("D: a b c C r s T u v");
747 case Switch is
748 when ASCII.NUL =>
749 exit;
751 when 'D' =>
752 Process_Command_Line_Symbol_Definition
753 (S => GNAT.Command_Line.Parameter);
755 when 'a' =>
756 Opt.No_Deletion := True;
757 Opt.Undefined_Symbols_Are_False := True;
759 when 'b' =>
760 Opt.Blank_Deleted_Lines := True;
762 when 'c' =>
763 Opt.Comment_Deleted_Lines := True;
765 when 'C' =>
766 Opt.Replace_In_Comments := True;
768 when 'r' =>
769 Source_Ref_Pragma := True;
771 when 's' =>
772 Opt.List_Preprocessing_Symbols := True;
774 when 'T' =>
775 Unix_Line_Terminators := True;
777 when 'u' =>
778 Opt.Undefined_Symbols_Are_False := True;
780 when 'v' =>
781 Opt.Verbose_Mode := True;
783 when others =>
784 Fail ("Invalid Switch: -" & Switch);
785 end case;
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;
796 -- Get the file names
798 loop
799 declare
800 S : constant String := GNAT.Command_Line.Get_Argument;
802 begin
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;
814 else
815 Fail ("too many arguments specified");
816 end if;
817 end;
818 end loop;
819 end Scan_Command_Line;
821 -----------
822 -- Usage --
823 -----------
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;
849 end GPrep;