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