?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Merged with mainline at revision 128810.
[official-gcc.git] / gcc / ada / gnatcmd.adb
blob7ffc55853c1c73900b11ca64b161f742945a62ec
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-2007, 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 MLib.Tgt; use MLib.Tgt;
30 with MLib.Utl;
31 with MLib.Fil;
32 with Namet; use Namet;
33 with Opt; use Opt;
34 with Osint; use Osint;
35 with Output;
36 with Prj; use Prj;
37 with Prj.Env;
38 with Prj.Ext; use Prj.Ext;
39 with Prj.Pars;
40 with Prj.Util; use Prj.Util;
41 with Sinput.P;
42 with Snames; use Snames;
43 with Table;
44 with Tempdir;
45 with Types; use Types;
46 with Hostparm; use Hostparm;
47 -- Used to determine if we are in VMS or not for error message purposes
48
49 with Ada.Characters.Handling; use Ada.Characters.Handling;
50 with Ada.Command_Line; use Ada.Command_Line;
51 with Ada.Text_IO; use Ada.Text_IO;
52
53 with GNAT.OS_Lib; use GNAT.OS_Lib;
54
55 with VMS_Conv; use VMS_Conv;
56
57 procedure GNATCmd is
58 Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
59 Project_File : String_Access;
60 Project : Prj.Project_Id;
61 Current_Verbosity : Prj.Verbosity := Prj.Default;
62 Tool_Package_Name : Name_Id := No_Name;
63
64 B_Start : String_Ptr := new String'("b~");
65 -- Prefix of binder generated file, changed to b__ for VMS
66
67 Old_Project_File_Used : Boolean := False;
68 -- This flag indicates a switch -p (for gnatxref and gnatfind) for
69 -- an old fashioned project file. -p cannot be used in conjonction
70 -- with -P.
71
72 Max_Files_On_The_Command_Line : constant := 30; -- Arbitrary
73
74 Temp_File_Name : String_Access := null;
75 -- The name of the temporary text file to put a list of source/object
76 -- files to pass to a tool, when there are more than
77 -- Max_Files_On_The_Command_Line files.
78
79 ASIS_Main : String_Access := null;
80 -- Main for commands Check, Metric and Pretty, when -U is used
81
82 package First_Switches is new Table.Table
83 (Table_Component_Type => String_Access,
84 Table_Index_Type => Integer,
85 Table_Low_Bound => 1,
86 Table_Initial => 20,
87 Table_Increment => 100,
88 Table_Name => "Gnatcmd.First_Switches");
89 -- A table to keep the switches from the project file
90
91 package Carg_Switches is new Table.Table
92 (Table_Component_Type => String_Access,
93 Table_Index_Type => Integer,
94 Table_Low_Bound => 1,
95 Table_Initial => 20,
96 Table_Increment => 100,
97 Table_Name => "Gnatcmd.Carg_Switches");
98 -- A table to keep the switches following -cargs for ASIS tools
99
100 package Rules_Switches is new Table.Table
101 (Table_Component_Type => String_Access,
102 Table_Index_Type => Integer,
103 Table_Low_Bound => 1,
104 Table_Initial => 20,
105 Table_Increment => 100,
106 Table_Name => "Gnatcmd.Rules_Switches");
107 -- A table to keep the switches following -rules for gnatcheck
108
109 package Library_Paths is new Table.Table (
110 Table_Component_Type => String_Access,
111 Table_Index_Type => Integer,
112 Table_Low_Bound => 1,
113 Table_Initial => 20,
114 Table_Increment => 100,
115 Table_Name => "Make.Library_Path");
116
117 -- Packages of project files to pass to Prj.Pars.Parse, depending on the
118 -- tool. We allocate objects because we cannot declare aliased objects
119 -- as we are in a procedure, not a library level package.
120
121 Naming_String : constant String_Access := new String'("naming");
122 Binder_String : constant String_Access := new String'("binder");
123 Compiler_String : constant String_Access := new String'("compiler");
124 Check_String : constant String_Access := new String'("check");
125 Eliminate_String : constant String_Access := new String'("eliminate");
126 Finder_String : constant String_Access := new String'("finder");
127 Linker_String : constant String_Access := new String'("linker");
128 Gnatls_String : constant String_Access := new String'("gnatls");
129 Pretty_String : constant String_Access := new String'("pretty_printer");
130 Stack_String : constant String_Access := new String'("stack");
131 Gnatstub_String : constant String_Access := new String'("gnatstub");
132 Metric_String : constant String_Access := new String'("metrics");
133 Xref_String : constant String_Access := new String'("cross_reference");
134
135 Packages_To_Check_By_Binder : constant String_List_Access :=
136 new String_List'((Naming_String, Binder_String));
137
138 Packages_To_Check_By_Check : constant String_List_Access :=
139 new String_List'((Naming_String, Check_String, Compiler_String));
140
141 Packages_To_Check_By_Eliminate : constant String_List_Access :=
142 new String_List'((Naming_String, Eliminate_String, Compiler_String));
143
144 Packages_To_Check_By_Finder : constant String_List_Access :=
145 new String_List'((Naming_String, Finder_String));
146
147 Packages_To_Check_By_Linker : constant String_List_Access :=
148 new String_List'((Naming_String, Linker_String));
149
150 Packages_To_Check_By_Gnatls : constant String_List_Access :=
151 new String_List'((Naming_String, Gnatls_String));
152
153 Packages_To_Check_By_Pretty : constant String_List_Access :=
154 new String_List'((Naming_String, Pretty_String, Compiler_String));
155
156 Packages_To_Check_By_Stack : constant String_List_Access :=
157 new String_List'((Naming_String, Stack_String));
158
159 Packages_To_Check_By_Gnatstub : constant String_List_Access :=
160 new String_List'((Naming_String, Gnatstub_String, Compiler_String));
161
162 Packages_To_Check_By_Metric : constant String_List_Access :=
163 new String_List'((Naming_String, Metric_String, Compiler_String));
164
165 Packages_To_Check_By_Xref : constant String_List_Access :=
166 new String_List'((Naming_String, Xref_String));
167
168 Packages_To_Check : String_List_Access := Prj.All_Packages;
169
170 ----------------------------------
171 -- Declarations for GNATCMD use --
172 ----------------------------------
173
174 The_Command : Command_Type;
175 -- The command specified in the invocation of the GNAT driver
176
177 Command_Arg : Positive := 1;
178 -- The index of the command in the arguments of the GNAT driver
179
180 My_Exit_Status : Exit_Status := Success;
181 -- The exit status of the spawned tool. Used to set the correct VMS
182 -- exit status.
183
184 Current_Work_Dir : constant String := Get_Current_Dir;
185 -- The path of the working directory
186
187 All_Projects : Boolean := False;
188 -- Flag used for GNAT CHECK, GNAT PRETTY, GNAT METRIC, and GNAT STACK to
189 -- indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
190 -- should be invoked for all sources of all projects.
191
192 -----------------------
193 -- Local Subprograms --
194 -----------------------
195
196 procedure Add_To_Carg_Switches (Switch : String_Access);
197 -- Add a switch to the Carg_Switches table. If it is the first one, put the
198 -- switch "-cargs" at the beginning of the table.
199
200 procedure Add_To_Rules_Switches (Switch : String_Access);
201 -- Add a switch to the Rules_Switches table. If it is the first one, put
202 -- the switch "-crules" at the beginning of the table.
203
204 procedure Check_Files;
205 -- For GNAT LIST, GNAT PRETTY, GNAT METRIC, and GNAT STACK, check if a
206 -- project file is specified, without any file arguments. If it is the
207 -- case, invoke the GNAT tool with the proper list of files, derived from
208 -- the sources of the project.
209
210 function Check_Project
211 (Project : Project_Id;
212 Root_Project : Project_Id) return Boolean;
213 -- Returns True if Project = Root_Project or if we want to consider all
214 -- sources of all projects. For GNAT METRIC, also returns True if Project
215 -- is extended by Root_Project.
216
217 procedure Check_Relative_Executable (Name : in out String_Access);
218 -- Check if an executable is specified as a relative path. If it is, and
219 -- the path contains directory information, fail. Otherwise, prepend the
220 -- exec directory. This procedure is only used for GNAT LINK when a project
221 -- file is specified.
222
223 function Configuration_Pragmas_File return Path_Name_Type;
224 -- Return an argument, if there is a configuration pragmas file to be
225 -- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT
226 -- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
227 -- METRIC).
228
229 procedure Delete_Temp_Config_Files;
230 -- Delete all temporary config files
231
232 procedure Get_Closure;
233 -- Get the sources in the closure of the ASIS_Main and add them to the
234 -- list of arguments.
235
236 function Index (Char : Character; Str : String) return Natural;
237 -- Returns first occurrence of Char in Str, returns 0 if Char not in Str
238
239 procedure Non_VMS_Usage;
240 -- Display usage for platforms other than VMS
241
242 procedure Process_Link;
243 -- Process GNAT LINK, when there is a project file specified
244
245 procedure Set_Library_For
246 (Project : Project_Id;
247 There_Are_Libraries : in out Boolean);
248 -- If Project is a library project, add the correct -L and -l switches to
249 -- the linker invocation.
250
251 procedure Set_Libraries is
252 new For_Every_Project_Imported (Boolean, Set_Library_For);
253 -- Add the -L and -l switches to the linker for all of the library
254 -- projects.
255
256 procedure Test_If_Relative_Path
257 (Switch : in out String_Access;
258 Parent : String);
259 -- Test if Switch is a relative search path switch. If it is and it
260 -- includes directory information, prepend the path with Parent. This
261 -- subprogram is only called when using project files.
262
263 --------------------------
264 -- Add_To_Carg_Switches --
265 --------------------------
266
267 procedure Add_To_Carg_Switches (Switch : String_Access) is
268 begin
269 -- If the Carg_Switches table is empty, put "-cargs" at the beginning
270
271 if Carg_Switches.Last = 0 then
272 Carg_Switches.Increment_Last;
273 Carg_Switches.Table (Carg_Switches.Last) := new String'("-cargs");
274 end if;
275
276 Carg_Switches.Increment_Last;
277 Carg_Switches.Table (Carg_Switches.Last) := Switch;
278 end Add_To_Carg_Switches;
279
280 ---------------------------
281 -- Add_To_Rules_Switches --
282 ---------------------------
283
284 procedure Add_To_Rules_Switches (Switch : String_Access) is
285 begin
286 -- If the Rules_Switches table is empty, put "-rules" at the beginning
287
288 if Rules_Switches.Last = 0 then
289 Rules_Switches.Increment_Last;
290 Rules_Switches.Table (Rules_Switches.Last) := new String'("-rules");
291 end if;
292
293 Rules_Switches.Increment_Last;
294 Rules_Switches.Table (Rules_Switches.Last) := Switch;
295 end Add_To_Rules_Switches;
296
297 -----------------
298 -- Check_Files --
299 -----------------
300
301 procedure Check_Files is
302 Add_Sources : Boolean := True;
303 Unit_Data : Prj.Unit_Data;
304 Subunit : Boolean := False;
305
306 begin
307 -- Check if there is at least one argument that is not a switch
308
309 for Index in 1 .. Last_Switches.Last loop
310 if Last_Switches.Table (Index) (1) /= '-' then
311 Add_Sources := False;
312 exit;
313 end if;
314 end loop;
315
316 -- If all arguments were switches, add the path names of all the sources
317 -- of the main project.
318
319 if Add_Sources then
320 declare
321 Current_Last : constant Integer := Last_Switches.Last;
322 begin
323 -- Gnatstack needs to add the the .ci file for the binder
324 -- generated files corresponding to all of the library projects
325 -- and main units belonging to the application.
326
327 if The_Command = Stack then
328 for Proj in Project_Table.First ..
329 Project_Table.Last (Project_Tree.Projects)
330 loop
331 if Check_Project (Proj, Project) then
332 declare
333 Data : Project_Data renames
334 Project_Tree.Projects.Table (Proj);
335 Main : String_List_Id := Data.Mains;
336 File : String_Access;
337
338 begin
339 -- Include binder generated files for main programs
340
341 while Main /= Nil_String loop
342 File :=
343 new String'
344 (Get_Name_String (Data.Object_Directory) &
345 Directory_Separator &
346 B_Start.all &
347 MLib.Fil.Ext_To
348 (Get_Name_String
349 (Project_Tree.String_Elements.Table
350 (Main).Value),
351 "ci"));
352
353 if Is_Regular_File (File.all) then
354 Last_Switches.Increment_Last;
355 Last_Switches.Table (Last_Switches.Last) := File;
356 end if;
357
358 Main :=
359 Project_Tree.String_Elements.Table (Main).Next;
360 end loop;
361
362 if Data.Library then
363
364 -- Include the .ci file for the binder generated
365 -- files that contains the initialization and
366 -- finalization of the library.
367
368 File :=
369 new String'
370 (Get_Name_String (Data.Object_Directory) &
371 Directory_Separator &
372 B_Start.all &
373 Get_Name_String (Data.Library_Name) &
374 ".ci");
375
376 if Is_Regular_File (File.all) then
377 Last_Switches.Increment_Last;
378 Last_Switches.Table (Last_Switches.Last) := File;
379 end if;
380 end if;
381 end;
382 end if;
383 end loop;
384 end if;
385
386 for Unit in Unit_Table.First ..
387 Unit_Table.Last (Project_Tree.Units)
388 loop
389 Unit_Data := Project_Tree.Units.Table (Unit);
390
391 -- For gnatls, we only need to put the library units, body or
392 -- spec, but not the subunits.
393
394 if The_Command = List then
395 if
396 Unit_Data.File_Names (Body_Part).Name /= No_File
397 and then
398 Unit_Data.File_Names (Body_Part).Path /= Slash
399 then
400 -- There is a body, check if it is for this project
401
402 if All_Projects or else
403 Unit_Data.File_Names (Body_Part).Project = Project
404 then
405 Subunit := False;
406
407 if
408 Unit_Data.File_Names (Specification).Name = No_File
409 or else
410 Unit_Data.File_Names (Specification).Path = Slash
411 then
412 -- We have a body with no spec: we need to check if
413 -- this is a subunit, because gnatls will complain
414 -- about subunits.
415
416 declare
417 Src_Ind : Source_File_Index;
418
419 begin
420 Src_Ind := Sinput.P.Load_Project_File
421 (Get_Name_String
422 (Unit_Data.File_Names
423 (Body_Part).Path));
424
425 Subunit :=
426 Sinput.P.Source_File_Is_Subunit
427 (Src_Ind);
428 end;
429 end if;
430
431 if not Subunit then
432 Last_Switches.Increment_Last;
433 Last_Switches.Table (Last_Switches.Last) :=
434 new String'
435 (Get_Name_String
436 (Unit_Data.File_Names
437 (Body_Part).Display_Name));
438 end if;
439 end if;
440
441 elsif
442 Unit_Data.File_Names (Specification).Name /= No_File
443 and then
444 Unit_Data.File_Names (Specification).Path /= Slash
445 then
446 -- We have a spec with no body; check if it is for this
447 -- project.
448
449 if All_Projects or else
450 Unit_Data.File_Names (Specification).Project = Project
451 then
452 Last_Switches.Increment_Last;
453 Last_Switches.Table (Last_Switches.Last) :=
454 new String'
455 (Get_Name_String
456 (Unit_Data.File_Names
457 (Specification).Display_Name));
458 end if;
459 end if;
460
461 -- For gnatstack, we put the .ci files corresponding to the
462 -- different units, including the binder generated files. We
463 -- only need to do that for the library units, body or spec,
464 -- but not the subunits.
465
466 elsif The_Command = Stack then
467 if
468 Unit_Data.File_Names (Body_Part).Name /= No_File
469 and then
470 Unit_Data.File_Names (Body_Part).Path /= Slash
471 then
472 -- There is a body. Check if .ci files for this project
473 -- must be added.
474
475 if
476 Check_Project
477 (Unit_Data.File_Names (Body_Part).Project, Project)
478 then
479 Subunit := False;
480
481 if
482 Unit_Data.File_Names (Specification).Name = No_File
483 or else
484 Unit_Data.File_Names (Specification).Path = Slash
485 then
486 -- We have a body with no spec: we need to check
487 -- if this is a subunit, because .ci files are not
488 -- generated for subunits.
489
490 declare
491 Src_Ind : Source_File_Index;
492
493 begin
494 Src_Ind := Sinput.P.Load_Project_File
495 (Get_Name_String
496 (Unit_Data.File_Names (Body_Part).Path));
497
498 Subunit :=
499 Sinput.P.Source_File_Is_Subunit (Src_Ind);
500 end;
501 end if;
502
503 if not Subunit then
504 Last_Switches.Increment_Last;
505 Last_Switches.Table (Last_Switches.Last) :=
506 new String'
507 (Get_Name_String
508 (Project_Tree.Projects.Table
509 (Unit_Data.File_Names
510 (Body_Part).Project).
511 Object_Directory) &
512 Directory_Separator &
513 MLib.Fil.Ext_To
514 (Get_Name_String
515 (Unit_Data.File_Names
516 (Body_Part).Display_Name),
517 "ci"));
518 end if;
519 end if;
520
521 elsif
522 Unit_Data.File_Names (Specification).Name /= No_File
523 and then
524 Unit_Data.File_Names (Specification).Path /= Slash
525 then
526 -- We have a spec with no body. Check if it is for this
527 -- project.
528
529 if
530 Check_Project
531 (Unit_Data.File_Names (Specification).Project,
532 Project)
533 then
534 Last_Switches.Increment_Last;
535 Last_Switches.Table (Last_Switches.Last) :=
536 new String'
537 (Get_Name_String
538 (Project_Tree.Projects.Table
539 (Unit_Data.File_Names
540 (Specification).Project).
541 Object_Directory) &
542 Dir_Separator &
543 MLib.Fil.Ext_To
544 (Get_Name_String
545 (Unit_Data.File_Names
546 (Specification).Name),
547 "ci"));
548 end if;
549 end if;
550
551 else
552 -- For gnatcheck, gnatpp and gnatmetric, put all sources
553 -- of the project, or of all projects if -U was specified.
554
555 for Kind in Spec_Or_Body loop
556 if Check_Project
557 (Unit_Data.File_Names (Kind).Project, Project)
558 and then Unit_Data.File_Names (Kind).Name /= No_File
559 and then Unit_Data.File_Names (Kind).Path /= Slash
560 then
561 Last_Switches.Increment_Last;
562 Last_Switches.Table (Last_Switches.Last) :=
563 new String'
564 (Get_Name_String
565 (Unit_Data.File_Names
566 (Kind).Display_Path));
567 end if;
568 end loop;
569 end if;
570 end loop;
571
572 -- If the list of files is too long, create a temporary text file
573 -- that lists these files, and pass this temp file to gnatcheck,
574 -- gnatpp or gnatmetric using switch -files=.
575
576 if Last_Switches.Last - Current_Last >
577 Max_Files_On_The_Command_Line
578 then
579 declare
580 Temp_File_FD : File_Descriptor;
581 Buffer : String (1 .. 1_000);
582 Len : Natural;
583 OK : Boolean := True;
584
585 begin
586 Create_Temp_File (Temp_File_FD, Temp_File_Name);
587
588 if Temp_File_Name /= null then
589 for Index in Current_Last + 1 ..
590 Last_Switches.Last
591 loop
592 Len := Last_Switches.Table (Index)'Length;
593 Buffer (1 .. Len) := Last_Switches.Table (Index).all;
594 Len := Len + 1;
595 Buffer (Len) := ASCII.LF;
596 Buffer (Len + 1) := ASCII.NUL;
597 OK :=
598 Write (Temp_File_FD,
599 Buffer (1)'Address,
600 Len) = Len;
601 exit when not OK;
602 end loop;
603
604 if OK then
605 Close (Temp_File_FD, OK);
606 else
607 Close (Temp_File_FD, OK);
608 OK := False;
609 end if;
610
611 -- If there were any problem creating the temp file, then
612 -- pass the list of files.
613
614 if OK then
615
616 -- Replace list of files with -files=<temp file name>
617
618 Last_Switches.Set_Last (Current_Last + 1);
619 Last_Switches.Table (Last_Switches.Last) :=
620 new String'("-files=" & Temp_File_Name.all);
621 end if;
622 end if;
623 end;
624 end if;
625 end;
626 end if;
627 end Check_Files;
628
629 -------------------
630 -- Check_Project --
631 -------------------
632
633 function Check_Project
634 (Project : Project_Id;
635 Root_Project : Project_Id) return Boolean
636 is
637 begin
638 if Project = No_Project then
639 return False;
640
641 elsif All_Projects or Project = Root_Project then
642 return True;
643
644 elsif The_Command = Metric then
645 declare
646 Data : Project_Data;
647
648 begin
649 Data := Project_Tree.Projects.Table (Root_Project);
650 while Data.Extends /= No_Project loop
651 if Project = Data.Extends then
652 return True;
653 end if;
654
655 Data := Project_Tree.Projects.Table (Data.Extends);
656 end loop;
657 end;
658 end if;
659
660 return False;
661 end Check_Project;
662
663 -------------------------------
664 -- Check_Relative_Executable --
665 -------------------------------
666
667 procedure Check_Relative_Executable (Name : in out String_Access) is
668 Exec_File_Name : constant String := Name.all;
669
670 begin
671 if not Is_Absolute_Path (Exec_File_Name) then
672 for Index in Exec_File_Name'Range loop
673 if Exec_File_Name (Index) = Directory_Separator then
674 Fail ("relative executable (""" &
675 Exec_File_Name &
676 """) with directory part not allowed " &
677 "when using project files");
678 end if;
679 end loop;
680
681 Get_Name_String (Project_Tree.Projects.Table
682 (Project).Exec_Directory);
683
684 if Name_Buffer (Name_Len) /= Directory_Separator then
685 Name_Len := Name_Len + 1;
686 Name_Buffer (Name_Len) := Directory_Separator;
687 end if;
688
689 Name_Buffer (Name_Len + 1 ..
690 Name_Len + Exec_File_Name'Length) :=
691 Exec_File_Name;
692 Name_Len := Name_Len + Exec_File_Name'Length;
693 Name := new String'(Name_Buffer (1 .. Name_Len));
694 end if;
695 end Check_Relative_Executable;
696
697 --------------------------------
698 -- Configuration_Pragmas_File --
699 --------------------------------
700
701 function Configuration_Pragmas_File return Path_Name_Type is
702 begin
703 Prj.Env.Create_Config_Pragmas_File
704 (Project, Project, Project_Tree, Include_Config_Files => False);
705 return Project_Tree.Projects.Table (Project).Config_File_Name;
706 end Configuration_Pragmas_File;
707
708 ------------------------------
709 -- Delete_Temp_Config_Files --
710 ------------------------------
711
712 procedure Delete_Temp_Config_Files is
713 Success : Boolean;
714
715 begin
716 if not Keep_Temporary_Files then
717 if Project /= No_Project then
718 for Prj in Project_Table.First ..
719 Project_Table.Last (Project_Tree.Projects)
720 loop
721 if
722 Project_Tree.Projects.Table (Prj).Config_File_Temp
723 then
724 if Verbose_Mode then
725 Output.Write_Str ("Deleting temp configuration file """);
726 Output.Write_Str
727 (Get_Name_String
728 (Project_Tree.Projects.Table
729 (Prj).Config_File_Name));
730 Output.Write_Line ("""");
731 end if;
732
733 Delete_File
734 (Name => Get_Name_String
735 (Project_Tree.Projects.Table
736 (Prj).Config_File_Name),
737 Success => Success);
738 end if;
739 end loop;
740 end if;
741
742 -- If a temporary text file that contains a list of files for a tool
743 -- has been created, delete this temporary file.
744
745 if Temp_File_Name /= null then
746 Delete_File (Temp_File_Name.all, Success);
747 end if;
748 end if;
749 end Delete_Temp_Config_Files;
750
751 -----------------
752 -- Get_Closure --
753 -----------------
754
755 procedure Get_Closure is
756 Args : constant Argument_List :=
757 (1 => new String'("-q"),
758 2 => new String'("-b"),
759 3 => new String'("-P"),
760 4 => Project_File,
761 5 => ASIS_Main,
762 6 => new String'("-bargs"),
763 7 => new String'("-R"),
764 8 => new String'("-Z"));
765 -- Arguments of the invocation of gnatmake to get the list of
766
767 FD : File_Descriptor;
768 -- File descriptor for the temp file that will get the output of the
769 -- invocation of gnatmake.
770
771 Name : Path_Name_Type;
772 -- Path of the file FD
773
774 GN_Name : constant String := Program_Name ("gnatmake").all;
775 -- Name for gnatmake
776
777 GN_Path : constant String_Access := Locate_Exec_On_Path (GN_Name);
778 -- Path of gnatmake
779
780 Return_Code : Integer;
781
782 Unused : Boolean;
783 pragma Warnings (Off, Unused);
784
785 File : Ada.Text_IO.File_Type;
786 Line : String (1 .. 250);
787 Last : Natural;
788
789 Udata : Unit_Data;
790 Path : Path_Name_Type;
791
792 begin
793 if GN_Path = null then
794 Put_Line (Standard_Error, "could not locate " & GN_Name);
795 raise Error_Exit;
796 end if;
797
798 -- Create the temp file
799
800 Tempdir.Create_Temp_File (FD, Name);
801
802 -- And close it, because on VMS Spawn with a file descriptor created
803 -- with Create_Temp_File does not redirect output.
804
805 Close (FD);
806
807 -- Spawn "gnatmake -q -b -P <project> <main> -bargs -R -Z"
808
809 Spawn
810 (Program_Name => GN_Path.all,
811 Args => Args,
812 Output_File => Get_Name_String (Name),
813 Success => Unused,
814 Return_Code => Return_Code,
815 Err_To_Out => True);
816
817 Close (FD);
818
819 -- Read the output of the invocation of gnatmake
820
821 Open (File, In_File, Get_Name_String (Name));
822
823 -- If it was unsuccessful, display the first line in the file and exit
824 -- with error.
825
826 if Return_Code /= 0 then
827 Get_Line (File, Line, Last);
828
829 if not Keep_Temporary_Files then
830 Delete (File);
831 else
832 Close (File);
833 end if;
834
835 Put_Line (Standard_Error, Line (1 .. Last));
836 Put_Line
837 (Standard_Error, "could not get closure of " & ASIS_Main.all);
838 raise Error_Exit;
839
840 else
841 -- Get each file name in the file, find its path and add it the the
842 -- list of arguments.
843
844 while not End_Of_File (File) loop
845 Get_Line (File, Line, Last);
846 Path := No_Path;
847
848 for Unit in Unit_Table.First ..
849 Unit_Table.Last (Project_Tree.Units)
850 loop
851 Udata := Project_Tree.Units.Table (Unit);
852
853 if Udata.File_Names (Specification).Name /= No_File
854 and then
855 Get_Name_String (Udata.File_Names (Specification).Name) =
856 Line (1 .. Last)
857 then
858 Path := Udata.File_Names (Specification).Path;
859 exit;
860
861 elsif Udata.File_Names (Body_Part).Name /= No_File
862 and then
863 Get_Name_String (Udata.File_Names (Body_Part).Name) =
864 Line (1 .. Last)
865 then
866 Path := Udata.File_Names (Body_Part).Path;
867 exit;
868 end if;
869 end loop;
870
871 Last_Switches.Increment_Last;
872
873 if Path /= No_Path then
874 Last_Switches.Table (Last_Switches.Last) :=
875 new String'(Get_Name_String (Path));
876
877 else
878 Last_Switches.Table (Last_Switches.Last) :=
879 new String'(Line (1 .. Last));
880 end if;
881 end loop;
882
883 if not Keep_Temporary_Files then
884 Delete (File);
885
886 else
887 Close (File);
888 end if;
889 end if;
890 end Get_Closure;
891
892 -----------
893 -- Index --
894 -----------
895
896 function Index (Char : Character; Str : String) return Natural is
897 begin
898 for Index in Str'Range loop
899 if Str (Index) = Char then
900 return Index;
901 end if;
902 end loop;
903
904 return 0;
905 end Index;
906
907 ------------------
908 -- Process_Link --
909 ------------------
910
911 procedure Process_Link is
912 Look_For_Executable : Boolean := True;
913 There_Are_Libraries : Boolean := False;
914 Path_Option : constant String_Access :=
915 MLib.Linker_Library_Path_Option;
916 Prj : Project_Id := Project;
917 Arg : String_Access;
918 Last : Natural := 0;
919 Skip_Executable : Boolean := False;
920
921 begin
922 -- Add the default search directories, to be able to find
923 -- libgnat in call to MLib.Utl.Lib_Directory.
924
925 Add_Default_Search_Dirs;
926
927 Library_Paths.Set_Last (0);
928
929 -- Check if there are library project files
930
931 if MLib.Tgt.Support_For_Libraries /= None then
932 Set_Libraries (Project, Project_Tree, There_Are_Libraries);
933 end if;
934
935 -- If there are, add the necessary additional switches
936
937 if There_Are_Libraries then
938
939 -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
940
941 Last_Switches.Increment_Last;
942 Last_Switches.Table (Last_Switches.Last) :=
943 new String'("-L" & MLib.Utl.Lib_Directory);
944 Last_Switches.Increment_Last;
945 Last_Switches.Table (Last_Switches.Last) :=
946 new String'("-lgnarl");
947 Last_Switches.Increment_Last;
948 Last_Switches.Table (Last_Switches.Last) :=
949 new String'("-lgnat");
950
951 -- If Path_Option is not null, create the switch ("-Wl,-rpath," or
952 -- equivalent) with all the library dirs plus the standard GNAT
953 -- library dir.
954
955 if Path_Option /= null then
956 declare
957 Option : String_Access;
958 Length : Natural := Path_Option'Length;
959 Current : Natural;
960
961 begin
962 -- First, compute the exact length for the switch
963
964 for Index in
965 Library_Paths.First .. Library_Paths.Last
966 loop
967 -- Add the length of the library dir plus one for the
968 -- directory separator.
969
970 Length :=
971 Length +
972 Library_Paths.Table (Index)'Length + 1;
973 end loop;
974
975 -- Finally, add the length of the standard GNAT library dir
976
977 Length := Length + MLib.Utl.Lib_Directory'Length;
978 Option := new String (1 .. Length);
979 Option (1 .. Path_Option'Length) := Path_Option.all;
980 Current := Path_Option'Length;
981
982 -- Put each library dir followed by a dir separator
983
984 for Index in
985 Library_Paths.First .. Library_Paths.Last
986 loop
987 Option
988 (Current + 1 ..
989 Current +
990 Library_Paths.Table (Index)'Length) :=
991 Library_Paths.Table (Index).all;
992 Current :=
993 Current +
994 Library_Paths.Table (Index)'Length + 1;
995 Option (Current) := Path_Separator;
996 end loop;
997
998 -- Finally put the standard GNAT library dir
999
1000 Option
1001 (Current + 1 ..
1002 Current + MLib.Utl.Lib_Directory'Length) :=
1003 MLib.Utl.Lib_Directory;
1004
1005 -- And add the switch to the last switches
1006
1007 Last_Switches.Increment_Last;
1008 Last_Switches.Table (Last_Switches.Last) :=
1009 Option;
1010 end;
1011 end if;
1012 end if;
1013
1014 -- Check if the first ALI file specified can be found, either in the
1015 -- object directory of the main project or in an object directory of a
1016 -- project file extended by the main project. If the ALI file can be
1017 -- found, replace its name with its absolute path.
1018
1019 Skip_Executable := False;
1020
1021 Switch_Loop : for J in 1 .. Last_Switches.Last loop
1022
1023 -- If we have an executable just reset the flag
1024
1025 if Skip_Executable then
1026 Skip_Executable := False;
1027
1028 -- If -o, set flag so that next switch is not processed
1029
1030 elsif Last_Switches.Table (J).all = "-o" then
1031 Skip_Executable := True;
1032
1033 -- Normal case
1034
1035 else
1036 declare
1037 Switch : constant String :=
1038 Last_Switches.Table (J).all;
1039
1040 ALI_File : constant String (1 .. Switch'Length + 4) :=
1041 Switch & ".ali";
1042
1043 Test_Existence : Boolean := False;
1044
1045 begin
1046 Last := Switch'Length;
1047
1048 -- Skip real switches
1049
1050 if Switch'Length /= 0
1051 and then Switch (Switch'First) /= '-'
1052 then
1053 -- Append ".ali" if file name does not end with it
1054
1055 if Switch'Length <= 4
1056 or else Switch (Switch'Last - 3 .. Switch'Last)
1057 /= ".ali"
1058 then
1059 Last := ALI_File'Last;
1060 end if;
1061
1062 -- If file name includes directory information, stop if ALI
1063 -- file exists.
1064
1065 if Is_Absolute_Path (ALI_File (1 .. Last)) then
1066 Test_Existence := True;
1067
1068 else
1069 for K in Switch'Range loop
1070 if Switch (K) = '/' or else
1071 Switch (K) = Directory_Separator
1072 then
1073 Test_Existence := True;
1074 exit;
1075 end if;
1076 end loop;
1077 end if;
1078
1079 if Test_Existence then
1080 if Is_Regular_File (ALI_File (1 .. Last)) then
1081 exit Switch_Loop;
1082 end if;
1083
1084 -- Look in object directories if ALI file exists
1085
1086 else
1087 Project_Loop : loop
1088 declare
1089 Dir : constant String :=
1090 Get_Name_String
1091 (Project_Tree.Projects.Table
1092 (Prj).Object_Directory);
1093 begin
1094 if Is_Regular_File
1095 (Dir &
1096 Directory_Separator &
1097 ALI_File (1 .. Last))
1098 then
1099 -- We have found the correct project, so we
1100 -- replace the file with the absolute path.
1101
1102 Last_Switches.Table (J) :=
1103 new String'
1104 (Dir & Directory_Separator &
1105 ALI_File (1 .. Last));
1106
1107 -- And we are done
1108
1109 exit Switch_Loop;
1110 end if;
1111 end;
1112
1113 -- Go to the project being extended, if any
1114
1115 Prj :=
1116 Project_Tree.Projects.Table (Prj).Extends;
1117 exit Project_Loop when Prj = No_Project;
1118 end loop Project_Loop;
1119 end if;
1120 end if;
1121 end;
1122 end if;
1123 end loop Switch_Loop;
1124
1125 -- If a relative path output file has been specified, we add the exec
1126 -- directory.
1127
1128 for J in reverse 1 .. Last_Switches.Last - 1 loop
1129 if Last_Switches.Table (J).all = "-o" then
1130 Check_Relative_Executable
1131 (Name => Last_Switches.Table (J + 1));
1132 Look_For_Executable := False;
1133 exit;
1134 end if;
1135 end loop;
1136
1137 if Look_For_Executable then
1138 for J in reverse 1 .. First_Switches.Last - 1 loop
1139 if First_Switches.Table (J).all = "-o" then
1140 Look_For_Executable := False;
1141 Check_Relative_Executable
1142 (Name => First_Switches.Table (J + 1));
1143 exit;
1144 end if;
1145 end loop;
1146 end if;
1147
1148 -- If no executable is specified, then find the name of the first ALI
1149 -- file on the command line and issue a -o switch with the absolute path
1150 -- of the executable in the exec directory.
1151
1152 if Look_For_Executable then
1153 for J in 1 .. Last_Switches.Last loop
1154 Arg := Last_Switches.Table (J);
1155 Last := 0;
1156
1157 if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
1158 if Arg'Length > 4
1159 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
1160 then
1161 Last := Arg'Last - 4;
1162
1163 elsif Is_Regular_File (Arg.all & ".ali") then
1164 Last := Arg'Last;
1165 end if;
1166
1167 if Last /= 0 then
1168 Last_Switches.Increment_Last;
1169 Last_Switches.Table (Last_Switches.Last) :=
1170 new String'("-o");
1171 Get_Name_String
1172 (Project_Tree.Projects.Table
1173 (Project).Exec_Directory);
1174 Last_Switches.Increment_Last;
1175 Last_Switches.Table (Last_Switches.Last) :=
1176 new String'(Name_Buffer (1 .. Name_Len) &
1177 Directory_Separator &
1178 Executable_Name
1179 (Base_Name (Arg (Arg'First .. Last))));
1180 exit;
1181 end if;
1182 end if;
1183 end loop;
1184 end if;
1185 end Process_Link;
1186
1187 ---------------------
1188 -- Set_Library_For --
1189 ---------------------
1190
1191 procedure Set_Library_For
1192 (Project : Project_Id;
1193 There_Are_Libraries : in out Boolean)
1194 is
1195 Path_Option : constant String_Access :=
1196 MLib.Linker_Library_Path_Option;
1197
1198 begin
1199 -- Case of library project
1200
1201 if Project_Tree.Projects.Table (Project).Library then
1202 There_Are_Libraries := True;
1203
1204 -- Add the -L switch
1205
1206 Last_Switches.Increment_Last;
1207 Last_Switches.Table (Last_Switches.Last) :=
1208 new String'("-L" &
1209 Get_Name_String
1210 (Project_Tree.Projects.Table
1211 (Project).Library_Dir));
1212
1213 -- Add the -l switch
1214
1215 Last_Switches.Increment_Last;
1216 Last_Switches.Table (Last_Switches.Last) :=
1217 new String'("-l" &
1218 Get_Name_String
1219 (Project_Tree.Projects.Table
1220 (Project).Library_Name));
1221
1222 -- Add the directory to table Library_Paths, to be processed later
1223 -- if library is not static and if Path_Option is not null.
1224
1225 if Project_Tree.Projects.Table (Project).Library_Kind /=
1226 Static
1227 and then Path_Option /= null
1228 then
1229 Library_Paths.Increment_Last;
1230 Library_Paths.Table (Library_Paths.Last) :=
1231 new String'(Get_Name_String
1232 (Project_Tree.Projects.Table
1233 (Project).Library_Dir));
1234 end if;
1235 end if;
1236 end Set_Library_For;
1237
1238 ---------------------------
1239 -- Test_If_Relative_Path --
1240 ---------------------------
1241
1242 procedure Test_If_Relative_Path
1243 (Switch : in out String_Access;
1244 Parent : String)
1245 is
1246 begin
1247 if Switch /= null then
1248
1249 declare
1250 Sw : String (1 .. Switch'Length);
1251 Start : Positive := 1;
1252
1253 begin
1254 Sw := Switch.all;
1255
1256 if Sw (1) = '-' then
1257 if Sw'Length >= 3
1258 and then (Sw (2) = 'A' or else
1259 Sw (2) = 'I' or else
1260 Sw (2) = 'L')
1261 then
1262 Start := 3;
1263
1264 if Sw = "-I-" then
1265 return;
1266 end if;
1267
1268 elsif Sw'Length >= 4
1269 and then (Sw (2 .. 3) = "aL" or else
1270 Sw (2 .. 3) = "aO" or else
1271 Sw (2 .. 3) = "aI")
1272 then
1273 Start := 4;
1274
1275 elsif Sw'Length >= 7
1276 and then Sw (2 .. 6) = "-RTS="
1277 then
1278 Start := 7;
1279 else
1280 return;
1281 end if;
1282 end if;
1283
1284 -- If the path is relative, test if it includes directory
1285 -- information. If it does, prepend Parent to the path.
1286
1287 if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
1288 for J in Start .. Sw'Last loop
1289 if Sw (J) = Directory_Separator then
1290 Switch :=
1291 new String'
1292 (Sw (1 .. Start - 1) &
1293 Parent &
1294 Directory_Separator &
1295 Sw (Start .. Sw'Last));
1296 return;
1297 end if;
1298 end loop;
1299 end if;
1300 end;
1301 end if;
1302 end Test_If_Relative_Path;
1303
1304 -------------------
1305 -- Non_VMS_Usage --
1306 -------------------
1307
1308 procedure Non_VMS_Usage is
1309 begin
1310 Output_Version;
1311 New_Line;
1312 Put_Line ("List of available commands");
1313 New_Line;
1314
1315 for C in Command_List'Range loop
1316 if not Command_List (C).VMS_Only then
1317 Put ("gnat " & To_Lower (Command_List (C).Cname.all));
1318 Set_Col (25);
1319 Put (Command_List (C).Unixcmd.all);
1320
1321 declare
1322 Sws : Argument_List_Access renames Command_List (C).Unixsws;
1323 begin
1324 if Sws /= null then
1325 for J in Sws'Range loop
1326 Put (' ');
1327 Put (Sws (J).all);
1328 end loop;
1329 end if;
1330 end;
1331
1332 New_Line;
1333 end if;
1334 end loop;
1335
1336 New_Line;
1337 Put_Line ("Commands find, list, metric, pretty, stack, stub and xref " &
1338 "accept project file switches -vPx, -Pprj and -Xnam=val");
1339 New_Line;
1340 end Non_VMS_Usage;
1341
1342 -------------------------------------
1343 -- Start of processing for GNATCmd --
1344 -------------------------------------
1345
1346 begin
1347 -- Initializations
1348
1349 Namet.Initialize;
1350 Csets.Initialize;
1351
1352 Snames.Initialize;
1353
1354 Prj.Initialize (Project_Tree);
1355
1356 Last_Switches.Init;
1357 Last_Switches.Set_Last (0);
1358
1359 First_Switches.Init;
1360 First_Switches.Set_Last (0);
1361 Carg_Switches.Init;
1362 Carg_Switches.Set_Last (0);
1363 Rules_Switches.Init;
1364 Rules_Switches.Set_Last (0);
1365
1366 VMS_Conv.Initialize;
1367
1368 Set_Mode (Ada_Only);
1369
1370 -- Add the directory where the GNAT driver is invoked in front of the path,
1371 -- if the GNAT driver is invoked with directory information. Do not do this
1372 -- for VMS, where the notion of path does not really exist.
1373
1374 if not OpenVMS then
1375 declare
1376 Command : constant String := Command_Name;
1377
1378 begin
1379 for Index in reverse Command'Range loop
1380 if Command (Index) = Directory_Separator then
1381 declare
1382 Absolute_Dir : constant String :=
1383 Normalize_Pathname
1384 (Command (Command'First .. Index));
1385
1386 PATH : constant String :=
1387 Absolute_Dir &
1388 Path_Separator &
1389 Getenv ("PATH").all;
1390
1391 begin
1392 Setenv ("PATH", PATH);
1393 end;
1394
1395 exit;
1396 end if;
1397 end loop;
1398 end;
1399 end if;
1400
1401 -- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
1402 -- filenames and pathnames to Unix style.
1403
1404 if Hostparm.OpenVMS
1405 or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
1406 then
1407 VMS_Conversion (The_Command);
1408
1409 B_Start := new String'("b__");
1410
1411 -- If not on VMS, scan the command line directly
1412
1413 else
1414 if Argument_Count = 0 then
1415 Non_VMS_Usage;
1416 return;
1417 else
1418 begin
1419 loop
1420 if Argument_Count > Command_Arg
1421 and then Argument (Command_Arg) = "-v"
1422 then
1423 Verbose_Mode := True;
1424 Command_Arg := Command_Arg + 1;
1425
1426 elsif Argument_Count > Command_Arg
1427 and then Argument (Command_Arg) = "-dn"
1428 then
1429 Keep_Temporary_Files := True;
1430 Command_Arg := Command_Arg + 1;
1431
1432 else
1433 exit;
1434 end if;
1435 end loop;
1436
1437 The_Command := Real_Command_Type'Value (Argument (Command_Arg));
1438
1439 if Command_List (The_Command).VMS_Only then
1440 Non_VMS_Usage;
1441 Fail
1442 ("Command """,
1443 Command_List (The_Command).Cname.all,
1444 """ can only be used on VMS");
1445 end if;
1446
1447 exception
1448 when Constraint_Error =>
1449
1450 -- Check if it is an alternate command
1451
1452 declare
1453 Alternate : Alternate_Command;
1454
1455 begin
1456 Alternate := Alternate_Command'Value
1457 (Argument (Command_Arg));
1458 The_Command := Corresponding_To (Alternate);
1459
1460 exception
1461 when Constraint_Error =>
1462 Non_VMS_Usage;
1463 Fail ("Unknown command: ", Argument (Command_Arg));
1464 end;
1465 end;
1466
1467 -- Get the arguments from the command line and from the eventual
1468 -- argument file(s) specified on the command line.
1469
1470 for Arg in Command_Arg + 1 .. Argument_Count loop
1471 declare
1472 The_Arg : constant String := Argument (Arg);
1473
1474 begin
1475 -- Check if an argument file is specified
1476
1477 if The_Arg (The_Arg'First) = '@' then
1478 declare
1479 Arg_File : Ada.Text_IO.File_Type;
1480 Line : String (1 .. 256);
1481 Last : Natural;
1482
1483 begin
1484 -- Open the file and fail if the file cannot be found
1485
1486 begin
1487 Open
1488 (Arg_File, In_File,
1489 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1490
1491 exception
1492 when others =>
1493 Put
1494 (Standard_Error, "Cannot open argument file """);
1495 Put
1496 (Standard_Error,
1497 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
1498
1499 Put_Line (Standard_Error, """");
1500 raise Error_Exit;
1501 end;
1502
1503 -- Read line by line and put the content of each non-
1504 -- empty line in the Last_Switches table.
1505
1506 while not End_Of_File (Arg_File) loop
1507 Get_Line (Arg_File, Line, Last);
1508
1509 if Last /= 0 then
1510 Last_Switches.Increment_Last;
1511 Last_Switches.Table (Last_Switches.Last) :=
1512 new String'(Line (1 .. Last));
1513 end if;
1514 end loop;
1515
1516 Close (Arg_File);
1517 end;
1518
1519 else
1520 -- It is not an argument file; just put the argument in
1521 -- the Last_Switches table.
1522
1523 Last_Switches.Increment_Last;
1524 Last_Switches.Table (Last_Switches.Last) :=
1525 new String'(The_Arg);
1526 end if;
1527 end;
1528 end loop;
1529 end if;
1530 end if;
1531
1532 declare
1533 Program : constant String :=
1534 Program_Name (Command_List (The_Command).Unixcmd.all).all;
1535
1536 Exec_Path : String_Access;
1537
1538 begin
1539 -- Locate the executable for the command
1540
1541 Exec_Path := Locate_Exec_On_Path (Program);
1542
1543 if Exec_Path = null then
1544 Put_Line (Standard_Error, "could not locate " & Program);
1545 raise Error_Exit;
1546 end if;
1547
1548 -- If there are switches for the executable, put them as first switches
1549
1550 if Command_List (The_Command).Unixsws /= null then
1551 for J in Command_List (The_Command).Unixsws'Range loop
1552 First_Switches.Increment_Last;
1553 First_Switches.Table (First_Switches.Last) :=
1554 Command_List (The_Command).Unixsws (J);
1555 end loop;
1556 end if;
1557
1558 -- For BIND, CHECK, ELIM, FIND, LINK, LIST, PRETTY, STACK, STUB,
1559 -- METRIC ad XREF, look for project file related switches.
1560
1561 if The_Command = Bind
1562 or else The_Command = Check
1563 or else The_Command = Elim
1564 or else The_Command = Find
1565 or else The_Command = Link
1566 or else The_Command = List
1567 or else The_Command = Xref
1568 or else The_Command = Pretty
1569 or else The_Command = Stack
1570 or else The_Command = Stub
1571 or else The_Command = Metric
1572 then
1573 case The_Command is
1574 when Bind =>
1575 Tool_Package_Name := Name_Binder;
1576 Packages_To_Check := Packages_To_Check_By_Binder;
1577 when Check =>
1578 Tool_Package_Name := Name_Check;
1579 Packages_To_Check := Packages_To_Check_By_Check;
1580 when Elim =>
1581 Tool_Package_Name := Name_Eliminate;
1582 Packages_To_Check := Packages_To_Check_By_Eliminate;
1583 when Find =>
1584 Tool_Package_Name := Name_Finder;
1585 Packages_To_Check := Packages_To_Check_By_Finder;
1586 when Link =>
1587 Tool_Package_Name := Name_Linker;
1588 Packages_To_Check := Packages_To_Check_By_Linker;
1589 when List =>
1590 Tool_Package_Name := Name_Gnatls;
1591 Packages_To_Check := Packages_To_Check_By_Gnatls;
1592 when Metric =>
1593 Tool_Package_Name := Name_Metrics;
1594 Packages_To_Check := Packages_To_Check_By_Metric;
1595 when Pretty =>
1596 Tool_Package_Name := Name_Pretty_Printer;
1597 Packages_To_Check := Packages_To_Check_By_Pretty;
1598 when Stack =>
1599 Tool_Package_Name := Name_Stack;
1600 Packages_To_Check := Packages_To_Check_By_Stack;
1601 when Stub =>
1602 Tool_Package_Name := Name_Gnatstub;
1603 Packages_To_Check := Packages_To_Check_By_Gnatstub;
1604 when Xref =>
1605 Tool_Package_Name := Name_Cross_Reference;
1606 Packages_To_Check := Packages_To_Check_By_Xref;
1607 when others =>
1608 null;
1609 end case;
1610
1611 -- Check that the switches are consistent. Detect project file
1612 -- related switches.
1613
1614 Inspect_Switches :
1615 declare
1616 Arg_Num : Positive := 1;
1617 Argv : String_Access;
1618
1619 procedure Remove_Switch (Num : Positive);
1620 -- Remove a project related switch from table Last_Switches
1621
1622 -------------------
1623 -- Remove_Switch --
1624 -------------------
1625
1626 procedure Remove_Switch (Num : Positive) is
1627 begin
1628 Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
1629 Last_Switches.Table (Num + 1 .. Last_Switches.Last);
1630 Last_Switches.Decrement_Last;
1631 end Remove_Switch;
1632
1633 -- Start of processing for Inspect_Switches
1634
1635 begin
1636 while Arg_Num <= Last_Switches.Last loop
1637 Argv := Last_Switches.Table (Arg_Num);
1638
1639 if Argv (Argv'First) = '-' then
1640 if Argv'Length = 1 then
1641 Fail
1642 ("switch character cannot be followed by a blank");
1643 end if;
1644
1645 -- The two style project files (-p and -P) cannot be used
1646 -- together
1647
1648 if (The_Command = Find or else The_Command = Xref)
1649 and then Argv (2) = 'p'
1650 then
1651 Old_Project_File_Used := True;
1652 if Project_File /= null then
1653 Fail ("-P and -p cannot be used together");
1654 end if;
1655 end if;
1656
1657 -- -aPdir Add dir to the project search path
1658
1659 if Argv'Length > 3
1660 and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
1661 then
1662 Add_Search_Project_Directory
1663 (Argv (Argv'First + 3 .. Argv'Last));
1664
1665 Remove_Switch (Arg_Num);
1666
1667 -- -vPx Specify verbosity while parsing project files
1668
1669 elsif Argv'Length = 4
1670 and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
1671 then
1672 case Argv (Argv'Last) is
1673 when '0' =>
1674 Current_Verbosity := Prj.Default;
1675 when '1' =>
1676 Current_Verbosity := Prj.Medium;
1677 when '2' =>
1678 Current_Verbosity := Prj.High;
1679 when others =>
1680 Fail ("Invalid switch: ", Argv.all);
1681 end case;
1682
1683 Remove_Switch (Arg_Num);
1684
1685 -- -Pproject_file Specify project file to be used
1686
1687 elsif Argv (Argv'First + 1) = 'P' then
1688
1689 -- Only one -P switch can be used
1690
1691 if Project_File /= null then
1692 Fail
1693 (Argv.all,
1694 ": second project file forbidden (first is """,
1695 Project_File.all & """)");
1696
1697 -- The two style project files (-p and -P) cannot be
1698 -- used together.
1699
1700 elsif Old_Project_File_Used then
1701 Fail ("-p and -P cannot be used together");
1702
1703 elsif Argv'Length = 2 then
1704
1705 -- There is space between -P and the project file
1706 -- name. -P cannot be the last option.
1707
1708 if Arg_Num = Last_Switches.Last then
1709 Fail ("project file name missing after -P");
1710
1711 else
1712 Remove_Switch (Arg_Num);
1713 Argv := Last_Switches.Table (Arg_Num);
1714
1715 -- After -P, there must be a project file name,
1716 -- not another switch.
1717
1718 if Argv (Argv'First) = '-' then
1719 Fail ("project file name missing after -P");
1720
1721 else
1722 Project_File := new String'(Argv.all);
1723 end if;
1724 end if;
1725
1726 else
1727 -- No space between -P and project file name
1728
1729 Project_File :=
1730 new String'(Argv (Argv'First + 2 .. Argv'Last));
1731 end if;
1732
1733 Remove_Switch (Arg_Num);
1734
1735 -- -Xexternal=value Specify an external reference to be
1736 -- used in project files
1737
1738 elsif Argv'Length >= 5
1739 and then Argv (Argv'First + 1) = 'X'
1740 then
1741 declare
1742 Equal_Pos : constant Natural :=
1743 Index
1744 ('=',
1745 Argv (Argv'First + 2 .. Argv'Last));
1746 begin
1747 if Equal_Pos >= Argv'First + 3 and then
1748 Equal_Pos /= Argv'Last then
1749 Add (External_Name =>
1750 Argv (Argv'First + 2 .. Equal_Pos - 1),
1751 Value => Argv (Equal_Pos + 1 .. Argv'Last));
1752 else
1753 Fail
1754 (Argv.all,
1755 " is not a valid external assignment.");
1756 end if;
1757 end;
1758
1759 Remove_Switch (Arg_Num);
1760
1761 elsif
1762 (The_Command = Check or else
1763 The_Command = Pretty or else
1764 The_Command = Metric or else
1765 The_Command = Stack or else
1766 The_Command = List)
1767 and then Argv'Length = 2
1768 and then Argv (2) = 'U'
1769 then
1770 All_Projects := True;
1771 Remove_Switch (Arg_Num);
1772
1773 else
1774 Arg_Num := Arg_Num + 1;
1775 end if;
1776
1777 elsif ((The_Command = Check and then Argv (Argv'First) /= '+')
1778 or else The_Command = Metric
1779 or else The_Command = Pretty)
1780 and then Project_File /= null
1781 and then All_Projects
1782 then
1783 if ASIS_Main /= null then
1784 Fail ("cannot specify more than one main after -U");
1785 else
1786 ASIS_Main := Argv;
1787 Remove_Switch (Arg_Num);
1788 end if;
1789
1790 else
1791 Arg_Num := Arg_Num + 1;
1792 end if;
1793 end loop;
1794 end Inspect_Switches;
1795 end if;
1796
1797 -- If there is a project file specified, parse it, get the switches
1798 -- for the tool and setup PATH environment variables.
1799
1800 if Project_File /= null then
1801 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
1802
1803 Prj.Pars.Parse
1804 (Project => Project,
1805 In_Tree => Project_Tree,
1806 Project_File_Name => Project_File.all,
1807 Packages_To_Check => Packages_To_Check);
1808
1809 if Project = Prj.No_Project then
1810 Fail ("""", Project_File.all, """ processing failed");
1811 end if;
1812
1813 -- Check if a package with the name of the tool is in the project
1814 -- file and if there is one, get the switches, if any, and scan them.
1815
1816 declare
1817 Data : constant Prj.Project_Data :=
1818 Project_Tree.Projects.Table (Project);
1819
1820 Pkg : constant Prj.Package_Id :=
1821 Prj.Util.Value_Of
1822 (Name => Tool_Package_Name,
1823 In_Packages => Data.Decl.Packages,
1824 In_Tree => Project_Tree);
1825
1826 Element : Package_Element;
1827
1828 Default_Switches_Array : Array_Element_Id;
1829
1830 The_Switches : Prj.Variable_Value;
1831 Current : Prj.String_List_Id;
1832 The_String : String_Element;
1833
1834 begin
1835 if Pkg /= No_Package then
1836 Element := Project_Tree.Packages.Table (Pkg);
1837
1838 -- Packages Gnatls and Gnatstack have a single attribute
1839 -- Switches, that is not an associative array.
1840
1841 if The_Command = List or else The_Command = Stack then
1842 The_Switches :=
1843 Prj.Util.Value_Of
1844 (Variable_Name => Snames.Name_Switches,
1845 In_Variables => Element.Decl.Attributes,
1846 In_Tree => Project_Tree);
1847
1848 -- Packages Binder (for gnatbind), Cross_Reference (for
1849 -- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
1850 -- Pretty_Printer (for gnatpp), Eliminate (for gnatelim), Check
1851 -- (for gnatcheck), and Metric (for gnatmetric) have an
1852 -- attributed Switches, an associative array, indexed by the
1853 -- name of the file.
1854
1855 -- They also have an attribute Default_Switches, indexed by the
1856 -- name of the programming language.
1857
1858 else
1859 if The_Switches.Kind = Prj.Undefined then
1860 Default_Switches_Array :=
1861 Prj.Util.Value_Of
1862 (Name => Name_Default_Switches,
1863 In_Arrays => Element.Decl.Arrays,
1864 In_Tree => Project_Tree);
1865 The_Switches := Prj.Util.Value_Of
1866 (Index => Name_Ada,
1867 Src_Index => 0,
1868 In_Array => Default_Switches_Array,
1869 In_Tree => Project_Tree);
1870 end if;
1871 end if;
1872
1873 -- If there are switches specified in the package of the
1874 -- project file corresponding to the tool, scan them.
1875
1876 case The_Switches.Kind is
1877 when Prj.Undefined =>
1878 null;
1879
1880 when Prj.Single =>
1881 declare
1882 Switch : constant String :=
1883 Get_Name_String (The_Switches.Value);
1884
1885 begin
1886 if Switch'Length > 0 then
1887 First_Switches.Increment_Last;
1888 First_Switches.Table (First_Switches.Last) :=
1889 new String'(Switch);
1890 end if;
1891 end;
1892
1893 when Prj.List =>
1894 Current := The_Switches.Values;
1895 while Current /= Prj.Nil_String loop
1896 The_String := Project_Tree.String_Elements.
1897 Table (Current);
1898
1899 declare
1900 Switch : constant String :=
1901 Get_Name_String (The_String.Value);
1902
1903 begin
1904 if Switch'Length > 0 then
1905 First_Switches.Increment_Last;
1906 First_Switches.Table (First_Switches.Last) :=
1907 new String'(Switch);
1908 end if;
1909 end;
1910
1911 Current := The_String.Next;
1912 end loop;
1913 end case;
1914 end if;
1915 end;
1916
1917 if The_Command = Bind
1918 or else The_Command = Link
1919 or else The_Command = Elim
1920 then
1921 Change_Dir
1922 (Get_Name_String
1923 (Project_Tree.Projects.Table
1924 (Project).Object_Directory));
1925 end if;
1926
1927 -- Set up the env vars for project path files
1928
1929 Prj.Env.Set_Ada_Paths
1930 (Project, Project_Tree, Including_Libraries => False);
1931
1932 -- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
1933 -- a configuration pragmas file, if necessary.
1934
1935 if The_Command = Pretty
1936 or else The_Command = Metric
1937 or else The_Command = Stub
1938 or else The_Command = Elim
1939 or else The_Command = Check
1940 then
1941 -- If there are switches in package Compiler, put them in the
1942 -- Carg_Switches table.
1943
1944 declare
1945 Data : constant Prj.Project_Data :=
1946 Project_Tree.Projects.Table (Project);
1947
1948 Pkg : constant Prj.Package_Id :=
1949 Prj.Util.Value_Of
1950 (Name => Name_Compiler,
1951 In_Packages => Data.Decl.Packages,
1952 In_Tree => Project_Tree);
1953
1954 Element : Package_Element;
1955
1956 Default_Switches_Array : Array_Element_Id;
1957
1958 The_Switches : Prj.Variable_Value;
1959 Current : Prj.String_List_Id;
1960 The_String : String_Element;
1961
1962 begin
1963 if Pkg /= No_Package then
1964 Element := Project_Tree.Packages.Table (Pkg);
1965
1966 Default_Switches_Array :=
1967 Prj.Util.Value_Of
1968 (Name => Name_Default_Switches,
1969 In_Arrays => Element.Decl.Arrays,
1970 In_Tree => Project_Tree);
1971 The_Switches := Prj.Util.Value_Of
1972 (Index => Name_Ada,
1973 Src_Index => 0,
1974 In_Array => Default_Switches_Array,
1975 In_Tree => Project_Tree);
1976
1977 -- If there are switches specified in the package of the
1978 -- project file corresponding to the tool, scan them.
1979
1980 case The_Switches.Kind is
1981 when Prj.Undefined =>
1982 null;
1983
1984 when Prj.Single =>
1985 declare
1986 Switch : constant String :=
1987 Get_Name_String (The_Switches.Value);
1988 begin
1989 if Switch'Length > 0 then
1990 Add_To_Carg_Switches (new String'(Switch));
1991 end if;
1992 end;
1993
1994 when Prj.List =>
1995 Current := The_Switches.Values;
1996 while Current /= Prj.Nil_String loop
1997 The_String :=
1998 Project_Tree.String_Elements.Table (Current);
1999
2000 declare
2001 Switch : constant String :=
2002 Get_Name_String (The_String.Value);
2003 begin
2004 if Switch'Length > 0 then
2005 Add_To_Carg_Switches (new String'(Switch));
2006 end if;
2007 end;
2008
2009 Current := The_String.Next;
2010 end loop;
2011 end case;
2012 end if;
2013 end;
2014
2015 -- If -cargs is one of the switches, move the following switches
2016 -- to the Carg_Switches table.
2017
2018 for J in 1 .. First_Switches.Last loop
2019 if First_Switches.Table (J).all = "-cargs" then
2020 for K in J + 1 .. First_Switches.Last loop
2021 Add_To_Carg_Switches (First_Switches.Table (K));
2022 end loop;
2023 First_Switches.Set_Last (J - 1);
2024 exit;
2025 end if;
2026 end loop;
2027
2028 for J in 1 .. Last_Switches.Last loop
2029 if Last_Switches.Table (J).all = "-cargs" then
2030 for K in J + 1 .. Last_Switches.Last loop
2031 Add_To_Carg_Switches (Last_Switches.Table (K));
2032 end loop;
2033 Last_Switches.Set_Last (J - 1);
2034 exit;
2035 end if;
2036 end loop;
2037
2038 declare
2039 CP_File : constant Path_Name_Type := Configuration_Pragmas_File;
2040
2041 begin
2042 if CP_File /= No_Path then
2043 if The_Command = Elim then
2044 First_Switches.Increment_Last;
2045 First_Switches.Table (First_Switches.Last) :=
2046 new String'("-C" & Get_Name_String (CP_File));
2047
2048 else
2049 Add_To_Carg_Switches
2050 (new String'("-gnatec=" & Get_Name_String (CP_File)));
2051 end if;
2052 end if;
2053 end;
2054 end if;
2055
2056 if The_Command = Link then
2057 Process_Link;
2058 end if;
2059
2060 if The_Command = Link or The_Command = Bind then
2061
2062 -- For files that are specified as relative paths with directory
2063 -- information, we convert them to absolute paths, with parent
2064 -- being the current working directory if specified on the command
2065 -- line and the project directory if specified in the project
2066 -- file. This is what gnatmake is doing for linker and binder
2067 -- arguments.
2068
2069 for J in 1 .. Last_Switches.Last loop
2070 Test_If_Relative_Path
2071 (Last_Switches.Table (J), Current_Work_Dir);
2072 end loop;
2073
2074 Get_Name_String
2075 (Project_Tree.Projects.Table (Project).Directory);
2076
2077 declare
2078 Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
2079 begin
2080 for J in 1 .. First_Switches.Last loop
2081 Test_If_Relative_Path
2082 (First_Switches.Table (J), Project_Dir);
2083 end loop;
2084 end;
2085
2086 elsif The_Command = Stub then
2087 declare
2088 Data : constant Prj.Project_Data :=
2089 Project_Tree.Projects.Table (Project);
2090 File_Index : Integer := 0;
2091 Dir_Index : Integer := 0;
2092 Last : constant Integer := Last_Switches.Last;
2093
2094 begin
2095 for Index in 1 .. Last loop
2096 if Last_Switches.Table (Index)
2097 (Last_Switches.Table (Index)'First) /= '-'
2098 then
2099 File_Index := Index;
2100 exit;
2101 end if;
2102 end loop;
2103
2104 -- If the naming scheme of the project file is not standard,
2105 -- and if the file name ends with the spec suffix, then
2106 -- indicate to gnatstub the name of the body file with
2107 -- a -o switch.
2108
2109 if Body_Suffix_Id_Of (Project_Tree, "ada", Data.Naming) /=
2110 Prj.Default_Ada_Spec_Suffix
2111 then
2112 if File_Index /= 0 then
2113 declare
2114 Spec : constant String :=
2115 Base_Name (Last_Switches.Table (File_Index).all);
2116 Last : Natural := Spec'Last;
2117
2118 begin
2119 Get_Name_String
2120 (Spec_Suffix_Id_Of
2121 (Project_Tree, "ada", Data.Naming));
2122
2123 if Spec'Length > Name_Len
2124 and then Spec (Last - Name_Len + 1 .. Last) =
2125 Name_Buffer (1 .. Name_Len)
2126 then
2127 Last := Last - Name_Len;
2128 Get_Name_String
2129 (Body_Suffix_Id_Of
2130 (Project_Tree, "ada", Data.Naming));
2131 Last_Switches.Increment_Last;
2132 Last_Switches.Table (Last_Switches.Last) :=
2133 new String'("-o");
2134 Last_Switches.Increment_Last;
2135 Last_Switches.Table (Last_Switches.Last) :=
2136 new String'(Spec (Spec'First .. Last) &
2137 Name_Buffer (1 .. Name_Len));
2138 end if;
2139 end;
2140 end if;
2141 end if;
2142
2143 -- Add the directory of the spec as the destination directory
2144 -- of the body, if there is no destination directory already
2145 -- specified.
2146
2147 if File_Index /= 0 then
2148 for Index in File_Index + 1 .. Last loop
2149 if Last_Switches.Table (Index)
2150 (Last_Switches.Table (Index)'First) /= '-'
2151 then
2152 Dir_Index := Index;
2153 exit;
2154 end if;
2155 end loop;
2156
2157 if Dir_Index = 0 then
2158 Last_Switches.Increment_Last;
2159 Last_Switches.Table (Last_Switches.Last) :=
2160 new String'
2161 (Dir_Name (Last_Switches.Table (File_Index).all));
2162 end if;
2163 end if;
2164 end;
2165 end if;
2166
2167 -- For gnatmetric, the generated files should be put in the object
2168 -- directory. This must be the first switch, because it may be
2169 -- overriden by a switch in package Metrics in the project file or by
2170 -- a command line option.
2171
2172 if The_Command = Metric then
2173 First_Switches.Increment_Last;
2174 First_Switches.Table (2 .. First_Switches.Last) :=
2175 First_Switches.Table (1 .. First_Switches.Last - 1);
2176 First_Switches.Table (1) :=
2177 new String'("-d=" &
2178 Get_Name_String
2179 (Project_Tree.Projects.Table
2180 (Project).Object_Directory));
2181 end if;
2182
2183 -- For gnat check, -rules and the following switches need to be the
2184 -- last options. So, we move all these switches to table
2185 -- Rules_Switches.
2186
2187 if The_Command = Check then
2188 declare
2189 New_Last : Natural;
2190 -- Set to rank of options preceding "-rules"
2191
2192 In_Rules_Switches : Boolean;
2193 -- Set to True when options "-rules" is found
2194
2195 begin
2196 New_Last := First_Switches.Last;
2197 In_Rules_Switches := False;
2198
2199 for J in 1 .. First_Switches.Last loop
2200 if In_Rules_Switches then
2201 Add_To_Rules_Switches (First_Switches.Table (J));
2202
2203 elsif First_Switches.Table (J).all = "-rules" then
2204 New_Last := J - 1;
2205 In_Rules_Switches := True;
2206 end if;
2207 end loop;
2208
2209 if In_Rules_Switches then
2210 First_Switches.Set_Last (New_Last);
2211 end if;
2212
2213 New_Last := Last_Switches.Last;
2214 In_Rules_Switches := False;
2215
2216 for J in 1 .. Last_Switches.Last loop
2217 if In_Rules_Switches then
2218 Add_To_Rules_Switches (Last_Switches.Table (J));
2219
2220 elsif Last_Switches.Table (J).all = "-rules" then
2221 New_Last := J - 1;
2222 In_Rules_Switches := True;
2223 end if;
2224 end loop;
2225
2226 if In_Rules_Switches then
2227 Last_Switches.Set_Last (New_Last);
2228 end if;
2229 end;
2230 end if;
2231
2232 -- For gnat check, metric or pretty with -U + a main, get the list
2233 -- of sources from the closure and add them to the arguments.
2234
2235 if ASIS_Main /= null then
2236 Get_Closure;
2237
2238 -- On VMS, set up again the env var for source dirs file. This is
2239 -- because the call to gnatmake has set this env var to another
2240 -- file that has now been deleted.
2241
2242 if Hostparm.OpenVMS then
2243 Setenv
2244 (Project_Include_Path_File,
2245 Prj.Env.Ada_Include_Path
2246 (Project, Project_Tree, Recursive => True));
2247 end if;
2248
2249 -- For gnat check, gnat pretty, gnat metric, gnat list, and gnat
2250 -- stack, if no file has been put on the command line, call tool
2251 -- with all the sources of the main project.
2252
2253 elsif The_Command = Check or else
2254 The_Command = Pretty or else
2255 The_Command = Metric or else
2256 The_Command = List or else
2257 The_Command = Stack
2258 then
2259 Check_Files;
2260 end if;
2261 end if;
2262
2263 -- Gather all the arguments and invoke the executable
2264
2265 declare
2266 The_Args : Argument_List
2267 (1 .. First_Switches.Last +
2268 Last_Switches.Last +
2269 Carg_Switches.Last +
2270 Rules_Switches.Last);
2271 Arg_Num : Natural := 0;
2272
2273 begin
2274 for J in 1 .. First_Switches.Last loop
2275 Arg_Num := Arg_Num + 1;
2276 The_Args (Arg_Num) := First_Switches.Table (J);
2277 end loop;
2278
2279 for J in 1 .. Last_Switches.Last loop
2280 Arg_Num := Arg_Num + 1;
2281 The_Args (Arg_Num) := Last_Switches.Table (J);
2282 end loop;
2283
2284 for J in 1 .. Carg_Switches.Last loop
2285 Arg_Num := Arg_Num + 1;
2286 The_Args (Arg_Num) := Carg_Switches.Table (J);
2287 end loop;
2288
2289 for J in 1 .. Rules_Switches.Last loop
2290 Arg_Num := Arg_Num + 1;
2291 The_Args (Arg_Num) := Rules_Switches.Table (J);
2292 end loop;
2293
2294 -- If Display_Command is on, only display the generated command
2295
2296 if Display_Command then
2297 Put (Standard_Error, "generated command -->");
2298 Put (Standard_Error, Exec_Path.all);
2299
2300 for Arg in The_Args'Range loop
2301 Put (Standard_Error, " ");
2302 Put (Standard_Error, The_Args (Arg).all);
2303 end loop;
2304
2305 Put (Standard_Error, "<--");
2306 New_Line (Standard_Error);
2307 raise Normal_Exit;
2308 end if;
2309
2310 if Verbose_Mode then
2311 Output.Write_Str (Exec_Path.all);
2312
2313 for Arg in The_Args'Range loop
2314 Output.Write_Char (' ');
2315 Output.Write_Str (The_Args (Arg).all);
2316 end loop;
2317
2318 Output.Write_Eol;
2319 end if;
2320
2321 My_Exit_Status :=
2322 Exit_Status (Spawn (Exec_Path.all, The_Args));
2323 raise Normal_Exit;
2324 end;
2325 end;
2326
2327 exception
2328 when Error_Exit =>
2329 if not Keep_Temporary_Files then
2330 Prj.Env.Delete_All_Path_Files (Project_Tree);
2331 Delete_Temp_Config_Files;
2332 end if;
2333
2334 Set_Exit_Status (Failure);
2335
2336 when Normal_Exit =>
2337 if not Keep_Temporary_Files then
2338 Prj.Env.Delete_All_Path_Files (Project_Tree);
2339 Delete_Temp_Config_Files;
2340 end if;
2341
2342 -- Since GNATCmd is normally called from DCL (the VMS shell), it must
2343 -- return an understandable VMS exit status. However the exit status
2344 -- returned *to* GNATCmd is a Posix style code, so we test it and return
2345 -- just a simple success or failure on VMS.
2346
2347 if Hostparm.OpenVMS and then My_Exit_Status /= Success then
2348 Set_Exit_Status (Failure);
2349 else
2350 Set_Exit_Status (My_Exit_Status);
2351 end if;
2352 end GNATCmd;
Mirror of the offical gcc git repository hosted at gcc.gnu.org