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