1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2014, 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
;
34 with Namet
; use Namet
;
36 with Osint
; use Osint
;
37 with Output
; use Output
;
40 with Prj
.Ext
; use Prj
.Ext
;
42 with Prj
.Tree
; use Prj
.Tree
;
43 with Prj
.Util
; use Prj
.Util
;
46 with Snames
; use Snames
;
48 with Switch
; use Switch
;
50 with Targparm
; use Targparm
;
52 with Types
; use Types
;
54 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
55 with Ada
.Command_Line
; use Ada
.Command_Line
;
56 with Ada
.Text_IO
; use Ada
.Text_IO
;
58 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
61 Normal_Exit
: exception;
62 -- Raise this exception for normal program termination
64 Error_Exit
: exception;
65 -- Raise this exception if error detected
90 subtype Real_Command_Type
is Command_Type
range Bind
.. Xref
;
91 -- All real command types (excludes only Undefined).
93 type Alternate_Command
is (Comp
, Ls
, Kr
, Pp
, Prep
);
94 -- Alternate command label
96 Corresponding_To
: constant array (Alternate_Command
) of Command_Type
:=
102 -- Mapping of alternate commands to commands
104 Project_Node_Tree
: Project_Node_Tree_Ref
;
105 Project_File
: String_Access
;
106 Project
: Prj
.Project_Id
;
107 Current_Verbosity
: Prj
.Verbosity
:= Prj
.Default
;
108 Tool_Package_Name
: Name_Id
:= No_Name
;
110 B_Start
: constant String := "b~";
111 -- Prefix of binder generated file
113 Project_Tree
: constant Project_Tree_Ref
:=
114 new Project_Tree_Data
(Is_Root_Tree
=> True);
117 Old_Project_File_Used
: Boolean := False;
118 -- This flag indicates a switch -p (for gnatxref and gnatfind) for
119 -- an old fashioned project file. -p cannot be used in conjunction
122 Temp_File_Name
: Path_Name_Type
:= No_Path
;
123 -- The name of the temporary text file to put a list of source/object
124 -- files to pass to a tool.
126 package First_Switches
is new Table
.Table
127 (Table_Component_Type
=> String_Access
,
128 Table_Index_Type
=> Integer,
129 Table_Low_Bound
=> 1,
131 Table_Increment
=> 100,
132 Table_Name
=> "Gnatcmd.First_Switches");
133 -- A table to keep the switches from the project file
135 package Carg_Switches
is new Table
.Table
136 (Table_Component_Type
=> String_Access
,
137 Table_Index_Type
=> Integer,
138 Table_Low_Bound
=> 1,
140 Table_Increment
=> 100,
141 Table_Name
=> "Gnatcmd.Carg_Switches");
142 -- A table to keep the switches following -cargs for ASIS tools
144 package Rules_Switches
is new Table
.Table
145 (Table_Component_Type
=> String_Access
,
146 Table_Index_Type
=> Integer,
147 Table_Low_Bound
=> 1,
149 Table_Increment
=> 100,
150 Table_Name
=> "Gnatcmd.Rules_Switches");
151 -- A table to keep the switches following -rules for gnatcheck
153 package Library_Paths
is new Table
.Table
(
154 Table_Component_Type
=> String_Access
,
155 Table_Index_Type
=> Integer,
156 Table_Low_Bound
=> 1,
158 Table_Increment
=> 100,
159 Table_Name
=> "Make.Library_Path");
161 package Last_Switches
is new Table
.Table
162 (Table_Component_Type
=> String_Access
,
163 Table_Index_Type
=> Integer,
164 Table_Low_Bound
=> 1,
166 Table_Increment
=> 100,
167 Table_Name
=> "Gnatcmd.Last_Switches");
169 -- Packages of project files to pass to Prj.Pars.Parse, depending on the
170 -- tool. We allocate objects because we cannot declare aliased objects
171 -- as we are in a procedure, not a library level package.
173 subtype SA
is String_Access
;
175 Naming_String
: constant SA
:= new String'("naming");
176 Binder_String : constant SA := new String'("binder");
177 Compiler_String
: constant SA
:= new String'("compiler");
178 Synchronize_String : constant SA := new String'("synchronize");
179 Finder_String
: constant SA
:= new String'("finder");
180 Linker_String : constant SA := new String'("linker");
181 Gnatls_String
: constant SA
:= new String'("gnatls");
182 Stack_String : constant SA := new String'("stack");
183 Xref_String
: constant SA
:= new String'("cross_reference");
185 Packages_To_Check_By_Binder : constant String_List_Access :=
186 new String_List'((Naming_String
, Binder_String
));
188 Packages_To_Check_By_Sync
: constant String_List_Access
:=
189 new String_List
'((Naming_String, Synchronize_String, Compiler_String));
191 Packages_To_Check_By_Finder : constant String_List_Access :=
192 new String_List'((Naming_String
, Finder_String
));
194 Packages_To_Check_By_Linker
: constant String_List_Access
:=
195 new String_List
'((Naming_String, Linker_String));
197 Packages_To_Check_By_Gnatls : constant String_List_Access :=
198 new String_List'((Naming_String
, Gnatls_String
));
200 Packages_To_Check_By_Stack
: constant String_List_Access
:=
201 new String_List
'((Naming_String, Stack_String));
203 Packages_To_Check_By_Xref : constant String_List_Access :=
204 new String_List'((Naming_String
, Xref_String
));
206 Packages_To_Check
: String_List_Access
:= Prj
.All_Packages
;
208 ----------------------------------
209 -- Declarations for GNATCMD use --
210 ----------------------------------
212 The_Command
: Command_Type
;
213 -- The command specified in the invocation of the GNAT driver
215 Command_Arg
: Positive := 1;
216 -- The index of the command in the arguments of the GNAT driver
218 My_Exit_Status
: Exit_Status
:= Success
;
219 -- The exit status of the spawned tool
221 Current_Work_Dir
: constant String := Get_Current_Dir
;
222 -- The path of the working directory
224 All_Projects
: Boolean := False;
225 -- Flag used for GNAT CHECK, GNAT PRETTY, GNAT METRIC, and GNAT STACK to
226 -- indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
227 -- should be invoked for all sources of all projects.
229 type Command_Entry
is record
230 Cname
: String_Access
;
231 -- Command name for GNAT xxx command
233 Unixcmd
: String_Access
;
234 -- Corresponding Unix command
236 Unixsws
: Argument_List_Access
;
237 -- List of switches to be used with the Unix command
240 Command_List
: constant array (Real_Command_Type
) of Command_Entry
:=
242 (Cname
=> new String'("BIND"),
243 Unixcmd => new String'("gnatbind"),
247 (Cname
=> new String'("CHOP"),
248 Unixcmd => new String'("gnatchop"),
252 (Cname
=> new String'("CLEAN"),
253 Unixcmd => new String'("gnatclean"),
257 (Cname
=> new String'("COMPILE"),
258 Unixcmd => new String'("gnatmake"),
259 Unixsws
=> new Argument_List
'(1 => new String'("-f"),
260 2 => new String'("-u"),
261 3 => new String'("-c"))),
264 (Cname
=> new String'("CHECK"),
265 Unixcmd => new String'("gnatcheck"),
269 (Cname
=> new String'("SYNC"),
270 Unixcmd => new String'("gnatsync"),
274 (Cname
=> new String'("ELIM"),
275 Unixcmd => new String'("gnatelim"),
279 (Cname
=> new String'("FIND"),
280 Unixcmd => new String'("gnatfind"),
284 (Cname
=> new String'("KRUNCH"),
285 Unixcmd => new String'("gnatkr"),
289 (Cname
=> new String'("LINK"),
290 Unixcmd => new String'("gnatlink"),
294 (Cname
=> new String'("LIST"),
295 Unixcmd => new String'("gnatls"),
299 (Cname
=> new String'("MAKE"),
300 Unixcmd => new String'("gnatmake"),
304 (Cname
=> new String'("METRIC"),
305 Unixcmd => new String'("gnatmetric"),
309 (Cname
=> new String'("NAME"),
310 Unixcmd => new String'("gnatname"),
314 (Cname
=> new String'("PREPROCESS"),
315 Unixcmd => new String'("gnatprep"),
319 (Cname
=> new String'("PRETTY"),
320 Unixcmd => new String'("gnatpp"),
324 (Cname
=> new String'("STACK"),
325 Unixcmd => new String'("gnatstack"),
329 (Cname
=> new String'("STUB"),
330 Unixcmd => new String'("gnatstub"),
334 (Cname
=> new String'("TEST"),
335 Unixcmd => new String'("gnattest"),
339 (Cname
=> new String'("XREF"),
340 Unixcmd => new String'("gnatxref"),
344 -----------------------
345 -- Local Subprograms --
346 -----------------------
348 procedure Add_To_Carg_Switches
(Switch
: String_Access
);
349 -- Add a switch to the Carg_Switches table. If it is the first one, put the
350 -- switch "-cargs" at the beginning of the table.
352 procedure Check_Files
;
353 -- For GNAT LIST, GNAT PRETTY, GNAT METRIC, and GNAT STACK, check if a
354 -- project file is specified, without any file arguments and without a
355 -- switch -files=. If it is the case, invoke the GNAT tool with the proper
356 -- list of files, derived from the sources of the project.
358 function Check_Project
359 (Project
: Project_Id
;
360 Root_Project
: Project_Id
) return Boolean;
361 -- Returns True if Project = Root_Project or if we want to consider all
362 -- sources of all projects. For GNAT METRIC, also returns True if Project
363 -- is extended by Root_Project.
365 procedure Check_Relative_Executable
(Name
: in out String_Access
);
366 -- Check if an executable is specified as a relative path. If it is, and
367 -- the path contains directory information, fail. Otherwise, prepend the
368 -- exec directory. This procedure is only used for GNAT LINK when a project
369 -- file is specified.
371 function Configuration_Pragmas_File
return Path_Name_Type
;
372 -- Return an argument, if there is a configuration pragmas file to be
373 -- specified for Project, otherwise return No_Name. Used for gnatstub
374 -- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
377 procedure Delete_Temp_Config_Files
;
378 -- Delete all temporary config files. The caller is responsible for
379 -- ensuring that Keep_Temporary_Files is False.
381 procedure Ensure_Absolute_Path
382 (Switch
: in out String_Access
;
384 -- Test if Switch is a relative search path switch. If it is and it
385 -- includes directory information, prepend the path with Parent. This
386 -- subprogram is only called when using project files.
388 function Mapping_File
return Path_Name_Type
;
389 -- Create and return the path name of a mapping file. Used for gnatstub
390 -- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
393 procedure Output_Version
;
394 -- Output the version of this program
399 procedure Process_Link
;
400 -- Process GNAT LINK, when there is a project file specified
402 procedure Set_Library_For
403 (Project
: Project_Id
;
404 Tree
: Project_Tree_Ref
;
405 Libraries_Present
: in out Boolean);
406 -- If Project is a library project, add the correct -L and -l switches to
407 -- the linker invocation.
409 procedure Set_Libraries
is new
410 For_Every_Project_Imported
(Boolean, Set_Library_For
);
411 -- Add the -L and -l switches to the linker for all the library projects
413 --------------------------
414 -- Add_To_Carg_Switches --
415 --------------------------
417 procedure Add_To_Carg_Switches
(Switch
: String_Access
) is
419 -- If the Carg_Switches table is empty, put "-cargs" at the beginning
421 if Carg_Switches
.Last
= 0 then
422 Carg_Switches
.Increment_Last
;
423 Carg_Switches
.Table
(Carg_Switches
.Last
) := new String'("-cargs");
426 Carg_Switches.Increment_Last;
427 Carg_Switches.Table (Carg_Switches.Last) := Switch;
428 end Add_To_Carg_Switches;
434 procedure Check_Files is
435 Add_Sources : Boolean := True;
436 Unit : Prj.Unit_Index;
437 Subunit : Boolean := False;
438 FD : File_Descriptor := Invalid_FD;
442 procedure Add_To_Response_File
444 Check_File : Boolean := True);
445 -- Include the file name passed as parameter in the response file for
446 -- the tool being called. If the response file can not be written then
447 -- the file name is passed in the parameter list of the tool. If the
448 -- Check_File parameter is True then the procedure verifies the
449 -- existence of the file before adding it to the response file.
451 --------------------------
452 -- Add_To_Response_File --
453 --------------------------
455 procedure Add_To_Response_File
457 Check_File : Boolean := True)
462 Add_Str_To_Name_Buffer (File_Name);
464 if not Check_File or else
465 Is_Regular_File (Name_Buffer (1 .. Name_Len))
467 if FD /= Invalid_FD then
468 Name_Len := Name_Len + 1;
469 Name_Buffer (Name_Len) := ASCII.LF;
471 Status := Write (FD, Name_Buffer (1)'Address, Name_Len);
473 if Status /= Name_Len then
474 Osint.Fail ("disk full");
477 Last_Switches.Increment_Last;
478 Last_Switches.Table (Last_Switches.Last) :=
479 new String'(File_Name
);
482 end Add_To_Response_File
;
484 -- Start of processing for Check_Files
487 -- Check if there is at least one argument that is not a switch or if
488 -- there is a -files= switch.
490 for Index
in 1 .. Last_Switches
.Last
loop
491 if Last_Switches
.Table
(Index
) (1) /= '-'
492 or else (Last_Switches
.Table
(Index
).all'Length > 7
493 and then Last_Switches
.Table
(Index
) (1 .. 7) = "-files=")
495 Add_Sources
:= False;
500 -- If all arguments are switches and there is no switch -files=, add the
501 -- path names of all the sources of the main project.
505 -- For gnatcheck, gnatpp, and gnatmetric, create a temporary file and
506 -- put the list of sources in it. For gnatstack create a temporary
507 -- file with the list of .ci files.
509 if The_Command
= List
or else The_Command
= Stack
then
510 Tempdir
.Create_Temp_File
(FD
, Temp_File_Name
);
511 Last_Switches
.Increment_Last
;
512 Last_Switches
.Table
(Last_Switches
.Last
) :=
513 new String'("-files=" & Get_Name_String (Temp_File_Name));
520 -- Gnatstack needs to add the .ci file for the binder generated
521 -- files corresponding to all of the library projects and main
522 -- units belonging to the application.
524 if The_Command = Stack then
525 Proj := Project_Tree.Projects;
526 while Proj /= null loop
527 if Check_Project (Proj.Project, Project) then
529 Main : String_List_Id;
532 -- Include binder generated files for main programs
534 Main := Proj.Project.Mains;
535 while Main /= Nil_String loop
538 (Proj.Project.Object_Directory.Name) &
542 (Project_Tree.Shared.String_Elements.Table
546 -- When looking for the .ci file for a binder
547 -- generated file, look for both b~xxx and b__xxx
548 -- as gprbuild always uses b__ as the prefix of
551 if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
555 (Proj.Project.Object_Directory.Name) &
560 .String_Elements.Table (Main).Value),
564 Main := Project_Tree.Shared.String_Elements.Table
568 if Proj.Project.Library then
570 -- Include the .ci file for the binder generated
571 -- files that contains the initialization and
572 -- finalization of the library.
576 (Proj.Project.Object_Directory.Name) &
578 Get_Name_String (Proj.Project.Library_Name) &
581 -- When looking for the .ci file for a binder
582 -- generated file, look for both b~xxx and b__xxx
583 -- as gprbuild always uses b__ as the prefix of
586 if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
590 (Proj.Project.Object_Directory.Name) &
592 Get_Name_String (Proj.Project.Library_Name) &
603 Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
604 while Unit /= No_Unit_Index loop
606 -- For gnatls, we only need to put the library units, body or
607 -- spec, but not the subunits.
609 if The_Command = List then
610 if Unit.File_Names (Impl) /= null
611 and then not Unit.File_Names (Impl).Locally_Removed
613 -- There is a body, check if it is for this project
616 or else Unit.File_Names (Impl).Project = Project
620 if Unit.File_Names (Spec) = null
621 or else Unit.File_Names (Spec).Locally_Removed
623 -- We have a body with no spec: we need to check if
624 -- this is a subunit, because gnatls will complain
628 Src_Ind : constant Source_File_Index :=
629 Sinput.P.Load_Project_File
635 Sinput.P.Source_File_Is_Subunit (Src_Ind);
642 (Unit.File_Names (Impl).Display_File),
643 Check_File => False);
647 elsif Unit.File_Names (Spec) /= null
648 and then not Unit.File_Names (Spec).Locally_Removed
650 -- We have a spec with no body. Check if it is for this
653 if All_Projects or else
654 Unit.File_Names (Spec).Project = Project
658 (Unit.File_Names (Spec).Display_File),
659 Check_File => False);
663 -- For gnatstack, we put the .ci files corresponding to the
664 -- different units, including the binder generated files. We
665 -- only need to do that for the library units, body or spec,
666 -- but not the subunits.
668 elsif The_Command = Stack then
669 if Unit.File_Names (Impl) /= null
670 and then not Unit.File_Names (Impl).Locally_Removed
672 -- There is a body. Check if .ci files for this project
676 (Unit.File_Names (Impl).Project, Project)
680 if Unit.File_Names (Spec) = null
681 or else Unit.File_Names (Spec).Locally_Removed
683 -- We have a body with no spec: we need to check
684 -- if this is a subunit, because .ci files are not
685 -- generated for subunits.
688 Src_Ind : constant Source_File_Index :=
689 Sinput.P.Load_Project_File
695 Sinput.P.Source_File_Is_Subunit (Src_Ind);
703 (Impl).Project. Object_Directory.Name) &
706 (Unit.File_Names (Impl).Display_File),
711 elsif Unit.File_Names (Spec) /= null
712 and then not Unit.File_Names (Spec).Locally_Removed
714 -- Spec with no body, check if it is for this project
717 (Unit.File_Names (Spec).Project, Project)
722 (Spec).Project. Object_Directory.Name) &
725 (Get_Name_String (Unit.File_Names (Spec).File),
731 Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
735 if FD /= Invalid_FD then
739 Osint.Fail ("disk full");
749 function Check_Project
750 (Project : Project_Id;
751 Root_Project : Project_Id) return Boolean
754 if Project = No_Project then
757 elsif All_Projects or else Project = Root_Project then
764 -------------------------------
765 -- Check_Relative_Executable --
766 -------------------------------
768 procedure Check_Relative_Executable (Name : in out String_Access) is
769 Exec_File_Name : constant String := Name.all;
772 if not Is_Absolute_Path (Exec_File_Name) then
773 for Index in Exec_File_Name'Range loop
774 if Exec_File_Name (Index) = Directory_Separator then
775 Fail ("relative executable (""" & Exec_File_Name
776 & """) with directory part not allowed "
777 & "when using project files");
781 Get_Name_String (Project.Exec_Directory.Name);
783 if Name_Buffer (Name_Len) /= Directory_Separator then
784 Name_Len := Name_Len + 1;
785 Name_Buffer (Name_Len) := Directory_Separator;
788 Name_Buffer (Name_Len + 1 ..
789 Name_Len + Exec_File_Name'Length) :=
791 Name_Len := Name_Len + Exec_File_Name'Length;
792 Name := new String'(Name_Buffer
(1 .. Name_Len
));
794 end Check_Relative_Executable
;
796 --------------------------------
797 -- Configuration_Pragmas_File --
798 --------------------------------
800 function Configuration_Pragmas_File
return Path_Name_Type
is
802 Prj
.Env
.Create_Config_Pragmas_File
(Project
, Project_Tree
);
803 return Project
.Config_File_Name
;
804 end Configuration_Pragmas_File
;
806 ------------------------------
807 -- Delete_Temp_Config_Files --
808 ------------------------------
810 procedure Delete_Temp_Config_Files
is
813 pragma Warnings
(Off
, Success
);
816 -- This should only be called if Keep_Temporary_Files is False
818 pragma Assert
(not Keep_Temporary_Files
);
820 if Project
/= No_Project
then
821 Proj
:= Project_Tree
.Projects
;
822 while Proj
/= null loop
823 if Proj
.Project
.Config_File_Temp
then
824 Delete_Temporary_File
825 (Project_Tree
.Shared
, Proj
.Project
.Config_File_Name
);
832 -- If a temporary text file that contains a list of files for a tool
833 -- has been created, delete this temporary file.
835 if Temp_File_Name
/= No_Path
then
836 Delete_Temporary_File
(Project_Tree
.Shared
, Temp_File_Name
);
838 end Delete_Temp_Config_Files
;
840 ---------------------------
841 -- Ensure_Absolute_Path --
842 ---------------------------
844 procedure Ensure_Absolute_Path
845 (Switch
: in out String_Access
;
849 Makeutl
.Ensure_Absolute_Path
851 Do_Fail
=> Osint
.Fail
'Access,
852 Including_Non_Switch
=> False,
853 Including_RTS
=> True);
854 end Ensure_Absolute_Path
;
860 function Mapping_File
return Path_Name_Type
is
861 Result
: Path_Name_Type
;
863 Prj
.Env
.Create_Mapping_File
865 Language
=> Name_Ada
,
866 In_Tree
=> Project_Tree
,
875 procedure Output_Version
is
877 if AAMP_On_Target
then
883 Put_Line
(Gnatvsn
.Gnat_Version_String
);
884 Put_Line
("Copyright 1996-" &
885 Gnatvsn
.Current_Year
&
886 ", Free Software Foundation, Inc.");
897 Put_Line
("List of available commands");
900 for C
in Command_List
'Range loop
905 if Targparm
.AAMP_On_Target
then
911 Put
(To_Lower
(Command_List
(C
).Cname
.all));
914 -- Never call gnatstack with a prefix
917 Put
(Command_List
(C
).Unixcmd
.all);
919 Put
(Program_Name
(Command_List
(C
).Unixcmd
.all, "gnat").all);
923 Sws
: Argument_List_Access
renames Command_List
(C
).Unixsws
;
926 for J
in Sws
'Range loop
938 Put_Line
("All commands except chop, krunch and preprocess " &
939 "accept project file switches -vPx, -Pprj, -Xnam=val," &
940 "--subdirs= and -eL");
948 procedure Process_Link
is
949 Look_For_Executable
: Boolean := True;
950 Libraries_Present
: Boolean := False;
951 Path_Option
: constant String_Access
:=
952 MLib
.Linker_Library_Path_Option
;
953 Prj
: Project_Id
:= Project
;
956 Skip_Executable
: Boolean := False;
959 -- Add the default search directories, to be able to find
960 -- libgnat in call to MLib.Utl.Lib_Directory.
962 Add_Default_Search_Dirs
;
964 Library_Paths
.Set_Last
(0);
966 -- Check if there are library project files
968 if MLib
.Tgt
.Support_For_Libraries
/= None
then
969 Set_Libraries
(Project
, Project_Tree
, Libraries_Present
);
972 -- If there are, add the necessary additional switches
974 if Libraries_Present
then
976 -- Add -Wl,-rpath,<lib_dir>
978 -- If Path_Option is not null, create the switch ("-Wl,-rpath," or
979 -- equivalent) with all the library dirs plus the standard GNAT
982 if Path_Option
/= null then
984 Option
: String_Access
;
985 Length
: Natural := Path_Option
'Length;
989 if MLib
.Separate_Run_Path_Options
then
991 -- We are going to create one switch of the form
992 -- "-Wl,-rpath,dir_N" for each directory to consider.
994 -- One switch for each library directory
997 Library_Paths
.First
.. Library_Paths
.Last
999 Last_Switches
.Increment_Last
;
1001 (Last_Switches
.Last
) := new String'
1003 Last_Switches.Table (Index).all);
1006 -- One switch for the standard GNAT library dir
1008 Last_Switches.Increment_Last;
1010 (Last_Switches.Last) := new String'
1011 (Path_Option
.all & MLib
.Utl
.Lib_Directory
);
1014 -- First, compute the exact length for the switch
1017 Library_Paths
.First
.. Library_Paths
.Last
1019 -- Add the length of the library dir plus one for the
1020 -- directory separator.
1024 Library_Paths
.Table
(Index
)'Length + 1;
1027 -- Finally, add the length of the standard GNAT library dir
1029 Length
:= Length
+ MLib
.Utl
.Lib_Directory
'Length;
1030 Option
:= new String (1 .. Length
);
1031 Option
(1 .. Path_Option
'Length) := Path_Option
.all;
1032 Current
:= Path_Option
'Length;
1034 -- Put each library dir followed by a dir separator
1037 Library_Paths
.First
.. Library_Paths
.Last
1042 Library_Paths
.Table
(Index
)'Length) :=
1043 Library_Paths
.Table
(Index
).all;
1046 Library_Paths
.Table
(Index
)'Length + 1;
1047 Option
(Current
) := Path_Separator
;
1050 -- Finally put the standard GNAT library dir
1054 Current
+ MLib
.Utl
.Lib_Directory
'Length) :=
1055 MLib
.Utl
.Lib_Directory
;
1057 -- And add the switch to the last switches
1059 Last_Switches
.Increment_Last
;
1060 Last_Switches
.Table
(Last_Switches
.Last
) :=
1067 -- Check if the first ALI file specified can be found, either in the
1068 -- object directory of the main project or in an object directory of a
1069 -- project file extended by the main project. If the ALI file can be
1070 -- found, replace its name with its absolute path.
1072 Skip_Executable
:= False;
1074 Switch_Loop
: for J
in 1 .. Last_Switches
.Last
loop
1076 -- If we have an executable just reset the flag
1078 if Skip_Executable
then
1079 Skip_Executable
:= False;
1081 -- If -o, set flag so that next switch is not processed
1083 elsif Last_Switches
.Table
(J
).all = "-o" then
1084 Skip_Executable
:= True;
1090 Switch
: constant String :=
1091 Last_Switches
.Table
(J
).all;
1092 ALI_File
: constant String (1 .. Switch
'Length + 4) :=
1095 Test_Existence
: Boolean := False;
1098 Last
:= Switch
'Length;
1100 -- Skip real switches
1102 if Switch
'Length /= 0
1103 and then Switch
(Switch
'First) /= '-'
1105 -- Append ".ali" if file name does not end with it
1107 if Switch
'Length <= 4
1108 or else Switch
(Switch
'Last - 3 .. Switch
'Last) /= ".ali"
1110 Last
:= ALI_File
'Last;
1113 -- If file name includes directory information, stop if ALI
1116 if Is_Absolute_Path
(ALI_File
(1 .. Last
)) then
1117 Test_Existence
:= True;
1120 for K
in Switch
'Range loop
1121 if Is_Directory_Separator
(Switch
(K
)) then
1122 Test_Existence
:= True;
1128 if Test_Existence
then
1129 if Is_Regular_File
(ALI_File
(1 .. Last
)) then
1133 -- Look in object directories if ALI file exists
1138 Dir
: constant String :=
1139 Get_Name_String
(Prj
.Object_Directory
.Name
);
1143 ALI_File
(1 .. Last
))
1145 -- We have found the correct project, so we
1146 -- replace the file with the absolute path.
1148 Last_Switches
.Table
(J
) :=
1149 new String'(Dir & ALI_File (1 .. Last));
1157 -- Go to the project being extended, if any
1160 exit Project_Loop when Prj = No_Project;
1161 end loop Project_Loop;
1166 end loop Switch_Loop;
1168 -- If a relative path output file has been specified, we add the exec
1171 for J in reverse 1 .. Last_Switches.Last - 1 loop
1172 if Last_Switches.Table (J).all = "-o" then
1173 Check_Relative_Executable
1174 (Name => Last_Switches.Table (J + 1));
1175 Look_For_Executable := False;
1180 if Look_For_Executable then
1181 for J in reverse 1 .. First_Switches.Last - 1 loop
1182 if First_Switches.Table (J).all = "-o" then
1183 Look_For_Executable := False;
1184 Check_Relative_Executable
1185 (Name => First_Switches.Table (J + 1));
1191 -- If no executable is specified, then find the name of the first ALI
1192 -- file on the command line and issue a -o switch with the absolute path
1193 -- of the executable in the exec directory.
1195 if Look_For_Executable then
1196 for J in 1 .. Last_Switches.Last loop
1197 Arg := Last_Switches.Table (J);
1200 if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
1202 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
1204 Last := Arg'Last - 4;
1206 elsif Is_Regular_File (Arg.all & ".ali") then
1211 Last_Switches.Increment_Last;
1212 Last_Switches.Table (Last_Switches.Last) :=
1214 Get_Name_String
(Project
.Exec_Directory
.Name
);
1215 Last_Switches
.Increment_Last
;
1216 Last_Switches
.Table
(Last_Switches
.Last
) :=
1217 new String'(Name_Buffer (1 .. Name_Len) &
1219 (Base_Name (Arg (Arg'First .. Last))));
1227 ---------------------
1228 -- Set_Library_For --
1229 ---------------------
1231 procedure Set_Library_For
1232 (Project : Project_Id;
1233 Tree : Project_Tree_Ref;
1234 Libraries_Present : in out Boolean)
1236 pragma Unreferenced (Tree);
1238 Path_Option : constant String_Access :=
1239 MLib.Linker_Library_Path_Option;
1242 -- Case of library project
1244 if Project.Library then
1245 Libraries_Present := True;
1247 -- Add the -L switch
1249 Last_Switches.Increment_Last;
1250 Last_Switches.Table (Last_Switches.Last) :=
1251 new String'("-L" & Get_Name_String
(Project
.Library_Dir
.Name
));
1253 -- Add the -l switch
1255 Last_Switches
.Increment_Last
;
1256 Last_Switches
.Table
(Last_Switches
.Last
) :=
1257 new String'("-l" & Get_Name_String (Project.Library_Name));
1259 -- Add the directory to table Library_Paths, to be processed later
1260 -- if library is not static and if Path_Option is not null.
1262 if Project.Library_Kind /= Static
1263 and then Path_Option /= null
1265 Library_Paths.Increment_Last;
1266 Library_Paths.Table (Library_Paths.Last) :=
1267 new String'(Get_Name_String
(Project
.Library_Dir
.Name
));
1270 end Set_Library_For
;
1272 procedure Check_Version_And_Help
is
1273 new Check_Version_And_Help_G
(Usage
);
1275 -- Start of processing for GNATCmd
1278 -- All output from GNATCmd is debugging or error output: send to stderr
1288 Prj
.Tree
.Initialize
(Root_Environment
, Gnatmake_Flags
);
1290 Project_Node_Tree
:= new Project_Node_Tree_Data
;
1291 Prj
.Tree
.Initialize
(Project_Node_Tree
);
1293 Prj
.Initialize
(Project_Tree
);
1296 Last_Switches
.Set_Last
(0);
1298 First_Switches
.Init
;
1299 First_Switches
.Set_Last
(0);
1301 Carg_Switches
.Set_Last
(0);
1302 Rules_Switches
.Init
;
1303 Rules_Switches
.Set_Last
(0);
1305 -- Set AAMP_On_Target from command name, for testing in Osint.Program_Name
1306 -- to handle the mapping of GNAAMP tool names. We don't extract it from
1307 -- system.ads, as there may be no default runtime.
1310 AAMP_On_Target
:= Name_Buffer
(1 .. Name_Len
) = "gnaampcmd";
1312 -- Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
1313 -- so that the spawned tool may know the way the GNAT driver was invoked.
1316 Add_Str_To_Name_Buffer
(Command_Name
);
1318 for J
in 1 .. Argument_Count
loop
1319 Add_Char_To_Name_Buffer
(' ');
1320 Add_Str_To_Name_Buffer
(Argument
(J
));
1323 Setenv
("GNAT_DRIVER_COMMAND_LINE", Name_Buffer
(1 .. Name_Len
));
1325 -- Add the directory where the GNAT driver is invoked in front of the path,
1326 -- if the GNAT driver is invoked with directory information.
1329 Command
: constant String := Command_Name
;
1332 for Index
in reverse Command
'Range loop
1333 if Command
(Index
) = Directory_Separator
then
1335 Absolute_Dir
: constant String :=
1337 (Command
(Command
'First .. Index
));
1339 PATH
: constant String :=
1340 Absolute_Dir
& Path_Separator
& Getenv
("PATH").all;
1343 Setenv
("PATH", PATH
);
1351 -- Scan the command line
1353 -- First, scan to detect --version and/or --help
1355 Check_Version_And_Help
("GNAT", "1996");
1359 if Command_Arg
<= Argument_Count
1360 and then Argument
(Command_Arg
) = "-v"
1362 Verbose_Mode
:= True;
1363 Command_Arg
:= Command_Arg
+ 1;
1365 elsif Command_Arg
<= Argument_Count
1366 and then Argument
(Command_Arg
) = "-dn"
1368 Keep_Temporary_Files
:= True;
1369 Command_Arg
:= Command_Arg
+ 1;
1376 -- If there is no command, just output the usage
1378 if Command_Arg
> Argument_Count
then
1383 The_Command
:= Real_Command_Type
'Value (Argument
(Command_Arg
));
1386 when Constraint_Error
=>
1388 -- Check if it is an alternate command
1391 Alternate
: Alternate_Command
;
1394 Alternate
:= Alternate_Command
'Value
1395 (Argument
(Command_Arg
));
1396 The_Command
:= Corresponding_To
(Alternate
);
1399 when Constraint_Error
=>
1401 Fail
("unknown command: " & Argument
(Command_Arg
));
1405 -- Get the arguments from the command line and from the eventual
1406 -- argument file(s) specified on the command line.
1408 for Arg
in Command_Arg
+ 1 .. Argument_Count
loop
1410 The_Arg
: constant String := Argument
(Arg
);
1413 -- Check if an argument file is specified
1415 if The_Arg
(The_Arg
'First) = '@' then
1417 Arg_File
: Ada
.Text_IO
.File_Type
;
1418 Line
: String (1 .. 256);
1422 -- Open the file and fail if the file cannot be found
1427 The_Arg
(The_Arg
'First + 1 .. The_Arg
'Last));
1431 Put
(Standard_Error
, "Cannot open argument file """);
1432 Put
(Standard_Error
,
1433 The_Arg
(The_Arg
'First + 1 .. The_Arg
'Last));
1434 Put_Line
(Standard_Error
, """");
1438 -- Read line by line and put the content of each non-
1439 -- empty line in the Last_Switches table.
1441 while not End_Of_File
(Arg_File
) loop
1442 Get_Line
(Arg_File
, Line
, Last
);
1445 Last_Switches
.Increment_Last
;
1446 Last_Switches
.Table
(Last_Switches
.Last
) :=
1447 new String'(Line (1 .. Last));
1455 -- It is not an argument file; just put the argument in
1456 -- the Last_Switches table.
1458 Last_Switches.Increment_Last;
1459 Last_Switches.Table (Last_Switches.Last) :=
1460 new String'(The_Arg
);
1466 Program
: String_Access
;
1467 Exec_Path
: String_Access
;
1470 if The_Command
= Stack
then
1472 -- Never call gnatstack with a prefix
1474 Program
:= new String'(Command_List (The_Command).Unixcmd.all);
1478 Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
1481 -- For the tools where the GNAT driver processes the project files,
1482 -- allow shared library projects to import projects that are not shared
1483 -- library projects, to avoid adding a switch for these tools. For the
1484 -- builder (gnatmake), if a shared library project imports a project
1485 -- that is not a shared library project and the appropriate switch is
1486 -- not specified, the invocation of gnatmake will fail.
1488 Opt.Unchecked_Shared_Lib_Imports := True;
1490 -- Locate the executable for the command
1492 Exec_Path := Locate_Exec_On_Path (Program.all);
1494 if Exec_Path = null then
1495 Put_Line (Standard_Error, "could not locate " & Program.all);
1499 -- If there are switches for the executable, put them as first switches
1501 if Command_List (The_Command).Unixsws /= null then
1502 for J in Command_List (The_Command).Unixsws'Range loop
1503 First_Switches.Increment_Last;
1504 First_Switches.Table (First_Switches.Last) :=
1505 Command_List (The_Command).Unixsws (J);
1509 -- For BIND, CHECK, ELIM, FIND, LINK, LIST, METRIC, PRETTY, STACK, STUB,
1510 -- SYNC and XREF, look for project file related switches.
1514 Tool_Package_Name := Name_Binder;
1515 Packages_To_Check := Packages_To_Check_By_Binder;
1517 Tool_Package_Name := Name_Finder;
1518 Packages_To_Check := Packages_To_Check_By_Finder;
1520 Tool_Package_Name := Name_Linker;
1521 Packages_To_Check := Packages_To_Check_By_Linker;
1523 Tool_Package_Name := Name_Gnatls;
1524 Packages_To_Check := Packages_To_Check_By_Gnatls;
1526 Tool_Package_Name := Name_Stack;
1527 Packages_To_Check := Packages_To_Check_By_Stack;
1529 Tool_Package_Name := Name_Synchronize;
1530 Packages_To_Check := Packages_To_Check_By_Sync;
1532 Tool_Package_Name := Name_Cross_Reference;
1533 Packages_To_Check := Packages_To_Check_By_Xref;
1535 Tool_Package_Name := No_Name;
1538 if Tool_Package_Name /= No_Name then
1540 -- Check that the switches are consistent. Detect project file
1541 -- related switches.
1543 Inspect_Switches : declare
1544 Arg_Num : Positive := 1;
1545 Argv : String_Access;
1547 procedure Remove_Switch (Num : Positive);
1548 -- Remove a project related switch from table Last_Switches
1554 procedure Remove_Switch (Num : Positive) is
1556 Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1557 Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1558 Last_Switches.Decrement_Last;
1561 -- Start of processing for Inspect_Switches
1564 while Arg_Num <= Last_Switches.Last loop
1565 Argv := Last_Switches.Table (Arg_Num);
1567 if Argv (Argv'First) = '-' then
1568 if Argv'Length = 1 then
1570 ("switch character cannot be followed by a blank");
1573 -- The two style project files (-p and -P) cannot be used
1576 if (The_Command = Find or else The_Command = Xref)
1577 and then Argv (2) = 'p
'
1579 Old_Project_File_Used := True;
1580 if Project_File /= null then
1581 Fail ("-P and -p cannot be used together");
1585 -- --subdirs=... Specify Subdirs
1587 if Argv'Length > Makeutl.Subdirs_Option'Length
1591 Argv'First + Makeutl.Subdirs_Option'Length - 1) =
1592 Makeutl.Subdirs_Option
1597 (Argv
'First + Makeutl
.Subdirs_Option
'Length ..
1600 Remove_Switch
(Arg_Num
);
1602 -- -aPdir Add dir to the project search path
1604 elsif Argv
'Length > 3
1605 and then Argv
(Argv
'First + 1 .. Argv
'First + 2) = "aP"
1607 Prj
.Env
.Add_Directories
1608 (Root_Environment
.Project_Path
,
1609 Argv
(Argv
'First + 3 .. Argv
'Last));
1611 -- Pass -aPdir to gnatls, but not to other tools
1613 if The_Command
= List
then
1614 Arg_Num
:= Arg_Num
+ 1;
1616 Remove_Switch
(Arg_Num
);
1619 -- -eL Follow links for files
1621 elsif Argv
.all = "-eL" then
1622 Follow_Links_For_Files
:= True;
1623 Follow_Links_For_Dirs
:= True;
1625 Remove_Switch
(Arg_Num
);
1627 -- -vPx Specify verbosity while parsing project files
1629 elsif Argv
'Length >= 3
1630 and then Argv
(Argv
'First + 1 .. Argv
'First + 2) = "vP"
1633 and then Argv
(Argv
'Last) in '0' .. '2'
1635 case Argv
(Argv
'Last) is
1637 Current_Verbosity
:= Prj
.Default
;
1639 Current_Verbosity
:= Prj
.Medium
;
1641 Current_Verbosity
:= Prj
.High
;
1646 raise Program_Error
;
1649 Fail
("invalid verbosity level: "
1650 & Argv
(Argv
'First + 3 .. Argv
'Last));
1653 Remove_Switch
(Arg_Num
);
1655 -- -Pproject_file Specify project file to be used
1657 elsif Argv
(Argv
'First + 1) = 'P' then
1659 -- Only one -P switch can be used
1661 if Project_File
/= null then
1664 & ": second project file forbidden (first is """
1668 -- The two style project files (-p and -P) cannot be
1671 elsif Old_Project_File_Used
then
1672 Fail
("-p and -P cannot be used together");
1674 elsif Argv
'Length = 2 then
1676 -- There is space between -P and the project file
1677 -- name. -P cannot be the last option.
1679 if Arg_Num
= Last_Switches
.Last
then
1680 Fail
("project file name missing after -P");
1683 Remove_Switch
(Arg_Num
);
1684 Argv
:= Last_Switches
.Table
(Arg_Num
);
1686 -- After -P, there must be a project file name,
1687 -- not another switch.
1689 if Argv
(Argv
'First) = '-' then
1690 Fail
("project file name missing after -P");
1693 Project_File
:= new String'(Argv.all);
1698 -- No space between -P and project file name
1701 new String'(Argv
(Argv
'First + 2 .. Argv
'Last));
1704 Remove_Switch
(Arg_Num
);
1706 -- -Xexternal=value Specify an external reference to be
1707 -- used in project files
1709 elsif Argv
'Length >= 5
1710 and then Argv
(Argv
'First + 1) = 'X'
1712 if not Check
(Root_Environment
.External
,
1713 Argv
(Argv
'First + 2 .. Argv
'Last))
1716 & " is not a valid external assignment.");
1719 Remove_Switch
(Arg_Num
);
1722 (The_Command
= Sync
or else
1723 The_Command
= Stack
or else
1725 and then Argv
'Length = 2
1726 and then Argv
(2) = 'U'
1728 All_Projects
:= True;
1729 Remove_Switch
(Arg_Num
);
1732 Arg_Num
:= Arg_Num
+ 1;
1736 Arg_Num
:= Arg_Num
+ 1;
1739 end Inspect_Switches
;
1742 -- Add the default project search directories now, after the directories
1743 -- that have been specified by switches -aP<dir>.
1745 Prj
.Env
.Initialize_Default_Project_Path
1746 (Root_Environment
.Project_Path
,
1747 Target_Name
=> Sdefault
.Target_Name
.all);
1749 -- If there is a project file specified, parse it, get the switches
1750 -- for the tool and setup PATH environment variables.
1752 if Project_File
/= null then
1753 Prj
.Pars
.Set_Verbosity
(To
=> Current_Verbosity
);
1756 (Project
=> Project
,
1757 In_Tree
=> Project_Tree
,
1758 In_Node_Tree
=> Project_Node_Tree
,
1759 Project_File_Name
=> Project_File
.all,
1760 Env
=> Root_Environment
,
1761 Packages_To_Check
=> Packages_To_Check
);
1763 -- Prj.Pars.Parse calls Set_Standard_Output, reset to stderr
1767 if Project
= Prj
.No_Project
then
1768 Fail
("""" & Project_File
.all & """ processing failed");
1770 elsif Project
.Qualifier
= Aggregate
then
1771 Fail
("aggregate projects are not supported");
1773 elsif Aggregate_Libraries_In
(Project_Tree
) then
1774 Fail
("aggregate library projects are not supported");
1777 -- Check if a package with the name of the tool is in the project
1778 -- file and if there is one, get the switches, if any, and scan them.
1781 Pkg
: constant Prj
.Package_Id
:=
1783 (Name
=> Tool_Package_Name
,
1784 In_Packages
=> Project
.Decl
.Packages
,
1785 Shared
=> Project_Tree
.Shared
);
1787 Element
: Package_Element
;
1789 Switches_Array
: Array_Element_Id
;
1791 The_Switches
: Prj
.Variable_Value
;
1792 Current
: Prj
.String_List_Id
;
1793 The_String
: String_Element
;
1795 Main
: String_Access
:= null;
1798 if Pkg
/= No_Package
then
1799 Element
:= Project_Tree
.Shared
.Packages
.Table
(Pkg
);
1801 -- Packages Gnatls and Gnatstack have a single attribute
1802 -- Switches, that is not an associative array.
1804 if The_Command
= List
or else The_Command
= Stack
then
1807 (Variable_Name
=> Snames
.Name_Switches
,
1808 In_Variables
=> Element
.Decl
.Attributes
,
1809 Shared
=> Project_Tree
.Shared
);
1811 -- Packages Binder (for gnatbind), Cross_Reference (for
1812 -- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
1813 -- have an attributed Switches, an associative array, indexed
1814 -- by the name of the file.
1816 -- They also have an attribute Default_Switches, indexed by the
1817 -- name of the programming language.
1820 -- First check if there is a single main
1822 for J
in 1 .. Last_Switches
.Last
loop
1823 if Last_Switches
.Table
(J
) (1) /= '-' then
1825 Main
:= Last_Switches
.Table
(J
);
1834 if Main
/= null then
1837 (Name
=> Name_Switches
,
1838 In_Arrays
=> Element
.Decl
.Arrays
,
1839 Shared
=> Project_Tree
.Shared
);
1842 -- If the single main has been specified as an absolute
1843 -- path, use only the simple file name. If the absolute
1844 -- path is incorrect, an error will be reported by the
1845 -- underlying tool and it does not make a difference
1846 -- what switches are used.
1848 if Is_Absolute_Path
(Main
.all) then
1849 Add_Str_To_Name_Buffer
(File_Name
(Main
.all));
1851 Add_Str_To_Name_Buffer
(Main
.all);
1854 The_Switches
:= Prj
.Util
.Value_Of
1855 (Index
=> Name_Find
,
1857 In_Array
=> Switches_Array
,
1858 Shared
=> Project_Tree
.Shared
);
1861 if The_Switches
.Kind
= Prj
.Undefined
then
1864 (Name
=> Name_Default_Switches
,
1865 In_Arrays
=> Element
.Decl
.Arrays
,
1866 Shared
=> Project_Tree
.Shared
);
1867 The_Switches
:= Prj
.Util
.Value_Of
1870 In_Array
=> Switches_Array
,
1871 Shared
=> Project_Tree
.Shared
);
1875 -- If there are switches specified in the package of the
1876 -- project file corresponding to the tool, scan them.
1878 case The_Switches
.Kind
is
1879 when Prj
.Undefined
=>
1884 Switch
: constant String :=
1885 Get_Name_String
(The_Switches
.Value
);
1888 if Switch
'Length > 0 then
1889 First_Switches
.Increment_Last
;
1890 First_Switches
.Table
(First_Switches
.Last
) :=
1891 new String'(Switch);
1896 Current := The_Switches.Values;
1897 while Current /= Prj.Nil_String loop
1898 The_String := Project_Tree.Shared.String_Elements.
1902 Switch : constant String :=
1903 Get_Name_String (The_String.Value);
1906 if Switch'Length > 0 then
1907 First_Switches.Increment_Last;
1908 First_Switches.Table (First_Switches.Last) :=
1909 new String'(Switch
);
1913 Current
:= The_String
.Next
;
1919 if The_Command
= Bind
or else The_Command
= Link
then
1920 if Project
.Object_Directory
.Name
= No_Path
then
1921 Fail
("project " & Get_Name_String
(Project
.Display_Name
)
1922 & " has no object directory");
1925 Change_Dir
(Get_Name_String
(Project
.Object_Directory
.Name
));
1928 -- Set up the env vars for project path files
1930 Prj
.Env
.Set_Ada_Paths
1931 (Project
, Project_Tree
, Including_Libraries
=> True);
1933 -- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1934 -- a configuration pragmas file, if necessary.
1936 if The_Command
= Sync
then
1938 -- If there are switches in package Compiler, put them in the
1939 -- Carg_Switches table.
1942 Pkg
: constant Prj
.Package_Id
:=
1944 (Name
=> Name_Compiler
,
1945 In_Packages
=> Project
.Decl
.Packages
,
1946 Shared
=> Project_Tree
.Shared
);
1948 Element
: Package_Element
;
1950 Switches_Array
: Array_Element_Id
;
1952 The_Switches
: Prj
.Variable_Value
;
1953 Current
: Prj
.String_List_Id
;
1954 The_String
: String_Element
;
1956 Main
: String_Access
:= null;
1960 if Pkg
/= No_Package
then
1962 -- First, check if there is a single main specified
1964 for J
in 1 .. Last_Switches
.Last
loop
1965 if Last_Switches
.Table
(J
) (1) /= '-' then
1967 Main
:= Last_Switches
.Table
(J
);
1976 Element
:= Project_Tree
.Shared
.Packages
.Table
(Pkg
);
1978 -- If there is a single main and there is compilation
1979 -- switches specified in the project file, use them.
1981 if Main
/= null and then not All_Projects
then
1982 Name_Len
:= Main
'Length;
1983 Name_Buffer
(1 .. Name_Len
) := Main
.all;
1984 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
1985 Main_Id
:= Name_Find
;
1989 (Name
=> Name_Switches
,
1990 In_Arrays
=> Element
.Decl
.Arrays
,
1991 Shared
=> Project_Tree
.Shared
);
1992 The_Switches
:= Prj
.Util
.Value_Of
1995 In_Array
=> Switches_Array
,
1996 Shared
=> Project_Tree
.Shared
);
1999 -- Otherwise, get the Default_Switches ("Ada")
2001 if The_Switches
.Kind
= Undefined
then
2004 (Name
=> Name_Default_Switches
,
2005 In_Arrays
=> Element
.Decl
.Arrays
,
2006 Shared
=> Project_Tree
.Shared
);
2007 The_Switches
:= Prj
.Util
.Value_Of
2010 In_Array
=> Switches_Array
,
2011 Shared
=> Project_Tree
.Shared
);
2014 -- If there are switches specified, put them in the
2015 -- Carg_Switches table.
2017 case The_Switches
.Kind
is
2018 when Prj
.Undefined
=>
2023 Switch
: constant String :=
2024 Get_Name_String
(The_Switches
.Value
);
2026 if Switch
'Length > 0 then
2027 Add_To_Carg_Switches
(new String'(Switch));
2032 Current := The_Switches.Values;
2033 while Current /= Prj.Nil_String loop
2034 The_String := Project_Tree.Shared.String_Elements
2038 Switch : constant String :=
2039 Get_Name_String (The_String.Value);
2041 if Switch'Length > 0 then
2042 Add_To_Carg_Switches (new String'(Switch
));
2046 Current
:= The_String
.Next
;
2052 -- If -cargs is one of the switches, move the following switches
2053 -- to the Carg_Switches table.
2055 for J
in 1 .. First_Switches
.Last
loop
2056 if First_Switches
.Table
(J
).all = "-cargs" then
2062 -- Move the switches that are before -rules when the
2063 -- command is CHECK.
2066 while K
<= First_Switches
.Last
loop
2067 Add_To_Carg_Switches
(First_Switches
.Table
(K
));
2071 if K
> First_Switches
.Last
then
2072 First_Switches
.Set_Last
(J
- 1);
2076 while K
<= First_Switches
.Last
loop
2078 First_Switches
.Table
(Last
) :=
2079 First_Switches
.Table
(K
);
2083 First_Switches
.Set_Last
(Last
);
2091 for J
in 1 .. Last_Switches
.Last
loop
2092 if Last_Switches
.Table
(J
).all = "-cargs" then
2093 for K
in J
+ 1 .. Last_Switches
.Last
loop
2094 Add_To_Carg_Switches
(Last_Switches
.Table
(K
));
2097 Last_Switches
.Set_Last
(J
- 1);
2103 CP_File
: constant Path_Name_Type
:= Configuration_Pragmas_File
;
2104 M_File
: constant Path_Name_Type
:= Mapping_File
;
2107 if CP_File
/= No_Path
then
2108 Add_To_Carg_Switches
2109 (new String'("-gnatec=" & Get_Name_String (CP_File)));
2112 if M_File /= No_Path then
2113 Add_To_Carg_Switches
2114 (new String'("-gnatem=" & Get_Name_String
(M_File
)));
2119 if The_Command
= Link
then
2123 if The_Command
= Link
or else The_Command
= Bind
then
2125 -- For files that are specified as relative paths with directory
2126 -- information, we convert them to absolute paths, with parent
2127 -- being the current working directory if specified on the command
2128 -- line and the project directory if specified in the project
2129 -- file. This is what gnatmake is doing for linker and binder
2132 for J
in 1 .. Last_Switches
.Last
loop
2133 GNATCmd
.Ensure_Absolute_Path
2134 (Last_Switches
.Table
(J
), Current_Work_Dir
);
2137 Get_Name_String
(Project
.Directory
.Name
);
2140 Project_Dir
: constant String := Name_Buffer
(1 .. Name_Len
);
2142 for J
in 1 .. First_Switches
.Last
loop
2143 GNATCmd
.Ensure_Absolute_Path
2144 (First_Switches
.Table
(J
), Project_Dir
);
2149 -- For gnat sync with -U + a main, get the list of sources from the
2150 -- closure and add them to the arguments.
2152 -- For gnat sync, gnat list, and gnat stack, if no file has been put
2153 -- on the command line, call tool with all the sources of the main
2156 if The_Command
= Sync
or else
2157 The_Command
= List
or else
2164 -- Gather all the arguments and invoke the executable
2167 The_Args
: Argument_List
2168 (1 .. First_Switches
.Last
+
2169 Last_Switches
.Last
+
2170 Carg_Switches
.Last
+
2171 Rules_Switches
.Last
);
2172 Arg_Num
: Natural := 0;
2175 for J
in 1 .. First_Switches
.Last
loop
2176 Arg_Num
:= Arg_Num
+ 1;
2177 The_Args
(Arg_Num
) := First_Switches
.Table
(J
);
2180 for J
in 1 .. Last_Switches
.Last
loop
2181 Arg_Num
:= Arg_Num
+ 1;
2182 The_Args
(Arg_Num
) := Last_Switches
.Table
(J
);
2185 for J
in 1 .. Carg_Switches
.Last
loop
2186 Arg_Num
:= Arg_Num
+ 1;
2187 The_Args
(Arg_Num
) := Carg_Switches
.Table
(J
);
2190 for J
in 1 .. Rules_Switches
.Last
loop
2191 Arg_Num
:= Arg_Num
+ 1;
2192 The_Args
(Arg_Num
) := Rules_Switches
.Table
(J
);
2195 if Verbose_Mode
then
2196 Output
.Write_Str
(Exec_Path
.all);
2198 for Arg
in The_Args
'Range loop
2199 Output
.Write_Char
(' ');
2200 Output
.Write_Str
(The_Args
(Arg
).all);
2207 Exit_Status
(Spawn
(Exec_Path
.all, The_Args
));
2214 if not Keep_Temporary_Files
then
2215 Prj
.Delete_All_Temp_Files
(Project_Tree
.Shared
);
2216 Delete_Temp_Config_Files
;
2219 Set_Exit_Status
(Failure
);
2222 if not Keep_Temporary_Files
then
2223 Prj
.Delete_All_Temp_Files
(Project_Tree
.Shared
);
2224 Delete_Temp_Config_Files
;
2227 Set_Exit_Status
(My_Exit_Status
);