1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2006, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
30 with MLib
.Tgt
; use MLib
.Tgt
;
32 with Namet
; use Namet
;
34 with Osint
; use Osint
;
38 with Prj
.Ext
; use Prj
.Ext
;
40 with Prj
.Util
; use Prj
.Util
;
42 with Snames
; use Snames
;
44 with Types
; use Types
;
45 with Hostparm
; use Hostparm
;
46 -- Used to determine if we are in VMS or not for error message purposes
48 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
49 with Ada
.Command_Line
; use Ada
.Command_Line
;
50 with Ada
.Text_IO
; use Ada
.Text_IO
;
52 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
54 with VMS_Conv
; use VMS_Conv
;
57 Project_Tree
: constant Project_Tree_Ref
:= new Project_Tree_Data
;
58 Project_File
: String_Access
;
59 Project
: Prj
.Project_Id
;
60 Current_Verbosity
: Prj
.Verbosity
:= Prj
.Default
;
61 Tool_Package_Name
: Name_Id
:= No_Name
;
63 Old_Project_File_Used
: Boolean := False;
64 -- This flag indicates a switch -p (for gnatxref and gnatfind) for
65 -- an old fashioned project file. -p cannot be used in conjonction
68 Max_Files_On_The_Command_Line
: constant := 30; -- Arbitrary
70 Temp_File_Name
: String_Access
:= null;
71 -- The name of the temporary text file to put a list of source/object
72 -- files to pass to a tool, when there are more than
73 -- Max_Files_On_The_Command_Line files.
75 package First_Switches
is new Table
.Table
76 (Table_Component_Type
=> String_Access
,
77 Table_Index_Type
=> Integer,
80 Table_Increment
=> 100,
81 Table_Name
=> "Gnatcmd.First_Switches");
82 -- A table to keep the switches from the project file
84 package Carg_Switches
is new Table
.Table
85 (Table_Component_Type
=> String_Access
,
86 Table_Index_Type
=> Integer,
89 Table_Increment
=> 100,
90 Table_Name
=> "Gnatcmd.Carg_Switches");
91 -- A table to keep the switches following -cargs for ASIS tools
93 package Rules_Switches
is new Table
.Table
94 (Table_Component_Type
=> String_Access
,
95 Table_Index_Type
=> Integer,
98 Table_Increment
=> 100,
99 Table_Name
=> "Gnatcmd.Rules_Switches");
100 -- A table to keep the switches following -rules for gnatcheck
102 package Library_Paths
is new Table
.Table
(
103 Table_Component_Type
=> String_Access
,
104 Table_Index_Type
=> Integer,
105 Table_Low_Bound
=> 1,
107 Table_Increment
=> 100,
108 Table_Name
=> "Make.Library_Path");
110 -- Packages of project files to pass to Prj.Pars.Parse, depending on the
111 -- tool. We allocate objects because we cannot declare aliased objects
112 -- as we are in a procedure, not a library level package.
114 Naming_String
: constant String_Access
:= new String'("naming");
115 Binder_String : constant String_Access := new String'("binder");
116 Compiler_String
: constant String_Access
:= new String'("compiler");
117 Check_String : constant String_Access := new String'("check");
118 Eliminate_String
: constant String_Access
:= new String'("eliminate");
119 Finder_String : constant String_Access := new String'("finder");
120 Linker_String
: constant String_Access
:= new String'("linker");
121 Gnatls_String : constant String_Access := new String'("gnatls");
122 Pretty_String
: constant String_Access
:= new String'("pretty_printer");
123 Gnatstub_String : constant String_Access := new String'("gnatstub");
124 Metric_String
: constant String_Access
:= new String'("metrics");
125 Xref_String : constant String_Access := new String'("cross_reference");
127 Packages_To_Check_By_Binder
: constant String_List_Access
:=
128 new String_List
'((Naming_String, Binder_String));
130 Packages_To_Check_By_Check : constant String_List_Access :=
131 new String_List'((Naming_String
, Check_String
, Compiler_String
));
133 Packages_To_Check_By_Eliminate
: constant String_List_Access
:=
134 new String_List
'((Naming_String, Eliminate_String, Compiler_String));
136 Packages_To_Check_By_Finder : constant String_List_Access :=
137 new String_List'((Naming_String
, Finder_String
));
139 Packages_To_Check_By_Linker
: constant String_List_Access
:=
140 new String_List
'((Naming_String, Linker_String));
142 Packages_To_Check_By_Gnatls : constant String_List_Access :=
143 new String_List'((Naming_String
, Gnatls_String
));
145 Packages_To_Check_By_Pretty
: constant String_List_Access
:=
146 new String_List
'((Naming_String, Pretty_String, Compiler_String));
148 Packages_To_Check_By_Gnatstub : constant String_List_Access :=
149 new String_List'((Naming_String
, Gnatstub_String
, Compiler_String
));
151 Packages_To_Check_By_Metric
: constant String_List_Access
:=
152 new String_List
'((Naming_String, Metric_String, Compiler_String));
154 Packages_To_Check_By_Xref : constant String_List_Access :=
155 new String_List'((Naming_String
, Xref_String
));
157 Packages_To_Check
: String_List_Access
:= Prj
.All_Packages
;
159 ----------------------------------
160 -- Declarations for GNATCMD use --
161 ----------------------------------
163 The_Command
: Command_Type
;
164 -- The command specified in the invocation of the GNAT driver
166 Command_Arg
: Positive := 1;
167 -- The index of the command in the arguments of the GNAT driver
169 My_Exit_Status
: Exit_Status
:= Success
;
170 -- The exit status of the spawned tool. Used to set the correct VMS
173 Current_Work_Dir
: constant String := Get_Current_Dir
;
174 -- The path of the working directory
176 All_Projects
: Boolean := False;
177 -- Flag used for GNAT PRETTY and GNAT METRIC to indicate that
178 -- the underlying tool (gnatcheck, gnatpp or gnatmetric) should be invoked
179 -- for all sources of all projects.
181 -----------------------
182 -- Local Subprograms --
183 -----------------------
185 procedure Add_To_Carg_Switches
(Switch
: String_Access
);
186 -- Add a switch to the Carg_Switches table. If it is the first one,
187 -- put the switch "-cargs" at the beginning of the table.
189 procedure Add_To_Rules_Switches
(Switch
: String_Access
);
190 -- Add a switch to the Rules_Switches table. If it is the first one,
191 -- put the switch "-crules" at the beginning of the table.
193 procedure Check_Files
;
194 -- For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project
195 -- file is specified, without any file arguments. If it is the case,
196 -- invoke the GNAT tool with the proper list of files, derived from
197 -- the sources of the project.
199 function Check_Project
200 (Project
: Project_Id
;
201 Root_Project
: Project_Id
) return Boolean;
202 -- Returns True if Project = Root_Project.
203 -- For GNAT METRIC, also returns True if Project is extended by
206 procedure Check_Relative_Executable
(Name
: in out String_Access
);
207 -- Check if an executable is specified as a relative path.
208 -- If it is, and the path contains directory information, fail.
209 -- Otherwise, prepend the exec directory.
210 -- This procedure is only used for GNAT LINK when a project file
213 function Configuration_Pragmas_File
return Name_Id
;
214 -- Return an argument, if there is a configuration pragmas file to be
215 -- specified for Project, otherwise return No_Name.
216 -- Used for gnatstub (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim
217 -- (GNAT ELIM), and gnatmetric (GNAT METRIC).
219 procedure Delete_Temp_Config_Files
;
220 -- Delete all temporary config files
222 function Index
(Char
: Character; Str
: String) return Natural;
223 -- Returns the first occurrence of Char in Str.
224 -- Returns 0 if Char is not in Str.
226 procedure Non_VMS_Usage
;
227 -- Display usage for platforms other than VMS
229 procedure Process_Link
;
230 -- Process GNAT LINK, when there is a project file specified
232 procedure Set_Library_For
233 (Project
: Project_Id
;
234 There_Are_Libraries
: in out Boolean);
235 -- If Project is a library project, add the correct
236 -- -L and -l switches to the linker invocation.
238 procedure Set_Libraries
is
239 new For_Every_Project_Imported
(Boolean, Set_Library_For
);
240 -- Add the -L and -l switches to the linker for all
241 -- of the library projects.
243 procedure Test_If_Relative_Path
244 (Switch
: in out String_Access
;
246 -- Test if Switch is a relative search path switch.
247 -- If it is and it includes directory information, prepend the path with
248 -- Parent.This subprogram is only called when using project files.
250 --------------------------
251 -- Add_To_Carg_Switches --
252 --------------------------
254 procedure Add_To_Carg_Switches
(Switch
: String_Access
) is
256 -- If the Carg_Switches table is empty, put "-cargs" at the beginning
258 if Carg_Switches
.Last
= 0 then
259 Carg_Switches
.Increment_Last
;
260 Carg_Switches
.Table
(Carg_Switches
.Last
) := new String'("-cargs");
263 Carg_Switches.Increment_Last;
264 Carg_Switches.Table (Carg_Switches.Last) := Switch;
265 end Add_To_Carg_Switches;
267 ---------------------------
268 -- Add_To_Rules_Switches --
269 ---------------------------
271 procedure Add_To_Rules_Switches (Switch : String_Access) is
273 -- If the Rules_Switches table is empty, put "-rules" at the beginning
275 if Rules_Switches.Last = 0 then
276 Rules_Switches.Increment_Last;
277 Rules_Switches.Table (Rules_Switches.Last) := new String'("-rules");
280 Rules_Switches
.Increment_Last
;
281 Rules_Switches
.Table
(Rules_Switches
.Last
) := Switch
;
282 end Add_To_Rules_Switches
;
288 procedure Check_Files
is
289 Add_Sources
: Boolean := True;
290 Unit_Data
: Prj
.Unit_Data
;
291 Subunit
: Boolean := False;
294 -- Check if there is at least one argument that is not a switch
296 for Index
in 1 .. Last_Switches
.Last
loop
297 if Last_Switches
.Table
(Index
) (1) /= '-' then
298 Add_Sources
:= False;
303 -- If all arguments were switches, add the path names of
304 -- all the sources of the main project.
308 Current_Last
: constant Integer := Last_Switches
.Last
;
310 for Unit
in Unit_Table
.First
..
311 Unit_Table
.Last
(Project_Tree
.Units
)
313 Unit_Data
:= Project_Tree
.Units
.Table
(Unit
);
315 -- For gnatls, we only need to put the library units,
316 -- body or spec, but not the subunits.
318 if The_Command
= List
then
320 Unit_Data
.File_Names
(Body_Part
).Name
/= No_Name
322 -- There is a body; check if it is for this
325 if Unit_Data
.File_Names
(Body_Part
).Project
=
330 if Unit_Data
.File_Names
(Specification
).Name
=
333 -- We have a body with no spec: we need
334 -- to check if this is a subunit, because
335 -- gnatls will complain about subunits.
338 Src_Ind
: Source_File_Index
;
341 Src_Ind
:= Sinput
.P
.Load_Project_File
343 (Unit_Data
.File_Names
347 Sinput
.P
.Source_File_Is_Subunit
353 Last_Switches
.Increment_Last
;
354 Last_Switches
.Table
(Last_Switches
.Last
) :=
357 (Unit_Data.File_Names
358 (Body_Part).Display_Name));
362 elsif Unit_Data.File_Names (Specification).Name /=
365 -- We have a spec with no body; check if it is
368 if Unit_Data.File_Names (Specification).Project =
371 Last_Switches.Increment_Last;
372 Last_Switches.Table (Last_Switches.Last) :=
375 (Unit_Data
.File_Names
376 (Specification
).Display_Name
));
381 -- For gnatcheck, gnatpp and gnatmetric, put all sources
382 -- of the project, or of all projects if -U was specified.
384 for Kind
in Spec_Or_Body
loop
386 -- Put only sources that belong to the main
390 (Unit_Data
.File_Names
(Kind
).Project
, Project
)
392 Last_Switches
.Increment_Last
;
393 Last_Switches
.Table
(Last_Switches
.Last
) :=
396 (Unit_Data.File_Names
397 (Kind).Display_Path));
403 -- If the list of files is too long, create a temporary
404 -- text file that lists these files, and pass this temp
405 -- file to gnatcheck, gnatpp or gnatmetric using switch -files=.
407 if Last_Switches.Last - Current_Last >
408 Max_Files_On_The_Command_Line
411 Temp_File_FD : File_Descriptor;
412 Buffer : String (1 .. 1_000);
414 OK : Boolean := True;
417 Create_Temp_File (Temp_File_FD, Temp_File_Name);
419 if Temp_File_Name /= null then
420 for Index in Current_Last + 1 ..
423 Len := Last_Switches.Table (Index)'Length;
425 Last_Switches.Table (Index).all;
427 Buffer (Len) := ASCII.LF;
428 Buffer (Len + 1) := ASCII.NUL;
437 Close (Temp_File_FD, OK);
439 Close (Temp_File_FD, OK);
443 -- If there were any problem creating the temp
444 -- file, then pass the list of files.
448 -- Replace the list of files with
449 -- "-files=<temp file name>".
451 Last_Switches.Set_Last (Current_Last + 1);
452 Last_Switches.Table (Last_Switches.Last) :=
453 new String'("-files=" & Temp_File_Name
.all);
466 function Check_Project
467 (Project
: Project_Id
;
468 Root_Project
: Project_Id
) return Boolean
471 if Project
= No_Project
then
474 elsif All_Projects
or Project
= Root_Project
then
477 elsif The_Command
= Metric
then
479 Data
: Project_Data
:=
480 Project_Tree
.Projects
.Table
(Root_Project
);
483 while Data
.Extends
/= No_Project
loop
484 if Project
= Data
.Extends
then
488 Data
:= Project_Tree
.Projects
.Table
(Data
.Extends
);
496 -------------------------------
497 -- Check_Relative_Executable --
498 -------------------------------
500 procedure Check_Relative_Executable
(Name
: in out String_Access
) is
501 Exec_File_Name
: constant String := Name
.all;
504 if not Is_Absolute_Path
(Exec_File_Name
) then
505 for Index
in Exec_File_Name
'Range loop
506 if Exec_File_Name
(Index
) = Directory_Separator
then
507 Fail
("relative executable (""" &
509 """) with directory part not allowed " &
510 "when using project files");
514 Get_Name_String
(Project_Tree
.Projects
.Table
515 (Project
).Exec_Directory
);
517 if Name_Buffer
(Name_Len
) /= Directory_Separator
then
518 Name_Len
:= Name_Len
+ 1;
519 Name_Buffer
(Name_Len
) := Directory_Separator
;
522 Name_Buffer
(Name_Len
+ 1 ..
523 Name_Len
+ Exec_File_Name
'Length) :=
525 Name_Len
:= Name_Len
+ Exec_File_Name
'Length;
526 Name
:= new String'(Name_Buffer (1 .. Name_Len));
528 end Check_Relative_Executable;
530 --------------------------------
531 -- Configuration_Pragmas_File --
532 --------------------------------
534 function Configuration_Pragmas_File return Name_Id is
536 Prj.Env.Create_Config_Pragmas_File
537 (Project, Project, Project_Tree, Include_Config_Files => False);
538 return Project_Tree.Projects.Table (Project).Config_File_Name;
539 end Configuration_Pragmas_File;
541 ------------------------------
542 -- Delete_Temp_Config_Files --
543 ------------------------------
545 procedure Delete_Temp_Config_Files is
549 if not Keep_Temporary_Files then
550 if Project /= No_Project then
551 for Prj in Project_Table.First ..
552 Project_Table.Last (Project_Tree.Projects)
555 Project_Tree.Projects.Table (Prj).Config_File_Temp
558 Output.Write_Str ("Deleting temp configuration file """);
561 (Project_Tree.Projects.Table
562 (Prj).Config_File_Name));
563 Output.Write_Line ("""");
567 (Name => Get_Name_String
568 (Project_Tree.Projects.Table
569 (Prj).Config_File_Name),
575 -- If a temporary text file that contains a list of files for a tool
576 -- has been created, delete this temporary file.
578 if Temp_File_Name /= null then
579 Delete_File (Temp_File_Name.all, Success);
582 end Delete_Temp_Config_Files;
588 function Index (Char : Character; Str : String) return Natural is
590 for Index in Str'Range loop
591 if Str (Index) = Char then
603 procedure Process_Link is
604 Look_For_Executable : Boolean := True;
605 There_Are_Libraries : Boolean := False;
606 Path_Option : constant String_Access :=
607 MLib.Linker_Library_Path_Option;
608 Prj : Project_Id := Project;
611 Skip_Executable : Boolean := False;
614 -- Add the default search directories, to be able to find
615 -- libgnat in call to MLib.Utl.Lib_Directory.
617 Add_Default_Search_Dirs;
619 Library_Paths.Set_Last (0);
621 -- Check if there are library project files
623 if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
624 Set_Libraries (Project, Project_Tree, There_Are_Libraries);
627 -- If there are, add the necessary additional switches
629 if There_Are_Libraries then
631 -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
633 Last_Switches.Increment_Last;
634 Last_Switches.Table (Last_Switches.Last) :=
635 new String'("-L" & MLib
.Utl
.Lib_Directory
);
636 Last_Switches
.Increment_Last
;
637 Last_Switches
.Table
(Last_Switches
.Last
) :=
638 new String'("-lgnarl");
639 Last_Switches.Increment_Last;
640 Last_Switches.Table (Last_Switches.Last) :=
641 new String'("-lgnat");
643 -- If Path_Option is not null, create the switch
644 -- ("-Wl,-rpath," or equivalent) with all the library dirs
645 -- plus the standard GNAT library dir.
647 if Path_Option
/= null then
649 Option
: String_Access
;
650 Length
: Natural := Path_Option
'Length;
654 -- First, compute the exact length for the switch
657 Library_Paths
.First
.. Library_Paths
.Last
659 -- Add the length of the library dir plus one
660 -- for the directory separator.
664 Library_Paths
.Table
(Index
)'Length + 1;
667 -- Finally, add the length of the standard GNAT
670 Length
:= Length
+ MLib
.Utl
.Lib_Directory
'Length;
671 Option
:= new String (1 .. Length
);
672 Option
(1 .. Path_Option
'Length) := Path_Option
.all;
673 Current
:= Path_Option
'Length;
675 -- Put each library dir followed by a dir separator
678 Library_Paths
.First
.. Library_Paths
.Last
683 Library_Paths
.Table
(Index
)'Length) :=
684 Library_Paths
.Table
(Index
).all;
687 Library_Paths
.Table
(Index
)'Length + 1;
688 Option
(Current
) := Path_Separator
;
691 -- Finally put the standard GNAT library dir
695 Current
+ MLib
.Utl
.Lib_Directory
'Length) :=
696 MLib
.Utl
.Lib_Directory
;
698 -- And add the switch to the last switches
700 Last_Switches
.Increment_Last
;
701 Last_Switches
.Table
(Last_Switches
.Last
) :=
707 -- Check if the first ALI file specified can be found, either
708 -- in the object directory of the main project or in an object
709 -- directory of a project file extended by the main project.
710 -- If the ALI file can be found, replace its name with its
713 Skip_Executable
:= False;
715 Switch_Loop
: for J
in 1 .. Last_Switches
.Last
loop
717 -- If we have an executable just reset the flag
719 if Skip_Executable
then
720 Skip_Executable
:= False;
722 -- If -o, set flag so that next switch is not processed
724 elsif Last_Switches
.Table
(J
).all = "-o" then
725 Skip_Executable
:= True;
731 Switch
: constant String :=
732 Last_Switches
.Table
(J
).all;
734 ALI_File
: constant String (1 .. Switch
'Length + 4) :=
737 Test_Existence
: Boolean := False;
740 Last
:= Switch
'Length;
742 -- Skip real switches
744 if Switch
'Length /= 0
745 and then Switch
(Switch
'First) /= '-'
747 -- Append ".ali" if file name does not end with it
749 if Switch
'Length <= 4
750 or else Switch
(Switch
'Last - 3 .. Switch
'Last)
753 Last
:= ALI_File
'Last;
756 -- If file name includes directory information,
757 -- stop if ALI file exists.
759 if Is_Absolute_Path
(ALI_File
(1 .. Last
)) then
760 Test_Existence
:= True;
763 for K
in Switch
'Range loop
764 if Switch
(K
) = '/' or else
765 Switch
(K
) = Directory_Separator
767 Test_Existence
:= True;
773 if Test_Existence
then
774 if Is_Regular_File
(ALI_File
(1 .. Last
)) then
778 -- Look in object directories if ALI file exists
783 Dir
: constant String :=
785 (Project_Tree
.Projects
.Table
786 (Prj
).Object_Directory
);
790 Directory_Separator
&
791 ALI_File
(1 .. Last
))
793 -- We have found the correct project, so we
794 -- replace the file with the absolute path.
796 Last_Switches
.Table
(J
) :=
798 (Dir & Directory_Separator &
799 ALI_File (1 .. Last));
807 -- Go to the project being extended,
811 Project_Tree.Projects.Table (Prj).Extends;
812 exit Project_Loop when Prj = No_Project;
813 end loop Project_Loop;
818 end loop Switch_Loop;
820 -- If a relative path output file has been specified, we add
821 -- the exec directory.
823 for J in reverse 1 .. Last_Switches.Last - 1 loop
824 if Last_Switches.Table (J).all = "-o" then
825 Check_Relative_Executable
826 (Name => Last_Switches.Table (J + 1));
827 Look_For_Executable := False;
832 if Look_For_Executable then
833 for J in reverse 1 .. First_Switches.Last - 1 loop
834 if First_Switches.Table (J).all = "-o" then
835 Look_For_Executable := False;
836 Check_Relative_Executable
837 (Name => First_Switches.Table (J + 1));
843 -- If no executable is specified, then find the name
844 -- of the first ALI file on the command line and issue
845 -- a -o switch with the absolute path of the executable
846 -- in the exec directory.
848 if Look_For_Executable then
849 for J in 1 .. Last_Switches.Last loop
850 Arg := Last_Switches.Table (J);
853 if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
855 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
857 Last := Arg'Last - 4;
859 elsif Is_Regular_File (Arg.all & ".ali") then
864 Last_Switches.Increment_Last;
865 Last_Switches.Table (Last_Switches.Last) :=
868 (Project_Tree
.Projects
.Table
869 (Project
).Exec_Directory
);
870 Last_Switches
.Increment_Last
;
871 Last_Switches
.Table
(Last_Switches
.Last
) :=
872 new String'(Name_Buffer (1 .. Name_Len) &
873 Directory_Separator &
875 (Base_Name (Arg (Arg'First .. Last))));
883 ---------------------
884 -- Set_Library_For --
885 ---------------------
887 procedure Set_Library_For
888 (Project : Project_Id;
889 There_Are_Libraries : in out Boolean)
891 Path_Option : constant String_Access :=
892 MLib.Linker_Library_Path_Option;
895 -- Case of library project
897 if Project_Tree.Projects.Table (Project).Library then
898 There_Are_Libraries := True;
902 Last_Switches.Increment_Last;
903 Last_Switches.Table (Last_Switches.Last) :=
906 (Project_Tree
.Projects
.Table
907 (Project
).Library_Dir
));
911 Last_Switches
.Increment_Last
;
912 Last_Switches
.Table
(Last_Switches
.Last
) :=
915 (Project_Tree.Projects.Table
916 (Project).Library_Name));
918 -- Add the directory to table Library_Paths, to be processed later
919 -- if library is not static and if Path_Option is not null.
921 if Project_Tree.Projects.Table (Project).Library_Kind /=
923 and then Path_Option /= null
925 Library_Paths.Increment_Last;
926 Library_Paths.Table (Library_Paths.Last) :=
927 new String'(Get_Name_String
928 (Project_Tree
.Projects
.Table
929 (Project
).Library_Dir
));
934 ---------------------------
935 -- Test_If_Relative_Path --
936 ---------------------------
938 procedure Test_If_Relative_Path
939 (Switch
: in out String_Access
;
943 if Switch
/= null then
946 Sw
: String (1 .. Switch
'Length);
947 Start
: Positive := 1;
954 and then (Sw
(2) = 'A' or else
965 and then (Sw
(2 .. 3) = "aL" or else
966 Sw
(2 .. 3) = "aO" or else
972 and then Sw
(2 .. 6) = "-RTS="
980 -- If the path is relative, test if it includes directory
981 -- information. If it does, prepend Parent to the path.
983 if not Is_Absolute_Path
(Sw
(Start
.. Sw
'Last)) then
984 for J
in Start
.. Sw
'Last loop
985 if Sw
(J
) = Directory_Separator
then
988 (Sw (1 .. Start - 1) &
990 Directory_Separator &
991 Sw (Start .. Sw'Last));
998 end Test_If_Relative_Path;
1004 procedure Non_VMS_Usage is
1008 Put_Line ("List of available commands");
1011 for C in Command_List'Range loop
1012 if not Command_List (C).VMS_Only then
1013 Put ("gnat " & To_Lower (Command_List (C).Cname.all));
1015 Put (Command_List (C).Unixcmd.all);
1018 Sws : Argument_List_Access renames Command_List (C).Unixsws;
1021 for J in Sws'Range loop
1033 Put_Line ("Commands find, list, metric, pretty, stub and xref accept " &
1034 "project file switches -vPx, -Pprj and -Xnam=val");
1038 -------------------------------------
1039 -- Start of processing for GNATCmd --
1040 -------------------------------------
1050 Prj.Initialize (Project_Tree);
1053 Last_Switches.Set_Last (0);
1055 First_Switches.Init;
1056 First_Switches.Set_Last (0);
1058 Carg_Switches.Set_Last (0);
1059 Rules_Switches.Init;
1060 Rules_Switches.Set_Last (0);
1062 VMS_Conv.Initialize;
1064 -- Add the directory where the GNAT driver is invoked in front of the
1065 -- path, if the GNAT driver is invoked with directory information.
1066 -- Only do this if the platform is not VMS, where the notion of path
1067 -- does not really exist.
1071 Command : constant String := Command_Name;
1074 for Index in reverse Command'Range loop
1075 if Command (Index) = Directory_Separator then
1077 Absolute_Dir : constant String :=
1079 (Command (Command'First .. Index));
1081 PATH : constant String :=
1084 Getenv ("PATH").all;
1087 Setenv ("PATH", PATH);
1096 -- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
1097 -- filenames and pathnames to Unix style.
1100 or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
1102 VMS_Conversion (The_Command);
1104 -- If not on VMS, scan the command line directly
1107 if Argument_Count = 0 then
1113 if Argument_Count > Command_Arg
1114 and then Argument (Command_Arg) = "-v"
1116 Verbose_Mode := True;
1117 Command_Arg := Command_Arg + 1;
1119 elsif Argument_Count > Command_Arg
1120 and then Argument (Command_Arg) = "-dn"
1122 Keep_Temporary_Files := True;
1123 Command_Arg := Command_Arg + 1;
1130 The_Command := Real_Command_Type'Value (Argument (Command_Arg));
1132 if Command_List (The_Command).VMS_Only then
1136 Command_List (The_Command).Cname.all,
1137 """ can only be used on VMS");
1141 when Constraint_Error =>
1143 -- Check if it is an alternate command
1146 Alternate : Alternate_Command;
1149 Alternate := Alternate_Command'Value
1150 (Argument (Command_Arg));
1151 The_Command := Corresponding_To (Alternate);
1154 when Constraint_Error =>
1156 Fail ("Unknown command: ", Argument (Command_Arg));
1160 -- Get the arguments from the command line and from the eventual
1161 -- argument file(s) specified on the command line.
1163 for Arg in Command_Arg + 1 .. Argument_Count loop
1165 The_Arg : constant String := Argument (Arg);
1168 -- Check if an argument file is specified
1170 if The_Arg (The_Arg'First) = '@
' then
1172 Arg_File : Ada.Text_IO.File_Type;
1173 Line : String (1 .. 256);
1177 -- Open the file and fail if the file cannot be found
1182 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1187 (Standard_Error, "Cannot open argument file """);
1190 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1192 Put_Line (Standard_Error, """");
1196 -- Read line by line and put the content of each
1197 -- non empty line in the Last_Switches table.
1199 while not End_Of_File (Arg_File) loop
1200 Get_Line (Arg_File, Line, Last);
1203 Last_Switches.Increment_Last;
1204 Last_Switches.Table (Last_Switches.Last) :=
1205 new String'(Line
(1 .. Last
));
1213 -- It is not an argument file; just put the argument in
1214 -- the Last_Switches table.
1216 Last_Switches
.Increment_Last
;
1217 Last_Switches
.Table
(Last_Switches
.Last
) :=
1218 new String'(The_Arg);
1226 Program : constant String :=
1227 Program_Name (Command_List (The_Command).Unixcmd.all).all;
1229 Exec_Path : String_Access;
1232 -- First deal with built-in command(s)
1234 if The_Command = Setup then
1237 Arg_Num : Positive := 1;
1238 Argv : String_Access;
1241 while Arg_Num <= Last_Switches.Last loop
1242 Argv := Last_Switches.Table (Arg_Num);
1244 if Argv (Argv'First) /= '-' then
1245 Fail ("invalid parameter """, Argv.all, """");
1248 if Argv'Length = 1 then
1250 ("switch character cannot be followed by a blank");
1253 -- -vPx Specify verbosity while parsing project files
1256 and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1258 case Argv (Argv'Last) is
1260 Current_Verbosity := Prj.Default;
1262 Current_Verbosity := Prj.Medium;
1264 Current_Verbosity := Prj.High;
1266 Fail ("Invalid switch: ", Argv.all);
1269 -- -Pproject_file Specify project file to be used
1271 elsif Argv (Argv'First + 1) = 'P
' then
1273 -- Only one -P switch can be used
1275 if Project_File /= null then
1278 ": second project file forbidden (first is """,
1279 Project_File.all & """)");
1281 elsif Argv'Length = 2 then
1283 -- There is space between -P and the project file
1284 -- name. -P cannot be the last option.
1286 if Arg_Num = Last_Switches.Last then
1287 Fail ("project file name missing after -P");
1290 Arg_Num := Arg_Num + 1;
1291 Argv := Last_Switches.Table (Arg_Num);
1293 -- After -P, there must be a project file name,
1294 -- not another switch.
1296 if Argv (Argv'First) = '-' then
1297 Fail ("project file name missing after -P");
1300 Project_File := new String'(Argv
.all);
1305 -- No space between -P and project file name
1308 new String'(Argv (Argv'First + 2 .. Argv'Last));
1311 -- -Xexternal=value Specify an external reference to be
1312 -- used in project files
1314 elsif Argv'Length >= 5
1315 and then Argv (Argv'First + 1) = 'X
'
1318 Equal_Pos : constant Natural :=
1319 Index ('=', Argv (Argv'First + 2 .. Argv'Last));
1321 if Equal_Pos >= Argv'First + 3 and then
1322 Equal_Pos /= Argv'Last then
1325 Argv (Argv'First + 2 .. Equal_Pos - 1),
1326 Value => Argv (Equal_Pos + 1 .. Argv'Last));
1330 " is not a valid external assignment.");
1334 elsif Argv.all = "-v" then
1335 Verbose_Mode := True;
1337 elsif Argv.all = "-q" then
1338 Quiet_Output := True;
1341 Fail ("invalid parameter """, Argv.all, """");
1345 Arg_Num := Arg_Num + 1;
1348 if Project_File = null then
1349 Fail ("no project file specified");
1352 Setup_Projects := True;
1354 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1356 -- Missing directories are created during processing of the
1360 (Project => Project,
1361 In_Tree => Project_Tree,
1362 Project_File_Name => Project_File.all,
1363 Packages_To_Check => All_Packages);
1365 if Project = Prj.No_Project then
1366 Fail ("""", Project_File.all, """ processing failed");
1369 -- Processing is done
1375 -- Locate the executable for the command
1377 Exec_Path := Locate_Exec_On_Path (Program);
1379 if Exec_Path = null then
1380 Put_Line (Standard_Error, "could not locate " & Program);
1384 -- If there are switches for the executable, put them as first switches
1386 if Command_List (The_Command).Unixsws /= null then
1387 for J in Command_List (The_Command).Unixsws'Range loop
1388 First_Switches.Increment_Last;
1389 First_Switches.Table (First_Switches.Last) :=
1390 Command_List (The_Command).Unixsws (J);
1394 -- For BIND, CHECK, FIND, LINK, LIST, PRETTY ad XREF, look for project
1395 -- file related switches.
1397 if The_Command = Bind
1398 or else The_Command = Check
1399 or else The_Command = Elim
1400 or else The_Command = Find
1401 or else The_Command = Link
1402 or else The_Command = List
1403 or else The_Command = Xref
1404 or else The_Command = Pretty
1405 or else The_Command = Stub
1406 or else The_Command = Metric
1410 Tool_Package_Name := Name_Binder;
1411 Packages_To_Check := Packages_To_Check_By_Binder;
1413 Tool_Package_Name := Name_Check;
1414 Packages_To_Check := Packages_To_Check_By_Check;
1416 Tool_Package_Name := Name_Eliminate;
1417 Packages_To_Check := Packages_To_Check_By_Eliminate;
1419 Tool_Package_Name := Name_Finder;
1420 Packages_To_Check := Packages_To_Check_By_Finder;
1422 Tool_Package_Name := Name_Linker;
1423 Packages_To_Check := Packages_To_Check_By_Linker;
1425 Tool_Package_Name := Name_Gnatls;
1426 Packages_To_Check := Packages_To_Check_By_Gnatls;
1428 Tool_Package_Name := Name_Metrics;
1429 Packages_To_Check := Packages_To_Check_By_Metric;
1431 Tool_Package_Name := Name_Pretty_Printer;
1432 Packages_To_Check := Packages_To_Check_By_Pretty;
1434 Tool_Package_Name := Name_Gnatstub;
1435 Packages_To_Check := Packages_To_Check_By_Gnatstub;
1437 Tool_Package_Name := Name_Cross_Reference;
1438 Packages_To_Check := Packages_To_Check_By_Xref;
1443 -- Check that the switches are consistent.
1444 -- Detect project file related switches.
1448 Arg_Num : Positive := 1;
1449 Argv : String_Access;
1451 procedure Remove_Switch (Num : Positive);
1452 -- Remove a project related switch from table Last_Switches
1458 procedure Remove_Switch (Num : Positive) is
1460 Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1461 Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1462 Last_Switches.Decrement_Last;
1465 -- Start of processing for Inspect_Switches
1468 while Arg_Num <= Last_Switches.Last loop
1469 Argv := Last_Switches.Table (Arg_Num);
1471 if Argv (Argv'First) = '-' then
1472 if Argv'Length = 1 then
1474 ("switch character cannot be followed by a blank");
1477 -- The two style project files (-p and -P) cannot be used
1480 if (The_Command = Find or else The_Command = Xref)
1481 and then Argv (2) = 'p
'
1483 Old_Project_File_Used := True;
1484 if Project_File /= null then
1485 Fail ("-P and -p cannot be used together");
1489 -- -vPx Specify verbosity while parsing project files
1492 and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1494 case Argv (Argv'Last) is
1496 Current_Verbosity := Prj.Default;
1498 Current_Verbosity := Prj.Medium;
1500 Current_Verbosity := Prj.High;
1502 Fail ("Invalid switch: ", Argv.all);
1505 Remove_Switch (Arg_Num);
1507 -- -Pproject_file Specify project file to be used
1509 elsif Argv (Argv'First + 1) = 'P
' then
1511 -- Only one -P switch can be used
1513 if Project_File /= null then
1516 ": second project file forbidden (first is """,
1517 Project_File.all & """)");
1519 -- The two style project files (-p and -P) cannot be
1522 elsif Old_Project_File_Used then
1523 Fail ("-p and -P cannot be used together");
1525 elsif Argv'Length = 2 then
1527 -- There is space between -P and the project file
1528 -- name. -P cannot be the last option.
1530 if Arg_Num = Last_Switches.Last then
1531 Fail ("project file name missing after -P");
1534 Remove_Switch (Arg_Num);
1535 Argv := Last_Switches.Table (Arg_Num);
1537 -- After -P, there must be a project file name,
1538 -- not another switch.
1540 if Argv (Argv'First) = '-' then
1541 Fail ("project file name missing after -P");
1544 Project_File := new String'(Argv
.all);
1549 -- No space between -P and project file name
1552 new String'(Argv (Argv'First + 2 .. Argv'Last));
1555 Remove_Switch (Arg_Num);
1557 -- -Xexternal=value Specify an external reference to be
1558 -- used in project files
1560 elsif Argv'Length >= 5
1561 and then Argv (Argv'First + 1) = 'X
'
1564 Equal_Pos : constant Natural :=
1565 Index ('=', Argv (Argv'First + 2 .. Argv'Last));
1567 if Equal_Pos >= Argv'First + 3 and then
1568 Equal_Pos /= Argv'Last then
1569 Add (External_Name =>
1570 Argv (Argv'First + 2 .. Equal_Pos - 1),
1571 Value => Argv (Equal_Pos + 1 .. Argv'Last));
1575 " is not a valid external assignment.");
1579 Remove_Switch (Arg_Num);
1582 (The_Command = Check or else
1583 The_Command = Pretty or else
1584 The_Command = Metric)
1585 and then Argv'Length = 2
1586 and then Argv (2) = 'U
'
1588 All_Projects := True;
1589 Remove_Switch (Arg_Num);
1592 Arg_Num := Arg_Num + 1;
1596 Arg_Num := Arg_Num + 1;
1599 end Inspect_Switches;
1602 -- If there is a project file specified, parse it, get the switches
1603 -- for the tool and setup PATH environment variables.
1605 if Project_File /= null then
1606 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1609 (Project => Project,
1610 In_Tree => Project_Tree,
1611 Project_File_Name => Project_File.all,
1612 Packages_To_Check => Packages_To_Check);
1614 if Project = Prj.No_Project then
1615 Fail ("""", Project_File.all, """ processing failed");
1618 -- Check if a package with the name of the tool is in the project
1619 -- file and if there is one, get the switches, if any, and scan them.
1622 Data : constant Prj.Project_Data :=
1623 Project_Tree.Projects.Table (Project);
1625 Pkg : constant Prj.Package_Id :=
1627 (Name => Tool_Package_Name,
1628 In_Packages => Data.Decl.Packages,
1629 In_Tree => Project_Tree);
1631 Element : Package_Element;
1633 Default_Switches_Array : Array_Element_Id;
1635 The_Switches : Prj.Variable_Value;
1636 Current : Prj.String_List_Id;
1637 The_String : String_Element;
1640 if Pkg /= No_Package then
1641 Element := Project_Tree.Packages.Table (Pkg);
1643 -- Packages Gnatls has a single attribute Switches, that is
1644 -- not an associative array.
1646 if The_Command = List then
1649 (Variable_Name => Snames.Name_Switches,
1650 In_Variables => Element.Decl.Attributes,
1651 In_Tree => Project_Tree);
1653 -- Packages Binder (for gnatbind), Cross_Reference (for
1654 -- gnatxref), Linker (for gnatlink) Finder (for gnatfind),
1655 -- Pretty_Printer (for gnatpp) Eliminate (for gnatelim),
1656 -- Check (for gnatcheck) and Metric (for gnatmetric) have
1657 -- an attributed Switches, an associative array, indexed
1658 -- by the name of the file.
1660 -- They also have an attribute Default_Switches, indexed
1661 -- by the name of the programming language.
1664 if The_Switches.Kind = Prj.Undefined then
1665 Default_Switches_Array :=
1667 (Name => Name_Default_Switches,
1668 In_Arrays => Element.Decl.Arrays,
1669 In_Tree => Project_Tree);
1670 The_Switches := Prj.Util.Value_Of
1673 In_Array => Default_Switches_Array,
1674 In_Tree => Project_Tree);
1678 -- If there are switches specified in the package of the
1679 -- project file corresponding to the tool, scan them.
1681 case The_Switches.Kind is
1682 when Prj.Undefined =>
1687 Switch : constant String :=
1688 Get_Name_String (The_Switches.Value);
1691 if Switch'Length > 0 then
1692 First_Switches.Increment_Last;
1693 First_Switches.Table (First_Switches.Last) :=
1694 new String'(Switch
);
1699 Current
:= The_Switches
.Values
;
1700 while Current
/= Prj
.Nil_String
loop
1701 The_String
:= Project_Tree
.String_Elements
.
1705 Switch
: constant String :=
1706 Get_Name_String
(The_String
.Value
);
1709 if Switch
'Length > 0 then
1710 First_Switches
.Increment_Last
;
1711 First_Switches
.Table
(First_Switches
.Last
) :=
1712 new String'(Switch);
1716 Current := The_String.Next;
1722 if The_Command = Bind
1723 or else The_Command = Link
1724 or else The_Command = Elim
1728 (Project_Tree.Projects.Table
1729 (Project).Object_Directory));
1732 -- Set up the env vars for project path files
1734 Prj.Env.Set_Ada_Paths
1735 (Project, Project_Tree, Including_Libraries => False);
1737 -- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1738 -- a configuration pragmas file, if necessary.
1740 if The_Command = Pretty
1741 or else The_Command = Metric
1742 or else The_Command = Stub
1743 or else The_Command = Elim
1744 or else The_Command = Check
1746 -- If there are switches in package Compiler, put them in the
1747 -- Carg_Switches table.
1750 Data : constant Prj.Project_Data :=
1751 Project_Tree.Projects.Table (Project);
1753 Pkg : constant Prj.Package_Id :=
1755 (Name => Name_Compiler,
1756 In_Packages => Data.Decl.Packages,
1757 In_Tree => Project_Tree);
1759 Element : Package_Element;
1761 Default_Switches_Array : Array_Element_Id;
1763 The_Switches : Prj.Variable_Value;
1764 Current : Prj.String_List_Id;
1765 The_String : String_Element;
1768 if Pkg /= No_Package then
1769 Element := Project_Tree.Packages.Table (Pkg);
1771 Default_Switches_Array :=
1773 (Name => Name_Default_Switches,
1774 In_Arrays => Element.Decl.Arrays,
1775 In_Tree => Project_Tree);
1776 The_Switches := Prj.Util.Value_Of
1779 In_Array => Default_Switches_Array,
1780 In_Tree => Project_Tree);
1782 -- If there are switches specified in the package of the
1783 -- project file corresponding to the tool, scan them.
1785 case The_Switches.Kind is
1786 when Prj.Undefined =>
1791 Switch : constant String :=
1792 Get_Name_String (The_Switches.Value);
1795 if Switch'Length > 0 then
1796 Add_To_Carg_Switches (new String'(Switch
));
1801 Current
:= The_Switches
.Values
;
1802 while Current
/= Prj
.Nil_String
loop
1804 Project_Tree
.String_Elements
.Table
(Current
);
1807 Switch
: constant String :=
1808 Get_Name_String
(The_String
.Value
);
1810 if Switch
'Length > 0 then
1811 Add_To_Carg_Switches
(new String'(Switch));
1815 Current := The_String.Next;
1821 -- If -cargs is one of the switches, move the following switches
1822 -- to the Carg_Switches table.
1824 for J in 1 .. First_Switches.Last loop
1825 if First_Switches.Table (J).all = "-cargs" then
1826 for K in J + 1 .. First_Switches.Last loop
1827 Add_To_Carg_Switches (First_Switches.Table (K));
1829 First_Switches.Set_Last (J - 1);
1834 for J in 1 .. Last_Switches.Last loop
1835 if Last_Switches.Table (J).all = "-cargs" then
1836 for K in J + 1 .. Last_Switches.Last loop
1837 Add_To_Carg_Switches (Last_Switches.Table (K));
1839 Last_Switches.Set_Last (J - 1);
1845 CP_File : constant Name_Id := Configuration_Pragmas_File;
1848 if CP_File /= No_Name then
1849 if The_Command = Elim then
1850 First_Switches.Increment_Last;
1851 First_Switches.Table (First_Switches.Last) :=
1852 new String'("-C" & Get_Name_String
(CP_File
));
1855 Add_To_Carg_Switches
1856 (new String'("-gnatec=" & Get_Name_String (CP_File)));
1862 if The_Command = Link then
1866 if The_Command = Link or The_Command = Bind then
1868 -- For files that are specified as relative paths with directory
1869 -- information, we convert them to absolute paths, with parent
1870 -- being the current working directory if specified on the command
1871 -- line and the project directory if specified in the project
1872 -- file. This is what gnatmake is doing for linker and binder
1875 for J in 1 .. Last_Switches.Last loop
1876 Test_If_Relative_Path
1877 (Last_Switches.Table (J), Current_Work_Dir);
1881 (Project_Tree.Projects.Table (Project).Directory);
1884 Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
1886 for J in 1 .. First_Switches.Last loop
1887 Test_If_Relative_Path
1888 (First_Switches.Table (J), Project_Dir);
1892 elsif The_Command = Stub then
1894 Data : constant Prj.Project_Data :=
1895 Project_Tree.Projects.Table (Project);
1896 File_Index : Integer := 0;
1897 Dir_Index : Integer := 0;
1898 Last : constant Integer := Last_Switches.Last;
1901 for Index in 1 .. Last loop
1902 if Last_Switches.Table (Index)
1903 (Last_Switches.Table (Index)'First) /= '-'
1905 File_Index := Index;
1910 -- If the naming scheme of the project file is not standard,
1911 -- and if the file name ends with the spec suffix, then
1912 -- indicate to gnatstub the name of the body file with
1915 if Data.Naming.Ada_Spec_Suffix /=
1916 Prj.Default_Ada_Spec_Suffix
1918 if File_Index /= 0 then
1920 Spec : constant String :=
1921 Base_Name (Last_Switches.Table (File_Index).all);
1922 Last : Natural := Spec'Last;
1925 Get_Name_String (Data.Naming.Ada_Spec_Suffix);
1927 if Spec'Length > Name_Len
1928 and then Spec (Last - Name_Len + 1 .. Last) =
1929 Name_Buffer (1 .. Name_Len)
1931 Last := Last - Name_Len;
1932 Get_Name_String (Data.Naming.Ada_Body_Suffix);
1933 Last_Switches.Increment_Last;
1934 Last_Switches.Table (Last_Switches.Last) :=
1936 Last_Switches
.Increment_Last
;
1937 Last_Switches
.Table
(Last_Switches
.Last
) :=
1938 new String'(Spec (Spec'First .. Last) &
1939 Name_Buffer (1 .. Name_Len));
1945 -- Add the directory of the spec as the destination directory
1946 -- of the body, if there is no destination directory already
1949 if File_Index /= 0 then
1950 for Index in File_Index + 1 .. Last loop
1951 if Last_Switches.Table (Index)
1952 (Last_Switches.Table (Index)'First) /= '-'
1959 if Dir_Index = 0 then
1960 Last_Switches.Increment_Last;
1961 Last_Switches.Table (Last_Switches.Last) :=
1963 (Dir_Name
(Last_Switches
.Table
(File_Index
).all));
1969 -- For gnatmetric, the generated files should be put in the object
1970 -- directory. This must be the first switch, because it may be
1971 -- overriden by a switch in package Metrics in the project file or by
1972 -- a command line option.
1974 if The_Command
= Metric
then
1975 First_Switches
.Increment_Last
;
1976 First_Switches
.Table
(2 .. First_Switches
.Last
) :=
1977 First_Switches
.Table
(1 .. First_Switches
.Last
- 1);
1978 First_Switches
.Table
(1) :=
1981 (Project_Tree.Projects.Table
1982 (Project).Object_Directory));
1985 -- For gnat check, -rules and the following switches need to be the
1986 -- last options. So, we move all these switches to table
1989 if The_Command = Check then
1992 -- Set to rank of options preceding "-rules"
1994 In_Rules_Switches : Boolean;
1995 -- Set to True when options "-rules" is found
1998 New_Last := First_Switches.Last;
1999 In_Rules_Switches := False;
2001 for J in 1 .. First_Switches.Last loop
2002 if In_Rules_Switches then
2003 Add_To_Rules_Switches (First_Switches.Table (J));
2005 elsif First_Switches.Table (J).all = "-rules" then
2007 In_Rules_Switches := True;
2011 if In_Rules_Switches then
2012 First_Switches.Set_Last (New_Last);
2015 New_Last := Last_Switches.Last;
2016 In_Rules_Switches := False;
2018 for J in 1 .. Last_Switches.Last loop
2019 if In_Rules_Switches then
2020 Add_To_Rules_Switches (Last_Switches.Table (J));
2022 elsif Last_Switches.Table (J).all = "-rules" then
2024 In_Rules_Switches := True;
2028 if In_Rules_Switches then
2029 Last_Switches.Set_Last (New_Last);
2034 -- For gnat check, gnat pretty, gnat metric ands gnat list,
2035 -- if no file has been put on the command line, call tool with all
2036 -- the sources of the main project.
2038 if The_Command = Check or else
2039 The_Command = Pretty or else
2040 The_Command = Metric or else
2047 -- Gather all the arguments and invoke the executable
2050 The_Args : Argument_List
2051 (1 .. First_Switches.Last +
2052 Last_Switches.Last +
2053 Carg_Switches.Last +
2054 Rules_Switches.Last);
2055 Arg_Num : Natural := 0;
2058 for J in 1 .. First_Switches.Last loop
2059 Arg_Num := Arg_Num + 1;
2060 The_Args (Arg_Num) := First_Switches.Table (J);
2063 for J in 1 .. Last_Switches.Last loop
2064 Arg_Num := Arg_Num + 1;
2065 The_Args (Arg_Num) := Last_Switches.Table (J);
2068 for J in 1 .. Carg_Switches.Last loop
2069 Arg_Num := Arg_Num + 1;
2070 The_Args (Arg_Num) := Carg_Switches.Table (J);
2073 for J in 1 .. Rules_Switches.Last loop
2074 Arg_Num := Arg_Num + 1;
2075 The_Args (Arg_Num) := Rules_Switches.Table (J);
2078 -- If Display_Command is on, only display the generated command
2080 if Display_Command then
2081 Put (Standard_Error, "generated command -->");
2082 Put (Standard_Error, Exec_Path.all);
2084 for Arg in The_Args'Range loop
2085 Put (Standard_Error, " ");
2086 Put (Standard_Error, The_Args (Arg).all);
2089 Put (Standard_Error, "<--");
2090 New_Line (Standard_Error);
2094 if Verbose_Mode then
2095 Output.Write_Str (Exec_Path.all);
2097 for Arg in The_Args'Range loop
2098 Output.Write_Char (' ');
2099 Output.Write_Str (The_Args (Arg).all);
2106 Exit_Status (Spawn (Exec_Path.all, The_Args));
2113 Prj.Env.Delete_All_Path_Files (Project_Tree);
2114 Delete_Temp_Config_Files;
2115 Set_Exit_Status (Failure);
2118 Prj.Env.Delete_All_Path_Files (Project_Tree);
2119 Delete_Temp_Config_Files;
2121 -- Since GNATCmd is normally called from DCL (the VMS shell), it must
2122 -- return an understandable VMS exit status. However the exit status
2123 -- returned *to* GNATCmd is a Posix style code, so we test it and return
2124 -- just a simple success or failure on VMS.
2126 if Hostparm.OpenVMS and then My_Exit_Status /= Success then
2127 Set_Exit_Status (Failure);
2129 Set_Exit_Status (My_Exit_Status);