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