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