OSDN Git Service

2007-08-30 Vincent Celier <celier@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / gprep.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                                G P R E P                                 --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 2002-2007, 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 ------------------------------------------------------------------------------
26
27 with Csets;
28 with Err_Vars; use Err_Vars;
29 with Errutil;
30 with Namet;    use Namet;
31 with Opt;
32 with Osint;    use Osint;
33 with Output;   use Output;
34 with Prep;     use Prep;
35 with Scng;
36 with Sinput.C;
37 with Snames;
38 with Stringt;  use Stringt;
39 with Switch;   use Switch;
40 with Types;    use Types;
41
42 with Ada.Text_IO;     use Ada.Text_IO;
43
44 with GNAT.Case_Util;            use GNAT.Case_Util;
45 with GNAT.Command_Line;
46 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
47
48 with System.OS_Lib; use System.OS_Lib;
49
50 package body GPrep is
51
52    Copyright_Displayed : Boolean := False;
53    --  Used to prevent multiple displays of the copyright notice
54
55    ------------------------
56    -- Argument Line Data --
57    ------------------------
58
59    Infile_Name  : Name_Id := No_Name;
60    Outfile_Name : Name_Id := No_Name;
61    Deffile_Name : Name_Id := No_Name;
62
63    Output_Directory : Name_Id := No_Name;
64    --  Used when the specified output is an existing directory
65
66    Input_Directory : Name_Id := No_Name;
67    --  Used when the specified input and output are existing directories
68
69    Source_Ref_Pragma : Boolean := False;
70    --  Record command line options (set if -r switch set)
71
72    Text_Outfile : aliased Ada.Text_IO.File_Type;
73    Outfile      : constant File_Access := Text_Outfile'Access;
74
75    File_Name_Buffer_Initial_Size : constant := 50;
76    File_Name_Buffer : String_Access :=
77                         new String (1 .. File_Name_Buffer_Initial_Size);
78    --  A buffer to build output file names from input file names
79
80    -----------------
81    -- Subprograms --
82    -----------------
83
84    procedure Display_Copyright;
85    --  Display the copyright notice
86
87    procedure Obsolescent_Check (S : Source_Ptr);
88    --  Null procedure, needed by instantiation of Scng below
89
90    procedure Post_Scan;
91    --  Null procedure, needed by instantiation of Scng below
92
93    package Scanner is new Scng
94      (Post_Scan,
95       Errutil.Error_Msg,
96       Errutil.Error_Msg_S,
97       Errutil.Error_Msg_SC,
98       Errutil.Error_Msg_SP,
99       Obsolescent_Check,
100       Errutil.Style);
101    --  The scanner for the preprocessor
102
103    function Is_ASCII_Letter (C : Character) return Boolean;
104    --  True if C is in 'a' .. 'z' or in 'A' .. 'Z'
105
106    procedure Double_File_Name_Buffer;
107    --  Double the size of the file name buffer
108
109    procedure Preprocess_Infile_Name;
110    --  When the specified output is a directory, preprocess the infile name
111    --  for symbol substitution, to get the output file name.
112
113    procedure Process_Files;
114    --  Process the single input file or all the files in the directory tree
115    --  rooted at the input directory.
116
117    procedure Process_Command_Line_Symbol_Definition (S : String);
118    --  Process a -D switch on the command line
119
120    procedure Put_Char_To_Outfile (C : Character);
121    --  Output one character to the output file. Used to initialize the
122    --  preprocessor.
123
124    procedure New_EOL_To_Outfile;
125    --  Output a new line to the output file. Used to initialize the
126    --  preprocessor.
127
128    procedure Scan_Command_Line;
129    --  Scan the switches and the file names
130
131    procedure Usage;
132    --  Display the usage
133
134    -----------------------
135    -- Display_Copyright --
136    -----------------------
137
138    procedure Display_Copyright is
139    begin
140       if not Copyright_Displayed then
141          Display_Version ("GNAT Preprocessor", "1996");
142          Copyright_Displayed := True;
143       end if;
144    end Display_Copyright;
145
146    -----------------------------
147    -- Double_File_Name_Buffer --
148    -----------------------------
149
150    procedure Double_File_Name_Buffer is
151       New_Buffer : constant String_Access :=
152                      new String (1 .. 2 * File_Name_Buffer'Length);
153    begin
154       New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all;
155       Free (File_Name_Buffer);
156       File_Name_Buffer := New_Buffer;
157    end Double_File_Name_Buffer;
158
159    --------------
160    -- Gnatprep --
161    --------------
162
163    procedure Gnatprep is
164    begin
165       --  Do some initializations (order is important here!)
166
167       Csets.Initialize;
168       Namet.Initialize;
169       Snames.Initialize;
170       Stringt.Initialize;
171
172       --  Initialize the preprocessor
173
174       Prep.Initialize
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);
180
181       --  Set the scanner characteristics for the preprocessor
182
183       Scanner.Set_Special_Character ('#');
184       Scanner.Set_Special_Character ('$');
185       Scanner.Set_End_Of_Line_As_Token (True);
186
187       --  Initialize the mapping table of symbols to values
188
189       Prep.Symbol_Table.Init (Prep.Mapping);
190
191       --  Parse the switches and arguments
192
193       Scan_Command_Line;
194
195       if Opt.Verbose_Mode then
196          Display_Copyright;
197       end if;
198
199       --  Test we had all the arguments needed
200
201       if Infile_Name = No_Name then
202
203          --  No input file specified, just output the usage and exit
204
205          Usage;
206          return;
207
208       elsif Outfile_Name = No_Name then
209
210          --  No output file specified, just output the usage and exit
211
212          Usage;
213          return;
214       end if;
215
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.
219
220       if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
221          Opt.Blank_Deleted_Lines := True;
222       end if;
223
224       --  If we have a definition file, parse it
225
226       if Deffile_Name /= No_Name then
227          declare
228             Deffile : Source_File_Index;
229
230          begin
231             Errutil.Initialize;
232             Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
233
234             --  Set Main_Source_File to the definition file for the benefit of
235             --  Errutil.Finalize.
236
237             Sinput.Main_Source_File := Deffile;
238
239             if Deffile = No_Source_File then
240                Fail ("unable to find definition file """,
241                      Get_Name_String (Deffile_Name),
242                      """");
243             end if;
244
245             Scanner.Initialize_Scanner (Deffile);
246
247             Prep.Parse_Def_File;
248          end;
249       end if;
250
251       --  If there are errors in the definition file, output them and exit
252
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       end if;
258
259       --  If -s switch was specified, print a sorted list of symbol names and
260       --  values, if any.
261
262       if Opt.List_Preprocessing_Symbols then
263          Prep.List_Symbols (Foreword => "");
264       end if;
265
266       Output_Directory := No_Name;
267       Input_Directory  := No_Name;
268
269       --  Check if the specified output is an existing directory
270
271       if Is_Directory (Get_Name_String (Outfile_Name)) then
272          Output_Directory := Outfile_Name;
273
274          --  As the output is an existing directory, check if the input too
275          --  is a directory.
276
277          if Is_Directory (Get_Name_String (Infile_Name)) then
278             Input_Directory := Infile_Name;
279          end if;
280       end if;
281
282       --  And process the single input or the files in the directory tree
283       --  rooted at the input directory.
284
285       Process_Files;
286    end Gnatprep;
287
288    ---------------------
289    -- Is_ASCII_Letter --
290    ---------------------
291
292    function Is_ASCII_Letter (C : Character) return Boolean is
293    begin
294       return C in 'A' .. 'Z' or else C in 'a' .. 'z';
295    end Is_ASCII_Letter;
296
297    ------------------------
298    -- New_EOL_To_Outfile --
299    ------------------------
300
301    procedure New_EOL_To_Outfile is
302    begin
303       New_Line (Outfile.all);
304    end New_EOL_To_Outfile;
305
306    -----------------------
307    -- Obsolescent_Check --
308    -----------------------
309
310    procedure Obsolescent_Check (S : Source_Ptr) is
311       pragma Warnings (Off, S);
312    begin
313       null;
314    end Obsolescent_Check;
315
316    ---------------
317    -- Post_Scan --
318    ---------------
319
320    procedure Post_Scan is
321    begin
322       null;
323    end Post_Scan;
324
325    ----------------------------
326    -- Preprocess_Infile_Name --
327    ----------------------------
328
329    procedure Preprocess_Infile_Name is
330       Len    : Natural;
331       First  : Positive;
332       Last   : Natural;
333       Symbol : Name_Id;
334       Data   : Symbol_Data;
335
336    begin
337       --  Initialize the buffer with the name of the input file
338
339       Get_Name_String (Infile_Name);
340       Len := Name_Len;
341
342       while File_Name_Buffer'Length < Len loop
343          Double_File_Name_Buffer;
344       end loop;
345
346       File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
347
348       --  Look for possible symbols in the file name
349
350       First := 1;
351       while First < Len loop
352
353          --  A symbol starts with a dollar sign followed by a letter
354
355          if File_Name_Buffer (First) = '$' and then
356            Is_ASCII_Letter (File_Name_Buffer (First + 1))
357          then
358             Last := First + 1;
359
360             --  Find the last letter of the symbol
361
362             while Last < Len and then
363                Is_ASCII_Letter (File_Name_Buffer (Last + 1))
364             loop
365                Last := Last + 1;
366             end loop;
367
368             --  Get the symbol name id
369
370             Name_Len := Last - First;
371             Name_Buffer (1 .. Name_Len) :=
372               File_Name_Buffer (First + 1 .. Last);
373             To_Lower (Name_Buffer (1 .. Name_Len));
374             Symbol := Name_Find;
375
376             --  And look for this symbol name in the symbol table
377
378             for Index in 1 .. Symbol_Table.Last (Mapping) loop
379                Data := Mapping.Table (Index);
380
381                if Data.Symbol = Symbol then
382
383                   --  We found the symbol. If its value is not a string,
384                   --  replace the symbol in the file name with the value of
385                   --  the symbol.
386
387                   if not Data.Is_A_String then
388                      String_To_Name_Buffer (Data.Value);
389
390                      declare
391                         Sym_Len : constant Positive := Last - First + 1;
392                         Offset  : constant Integer := Name_Len - Sym_Len;
393                         New_Len : constant Natural := Len + Offset;
394
395                      begin
396                         while New_Len > File_Name_Buffer'Length loop
397                            Double_File_Name_Buffer;
398                         end loop;
399
400                         File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
401                           File_Name_Buffer (Last + 1 .. Len);
402                         Len := New_Len;
403                         Last := Last + Offset;
404                         File_Name_Buffer (First .. Last) :=
405                           Name_Buffer (1 .. Name_Len);
406                      end;
407                   end if;
408
409                   exit;
410                end if;
411             end loop;
412
413             --  Skip over the symbol name or its value: we are not checking
414             --  for another symbol name in the value.
415
416             First := Last + 1;
417
418          else
419             First := First + 1;
420          end if;
421       end loop;
422
423       --  We now have the output file name in the buffer. Get the output
424       --  path and put it in Outfile_Name.
425
426       Get_Name_String (Output_Directory);
427       Add_Char_To_Name_Buffer (Directory_Separator);
428       Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
429       Outfile_Name := Name_Find;
430    end Preprocess_Infile_Name;
431
432    --------------------------------------------
433    -- Process_Command_Line_Symbol_Definition --
434    --------------------------------------------
435
436    procedure Process_Command_Line_Symbol_Definition (S : String) is
437       Data   : Symbol_Data;
438       Symbol : Symbol_Id;
439
440    begin
441       --  Check the symbol definition and get the symbol and its value.
442       --  Fail if symbol definition is illegal.
443
444       Check_Command_Line_Symbol_Definition (S, Data);
445
446       Symbol := Index_Of (Data.Symbol);
447
448       --  If symbol does not alrady exist, create a new entry in the mapping
449       --  table.
450
451       if Symbol = No_Symbol then
452          Symbol_Table.Increment_Last (Mapping);
453          Symbol := Symbol_Table.Last (Mapping);
454       end if;
455
456       Mapping.Table (Symbol) := Data;
457    end Process_Command_Line_Symbol_Definition;
458
459    -------------------
460    -- Process_Files --
461    -------------------
462
463    procedure Process_Files is
464
465       procedure Process_One_File;
466       --  Process input file Infile_Name and put the result in file
467       --  Outfile_Name.
468
469       procedure Recursive_Process (In_Dir : String; Out_Dir : String);
470       --  Process recursively files in In_Dir. Results go to Out_Dir
471
472       ----------------------
473       -- Process_One_File --
474       ----------------------
475
476       procedure Process_One_File is
477          Infile : Source_File_Index;
478
479       begin
480          --  Create the output file (fails if this does not work)
481
482          begin
483             Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
484
485          exception
486             when others =>
487                Fail
488                  ("unable to create output file """,
489                   Get_Name_String (Outfile_Name), """");
490          end;
491
492          --  Load the input file
493
494          Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
495
496          if Infile = No_Source_File then
497             Fail ("unable to find input file """,
498                   Get_Name_String (Infile_Name), """");
499          end if;
500
501          --  Set Main_Source_File to the input file for the benefit of
502          --  Errutil.Finalize.
503
504          Sinput.Main_Source_File := Infile;
505
506          Scanner.Initialize_Scanner (Infile);
507
508          --  Output the pragma Source_Reference if asked to
509
510          if Source_Ref_Pragma then
511             Put_Line
512               (Outfile.all,
513                "pragma Source_Reference (1, """ &
514                  Get_Name_String (Sinput.Full_File_Name (Infile)) & """);");
515          end if;
516
517          --  Preprocess the input file
518
519          Prep.Preprocess;
520
521          --  In verbose mode, if there is no error, report it
522
523          if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
524             Errutil.Finalize (Source_Type => "input");
525          end if;
526
527          --  If we had some errors, delete the output file, and report them
528
529          if Err_Vars.Total_Errors_Detected > 0 then
530             if Outfile /= Standard_Output then
531                Delete (Text_Outfile);
532             end if;
533
534             Errutil.Finalize (Source_Type => "input");
535
536             OS_Exit (0);
537
538          --  Otherwise, close the output file, and we are done
539
540          elsif Outfile /= Standard_Output then
541             Close (Text_Outfile);
542          end if;
543       end Process_One_File;
544
545       -----------------------
546       -- Recursive_Process --
547       -----------------------
548
549       procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
550          Dir_In : Dir_Type;
551          Name : String (1 .. 255);
552          Last : Natural;
553          In_Dir_Name  : Name_Id;
554          Out_Dir_Name : Name_Id;
555
556          procedure Set_Directory_Names;
557          --  Establish or reestablish the current input and output directories
558
559          -------------------------
560          -- Set_Directory_Names --
561          -------------------------
562
563          procedure Set_Directory_Names is
564          begin
565             Input_Directory := In_Dir_Name;
566             Output_Directory := Out_Dir_Name;
567          end Set_Directory_Names;
568
569       --  Start of processing for Recursive_Process
570
571       begin
572          --  Open the current input directory
573
574          begin
575             Open (Dir_In, In_Dir);
576
577          exception
578             when Directory_Error =>
579                Fail ("could not read directory " & In_Dir);
580          end;
581
582          --  Set the new input and output directory names
583
584          Name_Len := In_Dir'Length;
585          Name_Buffer (1 .. Name_Len) := In_Dir;
586          In_Dir_Name := Name_Find;
587          Name_Len := Out_Dir'Length;
588          Name_Buffer (1 .. Name_Len) := Out_Dir;
589          Out_Dir_Name := Name_Find;
590
591          Set_Directory_Names;
592
593          --  Traverse the input directory
594          loop
595             Read (Dir_In, Name, Last);
596             exit when Last = 0;
597
598             if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
599                declare
600                   Input : constant String :=
601                             In_Dir & Directory_Separator & Name (1 .. Last);
602                   Output : constant String :=
603                              Out_Dir & Directory_Separator & Name (1 .. Last);
604
605                begin
606                   --  If input is an ordinary file, process it
607
608                   if Is_Regular_File (Input) then
609                      --  First get the output file name
610
611                      Name_Len := Last;
612                      Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
613                      Infile_Name := Name_Find;
614                      Preprocess_Infile_Name;
615
616                      --  Set the input file name and process the file
617
618                      Name_Len := Input'Length;
619                      Name_Buffer (1 .. Name_Len) := Input;
620                      Infile_Name := Name_Find;
621                      Process_One_File;
622
623                   elsif Is_Directory (Input) then
624                      --  Input is a directory. If the corresponding output
625                      --  directory does not already exist, create it.
626
627                      if not Is_Directory (Output) then
628                         begin
629                            Make_Dir (Dir_Name => Output);
630
631                         exception
632                            when Directory_Error =>
633                               Fail ("could not create directory """,
634                                     Output, """");
635                         end;
636                      end if;
637
638                      --  And process this new input directory
639
640                      Recursive_Process (Input, Output);
641
642                      --  Reestablish the input and output directory names
643                      --  that have been modified by the recursive call.
644
645                      Set_Directory_Names;
646                   end if;
647                end;
648             end if;
649          end loop;
650       end Recursive_Process;
651
652    --  Start of processing for Process_Files
653
654    begin
655       if Output_Directory = No_Name then
656
657          --  If the output is not a directory, fail if the input is
658          --  an existing directory, to avoid possible problems.
659
660          if Is_Directory (Get_Name_String (Infile_Name)) then
661             Fail ("input file """ & Get_Name_String (Infile_Name) &
662                   """ is a directory");
663          end if;
664
665          --  Just process the single input file
666
667          Process_One_File;
668
669       elsif Input_Directory = No_Name then
670
671          --  Get the output file name from the input file name, and process
672          --  the single input file.
673
674          Preprocess_Infile_Name;
675          Process_One_File;
676
677       else
678          --  Recursively process files in the directory tree rooted at the
679          --  input directory.
680
681          Recursive_Process
682            (In_Dir => Get_Name_String (Input_Directory),
683             Out_Dir => Get_Name_String (Output_Directory));
684       end if;
685    end Process_Files;
686
687    -------------------------
688    -- Put_Char_To_Outfile --
689    -------------------------
690
691    procedure Put_Char_To_Outfile (C : Character) is
692    begin
693       Put (Outfile.all, C);
694    end Put_Char_To_Outfile;
695
696    -----------------------
697    -- Scan_Command_Line --
698    -----------------------
699
700    procedure Scan_Command_Line is
701       Switch : Character;
702
703    begin
704       --  First check for --version or --help
705
706       Check_Version_And_Help ("GNATPREP", "1996", Usage'Access);
707
708       --  Now scan the other switches
709
710       GNAT.Command_Line.Initialize_Option_Scan;
711
712       loop
713          begin
714             Switch := GNAT.Command_Line.Getopt ("D: b c C r s u v");
715
716             case Switch is
717
718                when ASCII.NUL =>
719                   exit;
720
721                when 'D' =>
722                   Process_Command_Line_Symbol_Definition
723                     (S => GNAT.Command_Line.Parameter);
724
725                when 'b' =>
726                   Opt.Blank_Deleted_Lines := True;
727
728                when 'c' =>
729                   Opt.Comment_Deleted_Lines := True;
730
731                when 'C' =>
732                   Opt.Replace_In_Comments := True;
733
734                when 'r' =>
735                   Source_Ref_Pragma := True;
736
737                when 's' =>
738                   Opt.List_Preprocessing_Symbols := True;
739
740                when 'u' =>
741                   Opt.Undefined_Symbols_Are_False := True;
742
743                when 'v' =>
744                   Opt.Verbose_Mode := True;
745
746                when others =>
747                   Fail ("Invalid Switch: -" & Switch);
748             end case;
749
750          exception
751             when GNAT.Command_Line.Invalid_Switch =>
752                Write_Str ("Invalid Switch: -");
753                Write_Line (GNAT.Command_Line.Full_Switch);
754                Usage;
755                OS_Exit (1);
756          end;
757       end loop;
758
759       --  Get the file names
760
761       loop
762          declare
763             S : constant String := GNAT.Command_Line.Get_Argument;
764
765          begin
766             exit when S'Length = 0;
767
768             Name_Len := S'Length;
769             Name_Buffer (1 .. Name_Len) := S;
770
771             if Infile_Name = No_Name then
772                Infile_Name := Name_Find;
773             elsif Outfile_Name = No_Name then
774                Outfile_Name := Name_Find;
775             elsif Deffile_Name = No_Name then
776                Deffile_Name := Name_Find;
777             else
778                Fail ("too many arguments specifed");
779             end if;
780          end;
781       end loop;
782    end Scan_Command_Line;
783
784    -----------
785    -- Usage --
786    -----------
787
788    procedure Usage is
789    begin
790       Display_Copyright;
791       Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
792                     "infile outfile [deffile]");
793       Write_Eol;
794       Write_Line ("  infile     Name of the input file");
795       Write_Line ("  outfile    Name of the output file");
796       Write_Line ("  deffile    Name of the definition file");
797       Write_Eol;
798       Write_Line ("gnatprep switches:");
799       Write_Line ("   -b  Replace preprocessor lines by blank lines");
800       Write_Line ("   -c  Keep preprocessor lines as comments");
801       Write_Line ("   -C  Do symbol replacements within comments");
802       Write_Line ("   -D  Associate symbol with value");
803       Write_Line ("   -r  Generate Source_Reference pragma");
804       Write_Line ("   -s  Print a sorted list of symbol names and values");
805       Write_Line ("   -u  Treat undefined symbols as FALSE");
806       Write_Line ("   -v  Verbose mode");
807       Write_Eol;
808    end Usage;
809
810 end GPrep;