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