OSDN Git Service

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