PR testsuite/39776
[official-gcc.git] / gcc / ada / gprep.adb
blobec56bcc171f27a89081e85b7478a0cff5f9b1326
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G P R E P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2008, 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 Csets;
27 with Err_Vars; use Err_Vars;
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 Infile_Name : Name_Id := No_Name;
59 Outfile_Name : Name_Id := No_Name;
60 Deffile_Name : Name_Id := No_Name;
62 Output_Directory : Name_Id := No_Name;
63 -- Used when the specified output is an existing directory
65 Input_Directory : Name_Id := No_Name;
66 -- Used when the specified input and output are existing directories
68 Source_Ref_Pragma : Boolean := False;
69 -- Record command line options (set if -r switch set)
71 Text_Outfile : aliased Ada.Text_IO.File_Type;
72 Outfile : constant File_Access := Text_Outfile'Access;
74 File_Name_Buffer_Initial_Size : constant := 50;
75 File_Name_Buffer : String_Access :=
76 new String (1 .. File_Name_Buffer_Initial_Size);
77 -- A buffer to build output file names from input file names
79 -----------------
80 -- Subprograms --
81 -----------------
83 procedure Display_Copyright;
84 -- Display the copyright notice
86 procedure Obsolescent_Check (S : Source_Ptr);
87 -- Null procedure, needed by instantiation of Scng below
89 procedure Post_Scan;
90 -- Null procedure, needed by instantiation of Scng below
92 package Scanner is new Scng
93 (Post_Scan,
94 Errutil.Error_Msg,
95 Errutil.Error_Msg_S,
96 Errutil.Error_Msg_SC,
97 Errutil.Error_Msg_SP,
98 Obsolescent_Check,
99 Errutil.Style);
100 -- The scanner for the preprocessor
102 function Is_ASCII_Letter (C : Character) return Boolean;
103 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
105 procedure Double_File_Name_Buffer;
106 -- Double the size of the file name buffer
108 procedure Preprocess_Infile_Name;
109 -- When the specified output is a directory, preprocess the infile name
110 -- for symbol substitution, to get the output file name.
112 procedure Process_Files;
113 -- Process the single input file or all the files in the directory tree
114 -- rooted at the input directory.
116 procedure Process_Command_Line_Symbol_Definition (S : String);
117 -- Process a -D switch on the command line
119 procedure Put_Char_To_Outfile (C : Character);
120 -- Output one character to the output file. Used to initialize the
121 -- preprocessor.
123 procedure New_EOL_To_Outfile;
124 -- Output a new line to the output file. Used to initialize the
125 -- preprocessor.
127 procedure Scan_Command_Line;
128 -- Scan the switches and the file names
130 procedure Usage;
131 -- Display the usage
133 -----------------------
134 -- Display_Copyright --
135 -----------------------
137 procedure Display_Copyright is
138 begin
139 if not Copyright_Displayed then
140 Display_Version ("GNAT Preprocessor", "1996");
141 Copyright_Displayed := True;
142 end if;
143 end Display_Copyright;
145 -----------------------------
146 -- Double_File_Name_Buffer --
147 -----------------------------
149 procedure Double_File_Name_Buffer is
150 New_Buffer : constant String_Access :=
151 new String (1 .. 2 * File_Name_Buffer'Length);
152 begin
153 New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all;
154 Free (File_Name_Buffer);
155 File_Name_Buffer := New_Buffer;
156 end Double_File_Name_Buffer;
158 --------------
159 -- Gnatprep --
160 --------------
162 procedure Gnatprep is
163 begin
164 -- Do some initializations (order is important here!)
166 Csets.Initialize;
167 Namet.Initialize;
168 Snames.Initialize;
169 Stringt.Initialize;
170 Prep.Initialize;
172 -- Initialize the preprocessor
174 Prep.Setup_Hooks
175 (Error_Msg => Errutil.Error_Msg'Access,
176 Scan => Scanner.Scan'Access,
177 Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
178 Put_Char => Put_Char_To_Outfile'Access,
179 New_EOL => New_EOL_To_Outfile'Access);
181 -- Set the scanner characteristics for the preprocessor
183 Scanner.Set_Special_Character ('#');
184 Scanner.Set_Special_Character ('$');
185 Scanner.Set_End_Of_Line_As_Token (True);
187 -- Initialize the mapping table of symbols to values
189 Prep.Symbol_Table.Init (Prep.Mapping);
191 -- Parse the switches and arguments
193 Scan_Command_Line;
195 if Opt.Verbose_Mode then
196 Display_Copyright;
197 end if;
199 -- Test we had all the arguments needed
201 if Infile_Name = No_Name then
203 -- No input file specified, just output the usage and exit
205 Usage;
206 return;
208 elsif Outfile_Name = No_Name then
210 -- No output file specified, just output the usage and exit
212 Usage;
213 return;
214 end if;
216 -- If a pragma Source_File_Name, we need to keep line numbers. So, if
217 -- the deleted lines are not put as comment, we must output them as
218 -- blank lines.
220 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
221 Opt.Blank_Deleted_Lines := True;
222 end if;
224 -- If we have a definition file, parse it
226 if Deffile_Name /= No_Name then
227 declare
228 Deffile : Source_File_Index;
230 begin
231 Errutil.Initialize;
232 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
234 -- Set Main_Source_File to the definition file for the benefit of
235 -- Errutil.Finalize.
237 Sinput.Main_Source_File := Deffile;
239 if Deffile = No_Source_File then
240 Fail ("unable to find definition file """
241 & Get_Name_String (Deffile_Name)
242 & """");
243 end if;
245 Scanner.Initialize_Scanner (Deffile);
247 Prep.Parse_Def_File;
248 end;
249 end if;
251 -- If there are errors in the definition file, output them and exit
253 if Total_Errors_Detected > 0 then
254 Errutil.Finalize (Source_Type => "definition");
255 Fail ("errors in definition file """
256 & Get_Name_String (Deffile_Name)
257 & """");
258 end if;
260 -- If -s switch was specified, print a sorted list of symbol names and
261 -- values, if any.
263 if Opt.List_Preprocessing_Symbols then
264 Prep.List_Symbols (Foreword => "");
265 end if;
267 Output_Directory := No_Name;
268 Input_Directory := No_Name;
270 -- Check if the specified output is an existing directory
272 if Is_Directory (Get_Name_String (Outfile_Name)) then
273 Output_Directory := Outfile_Name;
275 -- As the output is an existing directory, check if the input too
276 -- is a directory.
278 if Is_Directory (Get_Name_String (Infile_Name)) then
279 Input_Directory := Infile_Name;
280 end if;
281 end if;
283 -- And process the single input or the files in the directory tree
284 -- rooted at the input directory.
286 Process_Files;
287 end Gnatprep;
289 ---------------------
290 -- Is_ASCII_Letter --
291 ---------------------
293 function Is_ASCII_Letter (C : Character) return Boolean is
294 begin
295 return C in 'A' .. 'Z' or else C in 'a' .. 'z';
296 end Is_ASCII_Letter;
298 ------------------------
299 -- New_EOL_To_Outfile --
300 ------------------------
302 procedure New_EOL_To_Outfile is
303 begin
304 New_Line (Outfile.all);
305 end New_EOL_To_Outfile;
307 -----------------------
308 -- Obsolescent_Check --
309 -----------------------
311 procedure Obsolescent_Check (S : Source_Ptr) is
312 pragma Warnings (Off, S);
313 begin
314 null;
315 end Obsolescent_Check;
317 ---------------
318 -- Post_Scan --
319 ---------------
321 procedure Post_Scan is
322 begin
323 null;
324 end Post_Scan;
326 ----------------------------
327 -- Preprocess_Infile_Name --
328 ----------------------------
330 procedure Preprocess_Infile_Name is
331 Len : Natural;
332 First : Positive;
333 Last : Natural;
334 Symbol : Name_Id;
335 Data : Symbol_Data;
337 begin
338 -- Initialize the buffer with the name of the input file
340 Get_Name_String (Infile_Name);
341 Len := Name_Len;
343 while File_Name_Buffer'Length < Len loop
344 Double_File_Name_Buffer;
345 end loop;
347 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
349 -- Look for possible symbols in the file name
351 First := 1;
352 while First < Len loop
354 -- A symbol starts with a dollar sign followed by a letter
356 if File_Name_Buffer (First) = '$' and then
357 Is_ASCII_Letter (File_Name_Buffer (First + 1))
358 then
359 Last := First + 1;
361 -- Find the last letter of the symbol
363 while Last < Len and then
364 Is_ASCII_Letter (File_Name_Buffer (Last + 1))
365 loop
366 Last := Last + 1;
367 end loop;
369 -- Get the symbol name id
371 Name_Len := Last - First;
372 Name_Buffer (1 .. Name_Len) :=
373 File_Name_Buffer (First + 1 .. Last);
374 To_Lower (Name_Buffer (1 .. Name_Len));
375 Symbol := Name_Find;
377 -- And look for this symbol name in the symbol table
379 for Index in 1 .. Symbol_Table.Last (Mapping) loop
380 Data := Mapping.Table (Index);
382 if Data.Symbol = Symbol then
384 -- We found the symbol. If its value is not a string,
385 -- replace the symbol in the file name with the value of
386 -- the symbol.
388 if not Data.Is_A_String then
389 String_To_Name_Buffer (Data.Value);
391 declare
392 Sym_Len : constant Positive := Last - First + 1;
393 Offset : constant Integer := Name_Len - Sym_Len;
394 New_Len : constant Natural := Len + Offset;
396 begin
397 while New_Len > File_Name_Buffer'Length loop
398 Double_File_Name_Buffer;
399 end loop;
401 File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
402 File_Name_Buffer (Last + 1 .. Len);
403 Len := New_Len;
404 Last := Last + Offset;
405 File_Name_Buffer (First .. Last) :=
406 Name_Buffer (1 .. Name_Len);
407 end;
408 end if;
410 exit;
411 end if;
412 end loop;
414 -- Skip over the symbol name or its value: we are not checking
415 -- for another symbol name in the value.
417 First := Last + 1;
419 else
420 First := First + 1;
421 end if;
422 end loop;
424 -- We now have the output file name in the buffer. Get the output
425 -- path and put it in Outfile_Name.
427 Get_Name_String (Output_Directory);
428 Add_Char_To_Name_Buffer (Directory_Separator);
429 Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
430 Outfile_Name := Name_Find;
431 end Preprocess_Infile_Name;
433 --------------------------------------------
434 -- Process_Command_Line_Symbol_Definition --
435 --------------------------------------------
437 procedure Process_Command_Line_Symbol_Definition (S : String) is
438 Data : Symbol_Data;
439 Symbol : Symbol_Id;
441 begin
442 -- Check the symbol definition and get the symbol and its value.
443 -- Fail if symbol definition is illegal.
445 Check_Command_Line_Symbol_Definition (S, Data);
447 Symbol := Index_Of (Data.Symbol);
449 -- If symbol does not already exist, create a new entry in the mapping
450 -- table.
452 if Symbol = No_Symbol then
453 Symbol_Table.Increment_Last (Mapping);
454 Symbol := Symbol_Table.Last (Mapping);
455 end if;
457 Mapping.Table (Symbol) := Data;
458 end Process_Command_Line_Symbol_Definition;
460 -------------------
461 -- Process_Files --
462 -------------------
464 procedure Process_Files is
466 procedure Process_One_File;
467 -- Process input file Infile_Name and put the result in file
468 -- Outfile_Name.
470 procedure Recursive_Process (In_Dir : String; Out_Dir : String);
471 -- Process recursively files in In_Dir. Results go to Out_Dir
473 ----------------------
474 -- Process_One_File --
475 ----------------------
477 procedure Process_One_File is
478 Infile : Source_File_Index;
480 Modified : Boolean;
481 pragma Warnings (Off, Modified);
483 begin
484 -- Create the output file (fails if this does not work)
486 begin
487 Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
489 exception
490 when others =>
491 Fail
492 ("unable to create output file """
493 & Get_Name_String (Outfile_Name)
494 & """");
495 end;
497 -- Load the input file
499 Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
501 if Infile = No_Source_File then
502 Fail ("unable to find input file """
503 & Get_Name_String (Infile_Name)
504 & """");
505 end if;
507 -- Set Main_Source_File to the input file for the benefit of
508 -- Errutil.Finalize.
510 Sinput.Main_Source_File := Infile;
512 Scanner.Initialize_Scanner (Infile);
514 -- Output the pragma Source_Reference if asked to
516 if Source_Ref_Pragma then
517 Put_Line
518 (Outfile.all,
519 "pragma Source_Reference (1, """ &
520 Get_Name_String (Sinput.Full_File_Name (Infile)) & """);");
521 end if;
523 -- Preprocess the input file
525 Prep.Preprocess (Modified);
527 -- In verbose mode, if there is no error, report it
529 if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
530 Errutil.Finalize (Source_Type => "input");
531 end if;
533 -- If we had some errors, delete the output file, and report them
535 if Err_Vars.Total_Errors_Detected > 0 then
536 if Outfile /= Standard_Output then
537 Delete (Text_Outfile);
538 end if;
540 Errutil.Finalize (Source_Type => "input");
542 OS_Exit (0);
544 -- Otherwise, close the output file, and we are done
546 elsif Outfile /= Standard_Output then
547 Close (Text_Outfile);
548 end if;
549 end Process_One_File;
551 -----------------------
552 -- Recursive_Process --
553 -----------------------
555 procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
556 Dir_In : Dir_Type;
557 Name : String (1 .. 255);
558 Last : Natural;
559 In_Dir_Name : Name_Id;
560 Out_Dir_Name : Name_Id;
562 procedure Set_Directory_Names;
563 -- Establish or reestablish the current input and output directories
565 -------------------------
566 -- Set_Directory_Names --
567 -------------------------
569 procedure Set_Directory_Names is
570 begin
571 Input_Directory := In_Dir_Name;
572 Output_Directory := Out_Dir_Name;
573 end Set_Directory_Names;
575 -- Start of processing for Recursive_Process
577 begin
578 -- Open the current input directory
580 begin
581 Open (Dir_In, In_Dir);
583 exception
584 when Directory_Error =>
585 Fail ("could not read directory " & In_Dir);
586 end;
588 -- Set the new input and output directory names
590 Name_Len := In_Dir'Length;
591 Name_Buffer (1 .. Name_Len) := In_Dir;
592 In_Dir_Name := Name_Find;
593 Name_Len := Out_Dir'Length;
594 Name_Buffer (1 .. Name_Len) := Out_Dir;
595 Out_Dir_Name := Name_Find;
597 Set_Directory_Names;
599 -- Traverse the input directory
600 loop
601 Read (Dir_In, Name, Last);
602 exit when Last = 0;
604 if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
605 declare
606 Input : constant String :=
607 In_Dir & Directory_Separator & Name (1 .. Last);
608 Output : constant String :=
609 Out_Dir & Directory_Separator & Name (1 .. Last);
611 begin
612 -- If input is an ordinary file, process it
614 if Is_Regular_File (Input) then
615 -- First get the output file name
617 Name_Len := Last;
618 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
619 Infile_Name := Name_Find;
620 Preprocess_Infile_Name;
622 -- Set the input file name and process the file
624 Name_Len := Input'Length;
625 Name_Buffer (1 .. Name_Len) := Input;
626 Infile_Name := Name_Find;
627 Process_One_File;
629 elsif Is_Directory (Input) then
630 -- Input is a directory. If the corresponding output
631 -- directory does not already exist, create it.
633 if not Is_Directory (Output) then
634 begin
635 Make_Dir (Dir_Name => Output);
637 exception
638 when Directory_Error =>
639 Fail ("could not create directory """
640 & Output
641 & """");
642 end;
643 end if;
645 -- And process this new input directory
647 Recursive_Process (Input, Output);
649 -- Reestablish the input and output directory names
650 -- that have been modified by the recursive call.
652 Set_Directory_Names;
653 end if;
654 end;
655 end if;
656 end loop;
657 end Recursive_Process;
659 -- Start of processing for Process_Files
661 begin
662 if Output_Directory = No_Name then
664 -- If the output is not a directory, fail if the input is
665 -- an existing directory, to avoid possible problems.
667 if Is_Directory (Get_Name_String (Infile_Name)) then
668 Fail ("input file """ & Get_Name_String (Infile_Name) &
669 """ is a directory");
670 end if;
672 -- Just process the single input file
674 Process_One_File;
676 elsif Input_Directory = No_Name then
678 -- Get the output file name from the input file name, and process
679 -- the single input file.
681 Preprocess_Infile_Name;
682 Process_One_File;
684 else
685 -- Recursively process files in the directory tree rooted at the
686 -- input directory.
688 Recursive_Process
689 (In_Dir => Get_Name_String (Input_Directory),
690 Out_Dir => Get_Name_String (Output_Directory));
691 end if;
692 end Process_Files;
694 -------------------------
695 -- Put_Char_To_Outfile --
696 -------------------------
698 procedure Put_Char_To_Outfile (C : Character) is
699 begin
700 Put (Outfile.all, C);
701 end Put_Char_To_Outfile;
703 -----------------------
704 -- Scan_Command_Line --
705 -----------------------
707 procedure Scan_Command_Line is
708 Switch : Character;
710 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
712 -- Start of processing for Scan_Command_Line
714 begin
715 -- First check for --version or --help
717 Check_Version_And_Help ("GNATPREP", "1996");
719 -- Now scan the other switches
721 GNAT.Command_Line.Initialize_Option_Scan;
723 loop
724 begin
725 Switch := GNAT.Command_Line.Getopt ("D: b c C r s u v");
727 case Switch is
729 when ASCII.NUL =>
730 exit;
732 when 'D' =>
733 Process_Command_Line_Symbol_Definition
734 (S => GNAT.Command_Line.Parameter);
736 when 'b' =>
737 Opt.Blank_Deleted_Lines := True;
739 when 'c' =>
740 Opt.Comment_Deleted_Lines := True;
742 when 'C' =>
743 Opt.Replace_In_Comments := True;
745 when 'r' =>
746 Source_Ref_Pragma := True;
748 when 's' =>
749 Opt.List_Preprocessing_Symbols := True;
751 when 'u' =>
752 Opt.Undefined_Symbols_Are_False := True;
754 when 'v' =>
755 Opt.Verbose_Mode := True;
757 when others =>
758 Fail ("Invalid Switch: -" & Switch);
759 end case;
761 exception
762 when GNAT.Command_Line.Invalid_Switch =>
763 Write_Str ("Invalid Switch: -");
764 Write_Line (GNAT.Command_Line.Full_Switch);
765 Usage;
766 OS_Exit (1);
767 end;
768 end loop;
770 -- Get the file names
772 loop
773 declare
774 S : constant String := GNAT.Command_Line.Get_Argument;
776 begin
777 exit when S'Length = 0;
779 Name_Len := S'Length;
780 Name_Buffer (1 .. Name_Len) := S;
782 if Infile_Name = No_Name then
783 Infile_Name := Name_Find;
784 elsif Outfile_Name = No_Name then
785 Outfile_Name := Name_Find;
786 elsif Deffile_Name = No_Name then
787 Deffile_Name := Name_Find;
788 else
789 Fail ("too many arguments specified");
790 end if;
791 end;
792 end loop;
793 end Scan_Command_Line;
795 -----------
796 -- Usage --
797 -----------
799 procedure Usage is
800 begin
801 Display_Copyright;
802 Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
803 "infile outfile [deffile]");
804 Write_Eol;
805 Write_Line (" infile Name of the input file");
806 Write_Line (" outfile Name of the output file");
807 Write_Line (" deffile Name of the definition file");
808 Write_Eol;
809 Write_Line ("gnatprep switches:");
810 Write_Line (" -b Replace preprocessor lines by blank lines");
811 Write_Line (" -c Keep preprocessor lines as comments");
812 Write_Line (" -C Do symbol replacements within comments");
813 Write_Line (" -D Associate symbol with value");
814 Write_Line (" -r Generate Source_Reference pragma");
815 Write_Line (" -s Print a sorted list of symbol names and values");
816 Write_Line (" -u Treat undefined symbols as FALSE");
817 Write_Line (" -v Verbose mode");
818 Write_Eol;
819 end Usage;
821 end GPrep;