1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Ada.Command_Line; use Ada.Command_Line;
27 with Ada.Text_IO; use Ada.Text_IO;
29 with GNAT.Dynamic_Tables;
30 with GNAT.OS_Lib; use GNAT.OS_Lib;
34 with Osint; use Osint;
35 with Output; use Output;
38 with Switch; use Switch;
41 with System.Regexp; use System.Regexp;
45 Subdirs_Switch : constant String := "--subdirs=";
47 Usage_Output : Boolean := False;
48 -- Set to True when usage is output, to avoid multiple output
50 Usage_Needed : Boolean := False;
51 -- Set to True by -h switch
53 Version_Output : Boolean := False;
54 -- Set to True when version is output, to avoid multiple output
56 Very_Verbose : Boolean := False;
57 -- Set to True with -v -v
59 Create_Project : Boolean := False;
60 -- Set to True with a -P switch
62 File_Path : String_Access := new String'("gnat.adc");
63 -- Path name of the file specified by -c or -P switch
65 File_Set : Boolean := False;
66 -- Set to True by -c or -P switch.
67 -- Used to detect multiple -c/-P switches.
69 package Patterns is new GNAT.Dynamic_Tables
70 (Table_Component_Type => String_Access,
71 Table_Index_Type => Natural,
74 Table_Increment => 100);
75 -- Table to accumulate the patterns
77 type Argument_Data is record
78 Directories : Patterns.Instance;
79 Name_Patterns : Patterns.Instance;
80 Excluded_Patterns : Patterns.Instance;
81 Foreign_Patterns : Patterns.Instance;
84 package Arguments is new Table.Table
85 (Table_Component_Type => Argument_Data,
86 Table_Index_Type => Natural,
89 Table_Increment => 100,
90 Table_Name => "Gnatname.Arguments");
91 -- Table to accumulate the foreign patterns
93 package Preprocessor_Switches is new Table.Table
94 (Table_Component_Type => String_Access,
95 Table_Index_Type => Natural,
98 Table_Increment => 100,
99 Table_Name => "Gnatname.Preprocessor_Switches");
100 -- Table to store the preprocessor switches to be used in the call
103 procedure Output_Version;
104 -- Print name and version
110 -- Scan the command line arguments
112 procedure Add_Source_Directory (S : String);
113 -- Add S in the Source_Directories table
115 procedure Get_Directories (From_File : String);
116 -- Read a source directory text file
118 --------------------------
119 -- Add_Source_Directory --
120 --------------------------
122 procedure Add_Source_Directory (S : String) is
125 (Arguments.Table (Arguments.Last).Directories, new String'(S));
126 end Add_Source_Directory;
128 ---------------------
129 -- Get_Directories --
130 ---------------------
132 procedure Get_Directories (From_File : String) is
133 File : Ada.Text_IO.File_Type;
134 Line : String (1 .. 2_000);
138 Open (File, In_File, From_File);
140 while not End_Of_File (File) loop
141 Get_Line (File, Line, Last);
144 Add_Source_Directory (Line (1 .. Last));
152 Fail ("cannot open source directory file """ & From_File & '"');
159 procedure Output_Version is
161 if not Version_Output then
162 Version_Output := True;
164 Display_Version ("GNATNAME", "2001");
172 procedure Scan_Args is
174 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
176 Project_File_Name_Expected : Boolean;
178 Pragmas_File_Expected : Boolean;
180 Directory_Expected : Boolean;
182 Dir_File_Name_Expected : Boolean;
184 Foreign_Pattern_Expected : Boolean;
186 Excluded_Pattern_Expected : Boolean;
188 procedure Check_Regular_Expression (S : String);
189 -- Compile string S into a Regexp, fail if any error
191 -----------------------------
192 -- Check_Regular_Expression--
193 -----------------------------
195 procedure Check_Regular_Expression (S : String) is
197 pragma Warnings (Off, Dummy);
199 Dummy := Compile (S, Glob => True);
201 when Error_In_Regexp =>
202 Fail ("invalid regular expression """ & S & """");
203 end Check_Regular_Expression;
205 -- Start of processing for Scan_Args
208 -- First check for --version or --help
210 Check_Version_And_Help ("GNATNAME", "2001");
212 -- Now scan the other switches
214 Project_File_Name_Expected := False;
215 Pragmas_File_Expected := False;
216 Directory_Expected := False;
217 Dir_File_Name_Expected := False;
218 Foreign_Pattern_Expected := False;
219 Excluded_Pattern_Expected := False;
221 for Next_Arg in 1 .. Argument_Count loop
223 Next_Argv : constant String := Argument (Next_Arg);
224 Arg : String (1 .. Next_Argv'Length) := Next_Argv;
227 if Arg'Length > 0 then
231 if Project_File_Name_Expected then
232 if Arg (1) = '-' then
233 Fail ("project file name missing");
237 File_Path := new String'(Arg);
238 Project_File_Name_Expected := False;
243 elsif Pragmas_File_Expected then
245 File_Path := new String'(Arg);
246 Create_Project := False;
247 Pragmas_File_Expected := False;
251 elsif Directory_Expected then
252 Add_Source_Directory (Arg);
253 Directory_Expected := False;
257 elsif Dir_File_Name_Expected then
258 Get_Directories (Arg);
259 Dir_File_Name_Expected := False;
263 elsif Foreign_Pattern_Expected then
265 (Arguments.Table (Arguments.Last).Foreign_Patterns,
267 Check_Regular_Expression (Arg);
268 Foreign_Pattern_Expected := False;
272 elsif Excluded_Pattern_Expected then
274 (Arguments.Table (Arguments.Last).Excluded_Patterns,
276 Check_Regular_Expression (Arg);
277 Excluded_Pattern_Expected := False;
279 -- There must be at least one Ada pattern or one foreign
280 -- pattern for the previous section.
284 elsif Arg = "--and" then
287 (Arguments.Table (Arguments.Last).Name_Patterns) = 0
290 (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
296 -- If no directory were specified for the previous section,
297 -- then the directory is the project directory.
300 (Arguments.Table (Arguments.Last).Directories) = 0
303 (Arguments.Table (Arguments.Last).Directories,
307 -- Add and initialize another component to Arguments table
310 New_Arguments : Argument_Data;
311 pragma Warnings (Off, New_Arguments);
312 -- Declaring this defaulted initialized object ensures
313 -- that the new allocated component of table Arguments
314 -- is correctly initialized.
316 -- This is VERY ugly, Table should never be used with
317 -- data requiring default initialization. We should
318 -- find a way to avoid violating this rule ???
321 Arguments.Append (New_Arguments);
325 (Arguments.Table (Arguments.Last).Directories);
327 (Arguments.Table (Arguments.Last).Directories, 0);
329 (Arguments.Table (Arguments.Last).Name_Patterns);
331 (Arguments.Table (Arguments.Last).Name_Patterns, 0);
333 (Arguments.Table (Arguments.Last).Excluded_Patterns);
335 (Arguments.Table (Arguments.Last).Excluded_Patterns, 0);
337 (Arguments.Table (Arguments.Last).Foreign_Patterns);
339 (Arguments.Table (Arguments.Last).Foreign_Patterns, 0);
341 -- Subdirectory switch
343 elsif Arg'Length > Subdirs_Switch'Length
344 and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch
347 new String'(Arg (Subdirs_Switch'Length + 1 .. Arg'Last));
351 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then
353 Fail ("only one -P or -c switch may be specified");
356 if Arg'Length = 2 then
357 Pragmas_File_Expected := True;
359 if Next_Arg = Argument_Count then
360 Fail ("configuration pragmas file name missing");
365 File_Path := new String'(Arg (3 .. Arg'Last));
366 Create_Project := False;
371 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then
372 if Arg'Length = 2 then
373 Directory_Expected := True;
375 if Next_Arg = Argument_Count then
376 Fail ("directory name missing");
380 Add_Source_Directory (Arg (3 .. Arg'Last));
385 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then
386 if Arg'Length = 2 then
387 Dir_File_Name_Expected := True;
389 if Next_Arg = Argument_Count then
390 Fail ("directory list file name missing");
394 Get_Directories (Arg (3 .. Arg'Last));
399 elsif Arg = "-eL" then
400 Opt.Follow_Links_For_Files := True;
401 Opt.Follow_Links_For_Dirs := True;
405 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then
406 if Arg'Length = 2 then
407 Foreign_Pattern_Expected := True;
409 if Next_Arg = Argument_Count then
410 Fail ("foreign pattern missing");
415 (Arguments.Table (Arguments.Last).Foreign_Patterns,
416 new String'(Arg (3 .. Arg'Last)));
417 Check_Regular_Expression (Arg (3 .. Arg'Last));
420 -- -gnatep or -gnateD
422 elsif Arg'Length > 7 and then
423 (Arg (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD")
425 Preprocessor_Switches.Append (new String'(Arg));
429 elsif Arg = "-h" then
430 Usage_Needed := True;
434 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
436 Fail ("only one -c or -P switch may be specified");
439 if Arg'Length = 2 then
440 if Next_Arg = Argument_Count then
441 Fail ("project file name missing");
444 Project_File_Name_Expected := True;
449 File_Path := new String'(Arg (3 .. Arg'Last));
452 Create_Project := True;
456 elsif Arg = "-v" then
457 if Opt.Verbose_Mode then
458 Very_Verbose := True;
460 Opt.Verbose_Mode := True;
465 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then
466 if Arg'Length = 2 then
467 Excluded_Pattern_Expected := True;
469 if Next_Arg = Argument_Count then
470 Fail ("excluded pattern missing");
475 (Arguments.Table (Arguments.Last).Excluded_Patterns,
476 new String'(Arg (3 .. Arg'Last)));
477 Check_Regular_Expression (Arg (3 .. Arg'Last));
480 -- Junk switch starting with minus
482 elsif Arg (1) = '-' then
483 Fail ("wrong switch: " & Arg);
485 -- Not a recognized switch, assume file name
488 Canonical_Case_File_Name (Arg);
490 (Arguments.Table (Arguments.Last).Name_Patterns,
492 Check_Regular_Expression (Arg);
505 if not Usage_Output then
506 Usage_Needed := False;
507 Usage_Output := True;
508 Write_Str ("Usage: ");
509 Osint.Write_Program_Name;
510 Write_Line (" [switches] naming-pattern [naming-patterns]");
511 Write_Line (" {--and [switches] naming-pattern [naming-patterns]}");
513 Write_Line ("switches:");
515 Display_Usage_Version_And_Help;
517 Write_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs");
520 Write_Line (" --and use different patterns");
523 Write_Line (" -cfile create configuration pragmas file");
524 Write_Line (" -ddir use dir as one of the source " &
526 Write_Line (" -Dfile get source directories from file");
527 Write_Line (" -eL follow symbolic links when processing " &
529 Write_Line (" -fpat foreign pattern");
530 Write_Line (" -gnateDsym=v preprocess with symbol definition");
531 Write_Line (" -gnatep=data preprocess files with data file");
532 Write_Line (" -h output this help message");
533 Write_Line (" -Pproj update or create project file proj");
534 Write_Line (" -v verbose output");
535 Write_Line (" -v -v very verbose output");
536 Write_Line (" -xpat exclude pattern pat");
540 -- Start of processing for Gnatname
543 -- Add the directory where gnatname is invoked in front of the
544 -- path, if gnatname is invoked with directory information.
545 -- Only do this if the platform is not VMS, where the notion of path
546 -- does not really exist.
548 if not Hostparm.OpenVMS then
550 Command : constant String := Command_Name;
553 for Index in reverse Command'Range loop
554 if Command (Index) = Directory_Separator then
556 Absolute_Dir : constant String :=
558 (Command (Command'First .. Index));
560 PATH : constant String :=
566 Setenv ("PATH", PATH);
577 Arguments.Set_Last (0);
578 Arguments.Increment_Last;
579 Patterns.Init (Arguments.Table (1).Directories);
580 Patterns.Set_Last (Arguments.Table (1).Directories, 0);
581 Patterns.Init (Arguments.Table (1).Name_Patterns);
582 Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0);
583 Patterns.Init (Arguments.Table (1).Excluded_Patterns);
584 Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0);
585 Patterns.Init (Arguments.Table (1).Foreign_Patterns);
586 Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0);
588 Preprocessor_Switches.Set_Last (0);
594 if Opt.Verbose_Mode then
602 -- If no Ada or foreign pattern was specified, print the usage and return
604 if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0
606 Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
612 -- If no source directory was specified, use the current directory as the
613 -- unique directory. Note that if a file was specified with directory
614 -- information, the current directory is the directory of the specified
618 (Arguments.Table (Arguments.Last).Directories) = 0
621 (Arguments.Table (Arguments.Last).Directories, new String'("."));
627 Prep_Switches : Argument_List
628 (1 .. Integer (Preprocessor_Switches.Last));
631 for Index in Prep_Switches'Range loop
632 Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
636 (File_Path => File_Path.all,
637 Project_File => Create_Project,
638 Preproc_Switches => Prep_Switches,
639 Very_Verbose => Very_Verbose,
640 Flags => Gnatmake_Flags);
643 -- Process each section successively
645 for J in 1 .. Arguments.Last loop
647 Directories : Argument_List
649 (Patterns.Last (Arguments.Table (J).Directories)));
650 Name_Patterns : Prj.Makr.Regexp_List
652 (Patterns.Last (Arguments.Table (J).Name_Patterns)));
653 Excl_Patterns : Prj.Makr.Regexp_List
655 (Patterns.Last (Arguments.Table (J).Excluded_Patterns)));
656 Frgn_Patterns : Prj.Makr.Regexp_List
658 (Patterns.Last (Arguments.Table (J).Foreign_Patterns)));
661 -- Build the Directories and Patterns arguments
663 for Index in Directories'Range loop
664 Directories (Index) :=
665 Arguments.Table (J).Directories.Table (Index);
668 for Index in Name_Patterns'Range loop
669 Name_Patterns (Index) :=
671 (Arguments.Table (J).Name_Patterns.Table (Index).all,
675 for Index in Excl_Patterns'Range loop
676 Excl_Patterns (Index) :=
678 (Arguments.Table (J).Excluded_Patterns.Table (Index).all,
682 for Index in Frgn_Patterns'Range loop
683 Frgn_Patterns (Index) :=
685 (Arguments.Table (J).Foreign_Patterns.Table (Index).all,
689 -- Call Prj.Makr.Process where the real work is done
692 (Directories => Directories,
693 Name_Patterns => Name_Patterns,
694 Excluded_Patterns => Excl_Patterns,
695 Foreign_Patterns => Frgn_Patterns);
703 if Opt.Verbose_Mode then