1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2022, 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
.Characters
.Handling
; use Ada
.Characters
.Handling
;
27 with Ada
.Command_Line
; use Ada
.Command_Line
;
28 with Ada
.Text_IO
; use Ada
.Text_IO
;
30 with GNAT
.Command_Line
; use GNAT
.Command_Line
;
31 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
32 with GNAT
.Dynamic_Tables
;
33 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
35 with Make_Util
; use Make_Util
;
36 with Namet
; use Namet
;
38 with Osint
; use Osint
;
40 with Switch
; use Switch
;
43 with Types
; use Types
;
46 with System
.Regexp
; use System
.Regexp
;
50 pragma Warnings
(Off
);
51 type Matched_Type
is (True, False, Excluded
);
54 Create_Project
: Boolean := False;
56 Subdirs_Switch
: constant String := "--subdirs=";
58 Usage_Output
: Boolean := False;
59 -- Set to True when usage is output, to avoid multiple output
61 Usage_Needed
: Boolean := False;
62 -- Set to True by -h switch
64 Version_Output
: Boolean := False;
65 -- Set to True when version is output, to avoid multiple output
67 Very_Verbose
: Boolean := False;
68 -- Set to True with -v -v
70 File_Path
: String_Access
:= new String'("gnat.adc");
71 -- Path name of the file specified by -c or -P switch
73 File_Set : Boolean := False;
74 -- Set to True by -c or -P switch.
75 -- Used to detect multiple -c/-P switches.
77 Args : Argument_List_Access;
78 -- The list of arguments for calls to the compiler to get the unit names
79 -- and kinds (spec or body) in the Ada sources.
81 Path_Name : String_Access;
85 Directory_Last : Natural := 0;
87 function Dup (Fd : File_Descriptor) return File_Descriptor;
89 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
91 Gcc : constant String := "gcc";
92 Gcc_Path : String_Access := null;
94 package Patterns is new GNAT.Dynamic_Tables
95 (Table_Component_Type => String_Access,
96 Table_Index_Type => Natural,
99 Table_Increment => 100);
100 -- Table to accumulate the patterns
102 type Argument_Data is record
103 Directories : Patterns.Instance;
104 Name_Patterns : Patterns.Instance;
105 Excluded_Patterns : Patterns.Instance;
106 Foreign_Patterns : Patterns.Instance;
109 package Arguments is new Table.Table
110 (Table_Component_Type => Argument_Data,
111 Table_Index_Type => Natural,
112 Table_Low_Bound => 0,
114 Table_Increment => 100,
115 Table_Name => "Gnatname.Arguments");
116 -- Table to accumulate directories and patterns
118 package Preprocessor_Switches is new Table.Table
119 (Table_Component_Type => String_Access,
120 Table_Index_Type => Natural,
121 Table_Low_Bound => 0,
123 Table_Increment => 100,
124 Table_Name => "Gnatname.Preprocessor_Switches");
125 -- Table to store the preprocessor switches to be used in the call
128 type Source is record
135 package Processed_Directories is new Table.Table
136 (Table_Component_Type => String_Access,
137 Table_Index_Type => Natural,
138 Table_Low_Bound => 0,
140 Table_Increment => 100,
141 Table_Name => "Prj.Makr.Processed_Directories");
142 -- The list of already processed directories for each section, to avoid
143 -- processing several times the same directory in the same section.
145 package Sources is new Table.Table
146 (Table_Component_Type => Source,
147 Table_Index_Type => Natural,
148 Table_Low_Bound => 0,
150 Table_Increment => 100,
151 Table_Name => "Gnatname.Sources");
152 -- The list of Ada sources found, with their unit name and kind, to be put
153 -- in the pragmas Source_File_Name in the configuration pragmas file.
155 procedure Output_Version;
156 -- Print name and version
162 -- Scan the command line arguments
164 procedure Add_Source_Directory (S : String);
165 -- Add S in the Source_Directories table
167 procedure Get_Directories (From_File : String);
168 -- Read a source directory text file
171 -- Output an empty line
173 procedure Write_A_String (S : String);
174 -- Write a String to Output_FD
178 Preproc_Switches : Argument_List);
179 -- Start the creation of a configuration pragmas file
181 -- File_Path is the name of the configuration pragmas file to create
183 -- Preproc_Switches is a list of switches to be used when invoking the
184 -- compiler to get the name and kind of unit of a source file.
186 type Regexp_List is array (Positive range <>) of Regexp;
189 (Directories : Argument_List;
190 Name_Patterns : Regexp_List;
191 Excluded_Patterns : Regexp_List;
192 Foreign_Patterns : Regexp_List);
193 -- Look for source files in the specified directories, with the specified
196 -- Directories is the list of source directories where to look for sources.
198 -- Name_Patterns is a potentially empty list of file name patterns to check
201 -- Excluded_Patterns is a potentially empty list of file name patterns that
202 -- should not be checked for Ada or non Ada sources.
204 -- Foreign_Patterns is a potentially empty list of file name patterns to
205 -- check for non Ada sources.
207 -- At least one of Name_Patterns and Foreign_Patterns is not empty
210 -- Write the configuration pragmas file indicated in a call to procedure
211 -- Initialize, after one or several calls to procedure Process.
213 --------------------------
214 -- Add_Source_Directory --
215 --------------------------
217 procedure Add_Source_Directory (S : String) is
220 (Arguments.Table (Arguments.Last).Directories, new String'(S
));
221 end Add_Source_Directory
;
227 function Dup
(Fd
: File_Descriptor
) return File_Descriptor
is
229 return File_Descriptor
(System
.CRTL
.dup
(Integer (Fd
)));
236 procedure Dup2
(Old_Fd
, New_Fd
: File_Descriptor
) is
238 pragma Warnings
(Off
, Fd
);
240 Fd
:= System
.CRTL
.dup2
(Integer (Old_Fd
), Integer (New_Fd
));
243 ---------------------
244 -- Get_Directories --
245 ---------------------
247 procedure Get_Directories
(From_File
: String) is
248 File
: Ada
.Text_IO
.File_Type
;
249 Line
: String (1 .. 2_000
);
253 Open
(File
, In_File
, From_File
);
255 while not End_Of_File
(File
) loop
256 Get_Line
(File
, Line
, Last
);
259 Add_Source_Directory
(Line
(1 .. Last
));
267 Fail
("cannot open source directory file """ & From_File
& '"');
274 procedure Finalize
is
276 pragma Warnings
(Off
, Discard
);
279 -- Delete the file if it already exists
282 (Path_Name
(Directory_Last
+ 1 .. Path_Last
),
287 if Opt
.Verbose_Mode
then
288 Output
.Write_Str
("Creating new file """);
289 Output
.Write_Str
(Path_Name
(Directory_Last
+ 1 .. Path_Last
));
290 Output
.Write_Line
("""");
293 Output_FD
:= Create_New_File
294 (Path_Name
(Directory_Last
+ 1 .. Path_Last
),
297 -- Fails if file cannot be created
299 if Output_FD
= Invalid_FD
then
301 ("cannot create new """ & Path_Name
(1 .. Path_Last
) & """");
304 -- For each Ada source, write a pragma Source_File_Name to the
305 -- configuration pragmas file.
307 for Index
in 1 .. Sources
.Last
loop
308 if Sources
.Table
(Index
).Unit_Name
/= No_Name
then
309 Write_A_String
("pragma Source_File_Name");
311 Write_A_String
(" (");
313 (Get_Name_String
(Sources
.Table
(Index
).Unit_Name
));
314 Write_A_String
(",");
317 if Sources
.Table
(Index
).Spec
then
318 Write_A_String
(" Spec_File_Name => """);
321 Write_A_String
(" Body_File_Name => """);
325 (Get_Name_String
(Sources
.Table
(Index
).File_Name
));
327 Write_A_String
("""");
329 if Sources
.Table
(Index
).Index
/= 0 then
330 Write_A_String
(", Index =>");
331 Write_A_String
(Sources
.Table
(Index
).Index
'Img);
334 Write_A_String
(");");
348 Preproc_Switches
: Argument_List
)
351 Sources
.Set_Last
(0);
353 -- Initialize the compiler switches
355 Args
:= new Argument_List
(1 .. Preproc_Switches
'Length + 6);
356 Args
(1) := new String'("-c");
357 Args (2) := new String'("-gnats");
358 Args
(3) := new String'("-gnatu");
359 Args (4 .. 3 + Preproc_Switches'Length) := Preproc_Switches;
360 Args (4 + Preproc_Switches'Length) := new String'("-x");
361 Args
(5 + Preproc_Switches
'Length) := new String'("ada");
363 -- Get the path and file names
366 String (1 .. File_Path'Length);
367 Path_Last := File_Path'Length;
369 if File_Names_Case_Sensitive then
370 Path_Name (1 .. Path_Last) := File_Path;
372 Path_Name (1 .. Path_Last) := To_Lower (File_Path);
375 -- Get the end of directory information, if any
377 for Index in reverse 1 .. Path_Last loop
378 if Path_Name (Index) = Directory_Separator then
379 Directory_Last := Index;
384 -- Change the current directory to the directory of the project file,
385 -- if any directory information is specified.
387 if Directory_Last /= 0 then
389 Change_Dir (Path_Name (1 .. Directory_Last));
391 when Directory_Error =>
393 ("unknown directory """
394 & Path_Name (1 .. Directory_Last)
405 (Directories : Argument_List;
406 Name_Patterns : Regexp_List;
407 Excluded_Patterns : Regexp_List;
408 Foreign_Patterns : Regexp_List)
410 procedure Process_Directory (Dir_Name : String);
411 -- Look for Ada and foreign sources in a directory, according to the
414 -----------------------
415 -- Process_Directory --
416 -----------------------
418 procedure Process_Directory (Dir_Name : String) is
419 Matched : Matched_Type := False;
420 Str : String (1 .. 2_000);
421 Canon : String (1 .. 2_000);
424 Do_Process : Boolean := True;
426 Temp_File_Name : String_Access := null;
427 Save_Last_Source_Index : Natural := 0;
428 File_Name_Id : Name_Id := No_Name;
430 Current_Source : Source;
433 -- Avoid processing the same directory more than once
435 for Index in 1 .. Processed_Directories.Last loop
436 if Processed_Directories.Table (Index).all = Dir_Name then
443 if Opt.Verbose_Mode then
444 Output.Write_Str ("Processing directory """);
445 Output.Write_Str (Dir_Name);
446 Output.Write_Line ("""");
449 Processed_Directories. Increment_Last;
450 Processed_Directories.Table (Processed_Directories.Last) :=
451 new String'(Dir_Name
);
453 -- Get the source file names from the directory. Fails if the
454 -- directory does not exist.
457 Open
(Dir
, Dir_Name
);
459 when Directory_Error
=>
460 Fail_Program
("cannot open directory """ & Dir_Name
& """");
463 -- Process each regular file in the directory
466 Read
(Dir
, Str
, Last
);
467 exit File_Loop
when Last
= 0;
469 -- Copy the file name and put it in canonical case to match
470 -- against the patterns that have themselves already been put
471 -- in canonical case.
473 Canon
(1 .. Last
) := Str
(1 .. Last
);
474 Canonical_Case_File_Name
(Canon
(1 .. Last
));
477 (Dir_Name
& Directory_Separator
& Str
(1 .. Last
))
482 Name_Buffer
(1 .. Name_Len
) := Str
(1 .. Last
);
483 File_Name_Id
:= Name_Find
;
485 -- First, check if the file name matches at least one of
486 -- the excluded expressions;
488 for Index
in Excluded_Patterns
'Range loop
490 Match
(Canon
(1 .. Last
), Excluded_Patterns
(Index
))
497 -- If it does not match any of the excluded expressions,
498 -- check if the file name matches at least one of the
499 -- regular expressions.
501 if Matched
= True then
504 for Index
in Name_Patterns
'Range loop
507 (Canon
(1 .. Last
), Name_Patterns
(Index
))
516 or else (Matched
= True and then Opt
.Verbose_Mode
)
518 Output
.Write_Str
(" Checking """);
519 Output
.Write_Str
(Str
(1 .. Last
));
520 Output
.Write_Line
(""": ");
523 -- If the file name matches one of the regular expressions,
524 -- parse it to get its unit name.
526 if Matched
= True then
528 FD
: File_Descriptor
;
530 Saved_Output
: File_Descriptor
;
531 Saved_Error
: File_Descriptor
;
532 Tmp_File
: Path_Name_Type
;
535 -- If we don't have the path of the compiler yet,
536 -- get it now. The compiler name may have a prefix,
537 -- so we get the potentially prefixed name.
539 if Gcc_Path
= null then
541 Prefix_Gcc
: String_Access
:=
542 Program_Name
(Gcc
, "gnatname");
545 Locate_Exec_On_Path
(Prefix_Gcc
.all);
549 if Gcc_Path
= null then
550 Fail_Program
("could not locate " & Gcc
);
554 -- Create the temporary file
556 Tempdir
.Create_Temp_File
(FD
, Tmp_File
);
558 if FD
= Invalid_FD
then
560 ("could not create temporary file");
564 new String'(Get_Name_String (Tmp_File));
569 (Dir_Name
& Directory_Separator
& Str
(1 .. Last
));
571 -- Save the standard output and error
573 Saved_Output
:= Dup
(Standout
);
574 Saved_Error
:= Dup
(Standerr
);
576 -- Set standard output and error to the temporary file
581 -- And spawn the compiler
583 Spawn
(Gcc_Path
.all, Args
.all, Success
);
585 -- Restore the standard output and error
587 Dup2
(Saved_Output
, Standout
);
588 Dup2
(Saved_Error
, Standerr
);
590 -- Close the temporary file
594 -- And close the saved standard output and error to
595 -- avoid too many file descriptors.
597 Close
(Saved_Output
);
600 -- Now that standard output is restored, check if
601 -- the compiler ran correctly.
603 -- Read the lines of the temporary file:
604 -- they should contain the kind and name of the unit.
607 File
: Ada
.Text_IO
.File_Type
;
608 Text_Line
: String (1 .. 1_000
);
613 Open
(File
, In_File
, Temp_File_Name
.all);
618 ("could not read temporary file " &
622 Save_Last_Source_Index
:= Sources
.Last
;
624 if End_Of_File
(File
) then
625 if Opt
.Verbose_Mode
then
627 Output
.Write_Str
(" (process died) ");
632 Line_Loop
: while not End_Of_File
(File
) loop
633 Get_Line
(File
, Text_Line
, Text_Last
);
635 -- Find the first closing parenthesis
637 Char_Loop
: for J
in 1 .. Text_Last
loop
638 if Text_Line
(J
) = ')' then
640 Text_Line
(1 .. 4) = "Unit"
642 -- Add entry to Sources table
645 Name_Buffer
(1 .. Name_Len
) :=
646 Text_Line
(6 .. J
- 7);
648 (Unit_Name
=> Name_Find
,
649 File_Name
=> File_Name_Id
,
651 Spec
=> Text_Line
(J
- 5 .. J
) =
654 Sources
.Append
(Current_Source
);
663 if Save_Last_Source_Index
= Sources
.Last
then
664 if Opt
.Verbose_Mode
then
665 Output
.Write_Line
(" not a unit");
670 Save_Last_Source_Index
+ 1
672 for Index
in Save_Last_Source_Index
+ 1 ..
675 Sources
.Table
(Index
).Index
:=
676 Int
(Index
- Save_Last_Source_Index
);
680 for Index
in Save_Last_Source_Index
+ 1 ..
683 Current_Source
:= Sources
.Table
(Index
);
685 (CodePeer
, Modified
, Current_Source
);
687 if Opt
.Verbose_Mode
then
688 if Current_Source
.Spec
then
689 Output
.Write_Str
(" spec of ");
692 Output
.Write_Str
(" body of ");
697 (Current_Source
.Unit_Name
));
704 Delete_File
(Temp_File_Name
.all, Success
);
708 -- File name matches none of the regular expressions
711 -- If file is not excluded, see if this is foreign source
713 if Matched
/= Excluded
then
714 for Index
in Foreign_Patterns
'Range loop
715 if Match
(Canon
(1 .. Last
),
716 Foreign_Patterns
(Index
))
727 Output
.Write_Line
("no match");
730 Output
.Write_Line
("excluded");
733 Output
.Write_Line
("foreign source");
737 if Matched
= True then
739 -- Add source file name without unit name
742 Add_Str_To_Name_Buffer
(Canon
(1 .. Last
));
744 ((File_Name
=> Name_Find
,
745 Unit_Name
=> No_Name
,
756 end Process_Directory
;
758 -- Start of processing for Process
761 Processed_Directories
.Set_Last
(0);
763 -- Process each directory
765 for Index
in Directories
'Range loop
766 Process_Directory
(Directories
(Index
).all);
774 procedure Output_Version
is
776 if not Version_Output
then
777 Version_Output
:= True;
779 Display_Version
("GNATNAME", "2001");
787 procedure Scan_Args
is
789 procedure Check_Version_And_Help
is new Check_Version_And_Help_G
(Usage
);
791 Project_File_Name_Expected
: Boolean;
793 Pragmas_File_Expected
: Boolean;
795 Directory_Expected
: Boolean;
797 Dir_File_Name_Expected
: Boolean;
799 Foreign_Pattern_Expected
: Boolean;
801 Excluded_Pattern_Expected
: Boolean;
803 procedure Check_Regular_Expression
(S
: String);
804 -- Compile string S into a Regexp, fail if any error
806 -----------------------------
807 -- Check_Regular_Expression--
808 -----------------------------
810 procedure Check_Regular_Expression
(S
: String) is
812 pragma Warnings
(Off
, Dummy
);
814 Dummy
:= Compile
(S
, Glob
=> True);
816 when Error_In_Regexp
=>
817 Fail
("invalid regular expression """ & S
& """");
818 end Check_Regular_Expression
;
820 -- Start of processing for Scan_Args
823 -- First check for --version or --help
825 Check_Version_And_Help
("GNATNAME", "2001");
827 -- Now scan the other switches
829 Project_File_Name_Expected
:= False;
830 Pragmas_File_Expected
:= False;
831 Directory_Expected
:= False;
832 Dir_File_Name_Expected
:= False;
833 Foreign_Pattern_Expected
:= False;
834 Excluded_Pattern_Expected
:= False;
836 for Next_Arg
in 1 .. Argument_Count
loop
838 Next_Argv
: constant String := Argument
(Next_Arg
);
839 Arg
: String (1 .. Next_Argv
'Length) := Next_Argv
;
842 if Arg
'Length > 0 then
846 if Project_File_Name_Expected
then
847 if Arg
(1) = '-' then
848 Fail
("project file name missing");
852 File_Path
:= new String'(Arg);
853 Project_File_Name_Expected := False;
858 elsif Pragmas_File_Expected then
860 File_Path := new String'(Arg
);
861 Pragmas_File_Expected
:= False;
865 elsif Directory_Expected
then
866 Add_Source_Directory
(Arg
);
867 Directory_Expected
:= False;
871 elsif Dir_File_Name_Expected
then
872 Get_Directories
(Arg
);
873 Dir_File_Name_Expected
:= False;
877 elsif Foreign_Pattern_Expected
then
879 (Arguments
.Table
(Arguments
.Last
).Foreign_Patterns
,
881 Check_Regular_Expression (Arg);
882 Foreign_Pattern_Expected := False;
886 elsif Excluded_Pattern_Expected then
888 (Arguments.Table (Arguments.Last).Excluded_Patterns,
890 Check_Regular_Expression
(Arg
);
891 Excluded_Pattern_Expected
:= False;
893 -- There must be at least one Ada pattern or one foreign
894 -- pattern for the previous section.
898 elsif Arg
= "--and" then
901 (Arguments
.Table
(Arguments
.Last
).Name_Patterns
) = 0
904 (Arguments
.Table
(Arguments
.Last
).Foreign_Patterns
) = 0
910 -- If no directory were specified for the previous section,
911 -- then the directory is the project directory.
914 (Arguments
.Table
(Arguments
.Last
).Directories
) = 0
917 (Arguments
.Table
(Arguments
.Last
).Directories
,
921 -- Add and initialize another component to Arguments table
924 New_Arguments : Argument_Data;
925 pragma Warnings (Off, New_Arguments);
926 -- Declaring this defaulted initialized object ensures
927 -- that the new allocated component of table Arguments
928 -- is correctly initialized.
930 -- This is VERY ugly, Table should never be used with
931 -- data requiring default initialization. We should
932 -- find a way to avoid violating this rule ???
935 Arguments.Append (New_Arguments);
939 (Arguments.Table (Arguments.Last).Directories);
941 (Arguments.Table (Arguments.Last).Directories, 0);
943 (Arguments.Table (Arguments.Last).Name_Patterns);
945 (Arguments.Table (Arguments.Last).Name_Patterns, 0);
947 (Arguments.Table (Arguments.Last).Excluded_Patterns);
949 (Arguments.Table (Arguments.Last).Excluded_Patterns, 0);
951 (Arguments.Table (Arguments.Last).Foreign_Patterns);
953 (Arguments.Table (Arguments.Last).Foreign_Patterns, 0);
955 -- Subdirectory switch
957 elsif Arg'Length > Subdirs_Switch'Length
958 and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch
961 -- Subdirs are only used in gprname
965 elsif Arg = "--no-backup" then
966 Opt.No_Backup := True;
970 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then
972 Fail ("only one -P or -c switch may be specified");
975 if Arg'Length = 2 then
976 Pragmas_File_Expected := True;
978 if Next_Arg = Argument_Count then
979 Fail ("configuration pragmas file name missing");
984 File_Path := new String'(Arg
(3 .. Arg
'Last));
989 elsif Arg
'Length >= 2 and then Arg
(1 .. 2) = "-d" then
990 if Arg
'Length = 2 then
991 Directory_Expected
:= True;
993 if Next_Arg
= Argument_Count
then
994 Fail
("directory name missing");
998 Add_Source_Directory
(Arg
(3 .. Arg
'Last));
1003 elsif Arg
'Length >= 2 and then Arg
(1 .. 2) = "-D" then
1004 if Arg
'Length = 2 then
1005 Dir_File_Name_Expected
:= True;
1007 if Next_Arg
= Argument_Count
then
1008 Fail
("directory list file name missing");
1012 Get_Directories
(Arg
(3 .. Arg
'Last));
1017 elsif Arg
= "-eL" then
1018 Opt
.Follow_Links_For_Files
:= True;
1019 Opt
.Follow_Links_For_Dirs
:= True;
1023 elsif Arg
'Length >= 2 and then Arg
(1 .. 2) = "-f" then
1024 if Arg
'Length = 2 then
1025 Foreign_Pattern_Expected
:= True;
1027 if Next_Arg
= Argument_Count
then
1028 Fail
("foreign pattern missing");
1033 (Arguments
.Table
(Arguments
.Last
).Foreign_Patterns
,
1034 new String'(Arg (3 .. Arg'Last)));
1035 Check_Regular_Expression (Arg (3 .. Arg'Last));
1038 -- -gnatep or -gnateD
1040 elsif Arg'Length > 7 and then
1041 (Arg (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD")
1043 Preprocessor_Switches.Append (new String'(Arg
));
1047 elsif Arg
= "-h" then
1048 Usage_Needed
:= True;
1052 elsif Arg
'Length >= 2 and then Arg
(1 .. 2) = "-P" then
1054 Fail
("only one -c or -P switch may be specified");
1057 if Arg
'Length = 2 then
1058 if Next_Arg
= Argument_Count
then
1059 Fail
("project file name missing");
1062 Project_File_Name_Expected
:= True;
1067 File_Path
:= new String'(Arg (3 .. Arg'Last));
1070 Create_Project := True;
1074 elsif Arg = "-v" then
1075 if Opt.Verbose_Mode then
1076 Very_Verbose := True;
1078 Opt.Verbose_Mode := True;
1083 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then
1084 if Arg'Length = 2 then
1085 Excluded_Pattern_Expected := True;
1087 if Next_Arg = Argument_Count then
1088 Fail ("excluded pattern missing");
1093 (Arguments.Table (Arguments.Last).Excluded_Patterns,
1094 new String'(Arg
(3 .. Arg
'Last)));
1095 Check_Regular_Expression
(Arg
(3 .. Arg
'Last));
1098 -- Junk switch starting with minus
1100 elsif Arg
(1) = '-' then
1101 Fail
("wrong switch: " & Arg
);
1103 -- Not a recognized switch, assume file name
1106 Canonical_Case_File_Name
(Arg
);
1108 (Arguments
.Table
(Arguments
.Last
).Name_Patterns
,
1110 Check_Regular_Expression (Arg);
1123 if not Usage_Output then
1124 Usage_Needed := False;
1125 Usage_Output := True;
1126 Output.Write_Str ("Usage: ");
1127 Osint.Write_Program_Name;
1128 Output.Write_Line (" [switches] naming-pattern [naming-patterns]");
1130 (" {--and [switches] naming-pattern [naming-patterns]}");
1132 Output.Write_Line ("switches:");
1134 Display_Usage_Version_And_Help;
1137 (" --subdirs=dir real obj/lib/exec dirs are subdirs");
1139 (" --no-backup do not create backup of project file");
1142 Output.Write_Line (" --and use different patterns");
1146 (" -cfile create configuration pragmas file");
1147 Output.Write_Line (" -ddir use dir as one of the source " &
1149 Output.Write_Line (" -Dfile get source directories from file");
1151 (" -eL follow symbolic links when processing " &
1153 Output.Write_Line (" -fpat foreign pattern");
1155 (" -gnateDsym=v preprocess with symbol definition");
1156 Output.Write_Line (" -gnatep=data preprocess files with data file");
1157 Output.Write_Line (" -h output this help message");
1159 (" -Pproj update or create project file proj");
1160 Output.Write_Line (" -v verbose output");
1161 Output.Write_Line (" -v -v very verbose output");
1162 Output.Write_Line (" -xpat exclude pattern pat");
1170 procedure Write_Eol is
1172 Write_A_String ((1 => ASCII.LF));
1175 --------------------
1176 -- Write_A_String --
1177 --------------------
1179 procedure Write_A_String (S : String) is
1180 Str : String (1 .. S'Length);
1183 if S'Length > 0 then
1186 if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
1187 Fail_Program ("disk full");
1192 -- Start of processing for Gnatname
1195 -- Add the directory where gnatname is invoked in front of the
1196 -- path, if gnatname is invoked with directory information.
1199 Command : constant String := Command_Name;
1202 for Index in reverse Command'Range loop
1203 if Command (Index) = Directory_Separator then
1205 Absolute_Dir : constant String :=
1207 (Command (Command'First .. Index));
1209 PATH : constant String :=
1212 Getenv ("PATH").all;
1215 Setenv ("PATH", PATH);
1223 -- Initialize tables
1225 Arguments.Set_Last (0);
1227 New_Arguments : Argument_Data;
1228 pragma Warnings (Off, New_Arguments);
1229 -- Declaring this defaulted initialized object ensures that the new
1230 -- allocated component of table Arguments is correctly initialized.
1232 Arguments.Append (New_Arguments);
1235 Patterns.Init (Arguments.Table (1).Directories);
1236 Patterns.Set_Last (Arguments.Table (1).Directories, 0);
1237 Patterns.Init (Arguments.Table (1).Name_Patterns);
1238 Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0);
1239 Patterns.Init (Arguments.Table (1).Excluded_Patterns);
1240 Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0);
1241 Patterns.Init (Arguments.Table (1).Foreign_Patterns);
1242 Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0);
1244 Preprocessor_Switches.Set_Last (0);
1246 -- Get the arguments
1250 if Create_Project then
1252 Gprname_Path : constant String_Access :=
1253 Locate_Exec_On_Path ("gprname");
1254 Arg_Len : Natural := Argument_Count;
1256 Target : String_Access := null;
1257 Success : Boolean := False;
1259 if Gprname_Path = null then
1261 ("project files are no longer supported by gnatname;" &
1262 " use gprname instead");
1268 and then Name_Buffer (Name_Len - 7 .. Name_Len) = "gnatname"
1270 Target := new String'(Name_Buffer
(1 .. Name_Len
- 9));
1271 Arg_Len
:= Arg_Len
+ 1;
1275 Args
: Argument_List
(1 .. Arg_Len
);
1277 if Target
/= null then
1278 Args
(1) := new String'("--target=" & Target.all);
1282 for J in 1 .. Argument_Count loop
1284 Args (Pos) := new String'(Argument
(J
));
1287 Spawn
(Gprname_Path
.all, Args
, Success
);
1290 Exit_Program
(E_Success
);
1292 Exit_Program
(E_Errors
);
1298 if Opt
.Verbose_Mode
then
1302 if Usage_Needed
then
1306 -- If no Ada or foreign pattern was specified, print the usage and return
1308 if Patterns
.Last
(Arguments
.Table
(Arguments
.Last
).Name_Patterns
) = 0
1310 Patterns
.Last
(Arguments
.Table
(Arguments
.Last
).Foreign_Patterns
) = 0
1312 if Argument_Count
= 0 then
1314 elsif not Usage_Output
then
1321 -- If no source directory was specified, use the current directory as the
1322 -- unique directory. Note that if a file was specified with directory
1323 -- information, the current directory is the directory of the specified
1326 if Patterns
.Last
(Arguments
.Table
(Arguments
.Last
).Directories
) = 0 then
1328 (Arguments
.Table
(Arguments
.Last
).Directories
, new String'("."));
1334 Prep_Switches : Argument_List
1335 (1 .. Integer (Preprocessor_Switches.Last));
1338 for Index in Prep_Switches'Range loop
1339 Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
1343 (File_Path => File_Path.all,
1344 Preproc_Switches => Prep_Switches);
1347 -- Process each section successively
1349 for J in 1 .. Arguments.Last loop
1351 Directories : Argument_List
1353 (Patterns.Last (Arguments.Table (J).Directories)));
1354 Name_Patterns : Regexp_List
1356 (Patterns.Last (Arguments.Table (J).Name_Patterns)));
1357 Excl_Patterns : Regexp_List
1359 (Patterns.Last (Arguments.Table (J).Excluded_Patterns)));
1360 Frgn_Patterns : Regexp_List
1362 (Patterns.Last (Arguments.Table (J).Foreign_Patterns)));
1365 -- Build the Directories and Patterns arguments
1367 for Index in Directories'Range loop
1368 Directories (Index) :=
1369 Arguments.Table (J).Directories.Table (Index);
1372 for Index in Name_Patterns'Range loop
1373 Name_Patterns (Index) :=
1375 (Arguments.Table (J).Name_Patterns.Table (Index).all,
1379 for Index in Excl_Patterns'Range loop
1380 Excl_Patterns (Index) :=
1382 (Arguments.Table (J).Excluded_Patterns.Table (Index).all,
1386 for Index in Frgn_Patterns'Range loop
1387 Frgn_Patterns (Index) :=
1389 (Arguments.Table (J).Foreign_Patterns.Table (Index).all,
1393 -- Call Prj.Makr.Process where the real work is done
1396 (Directories => Directories,
1397 Name_Patterns => Name_Patterns,
1398 Excluded_Patterns => Excl_Patterns,
1399 Foreign_Patterns => Frgn_Patterns);
1407 if Opt.Verbose_Mode then