1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . P A R T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2003 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Err_Vars; use Err_Vars; 28with Namet; use Namet; 29with Opt; 30with Osint; use Osint; 31with Output; use Output; 32with Prj.Com; use Prj.Com; 33with Prj.Dect; 34with Prj.Err; use Prj.Err; 35with Scans; use Scans; 36with Sinput; use Sinput; 37with Sinput.P; use Sinput.P; 38with Snames; 39with Table; 40with Types; use Types; 41 42with Ada.Characters.Handling; use Ada.Characters.Handling; 43with Ada.Exceptions; use Ada.Exceptions; 44 45with GNAT.Directory_Operations; use GNAT.Directory_Operations; 46with GNAT.OS_Lib; use GNAT.OS_Lib; 47 48with System.HTable; use System.HTable; 49 50pragma Elaborate_All (GNAT.OS_Lib); 51 52package body Prj.Part is 53 54 Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; 55 56 Project_Path : String_Access; 57 -- The project path; initialized during package elaboration. 58 -- Contains at least the current working directory. 59 60 Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; 61 -- Name of the env. variable that contains path name(s) of directories 62 -- where project files may reside. 63 64 Prj_Path : constant String_Access := Getenv (Ada_Project_Path); 65 -- The path name(s) of directories where project files may reside. 66 -- May be empty. 67 68 type Extension_Origin is (None, Extending_Simple, Extending_All); 69 -- Type of parameter From_Extended for procedures Parse_Single_Project and 70 -- Post_Parse_Context_Clause. Extending_All means that we are parsing the 71 -- tree rooted at an extending all project. 72 73 ------------------------------------ 74 -- Local Packages and Subprograms -- 75 ------------------------------------ 76 77 type With_Id is new Nat; 78 No_With : constant With_Id := 0; 79 80 type With_Record is record 81 Path : Name_Id; 82 Location : Source_Ptr; 83 Limited_With : Boolean; 84 Node : Project_Node_Id; 85 Next : With_Id; 86 end record; 87 -- Information about an imported project, to be put in table Withs below 88 89 package Withs is new Table.Table 90 (Table_Component_Type => With_Record, 91 Table_Index_Type => With_Id, 92 Table_Low_Bound => 1, 93 Table_Initial => 10, 94 Table_Increment => 50, 95 Table_Name => "Prj.Part.Withs"); 96 -- Table used to store temporarily paths and locations of imported 97 -- projects. These imported projects will be effectively parsed after the 98 -- name of the current project has been extablished. 99 100 type Name_And_Id is record 101 Name : Name_Id; 102 Id : Project_Node_Id; 103 end record; 104 105 package Project_Stack is new Table.Table 106 (Table_Component_Type => Name_And_Id, 107 Table_Index_Type => Nat, 108 Table_Low_Bound => 1, 109 Table_Initial => 10, 110 Table_Increment => 50, 111 Table_Name => "Prj.Part.Project_Stack"); 112 -- This table is used to detect circular dependencies 113 -- for imported and extended projects and to get the project ids of 114 -- limited imported projects when there is a circularity with at least 115 -- one limited imported project file. 116 117 package Virtual_Hash is new Simple_HTable 118 (Header_Num => Header_Num, 119 Element => Project_Node_Id, 120 No_Element => Empty_Node, 121 Key => Project_Node_Id, 122 Hash => Prj.Tree.Hash, 123 Equal => "="); 124 -- Hash table to store the node id of the project for which a virtual 125 -- extending project need to be created. 126 127 package Processed_Hash is new Simple_HTable 128 (Header_Num => Header_Num, 129 Element => Boolean, 130 No_Element => False, 131 Key => Project_Node_Id, 132 Hash => Prj.Tree.Hash, 133 Equal => "="); 134 -- Hash table to store the project process when looking for project that 135 -- need to have a virtual extending project, to avoid processing the same 136 -- project twice. 137 138 procedure Create_Virtual_Extending_Project 139 (For_Project : Project_Node_Id; 140 Main_Project : Project_Node_Id); 141 -- Create a virtual extending project of For_Project. Main_Project is 142 -- the extending all project. 143 144 procedure Look_For_Virtual_Projects_For 145 (Proj : Project_Node_Id; 146 Potentially_Virtual : Boolean); 147 -- Look for projects that need to have a virtual extending project. 148 -- This procedure is recursive. If called with Potentially_Virtual set to 149 -- True, then Proj may need an virtual extending project; otherwise it 150 -- does not (because it is already extended), but other projects that it 151 -- imports may need to be virtually extended. 152 153 procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id); 154 -- Parse the context clause of a project. 155 -- Store the paths and locations of the imported projects in table Withs. 156 -- Does nothing if there is no context clause (if the current 157 -- token is not "with" or "limited" followed by "with"). 158 159 procedure Post_Parse_Context_Clause 160 (Context_Clause : With_Id; 161 Imported_Projects : out Project_Node_Id; 162 Project_Directory : Name_Id; 163 From_Extended : Extension_Origin); 164 -- Parse the imported projects that have been stored in table Withs, 165 -- if any. From_Extended is used for the call to Parse_Single_Project 166 -- below. 167 168 procedure Parse_Single_Project 169 (Project : out Project_Node_Id; 170 Path_Name : String; 171 Extended : Boolean; 172 From_Extended : Extension_Origin); 173 -- Parse a project file. 174 -- Recursive procedure: it calls itself for imported and extended 175 -- projects. When From_Extended is not None, if the project has already 176 -- been parsed and is an extended project A, return the ultimate 177 -- (not extended) project that extends A. 178 179 function Project_Path_Name_Of 180 (Project_File_Name : String; 181 Directory : String) 182 return String; 183 -- Returns the path name of a project file. Returns an empty string 184 -- if project file cannot be found. 185 186 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id; 187 -- Get the directory of the file with the specified path name. 188 -- This includes the directory separator as the last character. 189 -- Returns "./" if Path_Name contains no directory separator. 190 191 function Project_Name_From (Path_Name : String) return Name_Id; 192 -- Returns the name of the project that corresponds to its path name. 193 -- Returns No_Name if the path name is invalid, because the corresponding 194 -- project name does not have the syntax of an ada identifier. 195 196 -------------------------------------- 197 -- Create_Virtual_Extending_Project -- 198 -------------------------------------- 199 200 procedure Create_Virtual_Extending_Project 201 (For_Project : Project_Node_Id; 202 Main_Project : Project_Node_Id) 203 is 204 205 Virtual_Name : constant String := 206 Virtual_Prefix & 207 Get_Name_String (Name_Of (For_Project)); 208 -- The name of the virtual extending project 209 210 Virtual_Name_Id : Name_Id; 211 -- Virtual extending project name id 212 213 Virtual_Path_Id : Name_Id; 214 -- Fake path name of the virtual extending project. The directory is 215 -- the same directory as the extending all project. 216 217 Virtual_Dir_Id : constant Name_Id := 218 Immediate_Directory_Of (Path_Name_Of (Main_Project)); 219 -- The directory of the extending all project 220 221 -- The source of the virtual extending project is something like: 222 223 -- project V$<project name> extends <project path> is 224 225 -- for Source_Dirs use (); 226 227 -- end V$<project name>; 228 229 -- The project directory cannot be specified during parsing; it will be 230 -- put directly in the virtual extending project data during processing. 231 232 -- Nodes that made up the virtual extending project 233 234 Virtual_Project : constant Project_Node_Id := 235 Default_Project_Node (N_Project); 236 With_Clause : constant Project_Node_Id := 237 Default_Project_Node (N_With_Clause); 238 Project_Declaration : constant Project_Node_Id := 239 Default_Project_Node (N_Project_Declaration); 240 Source_Dirs_Declaration : constant Project_Node_Id := 241 Default_Project_Node (N_Declarative_Item); 242 Source_Dirs_Attribute : constant Project_Node_Id := 243 Default_Project_Node 244 (N_Attribute_Declaration, List); 245 Source_Dirs_Expression : constant Project_Node_Id := 246 Default_Project_Node (N_Expression, List); 247 Source_Dirs_Term : constant Project_Node_Id := 248 Default_Project_Node (N_Term, List); 249 Source_Dirs_List : constant Project_Node_Id := 250 Default_Project_Node 251 (N_Literal_String_List, List); 252 253 begin 254 -- Get the virtual name id 255 256 Name_Len := Virtual_Name'Length; 257 Name_Buffer (1 .. Name_Len) := Virtual_Name; 258 Virtual_Name_Id := Name_Find; 259 260 -- Get the virtual path name 261 262 Get_Name_String (Path_Name_Of (Main_Project)); 263 264 while Name_Len > 0 265 and then Name_Buffer (Name_Len) /= Directory_Separator 266 and then Name_Buffer (Name_Len) /= '/' 267 loop 268 Name_Len := Name_Len - 1; 269 end loop; 270 271 Name_Buffer (Name_Len + 1 .. Name_Len + Virtual_Name'Length) := 272 Virtual_Name; 273 Name_Len := Name_Len + Virtual_Name'Length; 274 Virtual_Path_Id := Name_Find; 275 276 -- With clause 277 278 Set_Name_Of (With_Clause, Virtual_Name_Id); 279 Set_Path_Name_Of (With_Clause, Virtual_Path_Id); 280 Set_Project_Node_Of (With_Clause, Virtual_Project); 281 Set_Next_With_Clause_Of 282 (With_Clause, First_With_Clause_Of (Main_Project)); 283 Set_First_With_Clause_Of (Main_Project, With_Clause); 284 285 -- Virtual project node 286 287 Set_Name_Of (Virtual_Project, Virtual_Name_Id); 288 Set_Path_Name_Of (Virtual_Project, Virtual_Path_Id); 289 Set_Location_Of (Virtual_Project, Location_Of (Main_Project)); 290 Set_Directory_Of (Virtual_Project, Virtual_Dir_Id); 291 Set_Project_Declaration_Of (Virtual_Project, Project_Declaration); 292 Set_Extended_Project_Path_Of 293 (Virtual_Project, Path_Name_Of (For_Project)); 294 295 -- Project declaration 296 297 Set_First_Declarative_Item_Of 298 (Project_Declaration, Source_Dirs_Declaration); 299 Set_Extended_Project_Of (Project_Declaration, For_Project); 300 301 -- Source_Dirs declaration 302 303 Set_Current_Item_Node (Source_Dirs_Declaration, Source_Dirs_Attribute); 304 305 -- Source_Dirs attribute 306 307 Set_Name_Of (Source_Dirs_Attribute, Snames.Name_Source_Dirs); 308 Set_Expression_Of (Source_Dirs_Attribute, Source_Dirs_Expression); 309 310 -- Source_Dirs expression 311 312 Set_First_Term (Source_Dirs_Expression, Source_Dirs_Term); 313 314 -- Source_Dirs term 315 316 Set_Current_Term (Source_Dirs_Term, Source_Dirs_List); 317 318 -- Source_Dirs empty list: nothing to do 319 320 end Create_Virtual_Extending_Project; 321 322 ---------------------------- 323 -- Immediate_Directory_Of -- 324 ---------------------------- 325 326 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is 327 begin 328 Get_Name_String (Path_Name); 329 330 for Index in reverse 1 .. Name_Len loop 331 if Name_Buffer (Index) = '/' 332 or else Name_Buffer (Index) = Dir_Sep 333 then 334 -- Remove all chars after last directory separator from name 335 336 if Index > 1 then 337 Name_Len := Index - 1; 338 339 else 340 Name_Len := Index; 341 end if; 342 343 return Name_Find; 344 end if; 345 end loop; 346 347 -- There is no directory separator in name. Return "./" or ".\" 348 349 Name_Len := 2; 350 Name_Buffer (1) := '.'; 351 Name_Buffer (2) := Dir_Sep; 352 return Name_Find; 353 end Immediate_Directory_Of; 354 355 ----------------------------------- 356 -- Look_For_Virtual_Projects_For -- 357 ----------------------------------- 358 359 procedure Look_For_Virtual_Projects_For 360 (Proj : Project_Node_Id; 361 Potentially_Virtual : Boolean) 362 363 is 364 Declaration : Project_Node_Id := Empty_Node; 365 -- Node for the project declaration of Proj 366 367 With_Clause : Project_Node_Id := Empty_Node; 368 -- Node for a with clause of Proj 369 370 Imported : Project_Node_Id := Empty_Node; 371 -- Node for a project imported by Proj 372 373 Extended : Project_Node_Id := Empty_Node; 374 -- Node for the eventual project extended by Proj 375 376 begin 377 -- Nothing to do if Proj is not defined or if it has already been 378 -- processed. 379 380 if Proj /= Empty_Node and then not Processed_Hash.Get (Proj) then 381 -- Make sure the project will not be processed again 382 383 Processed_Hash.Set (Proj, True); 384 385 Declaration := Project_Declaration_Of (Proj); 386 387 if Declaration /= Empty_Node then 388 Extended := Extended_Project_Of (Declaration); 389 end if; 390 391 -- If this is a project that may need a virtual extending project 392 -- and it is not itself an extending project, put it in the list. 393 394 if Potentially_Virtual and then Extended = Empty_Node then 395 Virtual_Hash.Set (Proj, Proj); 396 end if; 397 398 -- Now check the projects it imports 399 400 With_Clause := First_With_Clause_Of (Proj); 401 402 while With_Clause /= Empty_Node loop 403 Imported := Project_Node_Of (With_Clause); 404 405 if Imported /= Empty_Node then 406 Look_For_Virtual_Projects_For 407 (Imported, Potentially_Virtual => True); 408 end if; 409 410 With_Clause := Next_With_Clause_Of (With_Clause); 411 end loop; 412 413 -- Check also the eventual project extended by Proj. As this project 414 -- is already extended, call recursively with Potentially_Virtual 415 -- being False. 416 417 Look_For_Virtual_Projects_For 418 (Extended, Potentially_Virtual => False); 419 end if; 420 end Look_For_Virtual_Projects_For; 421 422 ----------- 423 -- Parse -- 424 ----------- 425 426 procedure Parse 427 (Project : out Project_Node_Id; 428 Project_File_Name : String; 429 Always_Errout_Finalize : Boolean; 430 Packages_To_Check : String_List_Access := All_Packages; 431 Store_Comments : Boolean := False) 432 is 433 Current_Directory : constant String := Get_Current_Dir; 434 435 begin 436 -- Save the Packages_To_Check in Prj, so that it is visible from 437 -- Prj.Dect. 438 439 Current_Packages_To_Check := Packages_To_Check; 440 441 Project := Empty_Node; 442 443 if Current_Verbosity >= Medium then 444 Write_Str ("ADA_PROJECT_PATH="""); 445 Write_Str (Project_Path.all); 446 Write_Line (""""); 447 end if; 448 449 declare 450 Path_Name : constant String := 451 Project_Path_Name_Of (Project_File_Name, 452 Directory => Current_Directory); 453 454 begin 455 Prj.Err.Initialize; 456 Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments); 457 Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments); 458 459 -- Parse the main project file 460 461 if Path_Name = "" then 462 Prj.Com.Fail 463 ("project file """, Project_File_Name, """ not found"); 464 Project := Empty_Node; 465 return; 466 end if; 467 468 Parse_Single_Project 469 (Project => Project, 470 Path_Name => Path_Name, 471 Extended => False, 472 From_Extended => None); 473 474 -- If Project is an extending-all project, create the eventual 475 -- virtual extending projects and check that there are no illegally 476 -- imported projects. 477 478 if Project /= Empty_Node and then Is_Extending_All (Project) then 479 -- First look for projects that potentially need a virtual 480 -- extending project. 481 482 Virtual_Hash.Reset; 483 Processed_Hash.Reset; 484 485 -- Mark the extending all project as processed, to avoid checking 486 -- the imported projects in case of a "limited with" on this 487 -- extending all project. 488 489 Processed_Hash.Set (Project, True); 490 491 declare 492 Declaration : constant Project_Node_Id := 493 Project_Declaration_Of (Project); 494 begin 495 Look_For_Virtual_Projects_For 496 (Extended_Project_Of (Declaration), 497 Potentially_Virtual => False); 498 end; 499 500 -- Now, check the projects directly imported by the main project. 501 -- Remove from the potentially virtual any project extended by one 502 -- of these imported projects. For non extending imported 503 -- projects, check that they do not belong to the project tree of 504 -- the project being "extended-all" by the main project. 505 506 declare 507 With_Clause : Project_Node_Id := 508 First_With_Clause_Of (Project); 509 Imported : Project_Node_Id := Empty_Node; 510 Declaration : Project_Node_Id := Empty_Node; 511 512 begin 513 while With_Clause /= Empty_Node loop 514 Imported := Project_Node_Of (With_Clause); 515 516 if Imported /= Empty_Node then 517 Declaration := Project_Declaration_Of (Imported); 518 519 if Extended_Project_Of (Declaration) /= Empty_Node then 520 loop 521 Imported := Extended_Project_Of (Declaration); 522 exit when Imported = Empty_Node; 523 Virtual_Hash.Remove (Imported); 524 Declaration := Project_Declaration_Of (Imported); 525 end loop; 526 527 elsif Virtual_Hash.Get (Imported) /= Empty_Node then 528 Error_Msg 529 ("this project cannot be imported directly", 530 Location_Of (With_Clause)); 531 end if; 532 533 end if; 534 535 With_Clause := Next_With_Clause_Of (With_Clause); 536 end loop; 537 end; 538 539 -- Now create all the virtual extending projects 540 541 declare 542 Proj : Project_Node_Id := Virtual_Hash.Get_First; 543 begin 544 while Proj /= Empty_Node loop 545 Create_Virtual_Extending_Project (Proj, Project); 546 Proj := Virtual_Hash.Get_Next; 547 end loop; 548 end; 549 end if; 550 551 -- If there were any kind of error during the parsing, serious 552 -- or not, then the parsing fails. 553 554 if Err_Vars.Total_Errors_Detected > 0 then 555 Project := Empty_Node; 556 end if; 557 558 if Project = Empty_Node or else Always_Errout_Finalize then 559 Prj.Err.Finalize; 560 end if; 561 end; 562 563 exception 564 when X : others => 565 566 -- Internal error 567 568 Write_Line (Exception_Information (X)); 569 Write_Str ("Exception "); 570 Write_Str (Exception_Name (X)); 571 Write_Line (" raised, while processing project file"); 572 Project := Empty_Node; 573 end Parse; 574 575 ------------------------------ 576 -- Pre_Parse_Context_Clause -- 577 ------------------------------ 578 579 procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id) is 580 Current_With_Clause : With_Id := No_With; 581 Limited_With : Boolean := False; 582 583 Current_With : With_Record; 584 585 Current_With_Node : Project_Node_Id := Empty_Node; 586 587 begin 588 -- Assume no context clause 589 590 Context_Clause := No_With; 591 With_Loop : 592 593 -- If Token is not WITH or LIMITED, there is no context clause, 594 -- or we have exhausted the with clauses. 595 596 while Token = Tok_With or else Token = Tok_Limited loop 597 Current_With_Node := Default_Project_Node (Of_Kind => N_With_Clause); 598 Limited_With := Token = Tok_Limited; 599 600 if Limited_With then 601 Scan; -- scan past LIMITED 602 Expect (Tok_With, "WITH"); 603 exit With_Loop when Token /= Tok_With; 604 end if; 605 606 Comma_Loop : 607 loop 608 Scan; -- scan past WITH or "," 609 610 Expect (Tok_String_Literal, "literal string"); 611 612 if Token /= Tok_String_Literal then 613 return; 614 end if; 615 616 -- Store path and location in table Withs 617 618 Current_With := 619 (Path => Token_Name, 620 Location => Token_Ptr, 621 Limited_With => Limited_With, 622 Node => Current_With_Node, 623 Next => No_With); 624 625 Withs.Increment_Last; 626 Withs.Table (Withs.Last) := Current_With; 627 628 if Current_With_Clause = No_With then 629 Context_Clause := Withs.Last; 630 631 else 632 Withs.Table (Current_With_Clause).Next := Withs.Last; 633 end if; 634 635 Current_With_Clause := Withs.Last; 636 637 Scan; 638 639 if Token = Tok_Semicolon then 640 Set_End_Of_Line (Current_With_Node); 641 Set_Previous_Line_Node (Current_With_Node); 642 643 -- End of (possibly multiple) with clause; 644 645 Scan; -- scan past the semicolon. 646 exit Comma_Loop; 647 648 elsif Token /= Tok_Comma then 649 Error_Msg ("expected comma or semi colon", Token_Ptr); 650 exit Comma_Loop; 651 end if; 652 653 Current_With_Node := 654 Default_Project_Node (Of_Kind => N_With_Clause); 655 end loop Comma_Loop; 656 end loop With_Loop; 657 end Pre_Parse_Context_Clause; 658 659 660 ------------------------------- 661 -- Post_Parse_Context_Clause -- 662 ------------------------------- 663 664 procedure Post_Parse_Context_Clause 665 (Context_Clause : With_Id; 666 Imported_Projects : out Project_Node_Id; 667 Project_Directory : Name_Id; 668 From_Extended : Extension_Origin) 669 is 670 Current_With_Clause : With_Id := Context_Clause; 671 672 Current_Project : Project_Node_Id := Empty_Node; 673 Previous_Project : Project_Node_Id := Empty_Node; 674 Next_Project : Project_Node_Id := Empty_Node; 675 676 Project_Directory_Path : constant String := 677 Get_Name_String (Project_Directory); 678 679 Current_With : With_Record; 680 Limited_With : Boolean := False; 681 682 begin 683 Imported_Projects := Empty_Node; 684 685 while Current_With_Clause /= No_With loop 686 Current_With := Withs.Table (Current_With_Clause); 687 Current_With_Clause := Current_With.Next; 688 689 Limited_With := Current_With.Limited_With; 690 691 declare 692 Original_Path : constant String := 693 Get_Name_String (Current_With.Path); 694 695 Imported_Path_Name : constant String := 696 Project_Path_Name_Of 697 (Original_Path, 698 Project_Directory_Path); 699 700 Withed_Project : Project_Node_Id := Empty_Node; 701 702 begin 703 if Imported_Path_Name = "" then 704 705 -- The project file cannot be found 706 707 Error_Msg_Name_1 := Current_With.Path; 708 709 Error_Msg ("unknown project file: {", Current_With.Location); 710 711 -- If this is not imported by the main project file, 712 -- display the import path. 713 714 if Project_Stack.Last > 1 then 715 for Index in reverse 1 .. Project_Stack.Last loop 716 Error_Msg_Name_1 := Project_Stack.Table (Index).Name; 717 Error_Msg ("\imported by {", Current_With.Location); 718 end loop; 719 end if; 720 721 else 722 -- New with clause 723 724 Previous_Project := Current_Project; 725 726 if Current_Project = Empty_Node then 727 728 -- First with clause of the context clause 729 730 Current_Project := Current_With.Node; 731 Imported_Projects := Current_Project; 732 733 else 734 Next_Project := Current_With.Node; 735 Set_Next_With_Clause_Of (Current_Project, Next_Project); 736 Current_Project := Next_Project; 737 end if; 738 739 Set_String_Value_Of 740 (Current_Project, Current_With.Path); 741 Set_Location_Of (Current_Project, Current_With.Location); 742 743 -- If this is a "limited with", check if we have 744 -- a circularity; if we have one, get the project id 745 -- of the limited imported project file, and don't 746 -- parse it. 747 748 if Limited_With and then Project_Stack.Last > 1 then 749 declare 750 Normed : constant String := 751 Normalize_Pathname (Imported_Path_Name); 752 Canonical_Path_Name : Name_Id; 753 754 begin 755 Name_Len := Normed'Length; 756 Name_Buffer (1 .. Name_Len) := Normed; 757 Canonical_Path_Name := Name_Find; 758 759 for Index in 1 .. Project_Stack.Last loop 760 if Project_Stack.Table (Index).Name = 761 Canonical_Path_Name 762 then 763 -- We have found the limited imported project, 764 -- get its project id, and don't parse it. 765 766 Withed_Project := Project_Stack.Table (Index).Id; 767 exit; 768 end if; 769 end loop; 770 end; 771 end if; 772 773 -- Parse the imported project, if its project id is unknown 774 775 if Withed_Project = Empty_Node then 776 Parse_Single_Project 777 (Project => Withed_Project, 778 Path_Name => Imported_Path_Name, 779 Extended => False, 780 From_Extended => From_Extended); 781 end if; 782 783 if Withed_Project = Empty_Node then 784 -- If parsing was not successful, remove the 785 -- context clause. 786 787 Current_Project := Previous_Project; 788 789 if Current_Project = Empty_Node then 790 Imported_Projects := Empty_Node; 791 792 else 793 Set_Next_With_Clause_Of 794 (Current_Project, Empty_Node); 795 end if; 796 else 797 -- If parsing was successful, record project name 798 -- and path name in with clause 799 800 Set_Project_Node_Of 801 (Node => Current_Project, 802 To => Withed_Project, 803 Limited_With => Limited_With); 804 Set_Name_Of (Current_Project, Name_Of (Withed_Project)); 805 Name_Len := Imported_Path_Name'Length; 806 Name_Buffer (1 .. Name_Len) := Imported_Path_Name; 807 Set_Path_Name_Of (Current_Project, Name_Find); 808 end if; 809 end if; 810 end; 811 end loop; 812 end Post_Parse_Context_Clause; 813 814 -------------------------- 815 -- Parse_Single_Project -- 816 -------------------------- 817 818 procedure Parse_Single_Project 819 (Project : out Project_Node_Id; 820 Path_Name : String; 821 Extended : Boolean; 822 From_Extended : Extension_Origin) 823 is 824 Normed_Path_Name : Name_Id; 825 Canonical_Path_Name : Name_Id; 826 Project_Directory : Name_Id; 827 Project_Scan_State : Saved_Project_Scan_State; 828 Source_Index : Source_File_Index; 829 830 Extended_Project : Project_Node_Id := Empty_Node; 831 832 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node := 833 Tree_Private_Part.Projects_Htable.Get_First; 834 835 Name_From_Path : constant Name_Id := Project_Name_From (Path_Name); 836 837 Name_Of_Project : Name_Id := No_Name; 838 839 First_With : With_Id; 840 841 use Tree_Private_Part; 842 843 Project_Comment_State : Tree.Comment_State; 844 845 begin 846 declare 847 Normed : String := Normalize_Pathname (Path_Name); 848 begin 849 Name_Len := Normed'Length; 850 Name_Buffer (1 .. Name_Len) := Normed; 851 Normed_Path_Name := Name_Find; 852 Canonical_Case_File_Name (Normed); 853 Name_Len := Normed'Length; 854 Name_Buffer (1 .. Name_Len) := Normed; 855 Canonical_Path_Name := Name_Find; 856 end; 857 858 -- Check for a circular dependency 859 860 for Index in 1 .. Project_Stack.Last loop 861 if Canonical_Path_Name = Project_Stack.Table (Index).Name then 862 Error_Msg ("circular dependency detected", Token_Ptr); 863 Error_Msg_Name_1 := Normed_Path_Name; 864 Error_Msg ("\ { is imported by", Token_Ptr); 865 866 for Current in reverse 1 .. Project_Stack.Last loop 867 Error_Msg_Name_1 := Project_Stack.Table (Current).Name; 868 869 if Error_Msg_Name_1 /= Canonical_Path_Name then 870 Error_Msg 871 ("\ { which itself is imported by", Token_Ptr); 872 873 else 874 Error_Msg ("\ {", Token_Ptr); 875 exit; 876 end if; 877 end loop; 878 879 Project := Empty_Node; 880 return; 881 end if; 882 end loop; 883 884 -- Put the new path name on the stack 885 886 Project_Stack.Increment_Last; 887 Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name; 888 889 -- Check if the project file has already been parsed. 890 891 while 892 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node 893 loop 894 if 895 Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name 896 then 897 if Extended then 898 899 if A_Project_Name_And_Node.Extended then 900 Error_Msg 901 ("cannot extend the same project file several times", 902 Token_Ptr); 903 904 else 905 Error_Msg 906 ("cannot extend an already imported project file", 907 Token_Ptr); 908 end if; 909 910 elsif A_Project_Name_And_Node.Extended then 911 -- If the imported project is an extended project A, and we are 912 -- in an extended project, replace A with the ultimate project 913 -- extending A. 914 915 if From_Extended /= None then 916 declare 917 Decl : Project_Node_Id := 918 Project_Declaration_Of 919 (A_Project_Name_And_Node.Node); 920 Prj : Project_Node_Id := 921 Extending_Project_Of (Decl); 922 begin 923 loop 924 Decl := Project_Declaration_Of (Prj); 925 exit when Extending_Project_Of (Decl) = Empty_Node; 926 Prj := Extending_Project_Of (Decl); 927 end loop; 928 929 A_Project_Name_And_Node.Node := Prj; 930 end; 931 else 932 Error_Msg 933 ("cannot import an already extended project file", 934 Token_Ptr); 935 end if; 936 end if; 937 938 Project := A_Project_Name_And_Node.Node; 939 Project_Stack.Decrement_Last; 940 return; 941 end if; 942 943 A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next; 944 end loop; 945 946 -- We never encountered this project file 947 -- Save the scan state, load the project file and start to scan it. 948 949 Save_Project_Scan_State (Project_Scan_State); 950 Source_Index := Load_Project_File (Path_Name); 951 Tree.Save (Project_Comment_State); 952 953 -- if we cannot find it, we stop 954 955 if Source_Index = No_Source_File then 956 Project := Empty_Node; 957 Project_Stack.Decrement_Last; 958 return; 959 end if; 960 961 Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index); 962 Tree.Reset_State; 963 Scan; 964 965 if Name_From_Path = No_Name then 966 967 -- The project file name is not correct (no or bad extension, 968 -- or not following Ada identifier's syntax). 969 970 Error_Msg_Name_1 := Canonical_Path_Name; 971 Error_Msg ("?{ is not a valid path name for a project file", 972 Token_Ptr); 973 end if; 974 975 if Current_Verbosity >= Medium then 976 Write_Str ("Parsing """); 977 Write_Str (Path_Name); 978 Write_Char ('"'); 979 Write_Eol; 980 end if; 981 982 -- Is there any imported project? 983 984 Pre_Parse_Context_Clause (First_With); 985 986 Project_Directory := Immediate_Directory_Of (Normed_Path_Name); 987 Project := Default_Project_Node (Of_Kind => N_Project); 988 Project_Stack.Table (Project_Stack.Last).Id := Project; 989 Set_Directory_Of (Project, Project_Directory); 990 Set_Path_Name_Of (Project, Normed_Path_Name); 991 Set_Location_Of (Project, Token_Ptr); 992 993 Expect (Tok_Project, "PROJECT"); 994 995 -- Mark location of PROJECT token if present 996 997 if Token = Tok_Project then 998 Set_Location_Of (Project, Token_Ptr); 999 Scan; -- scan past project 1000 end if; 1001 1002 -- Clear the Buffer 1003 1004 Buffer_Last := 0; 1005 1006 loop 1007 Expect (Tok_Identifier, "identifier"); 1008 1009 -- If the token is not an identifier, clear the buffer before 1010 -- exiting to indicate that the name of the project is ill-formed. 1011 1012 if Token /= Tok_Identifier then 1013 Buffer_Last := 0; 1014 exit; 1015 end if; 1016 1017 -- Add the identifier name to the buffer 1018 1019 Get_Name_String (Token_Name); 1020 Add_To_Buffer (Name_Buffer (1 .. Name_Len)); 1021 1022 -- Scan past the identifier 1023 1024 Scan; 1025 1026 -- If we have a dot, add a dot the the Buffer and look for the next 1027 -- identifier. 1028 1029 exit when Token /= Tok_Dot; 1030 Add_To_Buffer ("."); 1031 1032 -- Scan past the dot 1033 1034 Scan; 1035 end loop; 1036 1037 -- If the name is well formed, Buffer_Last is > 0 1038 1039 if Buffer_Last > 0 then 1040 1041 -- The Buffer contains the name of the project 1042 1043 Name_Len := Buffer_Last; 1044 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last); 1045 Name_Of_Project := Name_Find; 1046 Set_Name_Of (Project, Name_Of_Project); 1047 1048 -- To get expected name of the project file, replace dots by dashes 1049 1050 Name_Len := Buffer_Last; 1051 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last); 1052 1053 for Index in 1 .. Name_Len loop 1054 if Name_Buffer (Index) = '.' then 1055 Name_Buffer (Index) := '-'; 1056 end if; 1057 end loop; 1058 1059 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); 1060 1061 declare 1062 Expected_Name : constant Name_Id := Name_Find; 1063 1064 begin 1065 -- Output a warning if the actual name is not the expected name 1066 1067 if Name_From_Path /= No_Name 1068 and then Expected_Name /= Name_From_Path 1069 then 1070 Error_Msg_Name_1 := Expected_Name; 1071 Error_Msg ("?file name does not match unit name, " & 1072 "should be `{" & Project_File_Extension & "`", 1073 Token_Ptr); 1074 end if; 1075 end; 1076 1077 declare 1078 Imported_Projects : Project_Node_Id := Empty_Node; 1079 From_Ext : Extension_Origin := None; 1080 1081 begin 1082 -- Extending_All is always propagated 1083 1084 if From_Extended = Extending_All then 1085 From_Ext := Extending_All; 1086 1087 -- Otherwise, From_Extended is set to Extending_Single if the 1088 -- current project is an extending project. 1089 1090 elsif Extended then 1091 From_Ext := Extending_Simple; 1092 end if; 1093 1094 Post_Parse_Context_Clause 1095 (Context_Clause => First_With, 1096 Imported_Projects => Imported_Projects, 1097 Project_Directory => Project_Directory, 1098 From_Extended => From_Ext); 1099 Set_First_With_Clause_Of (Project, Imported_Projects); 1100 end; 1101 1102 declare 1103 Project_Name : Name_Id := 1104 Tree_Private_Part.Projects_Htable.Get_First.Name; 1105 1106 begin 1107 -- Check if we already have a project with this name 1108 1109 while Project_Name /= No_Name 1110 and then Project_Name /= Name_Of_Project 1111 loop 1112 Project_Name := Tree_Private_Part.Projects_Htable.Get_Next.Name; 1113 end loop; 1114 1115 -- Report an error if we already have a project with this name 1116 1117 if Project_Name /= No_Name then 1118 Error_Msg ("duplicate project name", Token_Ptr); 1119 1120 else 1121 -- Otherwise, add the name of the project to the hash table, so 1122 -- that we can check that no other subsequent project will have 1123 -- the same name. 1124 1125 Tree_Private_Part.Projects_Htable.Set 1126 (K => Name_Of_Project, 1127 E => (Name => Name_Of_Project, 1128 Node => Project, 1129 Extended => Extended)); 1130 end if; 1131 end; 1132 1133 end if; 1134 1135 if Token = Tok_Extends then 1136 1137 -- Make sure that gnatmake will use mapping files 1138 1139 Opt.Create_Mapping_File := True; 1140 1141 -- We are extending another project 1142 1143 Scan; -- scan past EXTENDS 1144 1145 if Token = Tok_All then 1146 Set_Is_Extending_All (Project); 1147 Scan; -- scan past ALL 1148 end if; 1149 1150 Expect (Tok_String_Literal, "literal string"); 1151 1152 if Token = Tok_String_Literal then 1153 Set_Extended_Project_Path_Of (Project, Token_Name); 1154 1155 declare 1156 Original_Path_Name : constant String := 1157 Get_Name_String (Token_Name); 1158 1159 Extended_Project_Path_Name : constant String := 1160 Project_Path_Name_Of 1161 (Original_Path_Name, 1162 Get_Name_String 1163 (Project_Directory)); 1164 1165 begin 1166 if Extended_Project_Path_Name = "" then 1167 1168 -- We could not find the project file to extend 1169 1170 Error_Msg_Name_1 := Token_Name; 1171 1172 Error_Msg ("unknown project file: {", Token_Ptr); 1173 1174 -- If we are not in the main project file, display the 1175 -- import path. 1176 1177 if Project_Stack.Last > 1 then 1178 Error_Msg_Name_1 := 1179 Project_Stack.Table (Project_Stack.Last).Name; 1180 Error_Msg ("\extended by {", Token_Ptr); 1181 1182 for Index in reverse 1 .. Project_Stack.Last - 1 loop 1183 Error_Msg_Name_1 := Project_Stack.Table (Index).Name; 1184 Error_Msg ("\imported by {", Token_Ptr); 1185 end loop; 1186 end if; 1187 1188 else 1189 declare 1190 From_Extended : Extension_Origin := None; 1191 1192 begin 1193 if Is_Extending_All (Project) then 1194 From_Extended := Extending_All; 1195 end if; 1196 1197 Parse_Single_Project 1198 (Project => Extended_Project, 1199 Path_Name => Extended_Project_Path_Name, 1200 Extended => True, 1201 From_Extended => From_Extended); 1202 end; 1203 1204 -- A project that extends an extending-all project is also 1205 -- an extending-all project. 1206 1207 if Is_Extending_All (Extended_Project) then 1208 Set_Is_Extending_All (Project); 1209 end if; 1210 end if; 1211 end; 1212 1213 Scan; -- scan past the extended project path 1214 end if; 1215 end if; 1216 1217 -- Check that a non extending-all project does not import an 1218 -- extending-all project. 1219 1220 if not Is_Extending_All (Project) then 1221 declare 1222 With_Clause : Project_Node_Id := First_With_Clause_Of (Project); 1223 Imported : Project_Node_Id := Empty_Node; 1224 1225 begin 1226 With_Clause_Loop : 1227 while With_Clause /= Empty_Node loop 1228 Imported := Project_Node_Of (With_Clause); 1229 With_Clause := Next_With_Clause_Of (With_Clause); 1230 1231 if Is_Extending_All (Imported) then 1232 Error_Msg_Name_1 := Name_Of (Imported); 1233 Error_Msg ("cannot import extending-all project {", 1234 Token_Ptr); 1235 exit With_Clause_Loop; 1236 end if; 1237 end loop With_Clause_Loop; 1238 end; 1239 end if; 1240 1241 -- Check that a project with a name including a dot either imports 1242 -- or extends the project whose name precedes the last dot. 1243 1244 if Name_Of_Project /= No_Name then 1245 Get_Name_String (Name_Of_Project); 1246 1247 else 1248 Name_Len := 0; 1249 end if; 1250 1251 -- Look for the last dot 1252 1253 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop 1254 Name_Len := Name_Len - 1; 1255 end loop; 1256 1257 -- If a dot was find, check if the parent project is imported 1258 -- or extended. 1259 1260 if Name_Len > 0 then 1261 Name_Len := Name_Len - 1; 1262 1263 declare 1264 Parent_Name : constant Name_Id := Name_Find; 1265 Parent_Found : Boolean := False; 1266 With_Clause : Project_Node_Id := First_With_Clause_Of (Project); 1267 1268 begin 1269 -- If there is an extended project, check its name 1270 1271 if Extended_Project /= Empty_Node then 1272 Parent_Found := Name_Of (Extended_Project) = Parent_Name; 1273 end if; 1274 1275 -- If the parent project is not the extended project, 1276 -- check each imported project until we find the parent project. 1277 1278 while not Parent_Found and then With_Clause /= Empty_Node loop 1279 Parent_Found := Name_Of (Project_Node_Of (With_Clause)) 1280 = Parent_Name; 1281 With_Clause := Next_With_Clause_Of (With_Clause); 1282 end loop; 1283 1284 -- If the parent project was not found, report an error 1285 1286 if not Parent_Found then 1287 Error_Msg_Name_1 := Name_Of_Project; 1288 Error_Msg_Name_2 := Parent_Name; 1289 Error_Msg ("project { does not import or extend project {", 1290 Location_Of (Project)); 1291 end if; 1292 end; 1293 end if; 1294 1295 Expect (Tok_Is, "IS"); 1296 Set_End_Of_Line (Project); 1297 Set_Previous_Line_Node (Project); 1298 Set_Next_End_Node (Project); 1299 1300 declare 1301 Project_Declaration : Project_Node_Id := Empty_Node; 1302 1303 begin 1304 -- No need to Scan past "is", Prj.Dect.Parse will do it. 1305 1306 Prj.Dect.Parse 1307 (Declarations => Project_Declaration, 1308 Current_Project => Project, 1309 Extends => Extended_Project); 1310 Set_Project_Declaration_Of (Project, Project_Declaration); 1311 1312 if Extended_Project /= Empty_Node then 1313 Set_Extending_Project_Of 1314 (Project_Declaration_Of (Extended_Project), To => Project); 1315 end if; 1316 end; 1317 1318 Expect (Tok_End, "END"); 1319 Remove_Next_End_Node; 1320 1321 -- Skip "end" if present 1322 1323 if Token = Tok_End then 1324 Scan; 1325 end if; 1326 1327 -- Clear the Buffer 1328 1329 Buffer_Last := 0; 1330 1331 -- Store the name following "end" in the Buffer. The name may be made of 1332 -- several simple names. 1333 1334 loop 1335 Expect (Tok_Identifier, "identifier"); 1336 1337 -- If we don't have an identifier, clear the buffer before exiting to 1338 -- avoid checking the name. 1339 1340 if Token /= Tok_Identifier then 1341 Buffer_Last := 0; 1342 exit; 1343 end if; 1344 1345 -- Add the identifier to the Buffer 1346 Get_Name_String (Token_Name); 1347 Add_To_Buffer (Name_Buffer (1 .. Name_Len)); 1348 1349 -- Scan past the identifier 1350 1351 Scan; 1352 exit when Token /= Tok_Dot; 1353 Add_To_Buffer ("."); 1354 Scan; 1355 end loop; 1356 1357 -- If we have a valid name, check if it is the name of the project 1358 1359 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then 1360 if To_Lower (Buffer (1 .. Buffer_Last)) /= 1361 Get_Name_String (Name_Of (Project)) 1362 then 1363 -- Invalid name: report an error 1364 1365 Error_Msg ("Expected """ & 1366 Get_Name_String (Name_Of (Project)) & """", 1367 Token_Ptr); 1368 end if; 1369 end if; 1370 1371 Expect (Tok_Semicolon, "`;`"); 1372 1373 -- Check that there is no more text following the end of the project 1374 -- source. 1375 1376 if Token = Tok_Semicolon then 1377 Set_Previous_End_Node (Project); 1378 Scan; 1379 1380 if Token /= Tok_EOF then 1381 Error_Msg 1382 ("Unexpected text following end of project", Token_Ptr); 1383 end if; 1384 end if; 1385 1386 -- Restore the scan state, in case we are not the main project 1387 1388 Restore_Project_Scan_State (Project_Scan_State); 1389 1390 -- And remove the project from the project stack 1391 1392 Project_Stack.Decrement_Last; 1393 1394 -- Indicate if there are unkept comments 1395 1396 Tree.Set_Project_File_Includes_Unkept_Comments 1397 (Node => Project, To => Tree.There_Are_Unkept_Comments); 1398 1399 -- And restore the comment state that was saved 1400 1401 Tree.Restore (Project_Comment_State); 1402 end Parse_Single_Project; 1403 1404 ----------------------- 1405 -- Project_Name_From -- 1406 ----------------------- 1407 1408 function Project_Name_From (Path_Name : String) return Name_Id is 1409 Canonical : String (1 .. Path_Name'Length) := Path_Name; 1410 First : Natural := Canonical'Last; 1411 Last : Natural := First; 1412 Index : Positive; 1413 1414 begin 1415 if Current_Verbosity = High then 1416 Write_Str ("Project_Name_From ("""); 1417 Write_Str (Canonical); 1418 Write_Line (""")"); 1419 end if; 1420 1421 -- If the path name is empty, return No_Name to indicate failure 1422 1423 if First = 0 then 1424 return No_Name; 1425 end if; 1426 1427 Canonical_Case_File_Name (Canonical); 1428 1429 -- Look for the last dot in the path name 1430 1431 while First > 0 1432 and then 1433 Canonical (First) /= '.' 1434 loop 1435 First := First - 1; 1436 end loop; 1437 1438 -- If we have a dot, check that it is followed by the correct extension 1439 1440 if First > 0 and then Canonical (First) = '.' then 1441 if Canonical (First .. Last) = Project_File_Extension 1442 and then First /= 1 1443 then 1444 -- Look for the last directory separator, if any 1445 1446 First := First - 1; 1447 Last := First; 1448 1449 while First > 0 1450 and then Canonical (First) /= '/' 1451 and then Canonical (First) /= Dir_Sep 1452 loop 1453 First := First - 1; 1454 end loop; 1455 1456 else 1457 -- Not the correct extension, return No_Name to indicate failure 1458 1459 return No_Name; 1460 end if; 1461 1462 -- If no dot in the path name, return No_Name to indicate failure 1463 1464 else 1465 return No_Name; 1466 end if; 1467 1468 First := First + 1; 1469 1470 -- If the extension is the file name, return No_Name to indicate failure 1471 1472 if First > Last then 1473 return No_Name; 1474 end if; 1475 1476 -- Put the name in lower case into Name_Buffer 1477 1478 Name_Len := Last - First + 1; 1479 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last)); 1480 1481 Index := 1; 1482 1483 -- Check if it is a well formed project name. Return No_Name if it is 1484 -- ill formed. 1485 1486 loop 1487 if not Is_Letter (Name_Buffer (Index)) then 1488 return No_Name; 1489 1490 else 1491 loop 1492 Index := Index + 1; 1493 1494 exit when Index >= Name_Len; 1495 1496 if Name_Buffer (Index) = '_' then 1497 if Name_Buffer (Index + 1) = '_' then 1498 return No_Name; 1499 end if; 1500 end if; 1501 1502 exit when Name_Buffer (Index) = '-'; 1503 1504 if Name_Buffer (Index) /= '_' 1505 and then not Is_Alphanumeric (Name_Buffer (Index)) 1506 then 1507 return No_Name; 1508 end if; 1509 1510 end loop; 1511 end if; 1512 1513 if Index >= Name_Len then 1514 if Is_Alphanumeric (Name_Buffer (Name_Len)) then 1515 1516 -- All checks have succeeded. Return name in Name_Buffer 1517 1518 return Name_Find; 1519 1520 else 1521 return No_Name; 1522 end if; 1523 1524 elsif Name_Buffer (Index) = '-' then 1525 Index := Index + 1; 1526 end if; 1527 end loop; 1528 end Project_Name_From; 1529 1530 -------------------------- 1531 -- Project_Path_Name_Of -- 1532 -------------------------- 1533 1534 function Project_Path_Name_Of 1535 (Project_File_Name : String; 1536 Directory : String) 1537 return String 1538 is 1539 Result : String_Access; 1540 1541 begin 1542 if Current_Verbosity = High then 1543 Write_Str ("Project_Path_Name_Of ("""); 1544 Write_Str (Project_File_Name); 1545 Write_Str (""", """); 1546 Write_Str (Directory); 1547 Write_Line (""");"); 1548 end if; 1549 1550 if not Is_Absolute_Path (Project_File_Name) then 1551 -- First we try <directory>/<file_name>.<extension> 1552 1553 if Current_Verbosity = High then 1554 Write_Str (" Trying "); 1555 Write_Str (Directory); 1556 Write_Char (Directory_Separator); 1557 Write_Str (Project_File_Name); 1558 Write_Line (Project_File_Extension); 1559 end if; 1560 1561 Result := 1562 Locate_Regular_File 1563 (File_Name => Directory & Directory_Separator & 1564 Project_File_Name & Project_File_Extension, 1565 Path => Project_Path.all); 1566 1567 -- Then we try <directory>/<file_name> 1568 1569 if Result = null then 1570 if Current_Verbosity = High then 1571 Write_Str (" Trying "); 1572 Write_Str (Directory); 1573 Write_Char (Directory_Separator); 1574 Write_Line (Project_File_Name); 1575 end if; 1576 1577 Result := 1578 Locate_Regular_File 1579 (File_Name => Directory & Directory_Separator & 1580 Project_File_Name, 1581 Path => Project_Path.all); 1582 end if; 1583 end if; 1584 1585 if Result = null then 1586 1587 -- Then we try <file_name>.<extension> 1588 1589 if Current_Verbosity = High then 1590 Write_Str (" Trying "); 1591 Write_Str (Project_File_Name); 1592 Write_Line (Project_File_Extension); 1593 end if; 1594 1595 Result := 1596 Locate_Regular_File 1597 (File_Name => Project_File_Name & Project_File_Extension, 1598 Path => Project_Path.all); 1599 end if; 1600 1601 if Result = null then 1602 1603 -- Then we try <file_name> 1604 1605 if Current_Verbosity = High then 1606 Write_Str (" Trying "); 1607 Write_Line (Project_File_Name); 1608 end if; 1609 1610 Result := 1611 Locate_Regular_File 1612 (File_Name => Project_File_Name, 1613 Path => Project_Path.all); 1614 end if; 1615 1616 -- If we cannot find the project file, we return an empty string 1617 1618 if Result = null then 1619 return ""; 1620 1621 else 1622 declare 1623 Final_Result : String := 1624 GNAT.OS_Lib.Normalize_Pathname (Result.all); 1625 begin 1626 Free (Result); 1627 Canonical_Case_File_Name (Final_Result); 1628 return Final_Result; 1629 end; 1630 end if; 1631 end Project_Path_Name_Of; 1632 1633begin 1634 -- Initialize Project_Path during package elaboration 1635 1636 if Prj_Path.all = "" then 1637 Project_Path := new String'("."); 1638 else 1639 Project_Path := new String'("." & Path_Separator & Prj_Path.all); 1640 end if; 1641end Prj.Part; 1642