gcc/ada/prj.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                  P R J                                   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2008, 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
  26 with Ada.Characters.Handling; use Ada.Characters.Handling;
  27 with Ada.Unchecked_Deallocation;
  28
  29 with Debug;
  30 with Output;   use Output;
  31 with Osint;    use Osint;
  32 with Prj.Attr;
  33 with Prj.Env;
  34 with Prj.Err;  use Prj.Err;
  35 with Snames;   use Snames;
  36 with Table;
  37 with Uintp;    use Uintp;
  38
  39 with System.Case_Util; use System.Case_Util;
  40 with System.HTable;
  41
  42 package body Prj is
  43
  44    Object_Suffix : constant String := Get_Target_Object_Suffix.all;
  45    --  File suffix for object files
  46
  47    Initial_Buffer_Size : constant := 100;
  48    --  Initial size for extensible buffer used in Add_To_Buffer
  49
  50    Current_Mode : Mode := Ada_Only;
  51
  52    Configuration_Mode : Boolean := False;
  53
  54    The_Empty_String : Name_Id;
  55
  56    Default_Ada_Spec_Suffix_Id : File_Name_Type;
  57    Default_Ada_Body_Suffix_Id : File_Name_Type;
  58    Slash_Id                   : Path_Name_Type;
  59    --  Initialized in Prj.Initialize, then never modified
  60
  61    subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
  62
  63    The_Casing_Images : constant array (Known_Casing) of String_Access :=
  64      (All_Lower_Case => new String'("lowercase"),
  65       All_Upper_Case => new String'("UPPERCASE"),
  66       Mixed_Case     => new String'("MixedCase"));
  67
  68    Initialized : Boolean := False;
  69
  70    Standard_Dot_Replacement : constant File_Name_Type :=
  71                                 File_Name_Type
  72                                   (First_Name_Id + Character'Pos ('-'));
  73
  74    Std_Naming_Data : constant Naming_Data :=
  75                        (Dot_Replacement           => Standard_Dot_Replacement,
  76                         Dot_Repl_Loc              => No_Location,
  77                         Casing                    => All_Lower_Case,
  78                         Spec_Suffix               => No_Array_Element,
  79                         Ada_Spec_Suffix_Loc       => No_Location,
  80                         Body_Suffix               => No_Array_Element,
  81                         Ada_Body_Suffix_Loc       => No_Location,
  82                         Separate_Suffix           => No_File,
  83                         Sep_Suffix_Loc            => No_Location,
  84                         Specs                     => No_Array_Element,
  85                         Bodies                    => No_Array_Element,
  86                         Specification_Exceptions  => No_Array_Element,
  87                         Implementation_Exceptions => No_Array_Element);
  88
  89    Project_Empty : constant Project_Data :=
  90                      (Qualifier                      => Unspecified,
  91                       Externally_Built               => False,
  92                       Config                         => Default_Project_Config,
  93                       Languages                      => No_Name_List,
  94                       Name                           => No_Name,
  95                       Display_Name                   => No_Name,
  96                       Path                           => No_Path_Information,
  97                       Virtual                        => False,
  98                       Location                       => No_Location,
  99                       Mains                          => Nil_String,
 100                       Directory                      => No_Path_Information,
 101                       Dir_Path                       => null,
 102                       Library                        => False,
 103                       Library_Dir                    => No_Path_Information,
 104                       Library_Src_Dir                => No_Path_Information,
 105                       Library_ALI_Dir                => No_Path_Information,
 106                       Library_Name                   => No_Name,
 107                       Library_Kind                   => Static,
 108                       Lib_Internal_Name              => No_Name,
 109                       Standalone_Library             => False,
 110                       Lib_Interface_ALIs             => Nil_String,
 111                       Lib_Auto_Init                  => False,
 112                       Libgnarl_Needed                => Unknown,
 113                       Symbol_Data                    => No_Symbols,
 114                       Ada_Sources_Present            => True,
 115                       Other_Sources_Present          => True,
 116                       Ada_Sources                    => Nil_String,
 117                       First_Source                   => No_Source,
 118                       Last_Source                    => No_Source,
 119                       Interfaces_Defined             => False,
 120                       Unit_Based_Language_Name       => No_Name,
 121                       Unit_Based_Language_Index      => No_Language_Index,
 122                       Imported_Directories_Switches  => null,
 123                       Include_Path                   => null,
 124                       Include_Data_Set               => False,
 125                       Include_Language               => No_Language_Index,
 126                       Source_Dirs                    => Nil_String,
 127                       Known_Order_Of_Source_Dirs     => True,
 128                       Object_Directory               => No_Path_Information,
 129                       Library_TS                     => Empty_Time_Stamp,
 130                       Exec_Directory                 => No_Path_Information,
 131                       Extends                        => No_Project,
 132                       Extended_By                    => No_Project,
 133                       Naming                         => Std_Naming_Data,
 134                       First_Language_Processing      => No_Language_Index,
 135                       Decl                           => No_Declarations,
 136                       Imported_Projects              => Empty_Project_List,
 137                       All_Imported_Projects          => Empty_Project_List,
 138                       Ada_Include_Path               => null,
 139                       Ada_Objects_Path               => null,
 140                       Objects_Path                   => null,
 141                       Include_Path_File              => No_Path,
 142                       Objects_Path_File_With_Libs    => No_Path,
 143                       Objects_Path_File_Without_Libs => No_Path,
 144                       Config_File_Name               => No_Path,
 145                       Config_File_Temp               => False,
 146                       Config_Checked                 => False,
 147                       Checked                        => False,
 148                       Seen                           => False,
 149                       Need_To_Build_Lib              => False,
 150                       Depth                          => 0,
 151                       Unkept_Comments                => False);
 152
 153    package Temp_Files is new Table.Table
 154      (Table_Component_Type => Path_Name_Type,
 155       Table_Index_Type     => Integer,
 156       Table_Low_Bound      => 1,
 157       Table_Initial        => 20,
 158       Table_Increment      => 100,
 159       Table_Name           => "Makegpr.Temp_Files");
 160    --  Table to store the path name of all the created temporary files, so that
 161    --  they can be deleted at the end, or when the program is interrupted.
 162
 163    procedure Free (Project : in out Project_Data);
 164    --  Free memory allocated for Project
 165
 166    -------------------
 167    -- Add_To_Buffer --
 168    -------------------
 169
 170    procedure Add_To_Buffer
 171      (S    : String;
 172       To   : in out String_Access;
 173       Last : in out Natural)
 174    is
 175    begin
 176       if To = null then
 177          To := new String (1 .. Initial_Buffer_Size);
 178          Last := 0;
 179       end if;
 180
 181       --  If Buffer is too small, double its size
 182
 183       while Last + S'Length > To'Last loop
 184          declare
 185             New_Buffer : constant  String_Access :=
 186                            new String (1 .. 2 * Last);
 187
 188          begin
 189             New_Buffer (1 .. Last) := To (1 .. Last);
 190             Free (To);
 191             To := New_Buffer;
 192          end;
 193       end loop;
 194
 195       To (Last + 1 .. Last + S'Length) := S;
 196       Last := Last + S'Length;
 197    end Add_To_Buffer;
 198
 199    -----------------------
 200    -- Body_Suffix_Id_Of --
 201    -----------------------
 202
 203    function Body_Suffix_Id_Of
 204      (In_Tree  : Project_Tree_Ref;
 205       Language : String;
 206       Naming   : Naming_Data) return File_Name_Type
 207    is
 208       Language_Id : Name_Id;
 209
 210    begin
 211       Name_Len := 0;
 212       Add_Str_To_Name_Buffer (Language);
 213       To_Lower (Name_Buffer (1 .. Name_Len));
 214       Language_Id := Name_Find;
 215
 216       return
 217         Body_Suffix_Id_Of
 218           (In_Tree     => In_Tree,
 219            Language_Id => Language_Id,
 220            Naming      => Naming);
 221    end Body_Suffix_Id_Of;
 222
 223    -----------------------
 224    -- Body_Suffix_Id_Of --
 225    -----------------------
 226
 227    function Body_Suffix_Id_Of
 228      (In_Tree     : Project_Tree_Ref;
 229       Language_Id : Name_Id;
 230       Naming      : Naming_Data) return File_Name_Type
 231    is
 232       Element_Id : Array_Element_Id;
 233       Element    : Array_Element;
 234       Suffix     : File_Name_Type := No_File;
 235       Lang       : Language_Index;
 236
 237    begin
 238       --  ??? This seems to be only for Ada_Only mode...
 239       Element_Id := Naming.Body_Suffix;
 240       while Element_Id /= No_Array_Element loop
 241          Element := In_Tree.Array_Elements.Table (Element_Id);
 242
 243          if Element.Index = Language_Id then
 244             return File_Name_Type (Element.Value.Value);
 245          end if;
 246
 247          Element_Id := Element.Next;
 248       end loop;
 249
 250       if Current_Mode = Multi_Language then
 251          Lang := In_Tree.First_Language;
 252          while Lang /= No_Language_Index loop
 253             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 254                Suffix :=
 255                  In_Tree.Languages_Data.Table
 256                    (Lang).Config.Naming_Data.Body_Suffix;
 257                exit;
 258             end if;
 259
 260             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 261          end loop;
 262       end if;
 263
 264       return Suffix;
 265    end Body_Suffix_Id_Of;
 266
 267    --------------------
 268    -- Body_Suffix_Of --
 269    --------------------
 270
 271    function Body_Suffix_Of
 272      (In_Tree  : Project_Tree_Ref;
 273       Language : String;
 274       Naming   : Naming_Data) return String
 275    is
 276       Language_Id : Name_Id;
 277       Element_Id  : Array_Element_Id;
 278       Element     : Array_Element;
 279       Suffix      : File_Name_Type := No_File;
 280       Lang        : Language_Index;
 281
 282    begin
 283       Name_Len := 0;
 284       Add_Str_To_Name_Buffer (Language);
 285       To_Lower (Name_Buffer (1 .. Name_Len));
 286       Language_Id := Name_Find;
 287
 288       Element_Id := Naming.Body_Suffix;
 289       while Element_Id /= No_Array_Element loop
 290          Element := In_Tree.Array_Elements.Table (Element_Id);
 291
 292          if Element.Index = Language_Id then
 293             return Get_Name_String (Element.Value.Value);
 294          end if;
 295
 296          Element_Id := Element.Next;
 297       end loop;
 298
 299       if Current_Mode = Multi_Language then
 300          Lang := In_Tree.First_Language;
 301          while Lang /= No_Language_Index loop
 302             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 303                Suffix :=
 304                  File_Name_Type
 305                    (In_Tree.Languages_Data.Table
 306                         (Lang).Config.Naming_Data.Body_Suffix);
 307                exit;
 308             end if;
 309
 310             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 311          end loop;
 312
 313          if Suffix /= No_File then
 314             return Get_Name_String (Suffix);
 315          end if;
 316       end if;
 317
 318       return "";
 319    end Body_Suffix_Of;
 320
 321    -----------------------------
 322    -- Default_Ada_Body_Suffix --
 323    -----------------------------
 324
 325    function Default_Ada_Body_Suffix return File_Name_Type is
 326    begin
 327       return Default_Ada_Body_Suffix_Id;
 328    end Default_Ada_Body_Suffix;
 329
 330    -----------------------------
 331    -- Default_Ada_Spec_Suffix --
 332    -----------------------------
 333
 334    function Default_Ada_Spec_Suffix return File_Name_Type is
 335    begin
 336       return Default_Ada_Spec_Suffix_Id;
 337    end Default_Ada_Spec_Suffix;
 338
 339    ---------------------------
 340    -- Delete_All_Temp_Files --
 341    ---------------------------
 342
 343    procedure Delete_All_Temp_Files is
 344       Dont_Care : Boolean;
 345       pragma Warnings (Off, Dont_Care);
 346    begin
 347       if not Debug.Debug_Flag_N then
 348          for Index in 1 .. Temp_Files.Last loop
 349             Delete_File
 350               (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
 351          end loop;
 352       end if;
 353    end Delete_All_Temp_Files;
 354
 355    ---------------------
 356    -- Dependency_Name --
 357    ---------------------
 358
 359    function Dependency_Name
 360      (Source_File_Name : File_Name_Type;
 361       Dependency       : Dependency_File_Kind) return File_Name_Type
 362    is
 363    begin
 364       case Dependency is
 365          when None =>
 366             return No_File;
 367
 368          when Makefile =>
 369             return
 370               File_Name_Type
 371                 (Extend_Name
 372                    (Source_File_Name, Makefile_Dependency_Suffix));
 373
 374          when ALI_File =>
 375             return
 376               File_Name_Type
 377                 (Extend_Name
 378                    (Source_File_Name, ALI_Dependency_Suffix));
 379       end case;
 380    end Dependency_Name;
 381
 382    ---------------------------
 383    -- Display_Language_Name --
 384    ---------------------------
 385
 386    procedure Display_Language_Name
 387      (In_Tree  : Project_Tree_Ref;
 388       Language : Language_Index)
 389    is
 390    begin
 391       Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
 392       Write_Str (Name_Buffer (1 .. Name_Len));
 393    end Display_Language_Name;
 394
 395    ----------------
 396    -- Empty_File --
 397    ----------------
 398
 399    function Empty_File return File_Name_Type is
 400    begin
 401       return File_Name_Type (The_Empty_String);
 402    end Empty_File;
 403
 404    -------------------
 405    -- Empty_Project --
 406    -------------------
 407
 408    function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
 409       Value : Project_Data;
 410
 411    begin
 412       Prj.Initialize (Tree => No_Project_Tree);
 413       Value := Project_Empty;
 414       Value.Naming := Tree.Private_Part.Default_Naming;
 415
 416       return Value;
 417    end Empty_Project;
 418
 419    ------------------
 420    -- Empty_String --
 421    ------------------
 422
 423    function Empty_String return Name_Id is
 424    begin
 425       return The_Empty_String;
 426    end Empty_String;
 427
 428    ------------
 429    -- Expect --
 430    ------------
 431
 432    procedure Expect (The_Token : Token_Type; Token_Image : String) is
 433    begin
 434       if Token /= The_Token then
 435          Error_Msg (Token_Image & " expected", Token_Ptr);
 436       end if;
 437    end Expect;
 438
 439    -----------------
 440    -- Extend_Name --
 441    -----------------
 442
 443    function Extend_Name
 444      (File        : File_Name_Type;
 445       With_Suffix : String) return File_Name_Type
 446    is
 447       Last : Positive;
 448
 449    begin
 450       Get_Name_String (File);
 451       Last := Name_Len + 1;
 452
 453       while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
 454          Name_Len := Name_Len - 1;
 455       end loop;
 456
 457       if Name_Len <= 1 then
 458          Name_Len := Last;
 459       end if;
 460
 461       for J in With_Suffix'Range loop
 462          Name_Buffer (Name_Len) := With_Suffix (J);
 463          Name_Len := Name_Len + 1;
 464       end loop;
 465
 466       Name_Len := Name_Len - 1;
 467       return Name_Find;
 468
 469    end Extend_Name;
 470
 471    --------------------------------
 472    -- For_Every_Project_Imported --
 473    --------------------------------
 474
 475    procedure For_Every_Project_Imported
 476      (By         : Project_Id;
 477       In_Tree    : Project_Tree_Ref;
 478       With_State : in out State)
 479    is
 480
 481       procedure Recursive_Check (Project : Project_Id);
 482       --  Check if a project has already been seen. If not seen, mark it as
 483       --  Seen, Call Action, and check all its imported projects.
 484
 485       ---------------------
 486       -- Recursive_Check --
 487       ---------------------
 488
 489       procedure Recursive_Check (Project : Project_Id) is
 490          List : Project_List;
 491       begin
 492          if not In_Tree.Projects.Table (Project).Seen then
 493             In_Tree.Projects.Table (Project).Seen := True;
 494             Action (Project, With_State);
 495
 496             List := In_Tree.Projects.Table (Project).Imported_Projects;
 497             while List /= Empty_Project_List loop
 498                Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
 499                List := In_Tree.Project_Lists.Table (List).Next;
 500             end loop;
 501          end if;
 502       end Recursive_Check;
 503
 504    --  Start of processing for For_Every_Project_Imported
 505
 506    begin
 507       for Project in Project_Table.First ..
 508                      Project_Table.Last (In_Tree.Projects)
 509       loop
 510          In_Tree.Projects.Table (Project).Seen := False;
 511       end loop;
 512
 513       Recursive_Check (Project => By);
 514    end For_Every_Project_Imported;
 515
 516    --------------
 517    -- Get_Mode --
 518    --------------
 519
 520    function Get_Mode return Mode is
 521    begin
 522       return Current_Mode;
 523    end Get_Mode;
 524
 525    ----------
 526    -- Hash --
 527    ----------
 528
 529    function Hash is new System.HTable.Hash (Header_Num => Header_Num);
 530    --  Used in implementation of other functions Hash below
 531
 532    function Hash (Name : File_Name_Type) return Header_Num is
 533    begin
 534       return Hash (Get_Name_String (Name));
 535    end Hash;
 536
 537    function Hash (Name : Name_Id) return Header_Num is
 538    begin
 539       return Hash (Get_Name_String (Name));
 540    end Hash;
 541
 542    function Hash (Name : Path_Name_Type) return Header_Num is
 543    begin
 544       return Hash (Get_Name_String (Name));
 545    end Hash;
 546
 547    function Hash (Project : Project_Id) return Header_Num is
 548    begin
 549       return Header_Num (Project mod Max_Header_Num);
 550    end Hash;
 551
 552    -----------
 553    -- Image --
 554    -----------
 555
 556    function Image (Casing : Casing_Type) return String is
 557    begin
 558       return The_Casing_Images (Casing).all;
 559    end Image;
 560
 561    ----------------------
 562    -- In_Configuration --
 563    ----------------------
 564
 565    function In_Configuration return Boolean is
 566    begin
 567       return Configuration_Mode;
 568    end In_Configuration;
 569
 570    ----------------
 571    -- Initialize --
 572    ----------------
 573
 574    procedure Initialize (Tree : Project_Tree_Ref) is
 575    begin
 576       if not Initialized then
 577          Initialized := True;
 578          Uintp.Initialize;
 579          Name_Len := 0;
 580          The_Empty_String := Name_Find;
 581          Empty_Name := The_Empty_String;
 582          Empty_File_Name := File_Name_Type (The_Empty_String);
 583          Name_Len := 4;
 584          Name_Buffer (1 .. 4) := ".ads";
 585          Default_Ada_Spec_Suffix_Id := Name_Find;
 586          Name_Len := 4;
 587          Name_Buffer (1 .. 4) := ".adb";
 588          Default_Ada_Body_Suffix_Id := Name_Find;
 589          Name_Len := 1;
 590          Name_Buffer (1) := '/';
 591          Slash_Id := Name_Find;
 592
 593          Prj.Env.Initialize;
 594          Prj.Attr.Initialize;
 595          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
 596          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
 597          Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
 598       end if;
 599
 600       if Tree /= No_Project_Tree then
 601          Reset (Tree);
 602       end if;
 603    end Initialize;
 604
 605    -------------------
 606    -- Is_A_Language --
 607    -------------------
 608
 609    function Is_A_Language
 610      (Tree          : Project_Tree_Ref;
 611       Data          : Project_Data;
 612       Language_Name : Name_Id) return Boolean
 613    is
 614    begin
 615       if Get_Mode = Ada_Only then
 616          declare
 617             List : Name_List_Index := Data.Languages;
 618          begin
 619             while List /= No_Name_List loop
 620                if Tree.Name_Lists.Table (List).Name = Language_Name then
 621                   return True;
 622                else
 623                   List := Tree.Name_Lists.Table (List).Next;
 624                end if;
 625             end loop;
 626          end;
 627
 628       else
 629          declare
 630             Lang_Ind  : Language_Index := Data.First_Language_Processing;
 631             Lang_Data : Language_Data;
 632
 633          begin
 634             while Lang_Ind /= No_Language_Index loop
 635                Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
 636
 637                if Lang_Data.Name = Language_Name then
 638                   return True;
 639                end if;
 640
 641                Lang_Ind := Lang_Data.Next;
 642             end loop;
 643          end;
 644       end if;
 645
 646       return False;
 647    end Is_A_Language;
 648
 649    ------------------
 650    -- Is_Extending --
 651    ------------------
 652
 653    function Is_Extending
 654      (Extending : Project_Id;
 655       Extended  : Project_Id;
 656       In_Tree   : Project_Tree_Ref) return Boolean
 657    is
 658       Proj : Project_Id;
 659
 660    begin
 661       Proj := Extending;
 662       while Proj /= No_Project loop
 663          if Proj = Extended then
 664             return True;
 665          end if;
 666
 667          Proj := In_Tree.Projects.Table (Proj).Extends;
 668       end loop;
 669
 670       return False;
 671    end Is_Extending;
 672
 673    -----------------------
 674    -- Objects_Exist_For --
 675    -----------------------
 676
 677    function Objects_Exist_For
 678      (Language : String;
 679       In_Tree  : Project_Tree_Ref) return Boolean
 680    is
 681       Language_Id : Name_Id;
 682       Lang        : Language_Index;
 683
 684    begin
 685       if Current_Mode = Multi_Language then
 686          Name_Len := 0;
 687          Add_Str_To_Name_Buffer (Language);
 688          To_Lower (Name_Buffer (1 .. Name_Len));
 689          Language_Id := Name_Find;
 690
 691          Lang := In_Tree.First_Language;
 692          while Lang /= No_Language_Index loop
 693             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 694                return
 695                  In_Tree.Languages_Data.Table
 696                    (Lang).Config.Object_Generated;
 697             end if;
 698
 699             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 700          end loop;
 701       end if;
 702
 703       return True;
 704    end Objects_Exist_For;
 705
 706    -----------------
 707    -- Object_Name --
 708    -----------------
 709
 710    function Object_Name
 711      (Source_File_Name   : File_Name_Type;
 712       Object_File_Suffix : Name_Id := No_Name)
 713       return File_Name_Type
 714    is
 715    begin
 716       if Object_File_Suffix = No_Name then
 717          return Extend_Name
 718            (Source_File_Name, Object_Suffix);
 719       else
 720          return Extend_Name
 721            (Source_File_Name, Get_Name_String (Object_File_Suffix));
 722       end if;
 723    end Object_Name;
 724
 725    ----------------------
 726    -- Record_Temp_File --
 727    ----------------------
 728
 729    procedure Record_Temp_File (Path : Path_Name_Type) is
 730    begin
 731       Temp_Files.Increment_Last;
 732       Temp_Files.Table (Temp_Files.Last) := Path;
 733    end Record_Temp_File;
 734
 735    ------------------------------------
 736    -- Register_Default_Naming_Scheme --
 737    ------------------------------------
 738
 739    procedure Register_Default_Naming_Scheme
 740      (Language            : Name_Id;
 741       Default_Spec_Suffix : File_Name_Type;
 742       Default_Body_Suffix : File_Name_Type;
 743       In_Tree             : Project_Tree_Ref)
 744    is
 745       Lang : Name_Id;
 746       Suffix : Array_Element_Id;
 747       Found : Boolean := False;
 748       Element : Array_Element;
 749
 750    begin
 751       --  Get the language name in small letters
 752
 753       Get_Name_String (Language);
 754       Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
 755       Lang := Name_Find;
 756
 757       --  Look for an element of the spec suffix array indexed by the language
 758       --  name. If one is found, put the default value.
 759
 760       Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
 761       Found := False;
 762       while Suffix /= No_Array_Element and then not Found loop
 763          Element := In_Tree.Array_Elements.Table (Suffix);
 764
 765          if Element.Index = Lang then
 766             Found := True;
 767             Element.Value.Value := Name_Id (Default_Spec_Suffix);
 768             In_Tree.Array_Elements.Table (Suffix) := Element;
 769
 770          else
 771             Suffix := Element.Next;
 772          end if;
 773       end loop;
 774
 775       --  If none can be found, create a new one
 776
 777       if not Found then
 778          Element :=
 779            (Index     => Lang,
 780             Src_Index => 0,
 781             Index_Case_Sensitive => False,
 782             Value => (Project  => No_Project,
 783                       Kind     => Single,
 784                       Location => No_Location,
 785                       Default  => False,
 786                       Value    => Name_Id (Default_Spec_Suffix),
 787                       Index    => 0),
 788             Next  => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
 789          Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 790          In_Tree.Array_Elements.Table
 791            (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
 792             Element;
 793          In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
 794            Array_Element_Table.Last (In_Tree.Array_Elements);
 795       end if;
 796
 797       --  Look for an element of the body suffix array indexed by the language
 798       --  name. If one is found, put the default value.
 799
 800       Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
 801       Found := False;
 802       while Suffix /= No_Array_Element and then not Found loop
 803          Element := In_Tree.Array_Elements.Table (Suffix);
 804
 805          if Element.Index = Lang then
 806             Found := True;
 807             Element.Value.Value := Name_Id (Default_Body_Suffix);
 808             In_Tree.Array_Elements.Table (Suffix) := Element;
 809
 810          else
 811             Suffix := Element.Next;
 812          end if;
 813       end loop;
 814
 815       --  If none can be found, create a new one
 816
 817       if not Found then
 818          Element :=
 819            (Index     => Lang,
 820             Src_Index => 0,
 821             Index_Case_Sensitive => False,
 822             Value => (Project  => No_Project,
 823                       Kind     => Single,
 824                       Location => No_Location,
 825                       Default  => False,
 826                       Value    => Name_Id (Default_Body_Suffix),
 827                       Index    => 0),
 828             Next  => In_Tree.Private_Part.Default_Naming.Body_Suffix);
 829          Array_Element_Table.Increment_Last
 830            (In_Tree.Array_Elements);
 831          In_Tree.Array_Elements.Table
 832            (Array_Element_Table.Last (In_Tree.Array_Elements))
 833              := Element;
 834          In_Tree.Private_Part.Default_Naming.Body_Suffix :=
 835            Array_Element_Table.Last (In_Tree.Array_Elements);
 836       end if;
 837    end Register_Default_Naming_Scheme;
 838
 839    ----------
 840    -- Free --
 841    ----------
 842
 843    procedure Free (Project : in out Project_Data) is
 844    begin
 845       Free (Project.Dir_Path);
 846       Free (Project.Include_Path);
 847       Free (Project.Ada_Include_Path);
 848       Free (Project.Objects_Path);
 849       Free (Project.Ada_Objects_Path);
 850    end Free;
 851
 852    ----------
 853    -- Free --
 854    ----------
 855
 856    procedure Free (Tree : in out Project_Tree_Ref) is
 857       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 858         (Project_Tree_Data, Project_Tree_Ref);
 859    begin
 860       if Tree /= null then
 861          Language_Data_Table.Free (Tree.Languages_Data);
 862          Name_List_Table.Free (Tree.Name_Lists);
 863          String_Element_Table.Free (Tree.String_Elements);
 864          Variable_Element_Table.Free (Tree.Variable_Elements);
 865          Array_Element_Table.Free (Tree.Array_Elements);
 866          Array_Table.Free (Tree.Arrays);
 867          Package_Table.Free (Tree.Packages);
 868          Project_List_Table.Free (Tree.Project_Lists);
 869          Source_Data_Table.Free (Tree.Sources);
 870          Alternate_Language_Table.Free (Tree.Alt_Langs);
 871          Unit_Table.Free (Tree.Units);
 872          Units_Htable.Reset (Tree.Units_HT);
 873          Files_Htable.Reset (Tree.Files_HT);
 874          Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
 875          Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
 876
 877          for P in Project_Table.First ..
 878            Project_Table.Last (Tree.Projects)
 879          loop
 880             Free (Tree.Projects.Table (P));
 881          end loop;
 882
 883          Project_Table.Free (Tree.Projects);
 884
 885          --  Private part
 886
 887          Naming_Table.Free (Tree.Private_Part.Namings);
 888          Path_File_Table.Free (Tree.Private_Part.Path_Files);
 889          Source_Path_Table.Free (Tree.Private_Part.Source_Paths);
 890          Object_Path_Table.Free (Tree.Private_Part.Object_Paths);
 891
 892          --  Naming data (nothing to free ?)
 893          null;
 894
 895          Unchecked_Free (Tree);
 896       end if;
 897    end Free;
 898
 899    -----------
 900    -- Reset --
 901    -----------
 902
 903    procedure Reset (Tree : Project_Tree_Ref) is
 904    begin
 905       Prj.Env.Initialize;
 906
 907       --  Visible tables
 908
 909       Language_Data_Table.Init      (Tree.Languages_Data);
 910       Name_List_Table.Init          (Tree.Name_Lists);
 911       String_Element_Table.Init     (Tree.String_Elements);
 912       Variable_Element_Table.Init   (Tree.Variable_Elements);
 913       Array_Element_Table.Init      (Tree.Array_Elements);
 914       Array_Table.Init              (Tree.Arrays);
 915       Package_Table.Init            (Tree.Packages);
 916       Project_List_Table.Init       (Tree.Project_Lists);
 917       Source_Data_Table.Init        (Tree.Sources);
 918       Alternate_Language_Table.Init (Tree.Alt_Langs);
 919       Unit_Table.Init               (Tree.Units);
 920       Units_Htable.Reset            (Tree.Units_HT);
 921       Files_Htable.Reset            (Tree.Files_HT);
 922       Source_Paths_Htable.Reset     (Tree.Source_Paths_HT);
 923       Unit_Sources_Htable.Reset     (Tree.Unit_Sources_HT);
 924
 925       if not Project_Table."=" (Tree.Projects.Table, null) then
 926          for P in Project_Table.First ..
 927            Project_Table.Last (Tree.Projects)
 928          loop
 929             Free (Tree.Projects.Table (P));
 930          end loop;
 931       end if;
 932
 933       Project_Table.Init            (Tree.Projects);
 934
 935       --  Private part table
 936
 937       Naming_Table.Init             (Tree.Private_Part.Namings);
 938       Naming_Table.Increment_Last   (Tree.Private_Part.Namings);
 939       Tree.Private_Part.Namings.Table
 940         (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
 941       Path_File_Table.Init        (Tree.Private_Part.Path_Files);
 942       Source_Path_Table.Init      (Tree.Private_Part.Source_Paths);
 943       Object_Path_Table.Init      (Tree.Private_Part.Object_Paths);
 944       Tree.Private_Part.Default_Naming := Std_Naming_Data;
 945
 946       if Current_Mode = Ada_Only then
 947          Register_Default_Naming_Scheme
 948            (Language            => Name_Ada,
 949             Default_Spec_Suffix => Default_Ada_Spec_Suffix,
 950             Default_Body_Suffix => Default_Ada_Body_Suffix,
 951             In_Tree             => Tree);
 952          Tree.Private_Part.Default_Naming.Separate_Suffix :=
 953            Default_Ada_Body_Suffix;
 954       end if;
 955    end Reset;
 956
 957    ------------------------
 958    -- Same_Naming_Scheme --
 959    ------------------------
 960
 961    function Same_Naming_Scheme
 962      (Left, Right : Naming_Data) return Boolean
 963    is
 964    begin
 965       return Left.Dot_Replacement = Right.Dot_Replacement
 966         and then Left.Casing = Right.Casing
 967         and then Left.Separate_Suffix = Right.Separate_Suffix;
 968    end Same_Naming_Scheme;
 969
 970    ---------------------
 971    -- Set_Body_Suffix --
 972    ---------------------
 973
 974    procedure Set_Body_Suffix
 975      (In_Tree  : Project_Tree_Ref;
 976       Language : String;
 977       Naming   : in out Naming_Data;
 978       Suffix   : File_Name_Type)
 979    is
 980       Language_Id : Name_Id;
 981       Element     : Array_Element;
 982
 983    begin
 984       Name_Len := 0;
 985       Add_Str_To_Name_Buffer (Language);
 986       To_Lower (Name_Buffer (1 .. Name_Len));
 987       Language_Id := Name_Find;
 988
 989       Element :=
 990         (Index                => Language_Id,
 991          Src_Index            => 0,
 992          Index_Case_Sensitive => False,
 993          Value                =>
 994            (Kind     => Single,
 995             Project  => No_Project,
 996             Location => No_Location,
 997             Default  => False,
 998             Value    => Name_Id (Suffix),
 999             Index    => 0),
1000          Next                 => Naming.Body_Suffix);
1001
1002       Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1003       Naming.Body_Suffix :=
1004          Array_Element_Table.Last (In_Tree.Array_Elements);
1005       In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1006    end Set_Body_Suffix;
1007
1008    --------------------------
1009    -- Set_In_Configuration --
1010    --------------------------
1011
1012    procedure Set_In_Configuration (Value : Boolean) is
1013    begin
1014       Configuration_Mode := Value;
1015    end Set_In_Configuration;
1016
1017    --------------
1018    -- Set_Mode --
1019    --------------
1020
1021    procedure Set_Mode (New_Mode : Mode) is
1022    begin
1023       Current_Mode := New_Mode;
1024       case New_Mode is
1025          when Ada_Only =>
1026             Default_Language_Is_Ada := True;
1027             Must_Check_Configuration := False;
1028          when Multi_Language =>
1029             Default_Language_Is_Ada := False;
1030             Must_Check_Configuration := True;
1031       end case;
1032    end Set_Mode;
1033
1034    ---------------------
1035    -- Set_Spec_Suffix --
1036    ---------------------
1037
1038    procedure Set_Spec_Suffix
1039      (In_Tree  : Project_Tree_Ref;
1040       Language : String;
1041       Naming   : in out Naming_Data;
1042       Suffix   : File_Name_Type)
1043    is
1044       Language_Id : Name_Id;
1045       Element     : Array_Element;
1046
1047    begin
1048       Name_Len := 0;
1049       Add_Str_To_Name_Buffer (Language);
1050       To_Lower (Name_Buffer (1 .. Name_Len));
1051       Language_Id := Name_Find;
1052
1053       Element :=
1054         (Index                => Language_Id,
1055          Src_Index            => 0,
1056          Index_Case_Sensitive => False,
1057          Value                =>
1058            (Kind     => Single,
1059             Project  => No_Project,
1060             Location => No_Location,
1061             Default  => False,
1062             Value    => Name_Id (Suffix),
1063             Index    => 0),
1064          Next                 => Naming.Spec_Suffix);
1065
1066       Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1067       Naming.Spec_Suffix :=
1068         Array_Element_Table.Last (In_Tree.Array_Elements);
1069       In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1070    end Set_Spec_Suffix;
1071
1072    -----------
1073    -- Slash --
1074    -----------
1075
1076    function Slash return Path_Name_Type is
1077    begin
1078       return Slash_Id;
1079    end Slash;
1080
1081    -----------------------
1082    -- Spec_Suffix_Id_Of --
1083    -----------------------
1084
1085    function Spec_Suffix_Id_Of
1086      (In_Tree  : Project_Tree_Ref;
1087       Language : String;
1088       Naming   : Naming_Data) return File_Name_Type
1089    is
1090       Language_Id : Name_Id;
1091
1092    begin
1093       Name_Len := 0;
1094       Add_Str_To_Name_Buffer (Language);
1095       To_Lower (Name_Buffer (1 .. Name_Len));
1096       Language_Id := Name_Find;
1097
1098       return
1099         Spec_Suffix_Id_Of
1100           (In_Tree     => In_Tree,
1101            Language_Id => Language_Id,
1102            Naming      => Naming);
1103    end Spec_Suffix_Id_Of;
1104
1105    -----------------------
1106    -- Spec_Suffix_Id_Of --
1107    -----------------------
1108
1109    function Spec_Suffix_Id_Of
1110      (In_Tree     : Project_Tree_Ref;
1111       Language_Id : Name_Id;
1112       Naming      : Naming_Data) return File_Name_Type
1113    is
1114       Element_Id : Array_Element_Id;
1115       Element    : Array_Element;
1116       Suffix     : File_Name_Type := No_File;
1117       Lang       : Language_Index;
1118
1119    begin
1120       Element_Id := Naming.Spec_Suffix;
1121       while Element_Id /= No_Array_Element loop
1122          Element := In_Tree.Array_Elements.Table (Element_Id);
1123
1124          if Element.Index = Language_Id then
1125             return File_Name_Type (Element.Value.Value);
1126          end if;
1127
1128          Element_Id := Element.Next;
1129       end loop;
1130
1131       if Current_Mode = Multi_Language then
1132          Lang := In_Tree.First_Language;
1133          while Lang /= No_Language_Index loop
1134             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1135                Suffix :=
1136                  In_Tree.Languages_Data.Table
1137                    (Lang).Config.Naming_Data.Spec_Suffix;
1138                exit;
1139             end if;
1140
1141             Lang := In_Tree.Languages_Data.Table (Lang).Next;
1142          end loop;
1143       end if;
1144
1145       return Suffix;
1146    end Spec_Suffix_Id_Of;
1147
1148    --------------------
1149    -- Spec_Suffix_Of --
1150    --------------------
1151
1152    function Spec_Suffix_Of
1153      (In_Tree  : Project_Tree_Ref;
1154       Language : String;
1155       Naming   : Naming_Data) return String
1156    is
1157       Language_Id : Name_Id;
1158       Element_Id  : Array_Element_Id;
1159       Element     : Array_Element;
1160       Suffix      : File_Name_Type := No_File;
1161       Lang        : Language_Index;
1162
1163    begin
1164       Name_Len := 0;
1165       Add_Str_To_Name_Buffer (Language);
1166       To_Lower (Name_Buffer (1 .. Name_Len));
1167       Language_Id := Name_Find;
1168
1169       Element_Id := Naming.Spec_Suffix;
1170       while Element_Id /= No_Array_Element loop
1171          Element := In_Tree.Array_Elements.Table (Element_Id);
1172
1173          if Element.Index = Language_Id then
1174             return Get_Name_String (Element.Value.Value);
1175          end if;
1176
1177          Element_Id := Element.Next;
1178       end loop;
1179
1180       if Current_Mode = Multi_Language then
1181          Lang := In_Tree.First_Language;
1182          while Lang /= No_Language_Index loop
1183             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1184                Suffix :=
1185                  File_Name_Type
1186                    (In_Tree.Languages_Data.Table
1187                       (Lang).Config.Naming_Data.Spec_Suffix);
1188                exit;
1189             end if;
1190
1191             Lang := In_Tree.Languages_Data.Table (Lang).Next;
1192          end loop;
1193
1194          if Suffix /= No_File then
1195             return Get_Name_String (Suffix);
1196          end if;
1197       end if;
1198
1199       return "";
1200    end Spec_Suffix_Of;
1201
1202    --------------------------
1203    -- Standard_Naming_Data --
1204    --------------------------
1205
1206    function Standard_Naming_Data
1207      (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1208    is
1209    begin
1210       if Tree = No_Project_Tree then
1211          Prj.Initialize (Tree => No_Project_Tree);
1212          return Std_Naming_Data;
1213       else
1214          return Tree.Private_Part.Default_Naming;
1215       end if;
1216    end Standard_Naming_Data;
1217
1218    -------------------
1219    -- Switches_Name --
1220    -------------------
1221
1222    function Switches_Name
1223      (Source_File_Name : File_Name_Type) return File_Name_Type
1224    is
1225    begin
1226       return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1227    end Switches_Name;
1228
1229    -----------
1230    -- Value --
1231    -----------
1232
1233    function Value (Image : String) return Casing_Type is
1234    begin
1235       for Casing in The_Casing_Images'Range loop
1236          if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1237             return Casing;
1238          end if;
1239       end loop;
1240
1241       raise Constraint_Error;
1242    end Value;
1243
1244 begin
1245    --  Make sure that the standard config and user project file extensions are
1246    --  compatible with canonical case file naming.
1247
1248    Canonical_Case_File_Name (Config_Project_File_Extension);
1249    Canonical_Case_File_Name (Project_File_Extension);
1250 end Prj;