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