?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2015-05-22 Eric Botcazou <ebotcazou@adacore.com>
[official-gcc.git] / gcc / ada / gnatcmd.adb
blobdcc3a85f539ac9535716b9a89f8a2c33c17b77a0
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T C M D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1996-2015, Free Software Foundation, Inc. --
10 -- --
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. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
27
28 with Csets;
29 with Gnatvsn;
30 with Makeutl; use Makeutl;
31 with MLib.Tgt; use MLib.Tgt;
32 with MLib.Utl;
33 with Namet; use Namet;
34 with Opt; use Opt;
35 with Osint; use Osint;
36 with Output; use Output;
37 with Prj; use Prj;
38 with Prj.Env;
39 with Prj.Ext; use Prj.Ext;
40 with Prj.Pars;
41 with Prj.Tree; use Prj.Tree;
42 with Prj.Util; use Prj.Util;
43 with Sdefault;
44 with Sinput.P;
45 with Snames; use Snames;
46 with Stringt;
47 with Switch; use Switch;
48 with Table;
49 with Targparm; use Targparm;
50 with Tempdir;
51 with Types; use Types;
52
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;
56
57 with GNAT.OS_Lib; use GNAT.OS_Lib;
58
59 procedure GNATCmd is
60 Gprbuild : constant String := "gprbuild";
61 Gnatmake : constant String := "gnatmake";
62
63 Gprclean : constant String := "gprclean";
64 Gnatclean : constant String := "gnatclean";
65
66 Normal_Exit : exception;
67 -- Raise this exception for normal program termination
68
69 Error_Exit : exception;
70 -- Raise this exception if error detected
71
72 type Command_Type is
73 (Bind,
74 Chop,
75 Clean,
76 Compile,
77 Check,
78 Elim,
79 Find,
80 Krunch,
81 Link,
82 List,
83 Make,
84 Metric,
85 Name,
86 Preprocess,
87 Pretty,
88 Stack,
89 Stub,
90 Test,
91 Xref,
92 Undefined);
93
94 subtype Real_Command_Type is Command_Type range Bind .. Xref;
95 -- All real command types (excludes only Undefined).
96
97 type Alternate_Command is (Comp, Ls, Kr, Pp, Prep);
98 -- Alternate command label
99
100 Corresponding_To : constant array (Alternate_Command) of Command_Type :=
101 (Comp => Compile,
102 Ls => List,
103 Kr => Krunch,
104 Prep => Preprocess,
105 Pp => Pretty);
106 -- Mapping of alternate commands to commands
107
108 Project_Node_Tree : Project_Node_Tree_Ref;
109 Project_File : String_Access;
110 Project : Prj.Project_Id;
111 Current_Verbosity : Prj.Verbosity := Prj.Default;
112 Tool_Package_Name : Name_Id := No_Name;
113
114 Project_Tree : constant Project_Tree_Ref :=
115 new Project_Tree_Data (Is_Root_Tree => True);
116 -- The project tree
117
118 Old_Project_File_Used : Boolean := False;
119 -- This flag indicates a switch -p (for gnatxref and gnatfind) for
120 -- an old fashioned project file. -p cannot be used in conjunction
121 -- with -P.
122
123 Temp_File_Name : Path_Name_Type := No_Path;
124 -- The name of the temporary text file to put a list of source/object
125 -- files to pass to a tool.
126
127 package First_Switches is new Table.Table
128 (Table_Component_Type => String_Access,
129 Table_Index_Type => Integer,
130 Table_Low_Bound => 1,
131 Table_Initial => 20,
132 Table_Increment => 100,
133 Table_Name => "Gnatcmd.First_Switches");
134 -- A table to keep the switches from the project file
135
136 package Carg_Switches is new Table.Table
137 (Table_Component_Type => String_Access,
138 Table_Index_Type => Integer,
139 Table_Low_Bound => 1,
140 Table_Initial => 20,
141 Table_Increment => 100,
142 Table_Name => "Gnatcmd.Carg_Switches");
143 -- A table to keep the switches following -cargs for ASIS tools
144
145 package Rules_Switches is new Table.Table
146 (Table_Component_Type => String_Access,
147 Table_Index_Type => Integer,
148 Table_Low_Bound => 1,
149 Table_Initial => 20,
150 Table_Increment => 100,
151 Table_Name => "Gnatcmd.Rules_Switches");
152 -- A table to keep the switches following -rules for gnatcheck
153
154 package Library_Paths is new Table.Table (
155 Table_Component_Type => String_Access,
156 Table_Index_Type => Integer,
157 Table_Low_Bound => 1,
158 Table_Initial => 20,
159 Table_Increment => 100,
160 Table_Name => "Make.Library_Path");
161
162 package Last_Switches is new Table.Table
163 (Table_Component_Type => String_Access,
164 Table_Index_Type => Integer,
165 Table_Low_Bound => 1,
166 Table_Initial => 20,
167 Table_Increment => 100,
168 Table_Name => "Gnatcmd.Last_Switches");
169
170 -- Packages of project files to pass to Prj.Pars.Parse, depending on the
171 -- tool. We allocate objects because we cannot declare aliased objects
172 -- as we are in a procedure, not a library level package.
173
174 subtype SA is String_Access;
175
176 Naming_String : constant SA := new String'("naming");
177 Binder_String : constant SA := new String'("binder");
178 Finder_String : constant SA := new String'("finder");
179 Linker_String : constant SA := new String'("linker");
180 Gnatls_String : constant SA := new String'("gnatls");
181 Xref_String : constant SA := new String'("cross_reference");
182
183 Packages_To_Check_By_Binder : constant String_List_Access :=
184 new String_List'((Naming_String, Binder_String));
185
186 Packages_To_Check_By_Finder : constant String_List_Access :=
187 new String_List'((Naming_String, Finder_String));
188
189 Packages_To_Check_By_Linker : constant String_List_Access :=
190 new String_List'((Naming_String, Linker_String));
191
192 Packages_To_Check_By_Gnatls : constant String_List_Access :=
193 new String_List'((Naming_String, Gnatls_String));
194
195 Packages_To_Check_By_Xref : constant String_List_Access :=
196 new String_List'((Naming_String, Xref_String));
197
198 Packages_To_Check : String_List_Access := Prj.All_Packages;
199
200 ----------------------------------
201 -- Declarations for GNATCMD use --
202 ----------------------------------
203
204 The_Command : Command_Type;
205 -- The command specified in the invocation of the GNAT driver
206
207 Command_Arg : Positive := 1;
208 -- The index of the command in the arguments of the GNAT driver
209
210 My_Exit_Status : Exit_Status := Success;
211 -- The exit status of the spawned tool
212
213 Current_Work_Dir : constant String := Get_Current_Dir;
214 -- The path of the working directory
215
216 All_Projects : Boolean := False;
217 -- Flag used for GNAT CHECK, GNAT PRETTY and GNAT METRIC to indicate that
218 -- the underlying tool (gnatcheck, gnatpp or gnatmetric) should be invoked
219 -- for all sources of all projects.
220
221 type Command_Entry is record
222 Cname : String_Access;
223 -- Command name for GNAT xxx command
224
225 Unixcmd : String_Access;
226 -- Corresponding Unix command
227
228 Unixsws : Argument_List_Access;
229 -- List of switches to be used with the Unix command
230 end record;
231
232 Command_List : constant array (Real_Command_Type) of Command_Entry :=
233 (Bind =>
234 (Cname => new String'("BIND"),
235 Unixcmd => new String'("gnatbind"),
236 Unixsws => null),
237
238 Chop =>
239 (Cname => new String'("CHOP"),
240 Unixcmd => new String'("gnatchop"),
241 Unixsws => null),
242
243 Clean =>
244 (Cname => new String'("CLEAN"),
245 Unixcmd => new String'("gnatclean"),
246 Unixsws => null),
247
248 Compile =>
249 (Cname => new String'("COMPILE"),
250 Unixcmd => new String'("gnatmake"),
251 Unixsws => new Argument_List'(1 => new String'("-f"),
252 2 => new String'("-u"),
253 3 => new String'("-c"))),
254
255 Check =>
256 (Cname => new String'("CHECK"),
257 Unixcmd => new String'("gnatcheck"),
258 Unixsws => null),
259
260 Elim =>
261 (Cname => new String'("ELIM"),
262 Unixcmd => new String'("gnatelim"),
263 Unixsws => null),
264
265 Find =>
266 (Cname => new String'("FIND"),
267 Unixcmd => new String'("gnatfind"),
268 Unixsws => null),
269
270 Krunch =>
271 (Cname => new String'("KRUNCH"),
272 Unixcmd => new String'("gnatkr"),
273 Unixsws => null),
274
275 Link =>
276 (Cname => new String'("LINK"),
277 Unixcmd => new String'("gnatlink"),
278 Unixsws => null),
279
280 List =>
281 (Cname => new String'("LIST"),
282 Unixcmd => new String'("gnatls"),
283 Unixsws => null),
284
285 Make =>
286 (Cname => new String'("MAKE"),
287 Unixcmd => new String'("gnatmake"),
288 Unixsws => null),
289
290 Metric =>
291 (Cname => new String'("METRIC"),
292 Unixcmd => new String'("gnatmetric"),
293 Unixsws => null),
294
295 Name =>
296 (Cname => new String'("NAME"),
297 Unixcmd => new String'("gnatname"),
298 Unixsws => null),
299
300 Preprocess =>
301 (Cname => new String'("PREPROCESS"),
302 Unixcmd => new String'("gnatprep"),
303 Unixsws => null),
304
305 Pretty =>
306 (Cname => new String'("PRETTY"),
307 Unixcmd => new String'("gnatpp"),
308 Unixsws => null),
309
310 Stack =>
311 (Cname => new String'("STACK"),
312 Unixcmd => new String'("gnatstack"),
313 Unixsws => null),
314
315 Stub =>
316 (Cname => new String'("STUB"),
317 Unixcmd => new String'("gnatstub"),
318 Unixsws => null),
319
320 Test =>
321 (Cname => new String'("TEST"),
322 Unixcmd => new String'("gnattest"),
323 Unixsws => null),
324
325 Xref =>
326 (Cname => new String'("XREF"),
327 Unixcmd => new String'("gnatxref"),
328 Unixsws => null)
329 );
330
331 -----------------------
332 -- Local Subprograms --
333 -----------------------
334
335 procedure Check_Files;
336 -- For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project file
337 -- is specified, without any file arguments and without a switch -files=.
338 -- If it is the case, invoke the GNAT tool with the proper list of files,
339 -- derived from the sources of the project.
340
341 procedure Check_Relative_Executable (Name : in out String_Access);
342 -- Check if an executable is specified as a relative path. If it is, and
343 -- the path contains directory information, fail. Otherwise, prepend the
344 -- exec directory. This procedure is only used for GNAT LINK when a project
345 -- file is specified.
346
347 procedure Delete_Temp_Config_Files;
348 -- Delete all temporary config files. The caller is responsible for
349 -- ensuring that Keep_Temporary_Files is False.
350
351 procedure Ensure_Absolute_Path
352 (Switch : in out String_Access;
353 Parent : String);
354 -- Test if Switch is a relative search path switch. If it is and it
355 -- includes directory information, prepend the path with Parent. This
356 -- subprogram is only called when using project files.
357
358 procedure Output_Version;
359 -- Output the version of this program
360
361 procedure Usage;
362 -- Display usage
363
364 procedure Process_Link;
365 -- Process GNAT LINK, when there is a project file specified
366
367 procedure Set_Library_For
368 (Project : Project_Id;
369 Tree : Project_Tree_Ref;
370 Libraries_Present : in out Boolean);
371 -- If Project is a library project, add the correct -L and -l switches to
372 -- the linker invocation.
373
374 procedure Set_Libraries is new
375 For_Every_Project_Imported (Boolean, Set_Library_For);
376 -- Add the -L and -l switches to the linker for all the library projects
377
378 -----------------
379 -- Check_Files --
380 -----------------
381
382 procedure Check_Files is
383 Add_Sources : Boolean := True;
384 Unit : Prj.Unit_Index;
385 Subunit : Boolean := False;
386 FD : File_Descriptor := Invalid_FD;
387 Status : Integer;
388 Success : Boolean;
389
390 procedure Add_To_Response_File
391 (File_Name : String;
392 Check_File : Boolean := True);
393 -- Include the file name passed as parameter in the response file for
394 -- the tool being called. If the response file can not be written then
395 -- the file name is passed in the parameter list of the tool. If the
396 -- Check_File parameter is True then the procedure verifies the
397 -- existence of the file before adding it to the response file.
398
399 --------------------------
400 -- Add_To_Response_File --
401 --------------------------
402
403 procedure Add_To_Response_File
404 (File_Name : String;
405 Check_File : Boolean := True)
406 is
407 begin
408 Name_Len := 0;
409
410 Add_Str_To_Name_Buffer (File_Name);
411
412 if not Check_File or else
413 Is_Regular_File (Name_Buffer (1 .. Name_Len))
414 then
415 if FD /= Invalid_FD then
416 Name_Len := Name_Len + 1;
417 Name_Buffer (Name_Len) := ASCII.LF;
418
419 Status := Write (FD, Name_Buffer (1)'Address, Name_Len);
420
421 if Status /= Name_Len then
422 Osint.Fail ("disk full");
423 end if;
424 else
425 Last_Switches.Increment_Last;
426 Last_Switches.Table (Last_Switches.Last) :=
427 new String'(File_Name);
428 end if;
429 end if;
430 end Add_To_Response_File;
431
432 -- Start of processing for Check_Files
433
434 begin
435 -- Check if there is at least one argument that is not a switch
436
437 for Index in 1 .. Last_Switches.Last loop
438 if Last_Switches.Table (Index) (1) /= '-'
439 or else (Last_Switches.Table (Index).all'Length > 7
440 and then Last_Switches.Table (Index) (1 .. 7) = "-files=")
441 then
442 Add_Sources := False;
443 exit;
444 end if;
445 end loop;
446
447 -- If all arguments are switches and there is no switch -files=, add the
448 -- path names of all the sources of the main project.
449
450 if Add_Sources then
451 Tempdir.Create_Temp_File (FD, Temp_File_Name);
452 Last_Switches.Increment_Last;
453 Last_Switches.Table (Last_Switches.Last) :=
454 new String'("-files=" & Get_Name_String (Temp_File_Name));
455
456 Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
457 while Unit /= No_Unit_Index loop
458
459 -- We only need to put the library units, body or spec, but not
460 -- the subunits.
461
462 if Unit.File_Names (Impl) /= null
463 and then not Unit.File_Names (Impl).Locally_Removed
464 then
465 -- There is a body, check if it is for this project
466
467 if All_Projects
468 or else Unit.File_Names (Impl).Project = Project
469 then
470 Subunit := False;
471
472 if Unit.File_Names (Spec) = null
473 or else Unit.File_Names (Spec).Locally_Removed
474 then
475 -- We have a body with no spec: we need to check if
476 -- this is a subunit, because gnatls will complain
477 -- about subunits.
478
479 declare
480 Src_Ind : constant Source_File_Index :=
481 Sinput.P.Load_Project_File
482 (Get_Name_String
483 (Unit.File_Names (Impl).Path.Name));
484 begin
485 Subunit := Sinput.P.Source_File_Is_Subunit (Src_Ind);
486 end;
487 end if;
488
489 if not Subunit then
490 Add_To_Response_File
491 (Get_Name_String (Unit.File_Names (Impl).Display_File),
492 Check_File => False);
493 end if;
494 end if;
495
496 elsif Unit.File_Names (Spec) /= null
497 and then not Unit.File_Names (Spec).Locally_Removed
498 then
499 -- We have a spec with no body. Check if it is for this project
500
501 if All_Projects
502 or else Unit.File_Names (Spec).Project = Project
503 then
504 Add_To_Response_File
505 (Get_Name_String (Unit.File_Names (Spec).Display_File),
506 Check_File => False);
507 end if;
508 end if;
509
510 Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
511 end loop;
512
513 if FD /= Invalid_FD then
514 Close (FD, Success);
515
516 if not Success then
517 Osint.Fail ("disk full");
518 end if;
519 end if;
520 end if;
521 end Check_Files;
522
523 -------------------------------
524 -- Check_Relative_Executable --
525 -------------------------------
526
527 procedure Check_Relative_Executable (Name : in out String_Access) is
528 Exec_File_Name : constant String := Name.all;
529
530 begin
531 if not Is_Absolute_Path (Exec_File_Name) then
532 for Index in Exec_File_Name'Range loop
533 if Exec_File_Name (Index) = Directory_Separator then
534 Fail ("relative executable (""" & Exec_File_Name
535 & """) with directory part not allowed "
536 & "when using project files");
537 end if;
538 end loop;
539
540 Get_Name_String (Project.Exec_Directory.Name);
541
542 if Name_Buffer (Name_Len) /= Directory_Separator then
543 Name_Len := Name_Len + 1;
544 Name_Buffer (Name_Len) := Directory_Separator;
545 end if;
546
547 Name_Buffer (Name_Len + 1 .. Name_Len + Exec_File_Name'Length) :=
548 Exec_File_Name;
549 Name_Len := Name_Len + Exec_File_Name'Length;
550 Name := new String'(Name_Buffer (1 .. Name_Len));
551 end if;
552 end Check_Relative_Executable;
553
554 ------------------------------
555 -- Delete_Temp_Config_Files --
556 ------------------------------
557
558 procedure Delete_Temp_Config_Files is
559 Success : Boolean;
560 Proj : Project_List;
561 pragma Warnings (Off, Success);
562
563 begin
564 -- This should only be called if Keep_Temporary_Files is False
565
566 pragma Assert (not Keep_Temporary_Files);
567
568 if Project /= No_Project then
569 Proj := Project_Tree.Projects;
570 while Proj /= null loop
571 if Proj.Project.Config_File_Temp then
572 Delete_Temporary_File
573 (Project_Tree.Shared, Proj.Project.Config_File_Name);
574 end if;
575
576 Proj := Proj.Next;
577 end loop;
578 end if;
579
580 -- If a temporary text file that contains a list of files for a tool
581 -- has been created, delete this temporary file.
582
583 if Temp_File_Name /= No_Path then
584 Delete_Temporary_File (Project_Tree.Shared, Temp_File_Name);
585 end if;
586 end Delete_Temp_Config_Files;
587
588 ---------------------------
589 -- Ensure_Absolute_Path --
590 ---------------------------
591
592 procedure Ensure_Absolute_Path
593 (Switch : in out String_Access;
594 Parent : String)
595 is
596 begin
597 Makeutl.Ensure_Absolute_Path
598 (Switch, Parent,
599 Do_Fail => Osint.Fail'Access,
600 Including_Non_Switch => False,
601 Including_RTS => True);
602 end Ensure_Absolute_Path;
603
604 --------------------
605 -- Output_Version --
606 --------------------
607
608 procedure Output_Version is
609 begin
610 if AAMP_On_Target then
611 Put ("GNAAMP ");
612 else
613 Put ("GNAT ");
614 end if;
615
616 Put_Line (Gnatvsn.Gnat_Version_String);
617 Put_Line ("Copyright 1996-" & Gnatvsn.Current_Year
618 & ", Free Software Foundation, Inc.");
619 end Output_Version;
620
621 -----------
622 -- Usage --
623 -----------
624
625 procedure Usage is
626 begin
627 Output_Version;
628 New_Line;
629 Put_Line ("List of available commands");
630 New_Line;
631
632 for C in Command_List'Range loop
633
634 if Targparm.AAMP_On_Target then
635 Put ("gnaampcmd ");
636 else
637 Put ("gnat ");
638 end if;
639
640 Put (To_Lower (Command_List (C).Cname.all));
641 Set_Col (25);
642 Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
643
644 declare
645 Sws : Argument_List_Access renames Command_List (C).Unixsws;
646 begin
647 if Sws /= null then
648 for J in Sws'Range loop
649 Put (' ');
650 Put (Sws (J).all);
651 end loop;
652 end if;
653 end;
654
655 New_Line;
656 end loop;
657
658 New_Line;
659 Put_Line ("Commands bind, find, link, list and xref "
660 & "accept project file switches -vPx, -Pprj, -Xnam=val,"
661 & "--subdirs= and -eL");
662 New_Line;
663 end Usage;
664
665 ------------------
666 -- Process_Link --
667 ------------------
668
669 procedure Process_Link is
670 Look_For_Executable : Boolean := True;
671 Libraries_Present : Boolean := False;
672 Path_Option : constant String_Access :=
673 MLib.Linker_Library_Path_Option;
674 Prj : Project_Id := Project;
675 Arg : String_Access;
676 Last : Natural := 0;
677 Skip_Executable : Boolean := False;
678
679 begin
680 -- Add the default search directories, to be able to find libgnat in
681 -- call to MLib.Utl.Lib_Directory.
682
683 Add_Default_Search_Dirs;
684
685 Library_Paths.Set_Last (0);
686
687 -- Check if there are library project files
688
689 if MLib.Tgt.Support_For_Libraries /= None then
690 Set_Libraries (Project, Project_Tree, Libraries_Present);
691 end if;
692
693 -- If there are, add the necessary additional switches
694
695 if Libraries_Present then
696
697 -- Add -Wl,-rpath,<lib_dir>
698
699 -- If Path_Option is not null, create the switch ("-Wl,-rpath," or
700 -- equivalent) with all the library dirs plus the standard GNAT
701 -- library dir.
702
703 if Path_Option /= null then
704 declare
705 Option : String_Access;
706 Length : Natural := Path_Option'Length;
707 Current : Natural;
708
709 begin
710 if MLib.Separate_Run_Path_Options then
711
712 -- We are going to create one switch of the form
713 -- "-Wl,-rpath,dir_N" for each directory to consider.
714
715 -- One switch for each library directory
716
717 for Index in
718 Library_Paths.First .. Library_Paths.Last
719 loop
720 Last_Switches.Increment_Last;
721 Last_Switches.Table
722 (Last_Switches.Last) := new String'
723 (Path_Option.all &
724 Last_Switches.Table (Index).all);
725 end loop;
726
727 -- One switch for the standard GNAT library dir
728
729 Last_Switches.Increment_Last;
730 Last_Switches.Table
731 (Last_Switches.Last) := new String'
732 (Path_Option.all & MLib.Utl.Lib_Directory);
733
734 else
735 -- First, compute the exact length for the switch
736
737 for Index in Library_Paths.First .. Library_Paths.Last loop
738
739 -- Add the length of the library dir plus one for the
740 -- directory separator.
741
742 Length :=
743 Length +
744 Library_Paths.Table (Index)'Length + 1;
745 end loop;
746
747 -- Finally, add the length of the standard GNAT library dir
748
749 Length := Length + MLib.Utl.Lib_Directory'Length;
750 Option := new String (1 .. Length);
751 Option (1 .. Path_Option'Length) := Path_Option.all;
752 Current := Path_Option'Length;
753
754 -- Put each library dir followed by a dir separator
755
756 for Index in
757 Library_Paths.First .. Library_Paths.Last
758 loop
759 Option
760 (Current + 1 ..
761 Current + Library_Paths.Table (Index)'Length) :=
762 Library_Paths.Table (Index).all;
763 Current :=
764 Current + Library_Paths.Table (Index)'Length + 1;
765 Option (Current) := Path_Separator;
766 end loop;
767
768 -- Finally put the standard GNAT library dir
769
770 Option
771 (Current + 1 .. Current + MLib.Utl.Lib_Directory'Length) :=
772 MLib.Utl.Lib_Directory;
773
774 -- And add the switch to the last switches
775
776 Last_Switches.Increment_Last;
777 Last_Switches.Table (Last_Switches.Last) := Option;
778 end if;
779 end;
780 end if;
781 end if;
782
783 -- Check if the first ALI file specified can be found, either in the
784 -- object directory of the main project or in an object directory of a
785 -- project file extended by the main project. If the ALI file can be
786 -- found, replace its name with its absolute path.
787
788 Skip_Executable := False;
789
790 Switch_Loop : for J in 1 .. Last_Switches.Last loop
791
792 -- If we have an executable just reset the flag
793
794 if Skip_Executable then
795 Skip_Executable := False;
796
797 -- If -o, set flag so that next switch is not processed
798
799 elsif Last_Switches.Table (J).all = "-o" then
800 Skip_Executable := True;
801
802 -- Normal case
803
804 else
805 declare
806 Switch : constant String := Last_Switches.Table (J).all;
807 ALI_File : constant String (1 .. Switch'Length + 4) :=
808 Switch & ".ali";
809
810 Test_Existence : Boolean := False;
811
812 begin
813 Last := Switch'Length;
814
815 -- Skip real switches
816
817 if Switch'Length /= 0
818 and then Switch (Switch'First) /= '-'
819 then
820 -- Append ".ali" if file name does not end with it
821
822 if Switch'Length <= 4
823 or else Switch (Switch'Last - 3 .. Switch'Last) /= ".ali"
824 then
825 Last := ALI_File'Last;
826 end if;
827
828 -- If file name includes directory information, stop if ALI
829 -- file exists.
830
831 if Is_Absolute_Path (ALI_File (1 .. Last)) then
832 Test_Existence := True;
833
834 else
835 for K in Switch'Range loop
836 if Is_Directory_Separator (Switch (K)) then
837 Test_Existence := True;
838 exit;
839 end if;
840 end loop;
841 end if;
842
843 if Test_Existence then
844 if Is_Regular_File (ALI_File (1 .. Last)) then
845 exit Switch_Loop;
846 end if;
847
848 -- Look in object directories if ALI file exists
849
850 else
851 Project_Loop : loop
852 declare
853 Dir : constant String :=
854 Get_Name_String (Prj.Object_Directory.Name);
855 begin
856 if Is_Regular_File (Dir & ALI_File (1 .. Last)) then
857
858 -- We have found the correct project, so we
859 -- replace the file with the absolute path.
860
861 Last_Switches.Table (J) :=
862 new String'(Dir & ALI_File (1 .. Last));
863
864 -- And we are done
865
866 exit Switch_Loop;
867 end if;
868 end;
869
870 -- Go to the project being extended, if any
871
872 Prj := Prj.Extends;
873 exit Project_Loop when Prj = No_Project;
874 end loop Project_Loop;
875 end if;
876 end if;
877 end;
878 end if;
879 end loop Switch_Loop;
880
881 -- If a relative path output file has been specified, we add the exec
882 -- directory.
883
884 for J in reverse 1 .. Last_Switches.Last - 1 loop
885 if Last_Switches.Table (J).all = "-o" then
886 Check_Relative_Executable (Name => Last_Switches.Table (J + 1));
887 Look_For_Executable := False;
888 exit;
889 end if;
890 end loop;
891
892 if Look_For_Executable then
893 for J in reverse 1 .. First_Switches.Last - 1 loop
894 if First_Switches.Table (J).all = "-o" then
895 Look_For_Executable := False;
896 Check_Relative_Executable
897 (Name => First_Switches.Table (J + 1));
898 exit;
899 end if;
900 end loop;
901 end if;
902
903 -- If no executable is specified, then find the name of the first ALI
904 -- file on the command line and issue a -o switch with the absolute path
905 -- of the executable in the exec directory.
906
907 if Look_For_Executable then
908 for J in 1 .. Last_Switches.Last loop
909 Arg := Last_Switches.Table (J);
910 Last := 0;
911
912 if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
913 if Arg'Length > 4
914 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
915 then
916 Last := Arg'Last - 4;
917
918 elsif Is_Regular_File (Arg.all & ".ali") then
919 Last := Arg'Last;
920 end if;
921
922 if Last /= 0 then
923 Last_Switches.Increment_Last;
924 Last_Switches.Table (Last_Switches.Last) :=
925 new String'("-o");
926 Get_Name_String (Project.Exec_Directory.Name);
927 Last_Switches.Increment_Last;
928 Last_Switches.Table (Last_Switches.Last) :=
929 new String'(Name_Buffer (1 .. Name_Len) &
930 Executable_Name
931 (Base_Name (Arg (Arg'First .. Last))));
932 exit;
933 end if;
934 end if;
935 end loop;
936 end if;
937 end Process_Link;
938
939 ---------------------
940 -- Set_Library_For --
941 ---------------------
942
943 procedure Set_Library_For
944 (Project : Project_Id;
945 Tree : Project_Tree_Ref;
946 Libraries_Present : in out Boolean)
947 is
948 pragma Unreferenced (Tree);
949
950 Path_Option : constant String_Access := MLib.Linker_Library_Path_Option;
951
952 begin
953 -- Case of library project
954
955 if Project.Library then
956 Libraries_Present := True;
957
958 -- Add the -L switch
959
960 Last_Switches.Increment_Last;
961 Last_Switches.Table (Last_Switches.Last) :=
962 new String'("-L" & Get_Name_String (Project.Library_Dir.Name));
963
964 -- Add the -l switch
965
966 Last_Switches.Increment_Last;
967 Last_Switches.Table (Last_Switches.Last) :=
968 new String'("-l" & Get_Name_String (Project.Library_Name));
969
970 -- Add the directory to table Library_Paths, to be processed later
971 -- if library is not static and if Path_Option is not null.
972
973 if Project.Library_Kind /= Static
974 and then Path_Option /= null
975 then
976 Library_Paths.Increment_Last;
977 Library_Paths.Table (Library_Paths.Last) :=
978 new String'(Get_Name_String (Project.Library_Dir.Name));
979 end if;
980 end if;
981 end Set_Library_For;
982
983 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
984
985 -- Start of processing for GNATCmd
986
987 begin
988 -- All output from GNATCmd is debugging or error output: send to stderr
989
990 Set_Standard_Error;
991
992 -- Initializations
993
994 Csets.Initialize;
995 Snames.Initialize;
996 Stringt.Initialize;
997
998 Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
999
1000 Project_Node_Tree := new Project_Node_Tree_Data;
1001 Prj.Tree.Initialize (Project_Node_Tree);
1002
1003 Prj.Initialize (Project_Tree);
1004
1005 Last_Switches.Init;
1006 Last_Switches.Set_Last (0);
1007
1008 First_Switches.Init;
1009 First_Switches.Set_Last (0);
1010 Carg_Switches.Init;
1011 Carg_Switches.Set_Last (0);
1012 Rules_Switches.Init;
1013 Rules_Switches.Set_Last (0);
1014
1015 -- Set AAMP_On_Target from command name, for testing in Osint.Program_Name
1016 -- to handle the mapping of GNAAMP tool names. We don't extract it from
1017 -- system.ads, as there may be no default runtime.
1018
1019 Find_Program_Name;
1020 AAMP_On_Target := Name_Buffer (1 .. Name_Len) = "gnaampcmd";
1021
1022 -- Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
1023 -- so that the spawned tool may know the way the GNAT driver was invoked.
1024
1025 Name_Len := 0;
1026 Add_Str_To_Name_Buffer (Command_Name);
1027
1028 for J in 1 .. Argument_Count loop
1029 Add_Char_To_Name_Buffer (' ');
1030 Add_Str_To_Name_Buffer (Argument (J));
1031 end loop;
1032
1033 Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
1034
1035 -- Add the directory where the GNAT driver is invoked in front of the path,
1036 -- if the GNAT driver is invoked with directory information.
1037
1038 declare
1039 Command : constant String := Command_Name;
1040
1041 begin
1042 for Index in reverse Command'Range loop
1043 if Command (Index) = Directory_Separator then
1044 declare
1045 Absolute_Dir : constant String :=
1046 Normalize_Pathname (Command (Command'First .. Index));
1047 PATH : constant String :=
1048 Absolute_Dir & Path_Separator & Getenv ("PATH").all;
1049 begin
1050 Setenv ("PATH", PATH);
1051 end;
1052
1053 exit;
1054 end if;
1055 end loop;
1056 end;
1057
1058 -- Scan the command line
1059
1060 -- First, scan to detect --version and/or --help
1061
1062 Check_Version_And_Help ("GNAT", "1996");
1063
1064 begin
1065 loop
1066 if Command_Arg <= Argument_Count
1067 and then Argument (Command_Arg) = "-v"
1068 then
1069 Verbose_Mode := True;
1070 Command_Arg := Command_Arg + 1;
1071
1072 elsif Command_Arg <= Argument_Count
1073 and then Argument (Command_Arg) = "-dn"
1074 then
1075 Keep_Temporary_Files := True;
1076 Command_Arg := Command_Arg + 1;
1077
1078 else
1079 exit;
1080 end if;
1081 end loop;
1082
1083 -- If there is no command, just output the usage
1084
1085 if Command_Arg > Argument_Count then
1086 Usage;
1087 return;
1088 end if;
1089
1090 The_Command := Real_Command_Type'Value (Argument (Command_Arg));
1091
1092 exception
1093 when Constraint_Error =>
1094
1095 -- Check if it is an alternate command
1096
1097 declare
1098 Alternate : Alternate_Command;
1099
1100 begin
1101 Alternate := Alternate_Command'Value (Argument (Command_Arg));
1102 The_Command := Corresponding_To (Alternate);
1103
1104 exception
1105 when Constraint_Error =>
1106 Usage;
1107 Fail ("unknown command: " & Argument (Command_Arg));
1108 end;
1109 end;
1110
1111 -- Get the arguments from the command line and from the eventual
1112 -- argument file(s) specified on the command line.
1113
1114 for Arg in Command_Arg + 1 .. Argument_Count loop
1115 declare
1116 The_Arg : constant String := Argument (Arg);
1117
1118 begin
1119 -- Check if an argument file is specified
1120
1121 if The_Arg (The_Arg'First) = '@' then
1122 declare
1123 Arg_File : Ada.Text_IO.File_Type;
1124 Line : String (1 .. 256);
1125 Last : Natural;
1126
1127 begin
1128 -- Open the file and fail if the file cannot be found
1129
1130 begin
1131 Open (Arg_File, In_File,
1132 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1133
1134 exception
1135 when others =>
1136 Put (Standard_Error, "Cannot open argument file """);
1137 Put (Standard_Error,
1138 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1139 Put_Line (Standard_Error, """");
1140 raise Error_Exit;
1141 end;
1142
1143 -- Read line by line and put the content of each non-
1144 -- empty line in the Last_Switches table.
1145
1146 while not End_Of_File (Arg_File) loop
1147 Get_Line (Arg_File, Line, Last);
1148
1149 if Last /= 0 then
1150 Last_Switches.Increment_Last;
1151 Last_Switches.Table (Last_Switches.Last) :=
1152 new String'(Line (1 .. Last));
1153 end if;
1154 end loop;
1155
1156 Close (Arg_File);
1157 end;
1158
1159 else
1160 -- It is not an argument file; just put the argument in
1161 -- the Last_Switches table.
1162
1163 Last_Switches.Increment_Last;
1164 Last_Switches.Table (Last_Switches.Last) := new String'(The_Arg);
1165 end if;
1166 end;
1167 end loop;
1168
1169 declare
1170 Program : String_Access;
1171 Exec_Path : String_Access;
1172
1173 begin
1174 if The_Command = Stack then
1175 -- Never call gnatstack with a prefix
1176
1177 Program := new String'(Command_List (The_Command).Unixcmd.all);
1178
1179 else
1180 Program :=
1181 Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
1182
1183 -- If we want to invoke gnatmake/gnatclean with -P, then check if
1184 -- gprbuild/gprclean is available; if it is, use gprbuild/gprclean
1185 -- instead of gnatmake/gnatclean.
1186
1187 if Program.all = Gnatmake or else Program.all = Gnatclean then
1188 declare
1189 Project_File_Used : Boolean := False;
1190 Switch : String_Access;
1191
1192 begin
1193 for J in 1 .. Last_Switches.Last loop
1194 Switch := Last_Switches.Table (J);
1195 if Switch'Length >= 2 and then
1196 Switch (Switch'First .. Switch'First + 1) = "-P"
1197 then
1198 Project_File_Used := True;
1199 exit;
1200 end if;
1201 end loop;
1202
1203 if Project_File_Used then
1204 if Program.all = Gnatmake
1205 and then Locate_Exec_On_Path (Gprbuild) /= null
1206 then
1207 Program := new String'(Gprbuild);
1208 elsif Program.all = Gnatclean
1209 and then Locate_Exec_On_Path (Gprclean) /= null
1210 then
1211 Program := new String'(Gprclean);
1212 end if;
1213 end if;
1214 end;
1215 end if;
1216 end if;
1217
1218 -- For the tools where the GNAT driver processes the project files,
1219 -- allow shared library projects to import projects that are not shared
1220 -- library projects, to avoid adding a switch for these tools. For the
1221 -- builder (gnatmake), if a shared library project imports a project
1222 -- that is not a shared library project and the appropriate switch is
1223 -- not specified, the invocation of gnatmake will fail.
1224
1225 Opt.Unchecked_Shared_Lib_Imports := True;
1226
1227 -- Locate the executable for the command
1228
1229 Exec_Path := Locate_Exec_On_Path (Program.all);
1230
1231 if Exec_Path = null then
1232 Put_Line (Standard_Error, "could not locate " & Program.all);
1233 raise Error_Exit;
1234 end if;
1235
1236 -- If there are switches for the executable, put them as first switches
1237
1238 if Command_List (The_Command).Unixsws /= null then
1239 for J in Command_List (The_Command).Unixsws'Range loop
1240 First_Switches.Increment_Last;
1241 First_Switches.Table (First_Switches.Last) :=
1242 Command_List (The_Command).Unixsws (J);
1243 end loop;
1244 end if;
1245
1246 -- For BIND, FIND, LINK, LIST and XREF, look for project file related
1247 -- switches.
1248
1249 case The_Command is
1250 when Bind =>
1251 Tool_Package_Name := Name_Binder;
1252 Packages_To_Check := Packages_To_Check_By_Binder;
1253 when Find =>
1254 Tool_Package_Name := Name_Finder;
1255 Packages_To_Check := Packages_To_Check_By_Finder;
1256 when Link =>
1257 Tool_Package_Name := Name_Linker;
1258 Packages_To_Check := Packages_To_Check_By_Linker;
1259 when List =>
1260 Tool_Package_Name := Name_Gnatls;
1261 Packages_To_Check := Packages_To_Check_By_Gnatls;
1262 when Xref =>
1263 Tool_Package_Name := Name_Cross_Reference;
1264 Packages_To_Check := Packages_To_Check_By_Xref;
1265 when others =>
1266 Tool_Package_Name := No_Name;
1267 end case;
1268
1269 if Tool_Package_Name /= No_Name then
1270
1271 -- Check that the switches are consistent. Detect project file
1272 -- related switches.
1273
1274 Inspect_Switches : declare
1275 Arg_Num : Positive := 1;
1276 Argv : String_Access;
1277
1278 procedure Remove_Switch (Num : Positive);
1279 -- Remove a project related switch from table Last_Switches
1280
1281 -------------------
1282 -- Remove_Switch --
1283 -------------------
1284
1285 procedure Remove_Switch (Num : Positive) is
1286 begin
1287 Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1288 Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1289 Last_Switches.Decrement_Last;
1290 end Remove_Switch;
1291
1292 -- Start of processing for Inspect_Switches
1293
1294 begin
1295 while Arg_Num <= Last_Switches.Last loop
1296 Argv := Last_Switches.Table (Arg_Num);
1297
1298 if Argv (Argv'First) = '-' then
1299 if Argv'Length = 1 then
1300 Fail ("switch character cannot be followed by a blank");
1301 end if;
1302
1303 -- The two style project files (-p and -P) cannot be used
1304 -- together
1305
1306 if (The_Command = Find or else The_Command = Xref)
1307 and then Argv (2) = 'p'
1308 then
1309 Old_Project_File_Used := True;
1310 if Project_File /= null then
1311 Fail ("-P and -p cannot be used together");
1312 end if;
1313 end if;
1314
1315 -- --subdirs=... Specify Subdirs
1316
1317 if Argv'Length > Makeutl.Subdirs_Option'Length
1318 and then
1319 Argv
1320 (Argv'First ..
1321 Argv'First + Makeutl.Subdirs_Option'Length - 1) =
1322 Makeutl.Subdirs_Option
1323 then
1324 Subdirs :=
1325 new String'
1326 (Argv (Argv'First + Makeutl.Subdirs_Option'Length ..
1327 Argv'Last));
1328
1329 Remove_Switch (Arg_Num);
1330
1331 -- -aPdir Add dir to the project search path
1332
1333 elsif Argv'Length > 3
1334 and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
1335 then
1336 Prj.Env.Add_Directories
1337 (Root_Environment.Project_Path,
1338 Argv (Argv'First + 3 .. Argv'Last));
1339
1340 -- Pass -aPdir to gnatls, but not to other tools
1341
1342 if The_Command = List then
1343 Arg_Num := Arg_Num + 1;
1344 else
1345 Remove_Switch (Arg_Num);
1346 end if;
1347
1348 -- -eL Follow links for files
1349
1350 elsif Argv.all = "-eL" then
1351 Follow_Links_For_Files := True;
1352 Follow_Links_For_Dirs := True;
1353
1354 Remove_Switch (Arg_Num);
1355
1356 -- -vPx Specify verbosity while parsing project files
1357
1358 elsif Argv'Length >= 3
1359 and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1360 then
1361 if Argv'Length = 4
1362 and then Argv (Argv'Last) in '0' .. '2'
1363 then
1364 case Argv (Argv'Last) is
1365 when '0' =>
1366 Current_Verbosity := Prj.Default;
1367 when '1' =>
1368 Current_Verbosity := Prj.Medium;
1369 when '2' =>
1370 Current_Verbosity := Prj.High;
1371 when others =>
1372
1373 -- Cannot happen
1374
1375 raise Program_Error;
1376 end case;
1377 else
1378 Fail ("invalid verbosity level: "
1379 & Argv (Argv'First + 3 .. Argv'Last));
1380 end if;
1381
1382 Remove_Switch (Arg_Num);
1383
1384 -- -Pproject_file Specify project file to be used
1385
1386 elsif Argv (Argv'First + 1) = 'P' then
1387
1388 -- Only one -P switch can be used
1389
1390 if Project_File /= null then
1391 Fail
1392 (Argv.all
1393 & ": second project file forbidden (first is """
1394 & Project_File.all & """)");
1395
1396 -- The two style project files (-p and -P) cannot be
1397 -- used together.
1398
1399 elsif Old_Project_File_Used then
1400 Fail ("-p and -P cannot be used together");
1401
1402 elsif Argv'Length = 2 then
1403
1404 -- There is space between -P and the project file
1405 -- name. -P cannot be the last option.
1406
1407 if Arg_Num = Last_Switches.Last then
1408 Fail ("project file name missing after -P");
1409
1410 else
1411 Remove_Switch (Arg_Num);
1412 Argv := Last_Switches.Table (Arg_Num);
1413
1414 -- After -P, there must be a project file name,
1415 -- not another switch.
1416
1417 if Argv (Argv'First) = '-' then
1418 Fail ("project file name missing after -P");
1419
1420 else
1421 Project_File := new String'(Argv.all);
1422 end if;
1423 end if;
1424
1425 else
1426 -- No space between -P and project file name
1427
1428 Project_File :=
1429 new String'(Argv (Argv'First + 2 .. Argv'Last));
1430 end if;
1431
1432 Remove_Switch (Arg_Num);
1433
1434 -- -Xexternal=value Specify an external reference to be
1435 -- used in project files
1436
1437 elsif Argv'Length >= 5
1438 and then Argv (Argv'First + 1) = 'X'
1439 then
1440 if not Check (Root_Environment.External,
1441 Argv (Argv'First + 2 .. Argv'Last))
1442 then
1443 Fail
1444 (Argv.all & " is not a valid external assignment.");
1445 end if;
1446
1447 Remove_Switch (Arg_Num);
1448
1449 elsif
1450 The_Command = List
1451 and then Argv'Length = 2
1452 and then Argv (2) = 'U'
1453 then
1454 All_Projects := True;
1455 Remove_Switch (Arg_Num);
1456
1457 else
1458 Arg_Num := Arg_Num + 1;
1459 end if;
1460
1461 else
1462 Arg_Num := Arg_Num + 1;
1463 end if;
1464 end loop;
1465 end Inspect_Switches;
1466 end if;
1467
1468 -- Add the default project search directories now, after the directories
1469 -- that have been specified by switches -aP<dir>.
1470
1471 Prj.Env.Initialize_Default_Project_Path
1472 (Root_Environment.Project_Path,
1473 Target_Name => Sdefault.Target_Name.all);
1474
1475 -- If there is a project file specified, parse it, get the switches
1476 -- for the tool and setup PATH environment variables.
1477
1478 if Project_File /= null then
1479 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1480
1481 Prj.Pars.Parse
1482 (Project => Project,
1483 In_Tree => Project_Tree,
1484 In_Node_Tree => Project_Node_Tree,
1485 Project_File_Name => Project_File.all,
1486 Env => Root_Environment,
1487 Packages_To_Check => Packages_To_Check);
1488
1489 -- Prj.Pars.Parse calls Set_Standard_Output, reset to stderr
1490
1491 Set_Standard_Error;
1492
1493 if Project = Prj.No_Project then
1494 Fail ("""" & Project_File.all & """ processing failed");
1495
1496 elsif Project.Qualifier = Aggregate then
1497 Fail ("aggregate projects are not supported");
1498
1499 elsif Aggregate_Libraries_In (Project_Tree) then
1500 Fail ("aggregate library projects are not supported");
1501 end if;
1502
1503 -- Check if a package with the name of the tool is in the project
1504 -- file and if there is one, get the switches, if any, and scan them.
1505
1506 declare
1507 Pkg : constant Prj.Package_Id :=
1508 Prj.Util.Value_Of
1509 (Name => Tool_Package_Name,
1510 In_Packages => Project.Decl.Packages,
1511 Shared => Project_Tree.Shared);
1512
1513 Element : Package_Element;
1514
1515 Switches_Array : Array_Element_Id;
1516
1517 The_Switches : Prj.Variable_Value;
1518 Current : Prj.String_List_Id;
1519 The_String : String_Element;
1520
1521 Main : String_Access := null;
1522
1523 begin
1524 if Pkg /= No_Package then
1525 Element := Project_Tree.Shared.Packages.Table (Pkg);
1526
1527 -- Package Gnatls has a single attribute Switches, that is not
1528 -- an associative array.
1529
1530 if The_Command = List then
1531 The_Switches :=
1532 Prj.Util.Value_Of
1533 (Variable_Name => Snames.Name_Switches,
1534 In_Variables => Element.Decl.Attributes,
1535 Shared => Project_Tree.Shared);
1536
1537 -- Packages Binder (for gnatbind), Cross_Reference (for
1538 -- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
1539 -- have an attributed Switches, an associative array, indexed
1540 -- by the name of the file.
1541
1542 -- They also have an attribute Default_Switches, indexed by the
1543 -- name of the programming language.
1544
1545 else
1546 -- First check if there is a single main
1547
1548 for J in 1 .. Last_Switches.Last loop
1549 if Last_Switches.Table (J) (1) /= '-' then
1550 if Main = null then
1551 Main := Last_Switches.Table (J);
1552 else
1553 Main := null;
1554 exit;
1555 end if;
1556 end if;
1557 end loop;
1558
1559 if Main /= null then
1560 Switches_Array :=
1561 Prj.Util.Value_Of
1562 (Name => Name_Switches,
1563 In_Arrays => Element.Decl.Arrays,
1564 Shared => Project_Tree.Shared);
1565 Name_Len := 0;
1566
1567 -- If the single main has been specified as an absolute
1568 -- path, use only the simple file name. If the absolute
1569 -- path is incorrect, an error will be reported by the
1570 -- underlying tool and it does not make a difference
1571 -- what switches are used.
1572
1573 if Is_Absolute_Path (Main.all) then
1574 Add_Str_To_Name_Buffer (File_Name (Main.all));
1575 else
1576 Add_Str_To_Name_Buffer (Main.all);
1577 end if;
1578
1579 The_Switches := Prj.Util.Value_Of
1580 (Index => Name_Find,
1581 Src_Index => 0,
1582 In_Array => Switches_Array,
1583 Shared => Project_Tree.Shared);
1584 end if;
1585
1586 if The_Switches.Kind = Prj.Undefined then
1587 Switches_Array :=
1588 Prj.Util.Value_Of
1589 (Name => Name_Default_Switches,
1590 In_Arrays => Element.Decl.Arrays,
1591 Shared => Project_Tree.Shared);
1592 The_Switches := Prj.Util.Value_Of
1593 (Index => Name_Ada,
1594 Src_Index => 0,
1595 In_Array => Switches_Array,
1596 Shared => Project_Tree.Shared);
1597 end if;
1598 end if;
1599
1600 -- If there are switches specified in the package of the
1601 -- project file corresponding to the tool, scan them.
1602
1603 case The_Switches.Kind is
1604 when Prj.Undefined =>
1605 null;
1606
1607 when Prj.Single =>
1608 declare
1609 Switch : constant String :=
1610 Get_Name_String (The_Switches.Value);
1611 begin
1612 if Switch'Length > 0 then
1613 First_Switches.Increment_Last;
1614 First_Switches.Table (First_Switches.Last) :=
1615 new String'(Switch);
1616 end if;
1617 end;
1618
1619 when Prj.List =>
1620 Current := The_Switches.Values;
1621 while Current /= Prj.Nil_String loop
1622 The_String := Project_Tree.Shared.String_Elements.
1623 Table (Current);
1624
1625 declare
1626 Switch : constant String :=
1627 Get_Name_String (The_String.Value);
1628 begin
1629 if Switch'Length > 0 then
1630 First_Switches.Increment_Last;
1631 First_Switches.Table (First_Switches.Last) :=
1632 new String'(Switch);
1633 end if;
1634 end;
1635
1636 Current := The_String.Next;
1637 end loop;
1638 end case;
1639 end if;
1640 end;
1641
1642 if The_Command = Bind or else The_Command = Link then
1643 if Project.Object_Directory.Name = No_Path then
1644 Fail ("project " & Get_Name_String (Project.Display_Name)
1645 & " has no object directory");
1646 end if;
1647
1648 Change_Dir (Get_Name_String (Project.Object_Directory.Name));
1649 end if;
1650
1651 -- Set up the env vars for project path files
1652
1653 Prj.Env.Set_Ada_Paths
1654 (Project, Project_Tree, Including_Libraries => True);
1655
1656 -- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1657 -- a configuration pragmas file, if necessary.
1658
1659 if The_Command = Link then
1660 Process_Link;
1661 end if;
1662
1663 if The_Command = Link or else The_Command = Bind then
1664
1665 -- For files that are specified as relative paths with directory
1666 -- information, we convert them to absolute paths, with parent
1667 -- being the current working directory if specified on the command
1668 -- line and the project directory if specified in the project
1669 -- file. This is what gnatmake is doing for linker and binder
1670 -- arguments.
1671
1672 for J in 1 .. Last_Switches.Last loop
1673 GNATCmd.Ensure_Absolute_Path
1674 (Last_Switches.Table (J), Current_Work_Dir);
1675 end loop;
1676
1677 Get_Name_String (Project.Directory.Name);
1678
1679 declare
1680 Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
1681 begin
1682 for J in 1 .. First_Switches.Last loop
1683 GNATCmd.Ensure_Absolute_Path
1684 (First_Switches.Table (J), Project_Dir);
1685 end loop;
1686 end;
1687 end if;
1688
1689 -- For gnat list, if no file has been put on the command line, call
1690 -- tool with all the sources of the main project.
1691
1692 if The_Command = List then
1693 Check_Files;
1694 end if;
1695 end if;
1696
1697 -- Gather all the arguments and invoke the executable
1698
1699 declare
1700 The_Args : Argument_List
1701 (1 .. First_Switches.Last +
1702 Last_Switches.Last +
1703 Carg_Switches.Last +
1704 Rules_Switches.Last);
1705 Arg_Num : Natural := 0;
1706
1707 begin
1708 for J in 1 .. First_Switches.Last loop
1709 Arg_Num := Arg_Num + 1;
1710 The_Args (Arg_Num) := First_Switches.Table (J);
1711 end loop;
1712
1713 for J in 1 .. Last_Switches.Last loop
1714 Arg_Num := Arg_Num + 1;
1715 The_Args (Arg_Num) := Last_Switches.Table (J);
1716 end loop;
1717
1718 for J in 1 .. Carg_Switches.Last loop
1719 Arg_Num := Arg_Num + 1;
1720 The_Args (Arg_Num) := Carg_Switches.Table (J);
1721 end loop;
1722
1723 for J in 1 .. Rules_Switches.Last loop
1724 Arg_Num := Arg_Num + 1;
1725 The_Args (Arg_Num) := Rules_Switches.Table (J);
1726 end loop;
1727
1728 if Verbose_Mode then
1729 Output.Write_Str (Exec_Path.all);
1730
1731 for Arg in The_Args'Range loop
1732 Output.Write_Char (' ');
1733 Output.Write_Str (The_Args (Arg).all);
1734 end loop;
1735
1736 Output.Write_Eol;
1737 end if;
1738
1739 My_Exit_Status :=
1740 Exit_Status (Spawn (Exec_Path.all, The_Args));
1741 raise Normal_Exit;
1742 end;
1743 end;
1744
1745 exception
1746 when Error_Exit =>
1747 if not Keep_Temporary_Files then
1748 Prj.Delete_All_Temp_Files (Project_Tree.Shared);
1749 Delete_Temp_Config_Files;
1750 end if;
1751
1752 Set_Exit_Status (Failure);
1753
1754 when Normal_Exit =>
1755 if not Keep_Temporary_Files then
1756 Prj.Delete_All_Temp_Files (Project_Tree.Shared);
1757 Delete_Temp_Config_Files;
1758 end if;
1759
1760 Set_Exit_Status (My_Exit_Status);
1761 end GNATCmd;
Mirror of the offical gcc git repository hosted at gcc.gnu.org