1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2009, 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
309 Arguments.Increment_Last;
312 (Arguments.Table (Arguments.Last).Directories);
314 (Arguments.Table (Arguments.Last).Directories, 0);
316 (Arguments.Table (Arguments.Last).Name_Patterns);
318 (Arguments.Table (Arguments.Last).Name_Patterns, 0);
320 (Arguments.Table (Arguments.Last).Excluded_Patterns);
322 (Arguments.Table (Arguments.Last).Excluded_Patterns, 0);
324 (Arguments.Table (Arguments.Last).Foreign_Patterns);
326 (Arguments.Table (Arguments.Last).Foreign_Patterns, 0);
328 -- Subdirectory switch
330 elsif Arg'Length > Subdirs_Switch'Length
331 and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch
334 new String'(Arg
(Subdirs_Switch
'Length + 1 .. Arg
'Last));
338 elsif Arg
'Length >= 2 and then Arg
(1 .. 2) = "-c" then
340 Fail
("only one -P or -c switch may be specified");
343 if Arg
'Length = 2 then
344 Pragmas_File_Expected
:= True;
346 if Next_Arg
= Argument_Count
then
347 Fail
("configuration pragmas file name missing");
352 File_Path
:= new String'(Arg (3 .. Arg'Last));
353 Create_Project := False;
358 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then
359 if Arg'Length = 2 then
360 Directory_Expected := True;
362 if Next_Arg = Argument_Count then
363 Fail ("directory name missing");
367 Add_Source_Directory (Arg (3 .. Arg'Last));
372 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then
373 if Arg'Length = 2 then
374 Dir_File_Name_Expected := True;
376 if Next_Arg = Argument_Count then
377 Fail ("directory list file name missing");
381 Get_Directories (Arg (3 .. Arg'Last));
386 elsif Arg = "-eL" then
387 Opt.Follow_Links_For_Files := True;
388 Opt.Follow_Links_For_Dirs := True;
392 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then
393 if Arg'Length = 2 then
394 Foreign_Pattern_Expected := True;
396 if Next_Arg = Argument_Count then
397 Fail ("foreign pattern missing");
402 (Arguments.Table (Arguments.Last).Foreign_Patterns,
403 new String'(Arg
(3 .. Arg
'Last)));
404 Check_Regular_Expression
(Arg
(3 .. Arg
'Last));
407 -- -gnatep or -gnateD
409 elsif Arg
'Length > 7 and then
410 (Arg
(1 .. 7) = "-gnatep" or else Arg
(1 .. 7) = "-gnateD")
412 Preprocessor_Switches
.Append
(new String'(Arg));
416 elsif Arg = "-h" then
417 Usage_Needed := True;
421 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
423 Fail ("only one -c or -P switch may be specified");
426 if Arg'Length = 2 then
427 if Next_Arg = Argument_Count then
428 Fail ("project file name missing");
431 Project_File_Name_Expected := True;
436 File_Path := new String'(Arg
(3 .. Arg
'Last));
439 Create_Project
:= True;
443 elsif Arg
= "-v" then
444 if Opt
.Verbose_Mode
then
445 Very_Verbose
:= True;
447 Opt
.Verbose_Mode
:= True;
452 elsif Arg
'Length >= 2 and then Arg
(1 .. 2) = "-x" then
453 if Arg
'Length = 2 then
454 Excluded_Pattern_Expected
:= True;
456 if Next_Arg
= Argument_Count
then
457 Fail
("excluded pattern missing");
462 (Arguments
.Table
(Arguments
.Last
).Excluded_Patterns
,
463 new String'(Arg (3 .. Arg'Last)));
464 Check_Regular_Expression (Arg (3 .. Arg'Last));
467 -- Junk switch starting with minus
469 elsif Arg (1) = '-' then
470 Fail ("wrong switch: " & Arg);
472 -- Not a recognized switch, assume file name
475 Canonical_Case_File_Name (Arg);
477 (Arguments.Table (Arguments.Last).Name_Patterns,
479 Check_Regular_Expression
(Arg
);
492 if not Usage_Output
then
493 Usage_Needed
:= False;
494 Usage_Output
:= True;
495 Write_Str
("Usage: ");
496 Osint
.Write_Program_Name
;
497 Write_Line
(" [switches] naming-pattern [naming-patterns]");
498 Write_Line
(" {--and [switches] naming-pattern [naming-patterns]}");
500 Write_Line
("switches:");
502 Write_Line
(" --subdirs=dir real obj/lib/exec dirs are subdirs");
505 Write_Line
(" --and use different patterns");
508 Write_Line
(" -cfile create configuration pragmas file");
509 Write_Line
(" -ddir use dir as one of the source " &
511 Write_Line
(" -Dfile get source directories from file");
512 Write_Line
(" -eL follow symbolic links when processing " &
514 Write_Line
(" -fpat foreign pattern");
515 Write_Line
(" -gnateDsym=v preprocess with symbol definition");
516 Write_Line
(" -gnatep=data preprocess files with data file");
517 Write_Line
(" -h output this help message");
518 Write_Line
(" -Pproj update or create project file proj");
519 Write_Line
(" -v verbose output");
520 Write_Line
(" -v -v very verbose output");
521 Write_Line
(" -xpat exclude pattern pat");
525 -- Start of processing for Gnatname
528 -- Add the directory where gnatname is invoked in front of the
529 -- path, if gnatname is invoked with directory information.
530 -- Only do this if the platform is not VMS, where the notion of path
531 -- does not really exist.
533 if not Hostparm
.OpenVMS
then
535 Command
: constant String := Command_Name
;
538 for Index
in reverse Command
'Range loop
539 if Command
(Index
) = Directory_Separator
then
541 Absolute_Dir
: constant String :=
543 (Command
(Command
'First .. Index
));
545 PATH
: constant String :=
551 Setenv
("PATH", PATH
);
562 Arguments
.Set_Last
(0);
563 Arguments
.Increment_Last
;
564 Patterns
.Init
(Arguments
.Table
(1).Directories
);
565 Patterns
.Set_Last
(Arguments
.Table
(1).Directories
, 0);
566 Patterns
.Init
(Arguments
.Table
(1).Name_Patterns
);
567 Patterns
.Set_Last
(Arguments
.Table
(1).Name_Patterns
, 0);
568 Patterns
.Init
(Arguments
.Table
(1).Excluded_Patterns
);
569 Patterns
.Set_Last
(Arguments
.Table
(1).Excluded_Patterns
, 0);
570 Patterns
.Init
(Arguments
.Table
(1).Foreign_Patterns
);
571 Patterns
.Set_Last
(Arguments
.Table
(1).Foreign_Patterns
, 0);
573 Preprocessor_Switches
.Set_Last
(0);
579 if Opt
.Verbose_Mode
then
587 -- If no Ada or foreign pattern was specified, print the usage and return
589 if Patterns
.Last
(Arguments
.Table
(Arguments
.Last
).Name_Patterns
) = 0
591 Patterns
.Last
(Arguments
.Table
(Arguments
.Last
).Foreign_Patterns
) = 0
597 -- If no source directory was specified, use the current directory as the
598 -- unique directory. Note that if a file was specified with directory
599 -- information, the current directory is the directory of the specified
603 (Arguments
.Table
(Arguments
.Last
).Directories
) = 0
606 (Arguments
.Table
(Arguments
.Last
).Directories
, new String'("."));
612 Prep_Switches : Argument_List
613 (1 .. Integer (Preprocessor_Switches.Last));
616 for Index in Prep_Switches'Range loop
617 Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
621 (File_Path => File_Path.all,
622 Project_File => Create_Project,
623 Preproc_Switches => Prep_Switches,
624 Very_Verbose => Very_Verbose,
625 Flags => Gnatmake_Flags);
628 -- Process each section successively
630 for J in 1 .. Arguments.Last loop
632 Directories : Argument_List
634 (Patterns.Last (Arguments.Table (J).Directories)));
635 Name_Patterns : Prj.Makr.Regexp_List
637 (Patterns.Last (Arguments.Table (J).Name_Patterns)));
638 Excl_Patterns : Prj.Makr.Regexp_List
640 (Patterns.Last (Arguments.Table (J).Excluded_Patterns)));
641 Frgn_Patterns : Prj.Makr.Regexp_List
643 (Patterns.Last (Arguments.Table (J).Foreign_Patterns)));
646 -- Build the Directories and Patterns arguments
648 for Index in Directories'Range loop
649 Directories (Index) :=
650 Arguments.Table (J).Directories.Table (Index);
653 for Index in Name_Patterns'Range loop
654 Name_Patterns (Index) :=
656 (Arguments.Table (J).Name_Patterns.Table (Index).all,
660 for Index in Excl_Patterns'Range loop
661 Excl_Patterns (Index) :=
663 (Arguments.Table (J).Excluded_Patterns.Table (Index).all,
667 for Index in Frgn_Patterns'Range loop
668 Frgn_Patterns (Index) :=
670 (Arguments.Table (J).Foreign_Patterns.Table (Index).all,
674 -- Call Prj.Makr.Process where the real work is done
677 (Directories => Directories,
678 Name_Patterns => Name_Patterns,
679 Excluded_Patterns => Excl_Patterns,
680 Foreign_Patterns => Frgn_Patterns);
688 if Opt.Verbose_Mode then