1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2015, 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 GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
30 with Makeutl
; use Makeutl
;
31 with MLib
.Tgt
; use MLib
.Tgt
;
33 with Namet
; use Namet
;
35 with Osint
; use Osint
;
36 with Output
; use Output
;
39 with Prj
.Ext
; use Prj
.Ext
;
41 with Prj
.Tree
; use Prj
.Tree
;
42 with Prj
.Util
; use Prj
.Util
;
45 with Snames
; use Snames
;
47 with Switch
; use Switch
;
49 with Targparm
; use Targparm
;
51 with Types
; use Types
;
53 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
54 with Ada
.Command_Line
; use Ada
.Command_Line
;
55 with Ada
.Text_IO
; use Ada
.Text_IO
;
57 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
60 Gprbuild
: constant String := "gprbuild";
61 Gprclean
: constant String := "gprclean";
62 Gprname
: constant String := "gprname";
64 Normal_Exit
: exception;
65 -- Raise this exception for normal program termination
67 Error_Exit
: exception;
68 -- Raise this exception if error detected
92 subtype Real_Command_Type
is Command_Type
range Bind
.. Xref
;
93 -- All real command types (excludes only Undefined).
95 type Alternate_Command
is (Comp
, Ls
, Kr
, Pp
, Prep
);
96 -- Alternate command label
98 Corresponding_To
: constant array (Alternate_Command
) of Command_Type
:=
104 -- Mapping of alternate commands to commands
106 Project_Node_Tree
: Project_Node_Tree_Ref
;
107 Project_File
: String_Access
;
108 Project
: Prj
.Project_Id
;
109 Current_Verbosity
: Prj
.Verbosity
:= Prj
.Default
;
110 Tool_Package_Name
: Name_Id
:= No_Name
;
112 Project_Tree
: constant Project_Tree_Ref
:=
113 new Project_Tree_Data
(Is_Root_Tree
=> True);
116 Old_Project_File_Used
: Boolean := False;
117 -- This flag indicates a switch -p (for gnatxref and gnatfind) for
118 -- an old fashioned project file. -p cannot be used in conjunction
121 Temp_File_Name
: Path_Name_Type
:= No_Path
;
122 -- The name of the temporary text file to put a list of source/object
123 -- files to pass to a tool.
125 package First_Switches
is new Table
.Table
126 (Table_Component_Type
=> String_Access
,
127 Table_Index_Type
=> Integer,
128 Table_Low_Bound
=> 1,
130 Table_Increment
=> 100,
131 Table_Name
=> "Gnatcmd.First_Switches");
132 -- A table to keep the switches from the project file
134 package Carg_Switches
is new Table
.Table
135 (Table_Component_Type
=> String_Access
,
136 Table_Index_Type
=> Integer,
137 Table_Low_Bound
=> 1,
139 Table_Increment
=> 100,
140 Table_Name
=> "Gnatcmd.Carg_Switches");
141 -- A table to keep the switches following -cargs for ASIS tools
143 package Rules_Switches
is new Table
.Table
144 (Table_Component_Type
=> String_Access
,
145 Table_Index_Type
=> Integer,
146 Table_Low_Bound
=> 1,
148 Table_Increment
=> 100,
149 Table_Name
=> "Gnatcmd.Rules_Switches");
150 -- A table to keep the switches following -rules for gnatcheck
152 package Library_Paths
is new Table
.Table
(
153 Table_Component_Type
=> String_Access
,
154 Table_Index_Type
=> Integer,
155 Table_Low_Bound
=> 1,
157 Table_Increment
=> 100,
158 Table_Name
=> "Make.Library_Path");
160 package Last_Switches
is new Table
.Table
161 (Table_Component_Type
=> String_Access
,
162 Table_Index_Type
=> Integer,
163 Table_Low_Bound
=> 1,
165 Table_Increment
=> 100,
166 Table_Name
=> "Gnatcmd.Last_Switches");
168 -- Packages of project files to pass to Prj.Pars.Parse, depending on the
169 -- tool. We allocate objects because we cannot declare aliased objects
170 -- as we are in a procedure, not a library level package.
172 subtype SA
is String_Access
;
174 Naming_String
: constant SA
:= new String'("naming");
175 Binder_String : constant SA := new String'("binder");
176 Finder_String
: constant SA
:= new String'("finder");
177 Linker_String : constant SA := new String'("linker");
178 Gnatls_String
: constant SA
:= new String'("gnatls");
179 Xref_String : constant SA := new String'("cross_reference");
181 Packages_To_Check_By_Binder
: constant String_List_Access
:=
182 new String_List
'((Naming_String, Binder_String));
184 Packages_To_Check_By_Finder : constant String_List_Access :=
185 new String_List'((Naming_String
, Finder_String
));
187 Packages_To_Check_By_Linker
: constant String_List_Access
:=
188 new String_List
'((Naming_String, Linker_String));
190 Packages_To_Check_By_Gnatls : constant String_List_Access :=
191 new String_List'((Naming_String
, Gnatls_String
));
193 Packages_To_Check_By_Xref
: constant String_List_Access
:=
194 new String_List
'((Naming_String, Xref_String));
196 Packages_To_Check : String_List_Access := Prj.All_Packages;
198 ----------------------------------
199 -- Declarations for GNATCMD use --
200 ----------------------------------
202 The_Command : Command_Type;
203 -- The command specified in the invocation of the GNAT driver
205 Command_Arg : Positive := 1;
206 -- The index of the command in the arguments of the GNAT driver
208 My_Exit_Status : Exit_Status := Success;
209 -- The exit status of the spawned tool
211 Current_Work_Dir : constant String := Get_Current_Dir;
212 -- The path of the working directory
214 All_Projects : Boolean := False;
215 -- Flag used for GNAT CHECK, GNAT PRETTY and GNAT METRIC to indicate that
216 -- the underlying tool (gnatcheck, gnatpp or gnatmetric) should be invoked
217 -- for all sources of all projects.
219 type Command_Entry is record
220 Cname : String_Access;
221 -- Command name for GNAT xxx command
223 Unixcmd : String_Access;
224 -- Corresponding Unix command
226 Unixsws : Argument_List_Access;
227 -- List of switches to be used with the Unix command
230 Command_List : constant array (Real_Command_Type) of Command_Entry :=
232 (Cname => new String'("BIND"),
233 Unixcmd
=> new String'("gnatbind"),
237 (Cname => new String'("CHOP"),
238 Unixcmd
=> new String'("gnatchop"),
242 (Cname => new String'("CLEAN"),
243 Unixcmd
=> new String'("gnatclean"),
247 (Cname => new String'("COMPILE"),
248 Unixcmd
=> new String'("gnatmake"),
249 Unixsws => new Argument_List'(1 => new String'("-f"),
250 2 => new String'("-u"),
251 3 => new String'("-c"))),
254 (Cname => new String'("CHECK"),
255 Unixcmd
=> new String'("gnatcheck"),
259 (Cname => new String'("ELIM"),
260 Unixcmd
=> new String'("gnatelim"),
264 (Cname => new String'("FIND"),
265 Unixcmd
=> new String'("gnatfind"),
269 (Cname => new String'("KRUNCH"),
270 Unixcmd
=> new String'("gnatkr"),
274 (Cname => new String'("LINK"),
275 Unixcmd
=> new String'("gnatlink"),
279 (Cname => new String'("LIST"),
280 Unixcmd
=> new String'("gnatls"),
284 (Cname => new String'("MAKE"),
285 Unixcmd
=> new String'("gnatmake"),
289 (Cname => new String'("METRIC"),
290 Unixcmd
=> new String'("gnatmetric"),
294 (Cname => new String'("NAME"),
295 Unixcmd
=> new String'("gnatname"),
299 (Cname => new String'("PREPROCESS"),
300 Unixcmd
=> new String'("gnatprep"),
304 (Cname => new String'("PRETTY"),
305 Unixcmd
=> new String'("gnatpp"),
309 (Cname => new String'("STACK"),
310 Unixcmd
=> new String'("gnatstack"),
314 (Cname => new String'("STUB"),
315 Unixcmd
=> new String'("gnatstub"),
319 (Cname => new String'("TEST"),
320 Unixcmd
=> new String'("gnattest"),
324 (Cname => new String'("XREF"),
325 Unixcmd
=> new String'("gnatxref"),
329 -----------------------
330 -- Local Subprograms --
331 -----------------------
333 procedure Check_Files;
334 -- For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project file
335 -- is specified, without any file arguments and without a switch -files=.
336 -- If it is the case, invoke the GNAT tool with the proper list of files,
337 -- derived from the sources of the project.
339 procedure Check_Relative_Executable (Name : in out String_Access);
340 -- Check if an executable is specified as a relative path. If it is, and
341 -- the path contains directory information, fail. Otherwise, prepend the
342 -- exec directory. This procedure is only used for GNAT LINK when a project
343 -- file is specified.
345 procedure Delete_Temp_Config_Files;
346 -- Delete all temporary config files. The caller is responsible for
347 -- ensuring that Keep_Temporary_Files is False.
349 procedure Ensure_Absolute_Path
350 (Switch : in out String_Access;
352 -- Test if Switch is a relative search path switch. If it is and it
353 -- includes directory information, prepend the path with Parent. This
354 -- subprogram is only called when using project files.
356 procedure Output_Version;
357 -- Output the version of this program
362 procedure Process_Link;
363 -- Process GNAT LINK, when there is a project file specified
365 procedure Set_Library_For
366 (Project : Project_Id;
367 Tree : Project_Tree_Ref;
368 Libraries_Present : in out Boolean);
369 -- If Project is a library project, add the correct -L and -l switches to
370 -- the linker invocation.
372 procedure Set_Libraries is new
373 For_Every_Project_Imported (Boolean, Set_Library_For);
374 -- Add the -L and -l switches to the linker for all the library projects
380 procedure Check_Files is
381 Add_Sources : Boolean := True;
382 Unit : Prj.Unit_Index;
383 Subunit : Boolean := False;
384 FD : File_Descriptor := Invalid_FD;
388 procedure Add_To_Response_File
390 Check_File : Boolean := True);
391 -- Include the file name passed as parameter in the response file for
392 -- the tool being called. If the response file can not be written then
393 -- the file name is passed in the parameter list of the tool. If the
394 -- Check_File parameter is True then the procedure verifies the
395 -- existence of the file before adding it to the response file.
397 --------------------------
398 -- Add_To_Response_File --
399 --------------------------
401 procedure Add_To_Response_File
403 Check_File : Boolean := True)
408 Add_Str_To_Name_Buffer (File_Name);
410 if not Check_File or else
411 Is_Regular_File (Name_Buffer (1 .. Name_Len))
413 if FD /= Invalid_FD then
414 Name_Len := Name_Len + 1;
415 Name_Buffer (Name_Len) := ASCII.LF;
417 Status := Write (FD, Name_Buffer (1)'Address, Name_Len);
419 if Status /= Name_Len then
420 Osint.Fail ("disk full");
423 Last_Switches.Increment_Last;
424 Last_Switches.Table (Last_Switches.Last) :=
425 new String'(File_Name
);
428 end Add_To_Response_File
;
430 -- Start of processing for Check_Files
433 -- Check if there is at least one argument that is not a switch
435 for Index
in 1 .. Last_Switches
.Last
loop
436 if Last_Switches
.Table
(Index
) (1) /= '-'
437 or else (Last_Switches
.Table
(Index
).all'Length > 7
438 and then Last_Switches
.Table
(Index
) (1 .. 7) = "-files=")
440 Add_Sources
:= False;
445 -- If all arguments are switches and there is no switch -files=, add the
446 -- path names of all the sources of the main project.
449 Tempdir
.Create_Temp_File
(FD
, Temp_File_Name
);
450 Last_Switches
.Increment_Last
;
451 Last_Switches
.Table
(Last_Switches
.Last
) :=
452 new String'("-files=" & Get_Name_String (Temp_File_Name));
454 Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
455 while Unit /= No_Unit_Index loop
457 -- We only need to put the library units, body or spec, but not
460 if Unit.File_Names (Impl) /= null
461 and then not Unit.File_Names (Impl).Locally_Removed
463 -- There is a body, check if it is for this project
466 or else Unit.File_Names (Impl).Project = Project
470 if Unit.File_Names (Spec) = null
471 or else Unit.File_Names (Spec).Locally_Removed
473 -- We have a body with no spec: we need to check if
474 -- this is a subunit, because gnatls will complain
478 Src_Ind : constant Source_File_Index :=
479 Sinput.P.Load_Project_File
481 (Unit.File_Names (Impl).Path.Name));
483 Subunit := Sinput.P.Source_File_Is_Subunit (Src_Ind);
489 (Get_Name_String (Unit.File_Names (Impl).Display_File),
490 Check_File => False);
494 elsif Unit.File_Names (Spec) /= null
495 and then not Unit.File_Names (Spec).Locally_Removed
497 -- We have a spec with no body. Check if it is for this project
500 or else Unit.File_Names (Spec).Project = Project
503 (Get_Name_String (Unit.File_Names (Spec).Display_File),
504 Check_File => False);
508 Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
511 if FD /= Invalid_FD then
515 Osint.Fail ("disk full");
521 -------------------------------
522 -- Check_Relative_Executable --
523 -------------------------------
525 procedure Check_Relative_Executable (Name : in out String_Access) is
526 Exec_File_Name : constant String := Name.all;
529 if not Is_Absolute_Path (Exec_File_Name) then
530 for Index in Exec_File_Name'Range loop
531 if Exec_File_Name (Index) = Directory_Separator then
532 Fail ("relative executable (""" & Exec_File_Name
533 & """) with directory part not allowed "
534 & "when using project files");
538 Get_Name_String (Project.Exec_Directory.Name);
540 if Name_Buffer (Name_Len) /= Directory_Separator then
541 Name_Len := Name_Len + 1;
542 Name_Buffer (Name_Len) := Directory_Separator;
545 Name_Buffer (Name_Len + 1 .. Name_Len + Exec_File_Name'Length) :=
547 Name_Len := Name_Len + Exec_File_Name'Length;
548 Name := new String'(Name_Buffer
(1 .. Name_Len
));
550 end Check_Relative_Executable
;
552 ------------------------------
553 -- Delete_Temp_Config_Files --
554 ------------------------------
556 procedure Delete_Temp_Config_Files
is
559 pragma Warnings
(Off
, Success
);
562 -- This should only be called if Keep_Temporary_Files is False
564 pragma Assert
(not Keep_Temporary_Files
);
566 if Project
/= No_Project
then
567 Proj
:= Project_Tree
.Projects
;
568 while Proj
/= null loop
569 if Proj
.Project
.Config_File_Temp
then
570 Delete_Temporary_File
571 (Project_Tree
.Shared
, Proj
.Project
.Config_File_Name
);
578 -- If a temporary text file that contains a list of files for a tool
579 -- has been created, delete this temporary file.
581 if Temp_File_Name
/= No_Path
then
582 Delete_Temporary_File
(Project_Tree
.Shared
, Temp_File_Name
);
584 end Delete_Temp_Config_Files
;
586 ---------------------------
587 -- Ensure_Absolute_Path --
588 ---------------------------
590 procedure Ensure_Absolute_Path
591 (Switch
: in out String_Access
;
595 Makeutl
.Ensure_Absolute_Path
597 Do_Fail
=> Osint
.Fail
'Access,
598 Including_Non_Switch
=> False,
599 Including_RTS
=> True);
600 end Ensure_Absolute_Path
;
606 procedure Output_Version
is
608 if AAMP_On_Target
then
614 Put_Line
(Gnatvsn
.Gnat_Version_String
);
615 Put_Line
("Copyright 1996-" & Gnatvsn
.Current_Year
616 & ", Free Software Foundation, Inc.");
627 Put_Line
("List of available commands");
630 for C
in Command_List
'Range loop
632 if Targparm
.AAMP_On_Target
then
638 Put
(To_Lower
(Command_List
(C
).Cname
.all));
640 Put
(Program_Name
(Command_List
(C
).Unixcmd
.all, "gnat").all);
643 Sws
: Argument_List_Access
renames Command_List
(C
).Unixsws
;
646 for J
in Sws
'Range loop
657 Put_Line
("Commands bind, find, link, list and xref "
658 & "accept project file switches -vPx, -Pprj, -Xnam=val,"
659 & "--subdirs= and -eL");
667 procedure Process_Link
is
668 Look_For_Executable
: Boolean := True;
669 Libraries_Present
: Boolean := False;
670 Path_Option
: constant String_Access
:=
671 MLib
.Linker_Library_Path_Option
;
672 Prj
: Project_Id
:= Project
;
675 Skip_Executable
: Boolean := False;
678 -- Add the default search directories, to be able to find libgnat in
679 -- call to MLib.Utl.Lib_Directory.
681 Add_Default_Search_Dirs
;
683 Library_Paths
.Set_Last
(0);
685 -- Check if there are library project files
687 if MLib
.Tgt
.Support_For_Libraries
/= None
then
688 Set_Libraries
(Project
, Project_Tree
, Libraries_Present
);
691 -- If there are, add the necessary additional switches
693 if Libraries_Present
then
695 -- Add -Wl,-rpath,<lib_dir>
697 -- If Path_Option is not null, create the switch ("-Wl,-rpath," or
698 -- equivalent) with all the library dirs plus the standard GNAT
701 if Path_Option
/= null then
703 Option
: String_Access
;
704 Length
: Natural := Path_Option
'Length;
708 if MLib
.Separate_Run_Path_Options
then
710 -- We are going to create one switch of the form
711 -- "-Wl,-rpath,dir_N" for each directory to consider.
713 -- One switch for each library directory
716 Library_Paths
.First
.. Library_Paths
.Last
718 Last_Switches
.Increment_Last
;
720 (Last_Switches
.Last
) := new String'
722 Last_Switches.Table (Index).all);
725 -- One switch for the standard GNAT library dir
727 Last_Switches.Increment_Last;
729 (Last_Switches.Last) := new String'
730 (Path_Option
.all & MLib
.Utl
.Lib_Directory
);
733 -- First, compute the exact length for the switch
735 for Index
in Library_Paths
.First
.. Library_Paths
.Last
loop
737 -- Add the length of the library dir plus one for the
738 -- directory separator.
742 Library_Paths
.Table
(Index
)'Length + 1;
745 -- Finally, add the length of the standard GNAT library dir
747 Length
:= Length
+ MLib
.Utl
.Lib_Directory
'Length;
748 Option
:= new String (1 .. Length
);
749 Option
(1 .. Path_Option
'Length) := Path_Option
.all;
750 Current
:= Path_Option
'Length;
752 -- Put each library dir followed by a dir separator
755 Library_Paths
.First
.. Library_Paths
.Last
759 Current
+ Library_Paths
.Table
(Index
)'Length) :=
760 Library_Paths
.Table
(Index
).all;
762 Current
+ Library_Paths
.Table
(Index
)'Length + 1;
763 Option
(Current
) := Path_Separator
;
766 -- Finally put the standard GNAT library dir
769 (Current
+ 1 .. Current
+ MLib
.Utl
.Lib_Directory
'Length) :=
770 MLib
.Utl
.Lib_Directory
;
772 -- And add the switch to the last switches
774 Last_Switches
.Increment_Last
;
775 Last_Switches
.Table
(Last_Switches
.Last
) := Option
;
781 -- Check if the first ALI file specified can be found, either in the
782 -- object directory of the main project or in an object directory of a
783 -- project file extended by the main project. If the ALI file can be
784 -- found, replace its name with its absolute path.
786 Skip_Executable
:= False;
788 Switch_Loop
: for J
in 1 .. Last_Switches
.Last
loop
790 -- If we have an executable just reset the flag
792 if Skip_Executable
then
793 Skip_Executable
:= False;
795 -- If -o, set flag so that next switch is not processed
797 elsif Last_Switches
.Table
(J
).all = "-o" then
798 Skip_Executable
:= True;
804 Switch
: constant String := Last_Switches
.Table
(J
).all;
805 ALI_File
: constant String (1 .. Switch
'Length + 4) :=
808 Test_Existence
: Boolean := False;
811 Last
:= Switch
'Length;
813 -- Skip real switches
815 if Switch
'Length /= 0
816 and then Switch
(Switch
'First) /= '-'
818 -- Append ".ali" if file name does not end with it
820 if Switch
'Length <= 4
821 or else Switch
(Switch
'Last - 3 .. Switch
'Last) /= ".ali"
823 Last
:= ALI_File
'Last;
826 -- If file name includes directory information, stop if ALI
829 if Is_Absolute_Path
(ALI_File
(1 .. Last
)) then
830 Test_Existence
:= True;
833 for K
in Switch
'Range loop
834 if Is_Directory_Separator
(Switch
(K
)) then
835 Test_Existence
:= True;
841 if Test_Existence
then
842 if Is_Regular_File
(ALI_File
(1 .. Last
)) then
846 -- Look in object directories if ALI file exists
851 Dir
: constant String :=
852 Get_Name_String
(Prj
.Object_Directory
.Name
);
854 if Is_Regular_File
(Dir
& ALI_File
(1 .. Last
)) then
856 -- We have found the correct project, so we
857 -- replace the file with the absolute path.
859 Last_Switches
.Table
(J
) :=
860 new String'(Dir & ALI_File (1 .. Last));
868 -- Go to the project being extended, if any
871 exit Project_Loop when Prj = No_Project;
872 end loop Project_Loop;
877 end loop Switch_Loop;
879 -- If a relative path output file has been specified, we add the exec
882 for J in reverse 1 .. Last_Switches.Last - 1 loop
883 if Last_Switches.Table (J).all = "-o" then
884 Check_Relative_Executable (Name => Last_Switches.Table (J + 1));
885 Look_For_Executable := False;
890 if Look_For_Executable then
891 for J in reverse 1 .. First_Switches.Last - 1 loop
892 if First_Switches.Table (J).all = "-o" then
893 Look_For_Executable := False;
894 Check_Relative_Executable
895 (Name => First_Switches.Table (J + 1));
901 -- If no executable is specified, then find the name of the first ALI
902 -- file on the command line and issue a -o switch with the absolute path
903 -- of the executable in the exec directory.
905 if Look_For_Executable then
906 for J in 1 .. Last_Switches.Last loop
907 Arg := Last_Switches.Table (J);
910 if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
912 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
914 Last := Arg'Last - 4;
916 elsif Is_Regular_File (Arg.all & ".ali") then
921 Last_Switches.Increment_Last;
922 Last_Switches.Table (Last_Switches.Last) :=
924 Get_Name_String
(Project
.Exec_Directory
.Name
);
925 Last_Switches
.Increment_Last
;
926 Last_Switches
.Table
(Last_Switches
.Last
) :=
927 new String'(Name_Buffer (1 .. Name_Len) &
929 (Base_Name (Arg (Arg'First .. Last))));
937 ---------------------
938 -- Set_Library_For --
939 ---------------------
941 procedure Set_Library_For
942 (Project : Project_Id;
943 Tree : Project_Tree_Ref;
944 Libraries_Present : in out Boolean)
946 pragma Unreferenced (Tree);
948 Path_Option : constant String_Access := MLib.Linker_Library_Path_Option;
951 -- Case of library project
953 if Project.Library then
954 Libraries_Present := True;
958 Last_Switches.Increment_Last;
959 Last_Switches.Table (Last_Switches.Last) :=
960 new String'("-L" & Get_Name_String
(Project
.Library_Dir
.Name
));
964 Last_Switches
.Increment_Last
;
965 Last_Switches
.Table
(Last_Switches
.Last
) :=
966 new String'("-l" & Get_Name_String (Project.Library_Name));
968 -- Add the directory to table Library_Paths, to be processed later
969 -- if library is not static and if Path_Option is not null.
971 if Project.Library_Kind /= Static
972 and then Path_Option /= null
974 Library_Paths.Increment_Last;
975 Library_Paths.Table (Library_Paths.Last) :=
976 new String'(Get_Name_String
(Project
.Library_Dir
.Name
));
981 procedure Check_Version_And_Help
is new Check_Version_And_Help_G
(Usage
);
983 -- Start of processing for GNATCmd
986 -- All output from GNATCmd is debugging or error output: send to stderr
996 Prj
.Tree
.Initialize
(Root_Environment
, Gnatmake_Flags
);
998 Project_Node_Tree
:= new Project_Node_Tree_Data
;
999 Prj
.Tree
.Initialize
(Project_Node_Tree
);
1001 Prj
.Initialize
(Project_Tree
);
1004 Last_Switches
.Set_Last
(0);
1006 First_Switches
.Init
;
1007 First_Switches
.Set_Last
(0);
1009 Carg_Switches
.Set_Last
(0);
1010 Rules_Switches
.Init
;
1011 Rules_Switches
.Set_Last
(0);
1013 -- Set AAMP_On_Target from command name, for testing in Osint.Program_Name
1014 -- to handle the mapping of GNAAMP tool names. We don't extract it from
1015 -- system.ads, as there may be no default runtime.
1018 AAMP_On_Target
:= Name_Buffer
(1 .. Name_Len
) = "gnaampcmd";
1020 -- Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
1021 -- so that the spawned tool may know the way the GNAT driver was invoked.
1024 Add_Str_To_Name_Buffer
(Command_Name
);
1026 for J
in 1 .. Argument_Count
loop
1027 Add_Char_To_Name_Buffer
(' ');
1028 Add_Str_To_Name_Buffer
(Argument
(J
));
1031 Setenv
("GNAT_DRIVER_COMMAND_LINE", Name_Buffer
(1 .. Name_Len
));
1033 -- Add the directory where the GNAT driver is invoked in front of the path,
1034 -- if the GNAT driver is invoked with directory information.
1037 Command
: constant String := Command_Name
;
1040 for Index
in reverse Command
'Range loop
1041 if Command
(Index
) = Directory_Separator
then
1043 Absolute_Dir
: constant String :=
1044 Normalize_Pathname
(Command
(Command
'First .. Index
));
1045 PATH
: constant String :=
1046 Absolute_Dir
& Path_Separator
& Getenv
("PATH").all;
1048 Setenv
("PATH", PATH
);
1056 -- Scan the command line
1058 -- First, scan to detect --version and/or --help
1060 Check_Version_And_Help
("GNAT", "1996");
1064 if Command_Arg
<= Argument_Count
1065 and then Argument
(Command_Arg
) = "-v"
1067 Verbose_Mode
:= True;
1068 Command_Arg
:= Command_Arg
+ 1;
1070 elsif Command_Arg
<= Argument_Count
1071 and then Argument
(Command_Arg
) = "-dn"
1073 Keep_Temporary_Files
:= True;
1074 Command_Arg
:= Command_Arg
+ 1;
1081 -- If there is no command, just output the usage
1083 if Command_Arg
> Argument_Count
then
1088 The_Command
:= Real_Command_Type
'Value (Argument
(Command_Arg
));
1091 when Constraint_Error
=>
1093 -- Check if it is an alternate command
1096 Alternate
: Alternate_Command
;
1099 Alternate
:= Alternate_Command
'Value (Argument
(Command_Arg
));
1100 The_Command
:= Corresponding_To
(Alternate
);
1103 when Constraint_Error
=>
1105 Fail
("unknown command: " & Argument
(Command_Arg
));
1109 -- Get the arguments from the command line and from the eventual
1110 -- argument file(s) specified on the command line.
1112 for Arg
in Command_Arg
+ 1 .. Argument_Count
loop
1114 The_Arg
: constant String := Argument
(Arg
);
1117 -- Check if an argument file is specified
1119 if The_Arg
(The_Arg
'First) = '@' then
1121 Arg_File
: Ada
.Text_IO
.File_Type
;
1122 Line
: String (1 .. 256);
1126 -- Open the file and fail if the file cannot be found
1129 Open
(Arg_File
, In_File
,
1130 The_Arg
(The_Arg
'First + 1 .. The_Arg
'Last));
1134 Put
(Standard_Error
, "Cannot open argument file """);
1135 Put
(Standard_Error
,
1136 The_Arg
(The_Arg
'First + 1 .. The_Arg
'Last));
1137 Put_Line
(Standard_Error
, """");
1141 -- Read line by line and put the content of each non-
1142 -- empty line in the Last_Switches table.
1144 while not End_Of_File
(Arg_File
) loop
1145 Get_Line
(Arg_File
, Line
, Last
);
1148 Last_Switches
.Increment_Last
;
1149 Last_Switches
.Table
(Last_Switches
.Last
) :=
1150 new String'(Line (1 .. Last));
1158 -- It is not an argument file; just put the argument in
1159 -- the Last_Switches table.
1161 Last_Switches.Increment_Last;
1162 Last_Switches.Table (Last_Switches.Last) := new String'(The_Arg
);
1168 Program
: String_Access
;
1169 Exec_Path
: String_Access
;
1170 Get_Target
: Boolean := False;
1173 if The_Command
= Stack
then
1174 -- Never call gnatstack with a prefix
1176 Program
:= new String'(Command_List (The_Command).Unixcmd.all);
1180 Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
1182 -- If we want to invoke gnatmake/gnatclean with -P, then check if
1183 -- gprbuild/gprclean is available; if it is, use gprbuild/gprclean
1184 -- instead of gnatmake/gnatclean.
1185 -- Ditto for gnatname -> gprname.
1187 if The_Command = Make
1188 or else The_Command = Compile
1189 or else The_Command = Clean
1190 or else The_Command = Name
1193 Project_File_Used : Boolean := False;
1194 Switch : String_Access;
1197 for J in 1 .. Last_Switches.Last loop
1198 Switch := Last_Switches.Table (J);
1199 if Switch'Length >= 2 and then
1200 Switch (Switch'First .. Switch'First + 1) = "-P"
1202 Project_File_Used := True;
1207 if Project_File_Used then
1209 when Make | Compile =>
1210 if Locate_Exec_On_Path (Gprbuild) /= null then
1211 Program := new String'(Gprbuild
);
1216 if Locate_Exec_On_Path
(Gprclean
) /= null then
1217 Program
:= new String'(Gprclean);
1222 if Locate_Exec_On_Path (Gprname) /= null then
1223 Program := new String'(Gprname
);
1234 if Name_Len
> 5 then
1235 First_Switches
.Append
1237 ("--target=" & Name_Buffer (1 .. Name_Len - 5)));
1245 -- For the tools where the GNAT driver processes the project files,
1246 -- allow shared library projects to import projects that are not shared
1247 -- library projects, to avoid adding a switch for these tools. For the
1248 -- builder (gnatmake), if a shared library project imports a project
1249 -- that is not a shared library project and the appropriate switch is
1250 -- not specified, the invocation of gnatmake will fail.
1252 Opt.Unchecked_Shared_Lib_Imports := True;
1254 -- Locate the executable for the command
1256 Exec_Path := Locate_Exec_On_Path (Program.all);
1258 if Exec_Path = null then
1259 Put_Line (Standard_Error, "could not locate " & Program.all);
1263 -- If there are switches for the executable, put them as first switches
1265 if Command_List (The_Command).Unixsws /= null then
1266 for J in Command_List (The_Command).Unixsws'Range loop
1267 First_Switches.Increment_Last;
1268 First_Switches.Table (First_Switches.Last) :=
1269 Command_List (The_Command).Unixsws (J);
1273 -- For BIND, FIND, LINK, LIST and XREF, look for project file related
1278 Tool_Package_Name := Name_Binder;
1279 Packages_To_Check := Packages_To_Check_By_Binder;
1281 Tool_Package_Name := Name_Finder;
1282 Packages_To_Check := Packages_To_Check_By_Finder;
1284 Tool_Package_Name := Name_Linker;
1285 Packages_To_Check := Packages_To_Check_By_Linker;
1287 Tool_Package_Name := Name_Gnatls;
1288 Packages_To_Check := Packages_To_Check_By_Gnatls;
1290 Tool_Package_Name := Name_Cross_Reference;
1291 Packages_To_Check := Packages_To_Check_By_Xref;
1293 Tool_Package_Name := No_Name;
1296 if Tool_Package_Name /= No_Name then
1298 -- Check that the switches are consistent. Detect project file
1299 -- related switches.
1301 Inspect_Switches : declare
1302 Arg_Num : Positive := 1;
1303 Argv : String_Access;
1305 procedure Remove_Switch (Num : Positive);
1306 -- Remove a project related switch from table Last_Switches
1312 procedure Remove_Switch (Num : Positive) is
1314 Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1315 Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1316 Last_Switches.Decrement_Last;
1319 -- Start of processing for Inspect_Switches
1322 while Arg_Num <= Last_Switches.Last loop
1323 Argv := Last_Switches.Table (Arg_Num);
1325 if Argv (Argv'First) = '-' then
1326 if Argv'Length = 1 then
1327 Fail ("switch character cannot be followed by a blank");
1330 -- The two style project files (-p and -P) cannot be used
1333 if (The_Command = Find or else The_Command = Xref)
1334 and then Argv (2) = 'p
'
1336 Old_Project_File_Used := True;
1337 if Project_File /= null then
1338 Fail ("-P and -p cannot be used together");
1342 -- --subdirs=... Specify Subdirs
1344 if Argv'Length > Makeutl.Subdirs_Option'Length
1348 Argv'First + Makeutl.Subdirs_Option'Length - 1) =
1349 Makeutl.Subdirs_Option
1353 (Argv
(Argv
'First + Makeutl
.Subdirs_Option
'Length ..
1356 Remove_Switch
(Arg_Num
);
1358 -- -aPdir Add dir to the project search path
1360 elsif Argv
'Length > 3
1361 and then Argv
(Argv
'First + 1 .. Argv
'First + 2) = "aP"
1363 Prj
.Env
.Add_Directories
1364 (Root_Environment
.Project_Path
,
1365 Argv
(Argv
'First + 3 .. Argv
'Last));
1367 -- Pass -aPdir to gnatls, but not to other tools
1369 if The_Command
= List
then
1370 Arg_Num
:= Arg_Num
+ 1;
1372 Remove_Switch
(Arg_Num
);
1375 -- -eL Follow links for files
1377 elsif Argv
.all = "-eL" then
1378 Follow_Links_For_Files
:= True;
1379 Follow_Links_For_Dirs
:= True;
1381 Remove_Switch
(Arg_Num
);
1383 -- -vPx Specify verbosity while parsing project files
1385 elsif Argv
'Length >= 3
1386 and then Argv
(Argv
'First + 1 .. Argv
'First + 2) = "vP"
1389 and then Argv
(Argv
'Last) in '0' .. '2'
1391 case Argv
(Argv
'Last) is
1393 Current_Verbosity
:= Prj
.Default
;
1395 Current_Verbosity
:= Prj
.Medium
;
1397 Current_Verbosity
:= Prj
.High
;
1402 raise Program_Error
;
1405 Fail
("invalid verbosity level: "
1406 & Argv
(Argv
'First + 3 .. Argv
'Last));
1409 Remove_Switch
(Arg_Num
);
1411 -- -Pproject_file Specify project file to be used
1413 elsif Argv
(Argv
'First + 1) = 'P' then
1415 -- Only one -P switch can be used
1417 if Project_File
/= null then
1420 & ": second project file forbidden (first is """
1421 & Project_File
.all & """)");
1423 -- The two style project files (-p and -P) cannot be
1426 elsif Old_Project_File_Used
then
1427 Fail
("-p and -P cannot be used together");
1429 elsif Argv
'Length = 2 then
1431 -- There is space between -P and the project file
1432 -- name. -P cannot be the last option.
1434 if Arg_Num
= Last_Switches
.Last
then
1435 Fail
("project file name missing after -P");
1438 Remove_Switch
(Arg_Num
);
1439 Argv
:= Last_Switches
.Table
(Arg_Num
);
1441 -- After -P, there must be a project file name,
1442 -- not another switch.
1444 if Argv
(Argv
'First) = '-' then
1445 Fail
("project file name missing after -P");
1448 Project_File
:= new String'(Argv.all);
1453 -- No space between -P and project file name
1456 new String'(Argv
(Argv
'First + 2 .. Argv
'Last));
1459 Remove_Switch
(Arg_Num
);
1461 -- -Xexternal=value Specify an external reference to be
1462 -- used in project files
1464 elsif Argv
'Length >= 5
1465 and then Argv
(Argv
'First + 1) = 'X'
1467 if not Check
(Root_Environment
.External
,
1468 Argv
(Argv
'First + 2 .. Argv
'Last))
1471 (Argv
.all & " is not a valid external assignment.");
1474 Remove_Switch
(Arg_Num
);
1478 and then Argv
'Length = 2
1479 and then Argv
(2) = 'U'
1481 All_Projects
:= True;
1482 Remove_Switch
(Arg_Num
);
1485 Arg_Num
:= Arg_Num
+ 1;
1489 Arg_Num
:= Arg_Num
+ 1;
1492 end Inspect_Switches
;
1495 -- Add the default project search directories now, after the directories
1496 -- that have been specified by switches -aP<dir>.
1498 Prj
.Env
.Initialize_Default_Project_Path
1499 (Root_Environment
.Project_Path
,
1500 Target_Name
=> Sdefault
.Target_Name
.all);
1502 -- If there is a project file specified, parse it, get the switches
1503 -- for the tool and setup PATH environment variables.
1505 if Project_File
/= null then
1506 Prj
.Pars
.Set_Verbosity
(To
=> Current_Verbosity
);
1509 (Project
=> Project
,
1510 In_Tree
=> Project_Tree
,
1511 In_Node_Tree
=> Project_Node_Tree
,
1512 Project_File_Name
=> Project_File
.all,
1513 Env
=> Root_Environment
,
1514 Packages_To_Check
=> Packages_To_Check
);
1516 -- Prj.Pars.Parse calls Set_Standard_Output, reset to stderr
1520 if Project
= Prj
.No_Project
then
1521 Fail
("""" & Project_File
.all & """ processing failed");
1523 elsif Project
.Qualifier
= Aggregate
then
1524 Fail
("aggregate projects are not supported");
1526 elsif Aggregate_Libraries_In
(Project_Tree
) then
1527 Fail
("aggregate library projects are not supported");
1530 -- Check if a package with the name of the tool is in the project
1531 -- file and if there is one, get the switches, if any, and scan them.
1534 Pkg
: constant Prj
.Package_Id
:=
1536 (Name
=> Tool_Package_Name
,
1537 In_Packages
=> Project
.Decl
.Packages
,
1538 Shared
=> Project_Tree
.Shared
);
1540 Element
: Package_Element
;
1542 Switches_Array
: Array_Element_Id
;
1544 The_Switches
: Prj
.Variable_Value
;
1545 Current
: Prj
.String_List_Id
;
1546 The_String
: String_Element
;
1548 Main
: String_Access
:= null;
1551 if Pkg
/= No_Package
then
1552 Element
:= Project_Tree
.Shared
.Packages
.Table
(Pkg
);
1554 -- Package Gnatls has a single attribute Switches, that is not
1555 -- an associative array.
1557 if The_Command
= List
then
1560 (Variable_Name
=> Snames
.Name_Switches
,
1561 In_Variables
=> Element
.Decl
.Attributes
,
1562 Shared
=> Project_Tree
.Shared
);
1564 -- Packages Binder (for gnatbind), Cross_Reference (for
1565 -- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
1566 -- have an attributed Switches, an associative array, indexed
1567 -- by the name of the file.
1569 -- They also have an attribute Default_Switches, indexed by the
1570 -- name of the programming language.
1573 -- First check if there is a single main
1575 for J
in 1 .. Last_Switches
.Last
loop
1576 if Last_Switches
.Table
(J
) (1) /= '-' then
1578 Main
:= Last_Switches
.Table
(J
);
1586 if Main
/= null then
1589 (Name
=> Name_Switches
,
1590 In_Arrays
=> Element
.Decl
.Arrays
,
1591 Shared
=> Project_Tree
.Shared
);
1594 -- If the single main has been specified as an absolute
1595 -- path, use only the simple file name. If the absolute
1596 -- path is incorrect, an error will be reported by the
1597 -- underlying tool and it does not make a difference
1598 -- what switches are used.
1600 if Is_Absolute_Path
(Main
.all) then
1601 Add_Str_To_Name_Buffer
(File_Name
(Main
.all));
1603 Add_Str_To_Name_Buffer
(Main
.all);
1606 The_Switches
:= Prj
.Util
.Value_Of
1607 (Index
=> Name_Find
,
1609 In_Array
=> Switches_Array
,
1610 Shared
=> Project_Tree
.Shared
);
1613 if The_Switches
.Kind
= Prj
.Undefined
then
1616 (Name
=> Name_Default_Switches
,
1617 In_Arrays
=> Element
.Decl
.Arrays
,
1618 Shared
=> Project_Tree
.Shared
);
1619 The_Switches
:= Prj
.Util
.Value_Of
1622 In_Array
=> Switches_Array
,
1623 Shared
=> Project_Tree
.Shared
);
1627 -- If there are switches specified in the package of the
1628 -- project file corresponding to the tool, scan them.
1630 case The_Switches
.Kind
is
1631 when Prj
.Undefined
=>
1636 Switch
: constant String :=
1637 Get_Name_String
(The_Switches
.Value
);
1639 if Switch
'Length > 0 then
1640 First_Switches
.Increment_Last
;
1641 First_Switches
.Table
(First_Switches
.Last
) :=
1642 new String'(Switch);
1647 Current := The_Switches.Values;
1648 while Current /= Prj.Nil_String loop
1649 The_String := Project_Tree.Shared.String_Elements.
1653 Switch : constant String :=
1654 Get_Name_String (The_String.Value);
1656 if Switch'Length > 0 then
1657 First_Switches.Increment_Last;
1658 First_Switches.Table (First_Switches.Last) :=
1659 new String'(Switch
);
1663 Current
:= The_String
.Next
;
1669 if The_Command
= Bind
or else The_Command
= Link
then
1670 if Project
.Object_Directory
.Name
= No_Path
then
1671 Fail
("project " & Get_Name_String
(Project
.Display_Name
)
1672 & " has no object directory");
1675 Change_Dir
(Get_Name_String
(Project
.Object_Directory
.Name
));
1678 -- Set up the env vars for project path files
1680 Prj
.Env
.Set_Ada_Paths
1681 (Project
, Project_Tree
, Including_Libraries
=> True);
1683 -- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1684 -- a configuration pragmas file, if necessary.
1686 if The_Command
= Link
then
1690 if The_Command
= Link
or else The_Command
= Bind
then
1692 -- For files that are specified as relative paths with directory
1693 -- information, we convert them to absolute paths, with parent
1694 -- being the current working directory if specified on the command
1695 -- line and the project directory if specified in the project
1696 -- file. This is what gnatmake is doing for linker and binder
1699 for J
in 1 .. Last_Switches
.Last
loop
1700 GNATCmd
.Ensure_Absolute_Path
1701 (Last_Switches
.Table
(J
), Current_Work_Dir
);
1704 Get_Name_String
(Project
.Directory
.Name
);
1707 Project_Dir
: constant String := Name_Buffer
(1 .. Name_Len
);
1709 for J
in 1 .. First_Switches
.Last
loop
1710 GNATCmd
.Ensure_Absolute_Path
1711 (First_Switches
.Table
(J
), Project_Dir
);
1716 -- For gnat list, if no file has been put on the command line, call
1717 -- tool with all the sources of the main project.
1719 if The_Command
= List
then
1724 -- Gather all the arguments and invoke the executable
1727 The_Args
: Argument_List
1728 (1 .. First_Switches
.Last
+
1729 Last_Switches
.Last
+
1730 Carg_Switches
.Last
+
1731 Rules_Switches
.Last
);
1732 Arg_Num
: Natural := 0;
1735 for J
in 1 .. First_Switches
.Last
loop
1736 Arg_Num
:= Arg_Num
+ 1;
1737 The_Args
(Arg_Num
) := First_Switches
.Table
(J
);
1740 for J
in 1 .. Last_Switches
.Last
loop
1741 Arg_Num
:= Arg_Num
+ 1;
1742 The_Args
(Arg_Num
) := Last_Switches
.Table
(J
);
1745 for J
in 1 .. Carg_Switches
.Last
loop
1746 Arg_Num
:= Arg_Num
+ 1;
1747 The_Args
(Arg_Num
) := Carg_Switches
.Table
(J
);
1750 for J
in 1 .. Rules_Switches
.Last
loop
1751 Arg_Num
:= Arg_Num
+ 1;
1752 The_Args
(Arg_Num
) := Rules_Switches
.Table
(J
);
1755 if Verbose_Mode
then
1756 Output
.Write_Str
(Exec_Path
.all);
1758 for Arg
in The_Args
'Range loop
1759 Output
.Write_Char
(' ');
1760 Output
.Write_Str
(The_Args
(Arg
).all);
1767 Exit_Status
(Spawn
(Exec_Path
.all, The_Args
));
1774 if not Keep_Temporary_Files
then
1775 Prj
.Delete_All_Temp_Files
(Project_Tree
.Shared
);
1776 Delete_Temp_Config_Files
;
1779 Set_Exit_Status
(Failure
);
1782 if not Keep_Temporary_Files
then
1783 Prj
.Delete_All_Temp_Files
(Project_Tree
.Shared
);
1784 Delete_Temp_Config_Files
;
1787 Set_Exit_Status
(My_Exit_Status
);