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