1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2020, 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