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