* tree-cfg.c (tree_find_edge_insert_loc): Handle naked RETURN_EXPR.
[official-gcc.git] / gcc / ada / gprep.adb
blob83cd12101f7096433cc0a522f329454513a25f00
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G P R E P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2005, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
27 with Csets;
28 with Err_Vars; use Err_Vars;
29 with Errutil;
30 with Gnatvsn;
31 with Namet; use Namet;
32 with Opt;
33 with Osint; use Osint;
34 with Output; use Output;
35 with Prep; use Prep;
36 with Scng;
37 with Sinput.C;
38 with Snames;
39 with Stringt; use Stringt;
40 with Types; use Types;
42 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;
46 with GNAT.OS_Lib; use GNAT.OS_Lib;
48 package body GPrep is
50 Copyright_Displayed : Boolean := False;
51 -- Used to prevent multiple displays of the copyright notice
53 ------------------------
54 -- Argument Line Data --
55 ------------------------
57 Infile_Name : Name_Id := No_Name;
58 Outfile_Name : Name_Id := No_Name;
59 Deffile_Name : Name_Id := No_Name;
61 Output_Directory : Name_Id := No_Name;
62 -- Used when the specified output is an existing directory
64 Input_Directory : Name_Id := No_Name;
65 -- Used when the specified input and output are existing directories
67 Source_Ref_Pragma : Boolean := False;
68 -- Record command line options (set if -r switch set)
70 Text_Outfile : aliased Ada.Text_IO.File_Type;
71 Outfile : constant File_Access := Text_Outfile'Access;
73 File_Name_Buffer_Initial_Size : constant := 50;
74 File_Name_Buffer : String_Access :=
75 new String (1 .. File_Name_Buffer_Initial_Size);
76 -- A buffer to build output file names from input file names.
78 -----------------
79 -- Subprograms --
80 -----------------
82 procedure Display_Copyright;
83 -- Display the copyright notice
85 procedure Obsolescent_Check (S : Source_Ptr);
86 -- Null procedure, needed by instantiation of Scng below
88 procedure Post_Scan;
89 -- Null procedure, needed by instantiation of Scng below
91 package Scanner is new Scng
92 (Post_Scan,
93 Errutil.Error_Msg,
94 Errutil.Error_Msg_S,
95 Errutil.Error_Msg_SC,
96 Errutil.Error_Msg_SP,
97 Obsolescent_Check,
98 Errutil.Style);
99 -- The scanner for the preprocessor
101 function Is_ASCII_Letter (C : Character) return Boolean;
102 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
104 procedure Double_File_Name_Buffer;
105 -- Double the size of the file name buffer.
107 procedure Preprocess_Infile_Name;
108 -- When the specified output is a directory, preprocess the infile name
109 -- for symbol substitution, to get the output file name.
111 procedure Process_Files;
112 -- Process the single input file or all the files in the directory tree
113 -- rooted at the input directory.
115 procedure Process_Command_Line_Symbol_Definition (S : String);
116 -- Process a -D switch on the command line
118 procedure Put_Char_To_Outfile (C : Character);
119 -- Output one character to the output file.
120 -- Used to initialize the preprocessor.
122 procedure New_EOL_To_Outfile;
123 -- Output a new line to the output file.
124 -- Used to initialize the preprocessor.
126 procedure Scan_Command_Line;
127 -- Scan the switches and the file names
129 procedure Usage;
130 -- Display the usage
132 -----------------------
133 -- Display_Copyright --
134 -----------------------
136 procedure Display_Copyright is
137 begin
138 if not Copyright_Displayed then
139 Write_Line ("GNAT Preprocessor " & Gnatvsn.Gnat_Version_String);
140 Write_Line ("Copyright 1996-2004 Free Software Foundation, Inc.");
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;
171 -- Initialize the preprocessor
173 Prep.Initialize
174 (Error_Msg => Errutil.Error_Msg'Access,
175 Scan => Scanner.Scan'Access,
176 Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
177 Put_Char => Put_Char_To_Outfile'Access,
178 New_EOL => New_EOL_To_Outfile'Access);
180 -- Set the scanner characteristics for the preprocessor
182 Scanner.Set_Special_Character ('#');
183 Scanner.Set_Special_Character ('$');
184 Scanner.Set_End_Of_Line_As_Token (True);
186 -- Initialize the mapping table of symbols to values
188 Prep.Symbol_Table.Init (Prep.Mapping);
190 -- Parse the switches and arguments
192 Scan_Command_Line;
194 if Opt.Verbose_Mode then
195 Display_Copyright;
196 end if;
198 -- Test we had all the arguments needed
200 if Infile_Name = No_Name then
201 -- No input file specified, just output the usage and exit
203 Usage;
204 return;
206 elsif Outfile_Name = No_Name then
207 -- No output file specified, just output the usage and exit
209 Usage;
210 return;
211 end if;
213 -- If a pragma Source_File_Name, we need to keep line numbers.
214 -- So, if the deleted lines are not put as comment, we must output them
215 -- as blank lines.
217 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
218 Opt.Blank_Deleted_Lines := True;
219 end if;
221 -- If we have a definition file, parse it
223 if Deffile_Name /= No_Name then
224 declare
225 Deffile : Source_File_Index;
227 begin
228 Errutil.Initialize;
229 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
231 -- Set Main_Source_File to the definition file for the benefit of
232 -- Errutil.Finalize.
234 Sinput.Main_Source_File := Deffile;
236 if Deffile = No_Source_File then
237 Fail ("unable to find definition file """,
238 Get_Name_String (Deffile_Name),
239 """");
240 end if;
242 Scanner.Initialize_Scanner (No_Unit, Deffile);
244 Prep.Parse_Def_File;
245 end;
246 end if;
248 -- If there are errors in the definition file, output these errors
249 -- and exit.
251 if Total_Errors_Detected > 0 then
252 Errutil.Finalize (Source_Type => "definition");
253 Fail ("errors in definition file """,
254 Get_Name_String (Deffile_Name), """");
255 end if;
257 -- If -s switch was specified, print a sorted list of symbol names and
258 -- values, if any.
260 if Opt.List_Preprocessing_Symbols then
261 Prep.List_Symbols (Foreword => "");
262 end if;
264 Output_Directory := No_Name;
265 Input_Directory := No_Name;
267 -- Check if the specified output is an existing directory
269 if Is_Directory (Get_Name_String (Outfile_Name)) then
270 Output_Directory := Outfile_Name;
272 -- As the output is an existing directory, check if the input too
273 -- is a directory.
275 if Is_Directory (Get_Name_String (Infile_Name)) then
276 Input_Directory := Infile_Name;
277 end if;
278 end if;
280 -- And process the single input or the files in the directory tree
281 -- rooted at the input directory.
283 Process_Files;
285 end Gnatprep;
287 ---------------------
288 -- Is_ASCII_Letter --
289 ---------------------
291 function Is_ASCII_Letter (C : Character) return Boolean is
292 begin
293 return C in 'A' .. 'Z' or else C in 'a' .. 'z';
294 end Is_ASCII_Letter;
296 ------------------------
297 -- New_EOL_To_Outfile --
298 ------------------------
300 procedure New_EOL_To_Outfile is
301 begin
302 New_Line (Outfile.all);
303 end New_EOL_To_Outfile;
305 -----------------------
306 -- Obsolescent_Check --
307 -----------------------
309 procedure Obsolescent_Check (S : Source_Ptr) is
310 pragma Warnings (Off, S);
311 begin
312 null;
313 end Obsolescent_Check;
315 ---------------
316 -- Post_Scan --
317 ---------------
319 procedure Post_Scan is
320 begin
321 null;
322 end Post_Scan;
324 ----------------------------
325 -- Preprocess_Infile_Name --
326 ----------------------------
328 procedure Preprocess_Infile_Name is
329 Len : Natural;
330 First : Positive := 1;
331 Last : Natural;
332 Symbol : Name_Id;
333 Data : Symbol_Data;
335 begin
336 -- Initialize the buffer with the name of the input file
338 Get_Name_String (Infile_Name);
339 Len := Name_Len;
341 while File_Name_Buffer'Length < Len loop
342 Double_File_Name_Buffer;
343 end loop;
345 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
347 -- Look for possible symbols in the file name
349 while First < Len loop
351 -- A symbol starts with a dollar sign followed by a letter
353 if File_Name_Buffer (First) = '$' and then
354 Is_ASCII_Letter (File_Name_Buffer (First + 1))
355 then
356 Last := First + 1;
358 -- Find the last letter of the symbol
360 while Last < Len and then
361 Is_ASCII_Letter (File_Name_Buffer (Last + 1))
362 loop
363 Last := Last + 1;
364 end loop;
366 -- Get the symbol name id
368 Name_Len := Last - First;
369 Name_Buffer (1 .. Name_Len) :=
370 File_Name_Buffer (First + 1 .. Last);
371 To_Lower (Name_Buffer (1 .. Name_Len));
372 Symbol := Name_Find;
374 -- And look for this symbol name in the symbol table
376 for Index in 1 .. Symbol_Table.Last (Mapping) loop
377 Data := Mapping.Table (Index);
379 if Data.Symbol = Symbol then
381 -- We found the symbol. If its value is not a string,
382 -- replace the symbol in the file name with the value of
383 -- the symbol.
385 if not Data.Is_A_String then
386 String_To_Name_Buffer (Data.Value);
388 declare
389 Sym_Len : constant Positive := Last - First + 1;
390 Offset : constant Integer := Name_Len - Sym_Len;
391 New_Len : constant Natural := Len + Offset;
393 begin
394 while New_Len > File_Name_Buffer'Length loop
395 Double_File_Name_Buffer;
396 end loop;
398 File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
399 File_Name_Buffer (Last + 1 .. Len);
400 Len := New_Len;
401 Last := Last + Offset;
402 File_Name_Buffer (First .. Last) :=
403 Name_Buffer (1 .. Name_Len);
404 end;
405 end if;
407 exit;
408 end if;
409 end loop;
411 -- Skip over the symbol name or its value: we are not checking
412 -- for another symbol name in the value.
414 First := Last + 1;
416 else
417 First := First + 1;
418 end if;
419 end loop;
421 -- We now have the output file name in the buffer. Get the output
422 -- path and put it in Outfile_Name.
424 Get_Name_String (Output_Directory);
425 Add_Char_To_Name_Buffer (Directory_Separator);
426 Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
427 Outfile_Name := Name_Find;
428 end Preprocess_Infile_Name;
430 --------------------------------------------
431 -- Process_Command_Line_Symbol_Definition --
432 --------------------------------------------
434 procedure Process_Command_Line_Symbol_Definition (S : String) is
435 Data : Symbol_Data;
436 Symbol : Symbol_Id;
438 begin
439 -- Check the symbol definition and get the symbol and its value.
440 -- Fail if symbol definition is illegal.
442 Check_Command_Line_Symbol_Definition (S, Data);
444 Symbol := Index_Of (Data.Symbol);
446 -- If symbol does not alrady exist, create a new entry in the mapping
447 -- table.
449 if Symbol = No_Symbol then
450 Symbol_Table.Increment_Last (Mapping);
451 Symbol := Symbol_Table.Last (Mapping);
452 end if;
454 Mapping.Table (Symbol) := Data;
455 end Process_Command_Line_Symbol_Definition;
457 -------------------
458 -- Process_Files --
459 -------------------
461 procedure Process_Files is
463 procedure Process_One_File;
464 -- Process input file Infile_Name and put the result in file
465 -- Outfile_Name.
467 procedure Recursive_Process (In_Dir : String; Out_Dir : String);
468 -- Process recursively files in In_Dir. Results go to Out_Dir.
470 ----------------------
471 -- Process_One_File --
472 ----------------------
474 procedure Process_One_File is
475 Infile : Source_File_Index;
477 begin
478 -- Create the output file; fails if this does not work.
480 begin
481 Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
483 exception
484 when others =>
485 Fail
486 ("unable to create output file """,
487 Get_Name_String (Outfile_Name), """");
488 end;
490 -- Load the input file
492 Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
494 if Infile = No_Source_File then
495 Fail ("unable to find input file """,
496 Get_Name_String (Infile_Name), """");
497 end if;
499 -- Set Main_Source_File to the input file for the benefit of
500 -- Errutil.Finalize.
502 Sinput.Main_Source_File := Infile;
504 Scanner.Initialize_Scanner (No_Unit, Infile);
506 -- Output the SFN pragma if asked to
508 if Source_Ref_Pragma then
509 Put_Line (Outfile.all, "pragma Source_Reference (1, """ &
510 Get_Name_String (Sinput.File_Name (Infile)) &
511 """);");
512 end if;
514 -- Preprocess the input file
516 Prep.Preprocess;
518 -- In verbose mode, if there is no error, report it
520 if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
521 Errutil.Finalize (Source_Type => "input");
522 end if;
524 -- If we had some errors, delete the output file, and report
525 -- the errors.
527 if Err_Vars.Total_Errors_Detected > 0 then
528 if Outfile /= Standard_Output then
529 Delete (Text_Outfile);
530 end if;
532 Errutil.Finalize (Source_Type => "input");
534 OS_Exit (0);
536 -- otherwise, close the output file, and we are done.
538 elsif Outfile /= Standard_Output then
539 Close (Text_Outfile);
540 end if;
541 end Process_One_File;
543 -----------------------
544 -- Recursive_Process --
545 -----------------------
547 procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
548 Dir_In : Dir_Type;
549 Name : String (1 .. 255);
550 Last : Natural;
551 In_Dir_Name : Name_Id;
552 Out_Dir_Name : Name_Id;
554 procedure Set_Directory_Names;
555 -- Establish or reestablish the current input and output directories
557 -------------------------
558 -- Set_Directory_Names --
559 -------------------------
561 procedure Set_Directory_Names is
562 begin
563 Input_Directory := In_Dir_Name;
564 Output_Directory := Out_Dir_Name;
565 end Set_Directory_Names;
567 begin
568 -- Open the current input directory
570 begin
571 Open (Dir_In, In_Dir);
573 exception
574 when Directory_Error =>
575 Fail ("could not read directory " & In_Dir);
576 end;
578 -- Set the new input and output directory names
580 Name_Len := In_Dir'Length;
581 Name_Buffer (1 .. Name_Len) := In_Dir;
582 In_Dir_Name := Name_Find;
583 Name_Len := Out_Dir'Length;
584 Name_Buffer (1 .. Name_Len) := Out_Dir;
585 Out_Dir_Name := Name_Find;
587 Set_Directory_Names;
589 -- Traverse the input directory
590 loop
591 Read (Dir_In, Name, Last);
592 exit when Last = 0;
594 if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
595 declare
596 Input : constant String :=
597 In_Dir & Directory_Separator & Name (1 .. Last);
598 Output : constant String :=
599 Out_Dir & Directory_Separator & Name (1 .. Last);
601 begin
602 -- If input is an ordinary file, process it
604 if Is_Regular_File (Input) then
605 -- First get the output file name
607 Name_Len := Last;
608 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
609 Infile_Name := Name_Find;
610 Preprocess_Infile_Name;
612 -- Set the input file name and process the file
614 Name_Len := Input'Length;
615 Name_Buffer (1 .. Name_Len) := Input;
616 Infile_Name := Name_Find;
617 Process_One_File;
619 elsif Is_Directory (Input) then
620 -- Input is a directory. If the corresponding output
621 -- directory does not already exist, create it.
623 if not Is_Directory (Output) then
624 begin
625 Make_Dir (Dir_Name => Output);
627 exception
628 when Directory_Error =>
629 Fail ("could not create directory """,
630 Output, """");
631 end;
632 end if;
634 -- And process this new input directory
636 Recursive_Process (Input, Output);
638 -- Reestablish the input and output directory names
639 -- that have been modified by the recursive call.
641 Set_Directory_Names;
642 end if;
643 end;
644 end if;
645 end loop;
646 end Recursive_Process;
648 begin
649 if Output_Directory = No_Name then
650 -- If the output is not a directory, fail if the input is
651 -- an existing directory, to avoid possible problems.
653 if Is_Directory (Get_Name_String (Infile_Name)) then
654 Fail ("input file """ & Get_Name_String (Infile_Name) &
655 """ is a directory");
656 end if;
658 -- Just process the single input file
660 Process_One_File;
662 elsif Input_Directory = No_Name then
663 -- Get the output file name from the input file name, and process
664 -- the single input file.
666 Preprocess_Infile_Name;
667 Process_One_File;
669 else
670 -- Recursively process files in the directory tree rooted at the
671 -- input directory.
673 Recursive_Process
674 (In_Dir => Get_Name_String (Input_Directory),
675 Out_Dir => Get_Name_String (Output_Directory));
676 end if;
677 end Process_Files;
679 -------------------------
680 -- Put_Char_To_Outfile --
681 -------------------------
683 procedure Put_Char_To_Outfile (C : Character) is
684 begin
685 Put (Outfile.all, C);
686 end Put_Char_To_Outfile;
688 -----------------------
689 -- Scan_Command_Line --
690 -----------------------
692 procedure Scan_Command_Line is
693 Switch : Character;
695 begin
696 -- Parse the switches
698 loop
699 begin
700 Switch := GNAT.Command_Line.Getopt ("D: b c r s u v");
701 case Switch is
703 when ASCII.NUL =>
704 exit;
706 when 'D' =>
707 Process_Command_Line_Symbol_Definition
708 (S => GNAT.Command_Line.Parameter);
710 when 'b' =>
711 Opt.Blank_Deleted_Lines := True;
713 when 'c' =>
714 Opt.Comment_Deleted_Lines := True;
716 when 'r' =>
717 Source_Ref_Pragma := True;
719 when 's' =>
720 Opt.List_Preprocessing_Symbols := True;
722 when 'u' =>
723 Opt.Undefined_Symbols_Are_False := True;
725 when 'v' =>
726 Opt.Verbose_Mode := True;
728 when others =>
729 Fail ("Invalid Switch: -" & Switch);
730 end case;
732 exception
733 when GNAT.Command_Line.Invalid_Switch =>
734 Write_Str ("Invalid Switch: -");
735 Write_Line (GNAT.Command_Line.Full_Switch);
736 Usage;
737 OS_Exit (1);
738 end;
739 end loop;
741 -- Get the file names
743 loop
744 declare
745 S : constant String := GNAT.Command_Line.Get_Argument;
747 begin
748 exit when S'Length = 0;
750 Name_Len := S'Length;
751 Name_Buffer (1 .. Name_Len) := S;
753 if Infile_Name = No_Name then
754 Infile_Name := Name_Find;
755 elsif Outfile_Name = No_Name then
756 Outfile_Name := Name_Find;
757 elsif Deffile_Name = No_Name then
758 Deffile_Name := Name_Find;
759 else
760 Fail ("too many arguments specifed");
761 end if;
762 end;
763 end loop;
764 end Scan_Command_Line;
766 -----------
767 -- Usage --
768 -----------
770 procedure Usage is
771 begin
772 Display_Copyright;
773 Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
774 "infile outfile [deffile]");
775 Write_Eol;
776 Write_Line (" infile Name of the input file");
777 Write_Line (" outfile Name of the output file");
778 Write_Line (" deffile Name of the definition file");
779 Write_Eol;
780 Write_Line ("gnatprep switches:");
781 Write_Line (" -b Replace preprocessor lines by blank lines");
782 Write_Line (" -c Keep preprocessor lines as comments");
783 Write_Line (" -D Associate symbol with value");
784 Write_Line (" -r Generate Source_Reference pragma");
785 Write_Line (" -s Print a sorted list of symbol names and values");
786 Write_Line (" -u Treat undefined symbols as FALSE");
787 Write_Line (" -v Verbose mode");
788 Write_Eol;
789 end Usage;
791 end GPrep;