1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . M A K R -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2013, 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 Csets; 27with Hostparm; 28with Makeutl; use Makeutl; 29with Opt; 30with Output; 31with Osint; use Osint; 32with Prj; use Prj; 33with Prj.Com; 34with Prj.Env; 35with Prj.Part; 36with Prj.PP; 37with Prj.Tree; use Prj.Tree; 38with Prj.Util; use Prj.Util; 39with Sdefault; 40with Snames; use Snames; 41with Stringt; 42with Table; use Table; 43with Tempdir; 44 45with Ada.Characters.Handling; use Ada.Characters.Handling; 46with GNAT.Directory_Operations; use GNAT.Directory_Operations; 47 48with System.Case_Util; use System.Case_Util; 49with System.CRTL; 50with System.HTable; 51 52package body Prj.Makr is 53 54 -- Packages of project files where unknown attributes are errors 55 56 -- All the following need comments ??? All global variables and 57 -- subprograms must be fully commented. 58 59 Very_Verbose : Boolean := False; 60 -- Set in call to Initialize to indicate very verbose output 61 62 Project_File : Boolean := False; 63 -- True when gnatname is creating/modifying a project file. False when 64 -- gnatname is creating a configuration pragmas file. 65 66 Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data; 67 -- The project tree where the project file is parsed 68 69 Args : Argument_List_Access; 70 -- The list of arguments for calls to the compiler to get the unit names 71 -- and kinds (spec or body) in the Ada sources. 72 73 Path_Name : String_Access; 74 75 Path_Last : Natural; 76 77 Directory_Last : Natural := 0; 78 79 Output_Name : String_Access; 80 Output_Name_Last : Natural; 81 Output_Name_Id : Name_Id; 82 83 Project_Naming_File_Name : String_Access; 84 -- String (1 .. Output_Name'Length + Naming_File_Suffix'Length); 85 86 Project_Naming_Last : Natural; 87 Project_Naming_Id : Name_Id := No_Name; 88 89 Source_List_Path : String_Access; 90 -- (1 .. Output_Name'Length + Source_List_File_Suffix'Length); 91 Source_List_Last : Natural; 92 93 Source_List_FD : File_Descriptor; 94 95 Project_Node : Project_Node_Id := Empty_Node; 96 Project_Declaration : Project_Node_Id := Empty_Node; 97 Source_Dirs_List : Project_Node_Id := Empty_Node; 98 99 Project_Naming_Node : Project_Node_Id := Empty_Node; 100 Project_Naming_Decl : Project_Node_Id := Empty_Node; 101 Naming_Package : Project_Node_Id := Empty_Node; 102 Naming_Package_Comments : Project_Node_Id := Empty_Node; 103 104 Source_Files_Comments : Project_Node_Id := Empty_Node; 105 Source_Dirs_Comments : Project_Node_Id := Empty_Node; 106 Source_List_File_Comments : Project_Node_Id := Empty_Node; 107 108 Naming_String : aliased String := "naming"; 109 110 Gnatname_Packages : aliased String_List := (1 => Naming_String'Access); 111 112 Packages_To_Check_By_Gnatname : constant String_List_Access := 113 Gnatname_Packages'Access; 114 115 function Dup (Fd : File_Descriptor) return File_Descriptor; 116 117 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor); 118 119 Gcc : constant String := "gcc"; 120 Gcc_Path : String_Access := null; 121 122 Non_Empty_Node : constant Project_Node_Id := 1; 123 -- Used for the With_Clause of the naming project 124 125 -- Turn off warnings for now around this redefinition of True and False, 126 -- but it really seems a bit horrible to do this redefinition ??? 127 128 pragma Warnings (Off); 129 type Matched_Type is (True, False, Excluded); 130 pragma Warnings (On); 131 132 Naming_File_Suffix : constant String := "_naming"; 133 Source_List_File_Suffix : constant String := "_source_list.txt"; 134 135 Output_FD : File_Descriptor; 136 -- To save the project file and its naming project file 137 138 procedure Write_Eol; 139 -- Output an empty line 140 141 procedure Write_A_Char (C : Character); 142 -- Write one character to Output_FD 143 144 procedure Write_A_String (S : String); 145 -- Write a String to Output_FD 146 147 package Processed_Directories is new Table.Table 148 (Table_Component_Type => String_Access, 149 Table_Index_Type => Natural, 150 Table_Low_Bound => 0, 151 Table_Initial => 10, 152 Table_Increment => 100, 153 Table_Name => "Prj.Makr.Processed_Directories"); 154 -- The list of already processed directories for each section, to avoid 155 -- processing several times the same directory in the same section. 156 157 package Source_Directories is new Table.Table 158 (Table_Component_Type => String_Access, 159 Table_Index_Type => Natural, 160 Table_Low_Bound => 0, 161 Table_Initial => 10, 162 Table_Increment => 100, 163 Table_Name => "Prj.Makr.Source_Directories"); 164 -- The complete list of directories to be put in attribute Source_Dirs in 165 -- the project file. 166 167 type Source is record 168 File_Name : Name_Id; 169 Unit_Name : Name_Id; 170 Index : Int := 0; 171 Spec : Boolean; 172 end record; 173 174 package Sources is new Table.Table 175 (Table_Component_Type => Source, 176 Table_Index_Type => Natural, 177 Table_Low_Bound => 0, 178 Table_Initial => 10, 179 Table_Increment => 100, 180 Table_Name => "Prj.Makr.Sources"); 181 -- The list of Ada sources found, with their unit name and kind, to be put 182 -- in the source attribute and package Naming of the project file, or in 183 -- the pragmas Source_File_Name in the configuration pragmas file. 184 185 package Source_Files is new System.HTable.Simple_HTable 186 (Header_Num => Prj.Header_Num, 187 Element => Boolean, 188 No_Element => False, 189 Key => Name_Id, 190 Hash => Prj.Hash, 191 Equal => "="); 192 -- Hash table to keep track of source file names, to avoid putting several 193 -- times the same file name in case of multi-unit files. 194 195 --------- 196 -- Dup -- 197 --------- 198 199 function Dup (Fd : File_Descriptor) return File_Descriptor is 200 begin 201 return File_Descriptor (System.CRTL.dup (Integer (Fd))); 202 end Dup; 203 204 ---------- 205 -- Dup2 -- 206 ---------- 207 208 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor) is 209 Fd : Integer; 210 pragma Warnings (Off, Fd); 211 begin 212 Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd)); 213 end Dup2; 214 215 -------------- 216 -- Finalize -- 217 -------------- 218 219 procedure Finalize is 220 Discard : Boolean; 221 pragma Warnings (Off, Discard); 222 223 Current_Source_Dir : Project_Node_Id := Empty_Node; 224 225 begin 226 if Project_File then 227 -- If there were no already existing project file, or if the parsing 228 -- was unsuccessful, create an empty project node with the correct 229 -- name and its project declaration node. 230 231 if No (Project_Node) then 232 Project_Node := 233 Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); 234 Set_Name_Of (Project_Node, Tree, To => Output_Name_Id); 235 Set_Project_Declaration_Of 236 (Project_Node, Tree, 237 To => Default_Project_Node 238 (Of_Kind => N_Project_Declaration, In_Tree => Tree)); 239 240 end if; 241 242 end if; 243 244 -- Delete the file if it already exists 245 246 Delete_File 247 (Path_Name (Directory_Last + 1 .. Path_Last), 248 Success => Discard); 249 250 -- Create a new one 251 252 if Opt.Verbose_Mode then 253 Output.Write_Str ("Creating new file """); 254 Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last)); 255 Output.Write_Line (""""); 256 end if; 257 258 Output_FD := Create_New_File 259 (Path_Name (Directory_Last + 1 .. Path_Last), 260 Fmode => Text); 261 262 -- Fails if project file cannot be created 263 264 if Output_FD = Invalid_FD then 265 Prj.Com.Fail 266 ("cannot create new """ & Path_Name (1 .. Path_Last) & """"); 267 end if; 268 269 if Project_File then 270 271 -- Delete the source list file, if it already exists 272 273 declare 274 Discard : Boolean; 275 pragma Warnings (Off, Discard); 276 begin 277 Delete_File 278 (Source_List_Path (1 .. Source_List_Last), 279 Success => Discard); 280 end; 281 282 -- And create a new source list file, fail if file cannot be created 283 284 Source_List_FD := Create_New_File 285 (Name => Source_List_Path (1 .. Source_List_Last), 286 Fmode => Text); 287 288 if Source_List_FD = Invalid_FD then 289 Prj.Com.Fail 290 ("cannot create file """ 291 & Source_List_Path (1 .. Source_List_Last) 292 & """"); 293 end if; 294 295 if Opt.Verbose_Mode then 296 Output.Write_Str ("Naming project file name is """); 297 Output.Write_Str 298 (Project_Naming_File_Name (1 .. Project_Naming_Last)); 299 Output.Write_Line (""""); 300 end if; 301 302 -- Create the naming project node 303 304 Project_Naming_Node := 305 Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); 306 Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id); 307 Project_Naming_Decl := 308 Default_Project_Node 309 (Of_Kind => N_Project_Declaration, In_Tree => Tree); 310 Set_Project_Declaration_Of 311 (Project_Naming_Node, Tree, Project_Naming_Decl); 312 Naming_Package := 313 Default_Project_Node 314 (Of_Kind => N_Package_Declaration, In_Tree => Tree); 315 Set_Name_Of (Naming_Package, Tree, To => Name_Naming); 316 317 -- Add an attribute declaration for Source_Files as an empty list (to 318 -- indicate there are no sources in the naming project) and a package 319 -- Naming (that will be filled later). 320 321 declare 322 Decl_Item : constant Project_Node_Id := 323 Default_Project_Node 324 (Of_Kind => N_Declarative_Item, In_Tree => Tree); 325 326 Attribute : constant Project_Node_Id := 327 Default_Project_Node 328 (Of_Kind => N_Attribute_Declaration, 329 In_Tree => Tree, 330 And_Expr_Kind => List); 331 332 Expression : constant Project_Node_Id := 333 Default_Project_Node 334 (Of_Kind => N_Expression, 335 In_Tree => Tree, 336 And_Expr_Kind => List); 337 338 Term : constant Project_Node_Id := 339 Default_Project_Node 340 (Of_Kind => N_Term, 341 In_Tree => Tree, 342 And_Expr_Kind => List); 343 344 Empty_List : constant Project_Node_Id := 345 Default_Project_Node 346 (Of_Kind => N_Literal_String_List, 347 In_Tree => Tree); 348 349 begin 350 Set_First_Declarative_Item_Of 351 (Project_Naming_Decl, Tree, To => Decl_Item); 352 Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package); 353 Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); 354 Set_Name_Of (Attribute, Tree, To => Name_Source_Files); 355 Set_Expression_Of (Attribute, Tree, To => Expression); 356 Set_First_Term (Expression, Tree, To => Term); 357 Set_Current_Term (Term, Tree, To => Empty_List); 358 end; 359 360 -- Add a with clause on the naming project in the main project, if 361 -- there is not already one. 362 363 declare 364 With_Clause : Project_Node_Id := 365 First_With_Clause_Of (Project_Node, Tree); 366 367 begin 368 while Present (With_Clause) loop 369 exit when 370 Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id; 371 With_Clause := Next_With_Clause_Of (With_Clause, Tree); 372 end loop; 373 374 if No (With_Clause) then 375 With_Clause := Default_Project_Node 376 (Of_Kind => N_With_Clause, In_Tree => Tree); 377 Set_Next_With_Clause_Of 378 (With_Clause, Tree, 379 To => First_With_Clause_Of (Project_Node, Tree)); 380 Set_First_With_Clause_Of 381 (Project_Node, Tree, To => With_Clause); 382 Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id); 383 384 -- We set the project node to something different than 385 -- Empty_Node, so that Prj.PP does not generate a limited 386 -- with clause. 387 388 Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node); 389 390 Name_Len := Project_Naming_Last; 391 Name_Buffer (1 .. Name_Len) := 392 Project_Naming_File_Name (1 .. Project_Naming_Last); 393 Set_String_Value_Of (With_Clause, Tree, To => Name_Find); 394 end if; 395 end; 396 397 Project_Declaration := Project_Declaration_Of (Project_Node, Tree); 398 399 -- Add a package Naming in the main project, that is a renaming of 400 -- package Naming in the naming project. 401 402 declare 403 Decl_Item : constant Project_Node_Id := 404 Default_Project_Node 405 (Of_Kind => N_Declarative_Item, 406 In_Tree => Tree); 407 408 Naming : constant Project_Node_Id := 409 Default_Project_Node 410 (Of_Kind => N_Package_Declaration, 411 In_Tree => Tree); 412 413 begin 414 Set_Next_Declarative_Item 415 (Decl_Item, Tree, 416 To => First_Declarative_Item_Of (Project_Declaration, Tree)); 417 Set_First_Declarative_Item_Of 418 (Project_Declaration, Tree, To => Decl_Item); 419 Set_Current_Item_Node (Decl_Item, Tree, To => Naming); 420 Set_Name_Of (Naming, Tree, To => Name_Naming); 421 Set_Project_Of_Renamed_Package_Of 422 (Naming, Tree, To => Project_Naming_Node); 423 424 -- Attach the comments, if any, that were saved for package 425 -- Naming. 426 427 Tree.Project_Nodes.Table (Naming).Comments := 428 Naming_Package_Comments; 429 end; 430 431 -- Add an attribute declaration for Source_Dirs, initialized as an 432 -- empty list. 433 434 declare 435 Decl_Item : constant Project_Node_Id := 436 Default_Project_Node 437 (Of_Kind => N_Declarative_Item, 438 In_Tree => Tree); 439 440 Attribute : constant Project_Node_Id := 441 Default_Project_Node 442 (Of_Kind => N_Attribute_Declaration, 443 In_Tree => Tree, 444 And_Expr_Kind => List); 445 446 Expression : constant Project_Node_Id := 447 Default_Project_Node 448 (Of_Kind => N_Expression, 449 In_Tree => Tree, 450 And_Expr_Kind => List); 451 452 Term : constant Project_Node_Id := 453 Default_Project_Node 454 (Of_Kind => N_Term, In_Tree => Tree, 455 And_Expr_Kind => List); 456 457 begin 458 Set_Next_Declarative_Item 459 (Decl_Item, Tree, 460 To => First_Declarative_Item_Of (Project_Declaration, Tree)); 461 Set_First_Declarative_Item_Of 462 (Project_Declaration, Tree, To => Decl_Item); 463 Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); 464 Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs); 465 Set_Expression_Of (Attribute, Tree, To => Expression); 466 Set_First_Term (Expression, Tree, To => Term); 467 Source_Dirs_List := 468 Default_Project_Node 469 (Of_Kind => N_Literal_String_List, 470 In_Tree => Tree, 471 And_Expr_Kind => List); 472 Set_Current_Term (Term, Tree, To => Source_Dirs_List); 473 474 -- Attach the comments, if any, that were saved for attribute 475 -- Source_Dirs. 476 477 Tree.Project_Nodes.Table (Attribute).Comments := 478 Source_Dirs_Comments; 479 end; 480 481 -- Put the source directories in attribute Source_Dirs 482 483 for Source_Dir_Index in 1 .. Source_Directories.Last loop 484 declare 485 Expression : constant Project_Node_Id := 486 Default_Project_Node 487 (Of_Kind => N_Expression, 488 In_Tree => Tree, 489 And_Expr_Kind => Single); 490 491 Term : constant Project_Node_Id := 492 Default_Project_Node 493 (Of_Kind => N_Term, 494 In_Tree => Tree, 495 And_Expr_Kind => Single); 496 497 Value : constant Project_Node_Id := 498 Default_Project_Node 499 (Of_Kind => N_Literal_String, 500 In_Tree => Tree, 501 And_Expr_Kind => Single); 502 503 begin 504 if No (Current_Source_Dir) then 505 Set_First_Expression_In_List 506 (Source_Dirs_List, Tree, To => Expression); 507 else 508 Set_Next_Expression_In_List 509 (Current_Source_Dir, Tree, To => Expression); 510 end if; 511 512 Current_Source_Dir := Expression; 513 Set_First_Term (Expression, Tree, To => Term); 514 Set_Current_Term (Term, Tree, To => Value); 515 Name_Len := 0; 516 Add_Str_To_Name_Buffer 517 (Source_Directories.Table (Source_Dir_Index).all); 518 Set_String_Value_Of (Value, Tree, To => Name_Find); 519 end; 520 end loop; 521 522 -- Add an attribute declaration for Source_Files or Source_List_File 523 -- with the source list file name that will be created. 524 525 declare 526 Decl_Item : constant Project_Node_Id := 527 Default_Project_Node 528 (Of_Kind => N_Declarative_Item, 529 In_Tree => Tree); 530 531 Attribute : constant Project_Node_Id := 532 Default_Project_Node 533 (Of_Kind => N_Attribute_Declaration, 534 In_Tree => Tree, 535 And_Expr_Kind => Single); 536 537 Expression : constant Project_Node_Id := 538 Default_Project_Node 539 (Of_Kind => N_Expression, 540 In_Tree => Tree, 541 And_Expr_Kind => Single); 542 543 Term : constant Project_Node_Id := 544 Default_Project_Node 545 (Of_Kind => N_Term, 546 In_Tree => Tree, 547 And_Expr_Kind => Single); 548 549 Value : constant Project_Node_Id := 550 Default_Project_Node 551 (Of_Kind => N_Literal_String, 552 In_Tree => Tree, 553 And_Expr_Kind => Single); 554 555 begin 556 Set_Next_Declarative_Item 557 (Decl_Item, Tree, 558 To => First_Declarative_Item_Of (Project_Declaration, Tree)); 559 Set_First_Declarative_Item_Of 560 (Project_Declaration, Tree, To => Decl_Item); 561 Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); 562 563 Set_Name_Of (Attribute, Tree, To => Name_Source_List_File); 564 Set_Expression_Of (Attribute, Tree, To => Expression); 565 Set_First_Term (Expression, Tree, To => Term); 566 Set_Current_Term (Term, Tree, To => Value); 567 Name_Len := Source_List_Last; 568 Name_Buffer (1 .. Name_Len) := 569 Source_List_Path (1 .. Source_List_Last); 570 Set_String_Value_Of (Value, Tree, To => Name_Find); 571 572 -- If there was no comments for attribute Source_List_File, put 573 -- those for Source_Files, if they exist. 574 575 if Present (Source_List_File_Comments) then 576 Tree.Project_Nodes.Table (Attribute).Comments := 577 Source_List_File_Comments; 578 else 579 Tree.Project_Nodes.Table (Attribute).Comments := 580 Source_Files_Comments; 581 end if; 582 end; 583 584 -- Put the sources in the source list files and in the naming 585 -- project. 586 587 for Source_Index in 1 .. Sources.Last loop 588 589 -- Add the corresponding attribute in the 590 -- Naming package of the naming project. 591 592 declare 593 Current_Source : constant Source := 594 Sources.Table (Source_Index); 595 596 Decl_Item : constant Project_Node_Id := 597 Default_Project_Node 598 (Of_Kind => 599 N_Declarative_Item, 600 In_Tree => Tree); 601 602 Attribute : constant Project_Node_Id := 603 Default_Project_Node 604 (Of_Kind => 605 N_Attribute_Declaration, 606 In_Tree => Tree); 607 608 Expression : constant Project_Node_Id := 609 Default_Project_Node 610 (Of_Kind => N_Expression, 611 And_Expr_Kind => Single, 612 In_Tree => Tree); 613 614 Term : constant Project_Node_Id := 615 Default_Project_Node 616 (Of_Kind => N_Term, 617 And_Expr_Kind => Single, 618 In_Tree => Tree); 619 620 Value : constant Project_Node_Id := 621 Default_Project_Node 622 (Of_Kind => N_Literal_String, 623 And_Expr_Kind => Single, 624 In_Tree => Tree); 625 626 begin 627 -- Add source file name to the source list file if it is not 628 -- already there. 629 630 if not Source_Files.Get (Current_Source.File_Name) then 631 Source_Files.Set (Current_Source.File_Name, True); 632 Get_Name_String (Current_Source.File_Name); 633 Add_Char_To_Name_Buffer (ASCII.LF); 634 635 if Write (Source_List_FD, 636 Name_Buffer (1)'Address, 637 Name_Len) /= Name_Len 638 then 639 Prj.Com.Fail ("disk full"); 640 end if; 641 end if; 642 643 -- For an Ada source, add entry in package Naming 644 645 if Current_Source.Unit_Name /= No_Name then 646 Set_Next_Declarative_Item 647 (Decl_Item, 648 To => First_Declarative_Item_Of 649 (Naming_Package, Tree), 650 In_Tree => Tree); 651 Set_First_Declarative_Item_Of 652 (Naming_Package, 653 To => Decl_Item, 654 In_Tree => Tree); 655 Set_Current_Item_Node 656 (Decl_Item, 657 To => Attribute, 658 In_Tree => Tree); 659 660 -- Is it a spec or a body? 661 662 if Current_Source.Spec then 663 Set_Name_Of 664 (Attribute, Tree, 665 To => Name_Spec); 666 else 667 Set_Name_Of 668 (Attribute, Tree, 669 To => Name_Body); 670 end if; 671 672 -- Get the name of the unit 673 674 Get_Name_String (Current_Source.Unit_Name); 675 To_Lower (Name_Buffer (1 .. Name_Len)); 676 Set_Associative_Array_Index_Of 677 (Attribute, Tree, To => Name_Find); 678 679 Set_Expression_Of 680 (Attribute, Tree, To => Expression); 681 Set_First_Term 682 (Expression, Tree, To => Term); 683 Set_Current_Term 684 (Term, Tree, To => Value); 685 686 -- And set the name of the file 687 688 Set_String_Value_Of 689 (Value, Tree, To => Current_Source.File_Name); 690 Set_Source_Index_Of 691 (Value, Tree, To => Current_Source.Index); 692 end if; 693 end; 694 end loop; 695 696 -- Close the source list file 697 698 Close (Source_List_FD); 699 700 -- Output the project file 701 702 Prj.PP.Pretty_Print 703 (Project_Node, Tree, 704 W_Char => Write_A_Char'Access, 705 W_Eol => Write_Eol'Access, 706 W_Str => Write_A_String'Access, 707 Backward_Compatibility => False, 708 Max_Line_Length => 79); 709 Close (Output_FD); 710 711 -- Delete the naming project file if it already exists 712 713 Delete_File 714 (Project_Naming_File_Name (1 .. Project_Naming_Last), 715 Success => Discard); 716 717 -- Create a new one 718 719 if Opt.Verbose_Mode then 720 Output.Write_Str ("Creating new naming project file """); 721 Output.Write_Str (Project_Naming_File_Name 722 (1 .. Project_Naming_Last)); 723 Output.Write_Line (""""); 724 end if; 725 726 Output_FD := Create_New_File 727 (Project_Naming_File_Name (1 .. Project_Naming_Last), 728 Fmode => Text); 729 730 -- Fails if naming project file cannot be created 731 732 if Output_FD = Invalid_FD then 733 Prj.Com.Fail 734 ("cannot create new """ 735 & Project_Naming_File_Name (1 .. Project_Naming_Last) 736 & """"); 737 end if; 738 739 -- Output the naming project file 740 741 Prj.PP.Pretty_Print 742 (Project_Naming_Node, Tree, 743 W_Char => Write_A_Char'Access, 744 W_Eol => Write_Eol'Access, 745 W_Str => Write_A_String'Access, 746 Backward_Compatibility => False); 747 Close (Output_FD); 748 749 else 750 -- For each Ada source, write a pragma Source_File_Name to the 751 -- configuration pragmas file. 752 753 for Index in 1 .. Sources.Last loop 754 if Sources.Table (Index).Unit_Name /= No_Name then 755 Write_A_String ("pragma Source_File_Name"); 756 Write_Eol; 757 Write_A_String (" ("); 758 Write_A_String 759 (Get_Name_String (Sources.Table (Index).Unit_Name)); 760 Write_A_String (","); 761 Write_Eol; 762 763 if Sources.Table (Index).Spec then 764 Write_A_String (" Spec_File_Name => """); 765 766 else 767 Write_A_String (" Body_File_Name => """); 768 end if; 769 770 Write_A_String 771 (Get_Name_String (Sources.Table (Index).File_Name)); 772 773 Write_A_String (""""); 774 775 if Sources.Table (Index).Index /= 0 then 776 Write_A_String (", Index =>"); 777 Write_A_String (Sources.Table (Index).Index'Img); 778 end if; 779 780 Write_A_String (");"); 781 Write_Eol; 782 end if; 783 end loop; 784 785 Close (Output_FD); 786 end if; 787 end Finalize; 788 789 ---------------- 790 -- Initialize -- 791 ---------------- 792 793 procedure Initialize 794 (File_Path : String; 795 Project_File : Boolean; 796 Preproc_Switches : Argument_List; 797 Very_Verbose : Boolean; 798 Flags : Processing_Flags) 799 is 800 begin 801 Makr.Very_Verbose := Initialize.Very_Verbose; 802 Makr.Project_File := Initialize.Project_File; 803 804 -- Do some needed initializations 805 806 Csets.Initialize; 807 Snames.Initialize; 808 Stringt.Initialize; 809 810 Prj.Initialize (No_Project_Tree); 811 812 Prj.Tree.Initialize (Root_Environment, Flags); 813 Prj.Env.Initialize_Default_Project_Path 814 (Root_Environment.Project_Path, 815 Target_Name => Sdefault.Target_Name.all); 816 817 Prj.Tree.Initialize (Tree); 818 819 Sources.Set_Last (0); 820 Source_Directories.Set_Last (0); 821 822 -- Initialize the compiler switches 823 824 Args := new Argument_List (1 .. Preproc_Switches'Length + 6); 825 Args (1) := new String'("-c"); 826 Args (2) := new String'("-gnats"); 827 Args (3) := new String'("-gnatu"); 828 Args (4 .. 3 + Preproc_Switches'Length) := Preproc_Switches; 829 Args (4 + Preproc_Switches'Length) := new String'("-x"); 830 Args (5 + Preproc_Switches'Length) := new String'("ada"); 831 832 -- Get the path and file names 833 834 Path_Name := new 835 String (1 .. File_Path'Length + Project_File_Extension'Length); 836 Path_Last := File_Path'Length; 837 838 if File_Names_Case_Sensitive then 839 Path_Name (1 .. Path_Last) := File_Path; 840 else 841 Path_Name (1 .. Path_Last) := To_Lower (File_Path); 842 end if; 843 844 Path_Name (Path_Last + 1 .. Path_Name'Last) := 845 Project_File_Extension; 846 847 -- Get the end of directory information, if any 848 849 for Index in reverse 1 .. Path_Last loop 850 if Path_Name (Index) = Directory_Separator then 851 Directory_Last := Index; 852 exit; 853 end if; 854 end loop; 855 856 if Project_File then 857 if Path_Last < Project_File_Extension'Length + 1 858 or else Path_Name 859 (Path_Last - Project_File_Extension'Length + 1 .. Path_Last) 860 /= Project_File_Extension 861 then 862 Path_Last := Path_Name'Last; 863 end if; 864 865 Output_Name := new String'(To_Lower (Path_Name (1 .. Path_Last))); 866 Output_Name_Last := Output_Name'Last - 4; 867 868 -- If there is already a project file with the specified name, parse 869 -- it to get the components that are not automatically generated. 870 871 if Is_Regular_File (Output_Name (1 .. Path_Last)) then 872 if Opt.Verbose_Mode then 873 Output.Write_Str ("Parsing already existing project file """); 874 Output.Write_Str (Output_Name.all); 875 Output.Write_Line (""""); 876 end if; 877 878 Part.Parse 879 (In_Tree => Tree, 880 Project => Project_Node, 881 Project_File_Name => Output_Name.all, 882 Errout_Handling => Part.Finalize_If_Error, 883 Store_Comments => True, 884 Is_Config_File => False, 885 Env => Root_Environment, 886 Current_Directory => Get_Current_Dir, 887 Packages_To_Check => Packages_To_Check_By_Gnatname); 888 889 -- Fail if parsing was not successful 890 891 if No (Project_Node) then 892 Prj.Com.Fail ("parsing of existing project file failed"); 893 894 elsif Project_Qualifier_Of (Project_Node, Tree) = Aggregate then 895 Prj.Com.Fail ("aggregate projects are not supported"); 896 897 elsif Project_Qualifier_Of (Project_Node, Tree) = 898 Aggregate_Library 899 then 900 Prj.Com.Fail ("aggregate library projects are not supported"); 901 902 else 903 -- If parsing was successful, remove the components that are 904 -- automatically generated, if any, so that they will be 905 -- unconditionally added later. 906 907 -- Remove the with clause for the naming project file 908 909 declare 910 With_Clause : Project_Node_Id := 911 First_With_Clause_Of (Project_Node, Tree); 912 Previous : Project_Node_Id := Empty_Node; 913 914 begin 915 while Present (With_Clause) loop 916 if Prj.Tree.Name_Of (With_Clause, Tree) = 917 Project_Naming_Id 918 then 919 if No (Previous) then 920 Set_First_With_Clause_Of 921 (Project_Node, Tree, 922 To => Next_With_Clause_Of (With_Clause, Tree)); 923 else 924 Set_Next_With_Clause_Of 925 (Previous, Tree, 926 To => Next_With_Clause_Of (With_Clause, Tree)); 927 end if; 928 929 exit; 930 end if; 931 932 Previous := With_Clause; 933 With_Clause := Next_With_Clause_Of (With_Clause, Tree); 934 end loop; 935 end; 936 937 -- Remove attribute declarations of Source_Files, 938 -- Source_List_File, Source_Dirs, and the declaration of 939 -- package Naming, if they exist, but preserve the comments 940 -- attached to these nodes. 941 942 declare 943 Declaration : Project_Node_Id := 944 First_Declarative_Item_Of 945 (Project_Declaration_Of 946 (Project_Node, Tree), 947 Tree); 948 Previous : Project_Node_Id := Empty_Node; 949 Current_Node : Project_Node_Id := Empty_Node; 950 951 Name : Name_Id; 952 Kind_Of_Node : Project_Node_Kind; 953 Comments : Project_Node_Id; 954 955 begin 956 while Present (Declaration) loop 957 Current_Node := Current_Item_Node (Declaration, Tree); 958 959 Kind_Of_Node := Kind_Of (Current_Node, Tree); 960 961 if Kind_Of_Node = N_Attribute_Declaration or else 962 Kind_Of_Node = N_Package_Declaration 963 then 964 Name := Prj.Tree.Name_Of (Current_Node, Tree); 965 966 if Nam_In (Name, Name_Source_Files, 967 Name_Source_List_File, 968 Name_Source_Dirs, 969 Name_Naming) 970 then 971 Comments := 972 Tree.Project_Nodes.Table (Current_Node).Comments; 973 974 if Name = Name_Source_Files then 975 Source_Files_Comments := Comments; 976 977 elsif Name = Name_Source_List_File then 978 Source_List_File_Comments := Comments; 979 980 elsif Name = Name_Source_Dirs then 981 Source_Dirs_Comments := Comments; 982 983 elsif Name = Name_Naming then 984 Naming_Package_Comments := Comments; 985 end if; 986 987 if No (Previous) then 988 Set_First_Declarative_Item_Of 989 (Project_Declaration_Of (Project_Node, Tree), 990 Tree, 991 To => Next_Declarative_Item 992 (Declaration, Tree)); 993 994 else 995 Set_Next_Declarative_Item 996 (Previous, Tree, 997 To => Next_Declarative_Item 998 (Declaration, Tree)); 999 end if; 1000 1001 else 1002 Previous := Declaration; 1003 end if; 1004 end if; 1005 1006 Declaration := Next_Declarative_Item (Declaration, Tree); 1007 end loop; 1008 end; 1009 end if; 1010 end if; 1011 1012 if Directory_Last /= 0 then 1013 Output_Name (1 .. Output_Name_Last - Directory_Last) := 1014 Output_Name (Directory_Last + 1 .. Output_Name_Last); 1015 Output_Name_Last := Output_Name_Last - Directory_Last; 1016 end if; 1017 1018 -- Get the project name id 1019 1020 Name_Len := Output_Name_Last; 1021 Name_Buffer (1 .. Name_Len) := Output_Name (1 .. Name_Len); 1022 Output_Name_Id := Name_Find; 1023 1024 -- Create the project naming file name 1025 1026 Project_Naming_Last := Output_Name_Last; 1027 Project_Naming_File_Name := 1028 new String'(Output_Name (1 .. Output_Name_Last) & 1029 Naming_File_Suffix & 1030 Project_File_Extension); 1031 Project_Naming_Last := 1032 Project_Naming_Last + Naming_File_Suffix'Length; 1033 1034 -- Get the project naming id 1035 1036 Name_Len := Project_Naming_Last; 1037 Name_Buffer (1 .. Name_Len) := 1038 Project_Naming_File_Name (1 .. Name_Len); 1039 Project_Naming_Id := Name_Find; 1040 1041 Project_Naming_Last := 1042 Project_Naming_Last + Project_File_Extension'Length; 1043 1044 -- Create the source list file name 1045 1046 Source_List_Last := Output_Name_Last; 1047 Source_List_Path := 1048 new String'(Output_Name (1 .. Output_Name_Last) & 1049 Source_List_File_Suffix); 1050 Source_List_Last := 1051 Output_Name_Last + Source_List_File_Suffix'Length; 1052 1053 -- Add the project file extension to the project name 1054 1055 Output_Name 1056 (Output_Name_Last + 1 .. 1057 Output_Name_Last + Project_File_Extension'Length) := 1058 Project_File_Extension; 1059 Output_Name_Last := Output_Name_Last + Project_File_Extension'Length; 1060 1061 -- Back up project file if it already exists (not needed in VMS since 1062 -- versioning of files takes care of this requirement on VMS). 1063 1064 if not Hostparm.OpenVMS 1065 and then not Opt.No_Backup 1066 and then Is_Regular_File (Path_Name (1 .. Path_Last)) 1067 then 1068 declare 1069 Discard : Boolean; 1070 Saved_Path : constant String := 1071 Path_Name (1 .. Path_Last) & ".saved_"; 1072 Nmb : Natural; 1073 1074 begin 1075 Nmb := 0; 1076 loop 1077 declare 1078 Img : constant String := Nmb'Img; 1079 1080 begin 1081 if not Is_Regular_File 1082 (Saved_Path & Img (2 .. Img'Last)) 1083 then 1084 Copy_File 1085 (Name => Path_Name (1 .. Path_Last), 1086 Pathname => Saved_Path & Img (2 .. Img'Last), 1087 Mode => Overwrite, 1088 Success => Discard); 1089 exit; 1090 end if; 1091 1092 Nmb := Nmb + 1; 1093 end; 1094 end loop; 1095 end; 1096 end if; 1097 end if; 1098 1099 -- Change the current directory to the directory of the project file, 1100 -- if any directory information is specified. 1101 1102 if Directory_Last /= 0 then 1103 begin 1104 Change_Dir (Path_Name (1 .. Directory_Last)); 1105 exception 1106 when Directory_Error => 1107 Prj.Com.Fail 1108 ("unknown directory """ 1109 & Path_Name (1 .. Directory_Last) 1110 & """"); 1111 end; 1112 end if; 1113 end Initialize; 1114 1115 ------------- 1116 -- Process -- 1117 ------------- 1118 1119 procedure Process 1120 (Directories : Argument_List; 1121 Name_Patterns : Regexp_List; 1122 Excluded_Patterns : Regexp_List; 1123 Foreign_Patterns : Regexp_List) 1124 is 1125 procedure Process_Directory (Dir_Name : String; Recursively : Boolean); 1126 -- Look for Ada and foreign sources in a directory, according to the 1127 -- patterns. When Recursively is True, after looking for sources in 1128 -- Dir_Name, look also in its subdirectories, if any. 1129 1130 ----------------------- 1131 -- Process_Directory -- 1132 ----------------------- 1133 1134 procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is 1135 Matched : Matched_Type := False; 1136 Str : String (1 .. 2_000); 1137 Canon : String (1 .. 2_000); 1138 Last : Natural; 1139 Dir : Dir_Type; 1140 Do_Process : Boolean := True; 1141 1142 Temp_File_Name : String_Access := null; 1143 Save_Last_Source_Index : Natural := 0; 1144 File_Name_Id : Name_Id := No_Name; 1145 1146 Current_Source : Source; 1147 1148 begin 1149 -- Avoid processing the same directory more than once 1150 1151 for Index in 1 .. Processed_Directories.Last loop 1152 if Processed_Directories.Table (Index).all = Dir_Name then 1153 Do_Process := False; 1154 exit; 1155 end if; 1156 end loop; 1157 1158 if Do_Process then 1159 if Opt.Verbose_Mode then 1160 Output.Write_Str ("Processing directory """); 1161 Output.Write_Str (Dir_Name); 1162 Output.Write_Line (""""); 1163 end if; 1164 1165 Processed_Directories. Increment_Last; 1166 Processed_Directories.Table (Processed_Directories.Last) := 1167 new String'(Dir_Name); 1168 1169 -- Get the source file names from the directory. Fails if the 1170 -- directory does not exist. 1171 1172 begin 1173 Open (Dir, Dir_Name); 1174 exception 1175 when Directory_Error => 1176 Prj.Com.Fail ("cannot open directory """ & Dir_Name & """"); 1177 end; 1178 1179 -- Process each regular file in the directory 1180 1181 File_Loop : loop 1182 Read (Dir, Str, Last); 1183 exit File_Loop when Last = 0; 1184 1185 -- Copy the file name and put it in canonical case to match 1186 -- against the patterns that have themselves already been put 1187 -- in canonical case. 1188 1189 Canon (1 .. Last) := Str (1 .. Last); 1190 Canonical_Case_File_Name (Canon (1 .. Last)); 1191 1192 if Is_Regular_File 1193 (Dir_Name & Directory_Separator & Str (1 .. Last)) 1194 then 1195 Matched := True; 1196 1197 Name_Len := Last; 1198 Name_Buffer (1 .. Name_Len) := Str (1 .. Last); 1199 File_Name_Id := Name_Find; 1200 1201 -- First, check if the file name matches at least one of 1202 -- the excluded expressions; 1203 1204 for Index in Excluded_Patterns'Range loop 1205 if 1206 Match (Canon (1 .. Last), Excluded_Patterns (Index)) 1207 then 1208 Matched := Excluded; 1209 exit; 1210 end if; 1211 end loop; 1212 1213 -- If it does not match any of the excluded expressions, 1214 -- check if the file name matches at least one of the 1215 -- regular expressions. 1216 1217 if Matched = True then 1218 Matched := False; 1219 1220 for Index in Name_Patterns'Range loop 1221 if 1222 Match 1223 (Canon (1 .. Last), Name_Patterns (Index)) 1224 then 1225 Matched := True; 1226 exit; 1227 end if; 1228 end loop; 1229 end if; 1230 1231 if Very_Verbose 1232 or else (Matched = True and then Opt.Verbose_Mode) 1233 then 1234 Output.Write_Str (" Checking """); 1235 Output.Write_Str (Str (1 .. Last)); 1236 Output.Write_Line (""": "); 1237 end if; 1238 1239 -- If the file name matches one of the regular expressions, 1240 -- parse it to get its unit name. 1241 1242 if Matched = True then 1243 declare 1244 FD : File_Descriptor; 1245 Success : Boolean; 1246 Saved_Output : File_Descriptor; 1247 Saved_Error : File_Descriptor; 1248 Tmp_File : Path_Name_Type; 1249 1250 begin 1251 -- If we don't have the path of the compiler yet, 1252 -- get it now. The compiler name may have a prefix, 1253 -- so we get the potentially prefixed name. 1254 1255 if Gcc_Path = null then 1256 declare 1257 Prefix_Gcc : String_Access := 1258 Program_Name (Gcc, "gnatname"); 1259 begin 1260 Gcc_Path := 1261 Locate_Exec_On_Path (Prefix_Gcc.all); 1262 Free (Prefix_Gcc); 1263 end; 1264 1265 if Gcc_Path = null then 1266 Prj.Com.Fail ("could not locate " & Gcc); 1267 end if; 1268 end if; 1269 1270 -- Create the temporary file 1271 1272 Tempdir.Create_Temp_File (FD, Tmp_File); 1273 1274 if FD = Invalid_FD then 1275 Prj.Com.Fail 1276 ("could not create temporary file"); 1277 1278 else 1279 Temp_File_Name := 1280 new String'(Get_Name_String (Tmp_File)); 1281 end if; 1282 1283 -- On VMS, a file created with Create_Temp_File cannot 1284 -- be used to redirect output. 1285 1286 if Hostparm.OpenVMS then 1287 Close (FD); 1288 Delete_File (Temp_File_Name.all, Success); 1289 FD := Create_Output_Text_File (Temp_File_Name.all); 1290 end if; 1291 1292 Args (Args'Last) := new String' 1293 (Dir_Name & 1294 Directory_Separator & 1295 Str (1 .. Last)); 1296 1297 -- Save the standard output and error 1298 1299 Saved_Output := Dup (Standout); 1300 Saved_Error := Dup (Standerr); 1301 1302 -- Set standard output and error to the temporary file 1303 1304 Dup2 (FD, Standout); 1305 Dup2 (FD, Standerr); 1306 1307 -- And spawn the compiler 1308 1309 Spawn (Gcc_Path.all, Args.all, Success); 1310 1311 -- Restore the standard output and error 1312 1313 Dup2 (Saved_Output, Standout); 1314 Dup2 (Saved_Error, Standerr); 1315 1316 -- Close the temporary file 1317 1318 Close (FD); 1319 1320 -- And close the saved standard output and error to 1321 -- avoid too many file descriptors. 1322 1323 Close (Saved_Output); 1324 Close (Saved_Error); 1325 1326 -- Now that standard output is restored, check if 1327 -- the compiler ran correctly. 1328 1329 -- Read the lines of the temporary file: 1330 -- they should contain the kind and name of the unit. 1331 1332 declare 1333 File : Text_File; 1334 Text_Line : String (1 .. 1_000); 1335 Text_Last : Natural; 1336 1337 begin 1338 Open (File, Temp_File_Name.all); 1339 1340 if not Is_Valid (File) then 1341 Prj.Com.Fail 1342 ("could not read temporary file " & 1343 Temp_File_Name.all); 1344 end if; 1345 1346 Save_Last_Source_Index := Sources.Last; 1347 1348 if End_Of_File (File) then 1349 if Opt.Verbose_Mode then 1350 if not Success then 1351 Output.Write_Str (" (process died) "); 1352 end if; 1353 end if; 1354 1355 else 1356 Line_Loop : while not End_Of_File (File) loop 1357 Get_Line (File, Text_Line, Text_Last); 1358 1359 -- Find the first closing parenthesis 1360 1361 Char_Loop : for J in 1 .. Text_Last loop 1362 if Text_Line (J) = ')' then 1363 if J >= 13 and then 1364 Text_Line (1 .. 4) = "Unit" 1365 then 1366 -- Add entry to Sources table 1367 1368 Name_Len := J - 12; 1369 Name_Buffer (1 .. Name_Len) := 1370 Text_Line (6 .. J - 7); 1371 Current_Source := 1372 (Unit_Name => Name_Find, 1373 File_Name => File_Name_Id, 1374 Index => 0, 1375 Spec => Text_Line (J - 5 .. J) = 1376 "(spec)"); 1377 1378 Sources.Append (Current_Source); 1379 end if; 1380 1381 exit Char_Loop; 1382 end if; 1383 end loop Char_Loop; 1384 end loop Line_Loop; 1385 end if; 1386 1387 if Save_Last_Source_Index = Sources.Last then 1388 if Opt.Verbose_Mode then 1389 Output.Write_Line (" not a unit"); 1390 end if; 1391 1392 else 1393 if Sources.Last > 1394 Save_Last_Source_Index + 1 1395 then 1396 for Index in Save_Last_Source_Index + 1 .. 1397 Sources.Last 1398 loop 1399 Sources.Table (Index).Index := 1400 Int (Index - Save_Last_Source_Index); 1401 end loop; 1402 end if; 1403 1404 for Index in Save_Last_Source_Index + 1 .. 1405 Sources.Last 1406 loop 1407 Current_Source := Sources.Table (Index); 1408 1409 if Opt.Verbose_Mode then 1410 if Current_Source.Spec then 1411 Output.Write_Str (" spec of "); 1412 1413 else 1414 Output.Write_Str (" body of "); 1415 end if; 1416 1417 Output.Write_Line 1418 (Get_Name_String 1419 (Current_Source.Unit_Name)); 1420 end if; 1421 end loop; 1422 end if; 1423 1424 Close (File); 1425 1426 Delete_File (Temp_File_Name.all, Success); 1427 end; 1428 end; 1429 1430 -- File name matches none of the regular expressions 1431 1432 else 1433 -- If file is not excluded, see if this is foreign source 1434 1435 if Matched /= Excluded then 1436 for Index in Foreign_Patterns'Range loop 1437 if Match (Canon (1 .. Last), 1438 Foreign_Patterns (Index)) 1439 then 1440 Matched := True; 1441 exit; 1442 end if; 1443 end loop; 1444 end if; 1445 1446 if Very_Verbose then 1447 case Matched is 1448 when False => 1449 Output.Write_Line ("no match"); 1450 1451 when Excluded => 1452 Output.Write_Line ("excluded"); 1453 1454 when True => 1455 Output.Write_Line ("foreign source"); 1456 end case; 1457 end if; 1458 1459 if Matched = True then 1460 1461 -- Add source file name without unit name 1462 1463 Name_Len := 0; 1464 Add_Str_To_Name_Buffer (Canon (1 .. Last)); 1465 Sources.Append 1466 ((File_Name => Name_Find, 1467 Unit_Name => No_Name, 1468 Index => 0, 1469 Spec => False)); 1470 end if; 1471 end if; 1472 end if; 1473 end loop File_Loop; 1474 1475 Close (Dir); 1476 end if; 1477 1478 -- If Recursively is True, call itself for each subdirectory. 1479 -- We do that, even when this directory has already been processed, 1480 -- because all of its subdirectories may not have been processed. 1481 1482 if Recursively then 1483 Open (Dir, Dir_Name); 1484 1485 loop 1486 Read (Dir, Str, Last); 1487 exit when Last = 0; 1488 1489 -- Do not call itself for "." or ".." 1490 1491 if Is_Directory 1492 (Dir_Name & Directory_Separator & Str (1 .. Last)) 1493 and then Str (1 .. Last) /= "." 1494 and then Str (1 .. Last) /= ".." 1495 then 1496 Process_Directory 1497 (Dir_Name & Directory_Separator & Str (1 .. Last), 1498 Recursively => True); 1499 end if; 1500 end loop; 1501 1502 Close (Dir); 1503 end if; 1504 end Process_Directory; 1505 1506 -- Start of processing for Process 1507 1508 begin 1509 Processed_Directories.Set_Last (0); 1510 1511 -- Process each directory 1512 1513 for Index in Directories'Range loop 1514 1515 declare 1516 Dir_Name : constant String := Directories (Index).all; 1517 Last : Natural := Dir_Name'Last; 1518 Recursively : Boolean := False; 1519 Found : Boolean; 1520 Canonical : String (1 .. Dir_Name'Length) := Dir_Name; 1521 1522 begin 1523 Canonical_Case_File_Name (Canonical); 1524 1525 Found := False; 1526 for J in 1 .. Source_Directories.Last loop 1527 if Source_Directories.Table (J).all = Canonical then 1528 Found := True; 1529 exit; 1530 end if; 1531 end loop; 1532 1533 if not Found then 1534 Source_Directories.Append (new String'(Canonical)); 1535 end if; 1536 1537 if Dir_Name'Length >= 4 1538 and then (Dir_Name (Last - 2 .. Last) = "/**") 1539 then 1540 Last := Last - 3; 1541 Recursively := True; 1542 end if; 1543 1544 Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively); 1545 end; 1546 1547 end loop; 1548 end Process; 1549 1550 ---------------- 1551 -- Write_Char -- 1552 ---------------- 1553 procedure Write_A_Char (C : Character) is 1554 begin 1555 Write_A_String ((1 => C)); 1556 end Write_A_Char; 1557 1558 --------------- 1559 -- Write_Eol -- 1560 --------------- 1561 1562 procedure Write_Eol is 1563 begin 1564 Write_A_String ((1 => ASCII.LF)); 1565 end Write_Eol; 1566 1567 -------------------- 1568 -- Write_A_String -- 1569 -------------------- 1570 1571 procedure Write_A_String (S : String) is 1572 Str : String (1 .. S'Length); 1573 1574 begin 1575 if S'Length > 0 then 1576 Str := S; 1577 1578 if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then 1579 Prj.Com.Fail ("disk full"); 1580 end if; 1581 end if; 1582 end Write_A_String; 1583 1584end Prj.Makr; 1585