2009-10-28 Paolo Bonzini <bonzini@gnu.org>
[official-gcc.git] / gcc / ada / gprep.adb
blobb5e6b063cac445fc148db02455c7f5040356a3cc
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G P R E P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2009, 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 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 Obsolescent_Check (S : Source_Ptr);
95 -- Null procedure, needed by instantiation of Scng below
97 procedure Post_Scan;
98 -- Null procedure, needed by instantiation of Scng below
100 package Scanner is new Scng
101 (Post_Scan,
102 Errutil.Error_Msg,
103 Errutil.Error_Msg_S,
104 Errutil.Error_Msg_SC,
105 Errutil.Error_Msg_SP,
106 Obsolescent_Check,
107 Errutil.Style);
108 -- The scanner for the preprocessor
110 function Is_ASCII_Letter (C : Character) return Boolean;
111 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
113 procedure Double_File_Name_Buffer;
114 -- Double the size of the file name buffer
116 procedure Preprocess_Infile_Name;
117 -- When the specified output is a directory, preprocess the infile name
118 -- for symbol substitution, to get the output file name.
120 procedure Process_Files;
121 -- Process the single input file or all the files in the directory tree
122 -- rooted at the input directory.
124 procedure Process_Command_Line_Symbol_Definition (S : String);
125 -- Process a -D switch on the command line
127 procedure Put_Char_To_Outfile (C : Character);
128 -- Output one character to the output file. Used to initialize the
129 -- preprocessor.
131 procedure New_EOL_To_Outfile;
132 -- Output a new line to the output file. Used to initialize the
133 -- preprocessor.
135 procedure Scan_Command_Line;
136 -- Scan the switches and the file names
138 procedure Usage;
139 -- Display the usage
141 -----------------------
142 -- Display_Copyright --
143 -----------------------
145 procedure Display_Copyright is
146 begin
147 if not Copyright_Displayed then
148 Display_Version ("GNAT Preprocessor", "1996");
149 Copyright_Displayed := True;
150 end if;
151 end Display_Copyright;
153 -----------------------------
154 -- Double_File_Name_Buffer --
155 -----------------------------
157 procedure Double_File_Name_Buffer is
158 New_Buffer : constant String_Access :=
159 new String (1 .. 2 * File_Name_Buffer'Length);
160 begin
161 New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all;
162 Free (File_Name_Buffer);
163 File_Name_Buffer := New_Buffer;
164 end Double_File_Name_Buffer;
166 --------------
167 -- Gnatprep --
168 --------------
170 procedure Gnatprep is
171 begin
172 -- Do some initializations (order is important here!)
174 Csets.Initialize;
175 Namet.Initialize;
176 Snames.Initialize;
177 Stringt.Initialize;
178 Prep.Initialize;
180 -- Initialize the preprocessor
182 Prep.Setup_Hooks
183 (Error_Msg => Errutil.Error_Msg'Access,
184 Scan => Scanner.Scan'Access,
185 Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
186 Put_Char => Put_Char_To_Outfile'Access,
187 New_EOL => New_EOL_To_Outfile'Access);
189 -- Set the scanner characteristics for the preprocessor
191 Scanner.Set_Special_Character ('#');
192 Scanner.Set_Special_Character ('$');
193 Scanner.Set_End_Of_Line_As_Token (True);
195 -- Initialize the mapping table of symbols to values
197 Prep.Symbol_Table.Init (Prep.Mapping);
199 -- Parse the switches and arguments
201 Scan_Command_Line;
203 if Opt.Verbose_Mode then
204 Display_Copyright;
205 end if;
207 -- Test we had all the arguments needed
209 if Infile_Name = No_Name then
211 -- No input file specified, just output the usage and exit
213 Usage;
214 return;
216 elsif Outfile_Name = No_Name then
218 -- No output file specified, just output the usage and exit
220 Usage;
221 return;
222 end if;
224 -- If a pragma Source_File_Name, we need to keep line numbers. So, if
225 -- the deleted lines are not put as comment, we must output them as
226 -- blank lines.
228 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
229 Opt.Blank_Deleted_Lines := True;
230 end if;
232 -- If we have a definition file, parse it
234 if Deffile_Name /= No_Name then
235 declare
236 Deffile : Source_File_Index;
238 begin
239 Errutil.Initialize;
240 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
242 -- Set Main_Source_File to the definition file for the benefit of
243 -- Errutil.Finalize.
245 Sinput.Main_Source_File := Deffile;
247 if Deffile = No_Source_File then
248 Fail ("unable to find definition file """
249 & Get_Name_String (Deffile_Name)
250 & """");
251 end if;
253 Scanner.Initialize_Scanner (Deffile);
255 Prep.Parse_Def_File;
256 end;
257 end if;
259 -- If there are errors in the definition file, output them and exit
261 if Total_Errors_Detected > 0 then
262 Errutil.Finalize (Source_Type => "definition");
263 Fail ("errors in definition file """
264 & Get_Name_String (Deffile_Name)
265 & """");
266 end if;
268 -- If -s switch was specified, print a sorted list of symbol names and
269 -- values, if any.
271 if Opt.List_Preprocessing_Symbols then
272 Prep.List_Symbols (Foreword => "");
273 end if;
275 Output_Directory := No_Name;
276 Input_Directory := No_Name;
278 -- Check if the specified output is an existing directory
280 if Is_Directory (Get_Name_String (Outfile_Name)) then
281 Output_Directory := Outfile_Name;
283 -- As the output is an existing directory, check if the input too
284 -- is a directory.
286 if Is_Directory (Get_Name_String (Infile_Name)) then
287 Input_Directory := Infile_Name;
288 end if;
289 end if;
291 -- And process the single input or the files in the directory tree
292 -- rooted at the input directory.
294 Process_Files;
295 end Gnatprep;
297 ---------------------
298 -- Is_ASCII_Letter --
299 ---------------------
301 function Is_ASCII_Letter (C : Character) return Boolean is
302 begin
303 return C in 'A' .. 'Z' or else C in 'a' .. 'z';
304 end Is_ASCII_Letter;
306 ------------------------
307 -- New_EOL_To_Outfile --
308 ------------------------
310 procedure New_EOL_To_Outfile is
311 begin
312 New_Line (Outfile.all);
313 end New_EOL_To_Outfile;
315 -----------------------
316 -- Obsolescent_Check --
317 -----------------------
319 procedure Obsolescent_Check (S : Source_Ptr) is
320 pragma Warnings (Off, S);
321 begin
322 null;
323 end Obsolescent_Check;
325 ---------------
326 -- Post_Scan --
327 ---------------
329 procedure Post_Scan is
330 begin
331 null;
332 end Post_Scan;
334 ----------------------------
335 -- Preprocess_Infile_Name --
336 ----------------------------
338 procedure Preprocess_Infile_Name is
339 Len : Natural;
340 First : Positive;
341 Last : Natural;
342 Symbol : Name_Id;
343 Data : Symbol_Data;
345 begin
346 -- Initialize the buffer with the name of the input file
348 Get_Name_String (Infile_Name);
349 Len := Name_Len;
351 while File_Name_Buffer'Length < Len loop
352 Double_File_Name_Buffer;
353 end loop;
355 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
357 -- Look for possible symbols in the file name
359 First := 1;
360 while First < Len loop
362 -- A symbol starts with a dollar sign followed by a letter
364 if File_Name_Buffer (First) = '$' and then
365 Is_ASCII_Letter (File_Name_Buffer (First + 1))
366 then
367 Last := First + 1;
369 -- Find the last letter of the symbol
371 while Last < Len and then
372 Is_ASCII_Letter (File_Name_Buffer (Last + 1))
373 loop
374 Last := Last + 1;
375 end loop;
377 -- Get the symbol name id
379 Name_Len := Last - First;
380 Name_Buffer (1 .. Name_Len) :=
381 File_Name_Buffer (First + 1 .. Last);
382 To_Lower (Name_Buffer (1 .. Name_Len));
383 Symbol := Name_Find;
385 -- And look for this symbol name in the symbol table
387 for Index in 1 .. Symbol_Table.Last (Mapping) loop
388 Data := Mapping.Table (Index);
390 if Data.Symbol = Symbol then
392 -- We found the symbol. If its value is not a string,
393 -- replace the symbol in the file name with the value of
394 -- the symbol.
396 if not Data.Is_A_String then
397 String_To_Name_Buffer (Data.Value);
399 declare
400 Sym_Len : constant Positive := Last - First + 1;
401 Offset : constant Integer := Name_Len - Sym_Len;
402 New_Len : constant Natural := Len + Offset;
404 begin
405 while New_Len > File_Name_Buffer'Length loop
406 Double_File_Name_Buffer;
407 end loop;
409 File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
410 File_Name_Buffer (Last + 1 .. Len);
411 Len := New_Len;
412 Last := Last + Offset;
413 File_Name_Buffer (First .. Last) :=
414 Name_Buffer (1 .. Name_Len);
415 end;
416 end if;
418 exit;
419 end if;
420 end loop;
422 -- Skip over the symbol name or its value: we are not checking
423 -- for another symbol name in the value.
425 First := Last + 1;
427 else
428 First := First + 1;
429 end if;
430 end loop;
432 -- We now have the output file name in the buffer. Get the output
433 -- path and put it in Outfile_Name.
435 Get_Name_String (Output_Directory);
436 Add_Char_To_Name_Buffer (Directory_Separator);
437 Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
438 Outfile_Name := Name_Find;
439 end Preprocess_Infile_Name;
441 --------------------------------------------
442 -- Process_Command_Line_Symbol_Definition --
443 --------------------------------------------
445 procedure Process_Command_Line_Symbol_Definition (S : String) is
446 Data : Symbol_Data;
447 Symbol : Symbol_Id;
449 begin
450 -- Check the symbol definition and get the symbol and its value.
451 -- Fail if symbol definition is illegal.
453 Check_Command_Line_Symbol_Definition (S, Data);
455 Symbol := Index_Of (Data.Symbol);
457 -- If symbol does not already exist, create a new entry in the mapping
458 -- table.
460 if Symbol = No_Symbol then
461 Symbol_Table.Increment_Last (Mapping);
462 Symbol := Symbol_Table.Last (Mapping);
463 end if;
465 Mapping.Table (Symbol) := Data;
466 end Process_Command_Line_Symbol_Definition;
468 -------------------
469 -- Process_Files --
470 -------------------
472 procedure Process_Files is
474 procedure Process_One_File;
475 -- Process input file Infile_Name and put the result in file
476 -- Outfile_Name.
478 procedure Recursive_Process (In_Dir : String; Out_Dir : String);
479 -- Process recursively files in In_Dir. Results go to Out_Dir
481 ----------------------
482 -- Process_One_File --
483 ----------------------
485 procedure Process_One_File is
486 Infile : Source_File_Index;
488 Modified : Boolean;
489 pragma Warnings (Off, Modified);
491 begin
492 -- Create the output file (fails if this does not work)
494 begin
495 Create
496 (File => Text_Outfile,
497 Mode => Out_File,
498 Name => Get_Name_String (Outfile_Name),
499 Form => "Text_Translation=" &
500 Yes_No (Unix_Line_Terminators).all);
502 exception
503 when others =>
504 Fail
505 ("unable to create output file """
506 & Get_Name_String (Outfile_Name)
507 & """");
508 end;
510 -- Load the input file
512 Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
514 if Infile = No_Source_File then
515 Fail ("unable to find input file """
516 & Get_Name_String (Infile_Name)
517 & """");
518 end if;
520 -- Set Main_Source_File to the input file for the benefit of
521 -- Errutil.Finalize.
523 Sinput.Main_Source_File := Infile;
525 Scanner.Initialize_Scanner (Infile);
527 -- Output the pragma Source_Reference if asked to
529 if Source_Ref_Pragma then
530 Put_Line
531 (Outfile.all,
532 "pragma Source_Reference (1, """ &
533 Get_Name_String (Sinput.Full_File_Name (Infile)) & """);");
534 end if;
536 -- Preprocess the input file
538 Prep.Preprocess (Modified);
540 -- In verbose mode, if there is no error, report it
542 if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
543 Errutil.Finalize (Source_Type => "input");
544 end if;
546 -- If we had some errors, delete the output file, and report them
548 if Err_Vars.Total_Errors_Detected > 0 then
549 if Outfile /= Standard_Output then
550 Delete (Text_Outfile);
551 end if;
553 Errutil.Finalize (Source_Type => "input");
555 OS_Exit (0);
557 -- Otherwise, close the output file, and we are done
559 elsif Outfile /= Standard_Output then
560 Close (Text_Outfile);
561 end if;
562 end Process_One_File;
564 -----------------------
565 -- Recursive_Process --
566 -----------------------
568 procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
569 Dir_In : Dir_Type;
570 Name : String (1 .. 255);
571 Last : Natural;
572 In_Dir_Name : Name_Id;
573 Out_Dir_Name : Name_Id;
575 procedure Set_Directory_Names;
576 -- Establish or reestablish the current input and output directories
578 -------------------------
579 -- Set_Directory_Names --
580 -------------------------
582 procedure Set_Directory_Names is
583 begin
584 Input_Directory := In_Dir_Name;
585 Output_Directory := Out_Dir_Name;
586 end Set_Directory_Names;
588 -- Start of processing for Recursive_Process
590 begin
591 -- Open the current input directory
593 begin
594 Open (Dir_In, In_Dir);
596 exception
597 when Directory_Error =>
598 Fail ("could not read directory " & In_Dir);
599 end;
601 -- Set the new input and output directory names
603 Name_Len := In_Dir'Length;
604 Name_Buffer (1 .. Name_Len) := In_Dir;
605 In_Dir_Name := Name_Find;
606 Name_Len := Out_Dir'Length;
607 Name_Buffer (1 .. Name_Len) := Out_Dir;
608 Out_Dir_Name := Name_Find;
610 Set_Directory_Names;
612 -- Traverse the input directory
613 loop
614 Read (Dir_In, Name, Last);
615 exit when Last = 0;
617 if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
618 declare
619 Input : constant String :=
620 In_Dir & Directory_Separator & Name (1 .. Last);
621 Output : constant String :=
622 Out_Dir & Directory_Separator & Name (1 .. Last);
624 begin
625 -- If input is an ordinary file, process it
627 if Is_Regular_File (Input) then
628 -- First get the output file name
630 Name_Len := Last;
631 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
632 Infile_Name := Name_Find;
633 Preprocess_Infile_Name;
635 -- Set the input file name and process the file
637 Name_Len := Input'Length;
638 Name_Buffer (1 .. Name_Len) := Input;
639 Infile_Name := Name_Find;
640 Process_One_File;
642 elsif Is_Directory (Input) then
643 -- Input is a directory. If the corresponding output
644 -- directory does not already exist, create it.
646 if not Is_Directory (Output) then
647 begin
648 Make_Dir (Dir_Name => Output);
650 exception
651 when Directory_Error =>
652 Fail ("could not create directory """
653 & Output
654 & """");
655 end;
656 end if;
658 -- And process this new input directory
660 Recursive_Process (Input, Output);
662 -- Reestablish the input and output directory names
663 -- that have been modified by the recursive call.
665 Set_Directory_Names;
666 end if;
667 end;
668 end if;
669 end loop;
670 end Recursive_Process;
672 -- Start of processing for Process_Files
674 begin
675 if Output_Directory = No_Name then
677 -- If the output is not a directory, fail if the input is
678 -- an existing directory, to avoid possible problems.
680 if Is_Directory (Get_Name_String (Infile_Name)) then
681 Fail ("input file """ & Get_Name_String (Infile_Name) &
682 """ is a directory");
683 end if;
685 -- Just process the single input file
687 Process_One_File;
689 elsif Input_Directory = No_Name then
691 -- Get the output file name from the input file name, and process
692 -- the single input file.
694 Preprocess_Infile_Name;
695 Process_One_File;
697 else
698 -- Recursively process files in the directory tree rooted at the
699 -- input directory.
701 Recursive_Process
702 (In_Dir => Get_Name_String (Input_Directory),
703 Out_Dir => Get_Name_String (Output_Directory));
704 end if;
705 end Process_Files;
707 -------------------------
708 -- Put_Char_To_Outfile --
709 -------------------------
711 procedure Put_Char_To_Outfile (C : Character) is
712 begin
713 Put (Outfile.all, C);
714 end Put_Char_To_Outfile;
716 -----------------------
717 -- Scan_Command_Line --
718 -----------------------
720 procedure Scan_Command_Line is
721 Switch : Character;
723 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
725 -- Start of processing for Scan_Command_Line
727 begin
728 -- First check for --version or --help
730 Check_Version_And_Help ("GNATPREP", "1996");
732 -- Now scan the other switches
734 GNAT.Command_Line.Initialize_Option_Scan;
736 loop
737 begin
738 Switch := GNAT.Command_Line.Getopt ("D: b c C r s T u v");
740 case Switch is
742 when ASCII.NUL =>
743 exit;
745 when 'D' =>
746 Process_Command_Line_Symbol_Definition
747 (S => GNAT.Command_Line.Parameter);
749 when 'b' =>
750 Opt.Blank_Deleted_Lines := True;
752 when 'c' =>
753 Opt.Comment_Deleted_Lines := True;
755 when 'C' =>
756 Opt.Replace_In_Comments := True;
758 when 'r' =>
759 Source_Ref_Pragma := True;
761 when 's' =>
762 Opt.List_Preprocessing_Symbols := True;
764 when 'T' =>
765 Unix_Line_Terminators := True;
767 when 'u' =>
768 Opt.Undefined_Symbols_Are_False := True;
770 when 'v' =>
771 Opt.Verbose_Mode := True;
773 when others =>
774 Fail ("Invalid Switch: -" & Switch);
775 end case;
777 exception
778 when GNAT.Command_Line.Invalid_Switch =>
779 Write_Str ("Invalid Switch: -");
780 Write_Line (GNAT.Command_Line.Full_Switch);
781 Usage;
782 OS_Exit (1);
783 end;
784 end loop;
786 -- Get the file names
788 loop
789 declare
790 S : constant String := GNAT.Command_Line.Get_Argument;
792 begin
793 exit when S'Length = 0;
795 Name_Len := S'Length;
796 Name_Buffer (1 .. Name_Len) := S;
798 if Infile_Name = No_Name then
799 Infile_Name := Name_Find;
800 elsif Outfile_Name = No_Name then
801 Outfile_Name := Name_Find;
802 elsif Deffile_Name = No_Name then
803 Deffile_Name := Name_Find;
804 else
805 Fail ("too many arguments specified");
806 end if;
807 end;
808 end loop;
809 end Scan_Command_Line;
811 -----------
812 -- Usage --
813 -----------
815 procedure Usage is
816 begin
817 Display_Copyright;
818 Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
819 "infile outfile [deffile]");
820 Write_Eol;
821 Write_Line (" infile Name of the input file");
822 Write_Line (" outfile Name of the output file");
823 Write_Line (" deffile Name of the definition file");
824 Write_Eol;
825 Write_Line ("gnatprep switches:");
826 Write_Line (" -b Replace preprocessor lines by blank lines");
827 Write_Line (" -c Keep preprocessor lines as comments");
828 Write_Line (" -C Do symbol replacements within comments");
829 Write_Line (" -D Associate symbol with value");
830 Write_Line (" -r Generate Source_Reference pragma");
831 Write_Line (" -s Print a sorted list of symbol names and values");
832 Write_Line (" -T Use LF as line terminators");
833 Write_Line (" -u Treat undefined symbols as FALSE");
834 Write_Line (" -v Verbose mode");
835 Write_Eol;
836 end Usage;
838 end GPrep;