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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Ada.Characters.Handling; use Ada.Characters.Handling;
  28
  29 with Debug;
  30 with Output;   use Output;
  31 with Osint;    use Osint;
  32 with Prj.Attr;
  33 with Prj.Env;
  34 with Prj.Err;  use Prj.Err;
  35 with Snames;   use Snames;
  36 with Uintp;    use Uintp;
  37
  38 with System.Case_Util; use System.Case_Util;
  39
  40 package body Prj is
  41
  42    Object_Suffix : constant String := Get_Target_Object_Suffix.all;
  43    --  File suffix for object files
  44
  45    Initial_Buffer_Size : constant := 100;
  46    --  Initial size for extensible buffer used in Add_To_Buffer
  47
  48    Current_Mode : Mode := Ada_Only;
  49
  50    Configuration_Mode : Boolean := False;
  51
  52    The_Empty_String : Name_Id;
  53
  54    Name_C_Plus_Plus : Name_Id;
  55
  56    Default_Ada_Spec_Suffix_Id : File_Name_Type;
  57    Default_Ada_Body_Suffix_Id : File_Name_Type;
  58    Slash_Id                   : Path_Name_Type;
  59    --  Initialized in Prj.Initialize, then never modified
  60
  61    subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
  62
  63    The_Casing_Images : constant array (Known_Casing) of String_Access :=
  64      (All_Lower_Case => new String'("lowercase"),
  65       All_Upper_Case => new String'("UPPERCASE"),
  66       Mixed_Case     => new String'("MixedCase"));
  67
  68    Initialized : Boolean := False;
  69
  70    Standard_Dot_Replacement : constant File_Name_Type :=
  71                                 File_Name_Type
  72                                   (First_Name_Id + Character'Pos ('-'));
  73
  74    Std_Naming_Data : constant Naming_Data :=
  75                        (Dot_Replacement           => Standard_Dot_Replacement,
  76                         Dot_Repl_Loc              => No_Location,
  77                         Casing                    => All_Lower_Case,
  78                         Spec_Suffix               => No_Array_Element,
  79                         Ada_Spec_Suffix_Loc       => No_Location,
  80                         Body_Suffix               => No_Array_Element,
  81                         Ada_Body_Suffix_Loc       => No_Location,
  82                         Separate_Suffix           => No_File,
  83                         Sep_Suffix_Loc            => No_Location,
  84                         Specs                     => No_Array_Element,
  85                         Bodies                    => No_Array_Element,
  86                         Specification_Exceptions  => No_Array_Element,
  87                         Implementation_Exceptions => No_Array_Element,
  88                         Impl_Suffixes             => No_Impl_Suffixes,
  89                         Supp_Suffixes             => No_Supp_Language_Index);
  90
  91    Project_Empty : constant Project_Data :=
  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          => Default_First_Language_Processing_Data,
 169       Supp_Language_Processing       => No_Supp_Language_Index);
 170
 171    package Temp_Files is new Table.Table
 172      (Table_Component_Type => Path_Name_Type,
 173       Table_Index_Type     => Integer,
 174       Table_Low_Bound      => 1,
 175       Table_Initial        => 20,
 176       Table_Increment      => 100,
 177       Table_Name           => "Makegpr.Temp_Files");
 178    --  Table to store the path name of all the created temporary files, so that
 179    --  they can be deleted at the end, or when the program is interrupted.
 180
 181    -----------------------
 182    -- Add_Language_Name --
 183    -----------------------
 184
 185    procedure Add_Language_Name (Name : Name_Id) is
 186    begin
 187       Last_Language_Index := Last_Language_Index + 1;
 188       Language_Indexes.Set (Name, Last_Language_Index);
 189       Language_Names.Increment_Last;
 190       Language_Names.Table (Last_Language_Index) := Name;
 191    end Add_Language_Name;
 192
 193    -------------------
 194    -- Add_To_Buffer --
 195    -------------------
 196
 197    procedure Add_To_Buffer
 198      (S    : String;
 199       To   : in out String_Access;
 200       Last : in out Natural)
 201    is
 202    begin
 203       if To = null then
 204          To := new String (1 .. Initial_Buffer_Size);
 205          Last := 0;
 206       end if;
 207
 208       --  If Buffer is too small, double its size
 209
 210       while Last + S'Length > To'Last loop
 211          declare
 212             New_Buffer : constant  String_Access :=
 213                            new String (1 .. 2 * Last);
 214
 215          begin
 216             New_Buffer (1 .. Last) := To (1 .. Last);
 217             Free (To);
 218             To := New_Buffer;
 219          end;
 220       end loop;
 221
 222       To (Last + 1 .. Last + S'Length) := S;
 223       Last := Last + S'Length;
 224    end Add_To_Buffer;
 225
 226    -----------------------
 227    -- Body_Suffix_Id_Of --
 228    -----------------------
 229
 230    function Body_Suffix_Id_Of
 231      (In_Tree  : Project_Tree_Ref;
 232       Language : String;
 233       Naming   : Naming_Data) return File_Name_Type
 234    is
 235       Language_Id : Name_Id;
 236       Element_Id  : Array_Element_Id;
 237       Element     : Array_Element;
 238       Suffix      : File_Name_Type := No_File;
 239       Lang        : Language_Index;
 240
 241    begin
 242       Name_Len := 0;
 243       Add_Str_To_Name_Buffer (Language);
 244       To_Lower (Name_Buffer (1 .. Name_Len));
 245       Language_Id := Name_Find;
 246
 247       Element_Id := Naming.Body_Suffix;
 248       while Element_Id /= No_Array_Element loop
 249          Element := In_Tree.Array_Elements.Table (Element_Id);
 250
 251          if Element.Index = Language_Id then
 252             return File_Name_Type (Element.Value.Value);
 253          end if;
 254
 255          Element_Id := Element.Next;
 256       end loop;
 257
 258       if Current_Mode = Multi_Language then
 259          Lang := In_Tree.First_Language;
 260          while Lang /= No_Language_Index loop
 261             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 262                Suffix :=
 263                  In_Tree.Languages_Data.Table
 264                    (Lang).Config.Naming_Data.Body_Suffix;
 265                exit;
 266             end if;
 267
 268             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 269          end loop;
 270       end if;
 271
 272       return Suffix;
 273    end Body_Suffix_Id_Of;
 274
 275    --------------------
 276    -- Body_Suffix_Of --
 277    --------------------
 278
 279    function Body_Suffix_Of
 280      (In_Tree  : Project_Tree_Ref;
 281       Language : String;
 282       Naming   : Naming_Data) return String
 283    is
 284       Language_Id : Name_Id;
 285       Element_Id  : Array_Element_Id;
 286       Element     : Array_Element;
 287       Suffix      : File_Name_Type := No_File;
 288       Lang        : Language_Index;
 289
 290    begin
 291       Name_Len := 0;
 292       Add_Str_To_Name_Buffer (Language);
 293       To_Lower (Name_Buffer (1 .. Name_Len));
 294       Language_Id := Name_Find;
 295
 296       Element_Id := Naming.Body_Suffix;
 297       while Element_Id /= No_Array_Element loop
 298          Element := In_Tree.Array_Elements.Table (Element_Id);
 299
 300          if Element.Index = Language_Id then
 301             return Get_Name_String (Element.Value.Value);
 302          end if;
 303
 304          Element_Id := Element.Next;
 305       end loop;
 306
 307       if Current_Mode = Multi_Language then
 308          Lang := In_Tree.First_Language;
 309          while Lang /= No_Language_Index loop
 310             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 311                Suffix :=
 312                  File_Name_Type
 313                    (In_Tree.Languages_Data.Table
 314                         (Lang).Config.Naming_Data.Body_Suffix);
 315                exit;
 316             end if;
 317
 318             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 319          end loop;
 320
 321          if Suffix /= No_File then
 322             return Get_Name_String (Suffix);
 323          end if;
 324       end if;
 325
 326       return "";
 327    end Body_Suffix_Of;
 328
 329    function Body_Suffix_Of
 330      (Language   : Language_Index;
 331       In_Project : Project_Data;
 332       In_Tree    : Project_Tree_Ref) return String
 333    is
 334       Suffix_Id : constant File_Name_Type :=
 335                     Suffix_Of (Language, In_Project, In_Tree);
 336    begin
 337       if Suffix_Id /= No_File then
 338          return Get_Name_String (Suffix_Id);
 339       else
 340          return "." & Get_Name_String (Language_Names.Table (Language));
 341       end if;
 342    end Body_Suffix_Of;
 343
 344    -----------------------------
 345    -- Default_Ada_Body_Suffix --
 346    -----------------------------
 347
 348    function Default_Ada_Body_Suffix return File_Name_Type is
 349    begin
 350       return Default_Ada_Body_Suffix_Id;
 351    end Default_Ada_Body_Suffix;
 352
 353    -----------------------------
 354    -- Default_Ada_Spec_Suffix --
 355    -----------------------------
 356
 357    function Default_Ada_Spec_Suffix return File_Name_Type is
 358    begin
 359       return Default_Ada_Spec_Suffix_Id;
 360    end Default_Ada_Spec_Suffix;
 361
 362    ----------------------
 363    -- Default_Language --
 364    ----------------------
 365
 366    function Default_Language (In_Tree : Project_Tree_Ref) return Name_Id is
 367    begin
 368       return In_Tree.Default_Language;
 369    end Default_Language;
 370
 371    ---------------------------
 372    -- Delete_All_Temp_Files --
 373    ---------------------------
 374
 375    procedure Delete_All_Temp_Files is
 376       Dont_Care : Boolean;
 377    begin
 378       if not Debug.Debug_Flag_N then
 379          for Index in 1 .. Temp_Files.Last loop
 380             Delete_File
 381               (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
 382          end loop;
 383       end if;
 384    end Delete_All_Temp_Files;
 385
 386    ---------------------
 387    -- Dependency_Name --
 388    ---------------------
 389
 390    function Dependency_Name
 391      (Source_File_Name : File_Name_Type;
 392       Dependency       : Dependency_File_Kind) return File_Name_Type
 393    is
 394    begin
 395       case Dependency is
 396          when None =>
 397             return No_File;
 398
 399          when Makefile =>
 400             return
 401               File_Name_Type
 402                 (Extend_Name
 403                    (Source_File_Name, Makefile_Dependency_Suffix));
 404
 405          when ALI_File =>
 406             return
 407               File_Name_Type
 408                 (Extend_Name
 409                    (Source_File_Name, ALI_Dependency_Suffix));
 410       end case;
 411    end Dependency_Name;
 412
 413    ---------------------------
 414    -- Display_Language_Name --
 415    ---------------------------
 416
 417    procedure Display_Language_Name
 418      (In_Tree  : Project_Tree_Ref;
 419       Language : Language_Index)
 420    is
 421    begin
 422       Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
 423       Write_Str (Name_Buffer (1 .. Name_Len));
 424    end Display_Language_Name;
 425
 426    ---------------------------
 427    -- Display_Language_Name --
 428    ---------------------------
 429
 430    procedure Display_Language_Name (Language : Language_Index) is
 431    begin
 432       Get_Name_String (Language_Names.Table (Language));
 433       To_Upper (Name_Buffer (1 .. 1));
 434       Write_Str (Name_Buffer (1 .. Name_Len));
 435    end Display_Language_Name;
 436
 437    ----------------
 438    -- Empty_File --
 439    ----------------
 440
 441    function Empty_File return File_Name_Type is
 442    begin
 443       return File_Name_Type (The_Empty_String);
 444    end Empty_File;
 445
 446    -------------------
 447    -- Empty_Project --
 448    -------------------
 449
 450    function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
 451       Value : Project_Data;
 452
 453    begin
 454       Prj.Initialize (Tree => No_Project_Tree);
 455       Value := Project_Empty;
 456       Value.Naming := Tree.Private_Part.Default_Naming;
 457
 458       if Current_Mode = Multi_Language then
 459          Value.Config := Tree.Config;
 460       end if;
 461
 462       return Value;
 463    end Empty_Project;
 464
 465    ------------------
 466    -- Empty_String --
 467    ------------------
 468
 469    function Empty_String return Name_Id is
 470    begin
 471       return The_Empty_String;
 472    end Empty_String;
 473
 474    ------------
 475    -- Expect --
 476    ------------
 477
 478    procedure Expect (The_Token : Token_Type; Token_Image : String) is
 479    begin
 480       if Token /= The_Token then
 481          Error_Msg (Token_Image & " expected", Token_Ptr);
 482       end if;
 483    end Expect;
 484
 485    -----------------
 486    -- Extend_Name --
 487    -----------------
 488
 489    function Extend_Name
 490      (File        : File_Name_Type;
 491       With_Suffix : String) return File_Name_Type
 492    is
 493       Last : Positive;
 494
 495    begin
 496       Get_Name_String (File);
 497       Last := Name_Len + 1;
 498
 499       while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
 500          Name_Len := Name_Len - 1;
 501       end loop;
 502
 503       if Name_Len <= 1 then
 504          Name_Len := Last;
 505       end if;
 506
 507       for J in With_Suffix'Range loop
 508          Name_Buffer (Name_Len) := With_Suffix (J);
 509          Name_Len := Name_Len + 1;
 510       end loop;
 511
 512       Name_Len := Name_Len - 1;
 513       return Name_Find;
 514
 515    end Extend_Name;
 516
 517    --------------------------------
 518    -- For_Every_Project_Imported --
 519    --------------------------------
 520
 521    procedure For_Every_Project_Imported
 522      (By         : Project_Id;
 523       In_Tree    : Project_Tree_Ref;
 524       With_State : in out State)
 525    is
 526
 527       procedure Recursive_Check (Project : Project_Id);
 528       --  Check if a project has already been seen. If not seen, mark it as
 529       --  Seen, Call Action, and check all its imported projects.
 530
 531       ---------------------
 532       -- Recursive_Check --
 533       ---------------------
 534
 535       procedure Recursive_Check (Project : Project_Id) is
 536          List : Project_List;
 537       begin
 538          if not In_Tree.Projects.Table (Project).Seen then
 539             In_Tree.Projects.Table (Project).Seen := True;
 540             Action (Project, With_State);
 541
 542             List :=
 543               In_Tree.Projects.Table (Project).Imported_Projects;
 544             while List /= Empty_Project_List loop
 545                Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
 546                List := In_Tree.Project_Lists.Table (List).Next;
 547             end loop;
 548          end if;
 549       end Recursive_Check;
 550
 551    --  Start of processing for For_Every_Project_Imported
 552
 553    begin
 554       for Project in Project_Table.First ..
 555                      Project_Table.Last (In_Tree.Projects)
 556       loop
 557          In_Tree.Projects.Table (Project).Seen := False;
 558       end loop;
 559
 560       Recursive_Check (Project => By);
 561    end For_Every_Project_Imported;
 562
 563    --------------
 564    -- Get_Mode --
 565    --------------
 566
 567    function Get_Mode return Mode is
 568    begin
 569       return Current_Mode;
 570    end Get_Mode;
 571
 572    ----------
 573    -- Hash --
 574    ----------
 575
 576    function Hash (Name : File_Name_Type) return Header_Num is
 577    begin
 578       return Hash (Get_Name_String (Name));
 579    end Hash;
 580
 581    function Hash (Name : Name_Id) return Header_Num is
 582    begin
 583       return Hash (Get_Name_String (Name));
 584    end Hash;
 585
 586    function Hash (Name : Path_Name_Type) return Header_Num is
 587    begin
 588       return Hash (Get_Name_String (Name));
 589    end Hash;
 590
 591    -----------
 592    -- Image --
 593    -----------
 594
 595    function Image (Casing : Casing_Type) return String is
 596    begin
 597       return The_Casing_Images (Casing).all;
 598    end Image;
 599
 600    ----------------------
 601    -- In_Configuration --
 602    ----------------------
 603
 604    function In_Configuration return Boolean is
 605    begin
 606       return Configuration_Mode;
 607    end In_Configuration;
 608
 609    ----------------
 610    -- Initialize --
 611    ----------------
 612
 613    procedure Initialize (Tree : Project_Tree_Ref) is
 614    begin
 615       if not Initialized then
 616          Initialized := True;
 617          Uintp.Initialize;
 618          Name_Len := 0;
 619          The_Empty_String := Name_Find;
 620          Empty_Name := The_Empty_String;
 621          Name_Len := 4;
 622          Name_Buffer (1 .. 4) := ".ads";
 623          Default_Ada_Spec_Suffix_Id := Name_Find;
 624          Name_Len := 4;
 625          Name_Buffer (1 .. 4) := ".adb";
 626          Default_Ada_Body_Suffix_Id := Name_Find;
 627          Name_Len := 1;
 628          Name_Buffer (1) := '/';
 629          Slash_Id := Name_Find;
 630          Name_Len := 3;
 631          Name_Buffer (1 .. 3) := "c++";
 632          Name_C_Plus_Plus := Name_Find;
 633
 634          Prj.Env.Initialize;
 635          Prj.Attr.Initialize;
 636          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
 637          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
 638          Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
 639
 640          Language_Indexes.Reset;
 641          Last_Language_Index := No_Language_Index;
 642          Language_Names.Init;
 643          Add_Language_Name (Name_Ada);
 644          Add_Language_Name (Name_C);
 645          Add_Language_Name (Name_C_Plus_Plus);
 646       end if;
 647
 648       if Tree /= No_Project_Tree then
 649          Reset (Tree);
 650       end if;
 651    end Initialize;
 652
 653    -------------------
 654    -- Is_A_Language --
 655    -------------------
 656
 657    function Is_A_Language
 658      (Tree          : Project_Tree_Ref;
 659       Data          : Project_Data;
 660       Language_Name : String) return Boolean
 661    is
 662       Lang_Id : Name_Id;
 663
 664    begin
 665       Name_Len := 0;
 666       Add_Str_To_Name_Buffer (Language_Name);
 667       To_Lower (Name_Buffer (1 .. Name_Len));
 668       Lang_Id := Name_Find;
 669
 670       if Get_Mode = Ada_Only then
 671          declare
 672             List : Name_List_Index := Data.Languages;
 673
 674          begin
 675             while List /= No_Name_List loop
 676                if Tree.Name_Lists.Table (List).Name = Lang_Id then
 677                   return True;
 678
 679                else
 680                   List := Tree.Name_Lists.Table (List).Next;
 681                end if;
 682             end loop;
 683          end;
 684
 685       else
 686          declare
 687             Lang_Ind  : Language_Index;
 688             Lang_Data : Language_Data;
 689
 690          begin
 691             Lang_Ind := Data.First_Language_Processing;
 692             while Lang_Ind /= No_Language_Index loop
 693                Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
 694
 695                if Lang_Data.Name = Lang_Id then
 696                   return True;
 697                end if;
 698
 699                Lang_Ind := Lang_Data.Next;
 700             end loop;
 701          end;
 702       end if;
 703
 704       return False;
 705    end Is_A_Language;
 706
 707    ------------------
 708    -- Is_Extending --
 709    ------------------
 710
 711    function Is_Extending
 712      (Extending : Project_Id;
 713       Extended  : Project_Id;
 714       In_Tree   : Project_Tree_Ref) return Boolean
 715    is
 716       Proj : Project_Id;
 717
 718    begin
 719       Proj := Extending;
 720       while Proj /= No_Project loop
 721          if Proj = Extended then
 722             return True;
 723          end if;
 724
 725          Proj := In_Tree.Projects.Table (Proj).Extends;
 726       end loop;
 727
 728       return False;
 729    end Is_Extending;
 730
 731    ----------------
 732    -- Is_Present --
 733    ----------------
 734
 735    function Is_Present
 736      (Language   : Language_Index;
 737       In_Project : Project_Data;
 738       In_Tree    : Project_Tree_Ref) return Boolean
 739    is
 740    begin
 741       case Language is
 742          when No_Language_Index =>
 743             return False;
 744
 745          when First_Language_Indexes =>
 746             return In_Project.Langs (Language);
 747
 748          when others =>
 749             declare
 750                Supp : Supp_Language;
 751                Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
 752
 753             begin
 754                while Supp_Index /= No_Supp_Language_Index loop
 755                   Supp := In_Tree.Present_Languages.Table (Supp_Index);
 756
 757                   if Supp.Index = Language then
 758                      return Supp.Present;
 759                   end if;
 760
 761                   Supp_Index := Supp.Next;
 762                end loop;
 763
 764                return False;
 765             end;
 766       end case;
 767    end Is_Present;
 768
 769    ---------------------------------
 770    -- Language_Processing_Data_Of --
 771    ---------------------------------
 772
 773    function Language_Processing_Data_Of
 774      (Language   : Language_Index;
 775       In_Project : Project_Data;
 776       In_Tree    : Project_Tree_Ref) return Language_Processing_Data
 777    is
 778    begin
 779       case Language is
 780          when No_Language_Index =>
 781             return Default_Language_Processing_Data;
 782
 783          when First_Language_Indexes =>
 784             return In_Project.First_Lang_Processing (Language);
 785
 786          when others =>
 787             declare
 788                Supp : Supp_Language_Data;
 789                Supp_Index : Supp_Language_Index :=
 790                  In_Project.Supp_Language_Processing;
 791
 792             begin
 793                while Supp_Index /= No_Supp_Language_Index loop
 794                   Supp := In_Tree.Supp_Languages.Table (Supp_Index);
 795
 796                   if Supp.Index = Language then
 797                      return Supp.Data;
 798                   end if;
 799
 800                   Supp_Index := Supp.Next;
 801                end loop;
 802
 803                return Default_Language_Processing_Data;
 804             end;
 805       end case;
 806    end Language_Processing_Data_Of;
 807
 808    -----------------------
 809    -- Objects_Exist_For --
 810    -----------------------
 811
 812    function Objects_Exist_For
 813      (Language : String;
 814       In_Tree  : Project_Tree_Ref) return Boolean
 815    is
 816       Language_Id : Name_Id;
 817       Lang        : Language_Index;
 818
 819    begin
 820       if Current_Mode = Multi_Language then
 821          Name_Len := 0;
 822          Add_Str_To_Name_Buffer (Language);
 823          To_Lower (Name_Buffer (1 .. Name_Len));
 824          Language_Id := Name_Find;
 825
 826          Lang := In_Tree.First_Language;
 827
 828          while Lang /= No_Language_Index loop
 829             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 830                return
 831                  In_Tree.Languages_Data.Table
 832                    (Lang).Config.Objects_Generated;
 833             end if;
 834
 835             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 836          end loop;
 837       end if;
 838
 839       return True;
 840    end Objects_Exist_For;
 841
 842    -----------------
 843    -- Object_Name --
 844    -----------------
 845
 846    function Object_Name
 847      (Source_File_Name : File_Name_Type)
 848       return File_Name_Type
 849    is
 850    begin
 851       return Extend_Name (Source_File_Name, Object_Suffix);
 852    end Object_Name;
 853
 854    ----------------------
 855    -- Record_Temp_File --
 856    ----------------------
 857
 858    procedure Record_Temp_File (Path : Path_Name_Type) is
 859    begin
 860       Temp_Files.Increment_Last;
 861       Temp_Files.Table (Temp_Files.Last) := Path;
 862    end Record_Temp_File;
 863
 864    ------------------------------------
 865    -- Register_Default_Naming_Scheme --
 866    ------------------------------------
 867
 868    procedure Register_Default_Naming_Scheme
 869      (Language            : Name_Id;
 870       Default_Spec_Suffix : File_Name_Type;
 871       Default_Body_Suffix : File_Name_Type;
 872       In_Tree             : Project_Tree_Ref)
 873    is
 874       Lang : Name_Id;
 875       Suffix : Array_Element_Id;
 876       Found : Boolean := False;
 877       Element : Array_Element;
 878
 879    begin
 880       --  Get the language name in small letters
 881
 882       Get_Name_String (Language);
 883       Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
 884       Lang := Name_Find;
 885
 886       Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
 887       Found := False;
 888
 889       --  Look for an element of the spec sufix array indexed by the language
 890       --  name. If one is found, put the default value.
 891
 892       while Suffix /= No_Array_Element and then not Found loop
 893          Element := In_Tree.Array_Elements.Table (Suffix);
 894
 895          if Element.Index = Lang then
 896             Found := True;
 897             Element.Value.Value := Name_Id (Default_Spec_Suffix);
 898             In_Tree.Array_Elements.Table (Suffix) := Element;
 899
 900          else
 901             Suffix := Element.Next;
 902          end if;
 903       end loop;
 904
 905       --  If none can be found, create a new one
 906
 907       if not Found then
 908          Element :=
 909            (Index     => Lang,
 910             Src_Index => 0,
 911             Index_Case_Sensitive => False,
 912             Value => (Project  => No_Project,
 913                       Kind     => Single,
 914                       Location => No_Location,
 915                       Default  => False,
 916                       Value    => Name_Id (Default_Spec_Suffix),
 917                       Index    => 0),
 918             Next  => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
 919          Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 920          In_Tree.Array_Elements.Table
 921            (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
 922             Element;
 923          In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
 924            Array_Element_Table.Last (In_Tree.Array_Elements);
 925       end if;
 926
 927       Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
 928       Found := False;
 929
 930       --  Look for an element of the body sufix array indexed by the language
 931       --  name. If one is found, put the default value.
 932
 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 := In_Project.Supp_Languages;
1066
1067             begin
1068                while Supp_Index /= No_Supp_Language_Index loop
1069                   Supp := In_Tree.Present_Languages.Table
1070                                                                 (Supp_Index);
1071
1072                   if Supp.Index = Language then
1073                      In_Tree.Present_Languages.Table
1074                                             (Supp_Index).Present := 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 := Present_Language_Table.Last
1086                  (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                  In_Project.Naming.Supp_Suffixes;
1159
1160             begin
1161                while Supp_Index /= No_Supp_Language_Index loop
1162                   Supp := In_Tree.Supp_Suffixes.Table
1163                                                             (Supp_Index);
1164
1165                   if Supp.Index = For_Language then
1166                      In_Tree.Supp_Suffixes.Table
1167                        (Supp_Index).Suffix := Suffix;
1168                      return;
1169                   end if;
1170
1171                   Supp_Index := Supp.Next;
1172                end loop;
1173
1174                Supp := (Index => For_Language, Suffix => Suffix,
1175                         Next  => In_Project.Naming.Supp_Suffixes);
1176                Supp_Suffix_Table.Increment_Last
1177                  (In_Tree.Supp_Suffixes);
1178                Supp_Index := Supp_Suffix_Table.Last
1179                  (In_Tree.Supp_Suffixes);
1180                In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
1181                In_Project.Naming.Supp_Suffixes := Supp_Index;
1182             end;
1183       end case;
1184    end Set;
1185
1186    ---------------------
1187    -- Set_Body_Suffix --
1188    ---------------------
1189
1190    procedure Set_Body_Suffix
1191      (In_Tree  : Project_Tree_Ref;
1192       Language : String;
1193       Naming   : in out Naming_Data;
1194       Suffix   : File_Name_Type)
1195    is
1196       Language_Id : Name_Id;
1197       Element     : Array_Element;
1198
1199    begin
1200       Name_Len := 0;
1201       Add_Str_To_Name_Buffer (Language);
1202       To_Lower (Name_Buffer (1 .. Name_Len));
1203       Language_Id := Name_Find;
1204
1205       Element :=
1206         (Index                => Language_Id,
1207          Src_Index            => 0,
1208          Index_Case_Sensitive => False,
1209          Value                =>
1210            (Kind     => Single,
1211             Project  => No_Project,
1212             Location => No_Location,
1213             Default  => False,
1214             Value    => Name_Id (Suffix),
1215             Index    => 0),
1216          Next                 => Naming.Body_Suffix);
1217
1218       Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1219       Naming.Body_Suffix :=
1220          Array_Element_Table.Last (In_Tree.Array_Elements);
1221       In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1222    end Set_Body_Suffix;
1223
1224    --------------------------
1225    -- Set_In_Configuration --
1226    --------------------------
1227
1228    procedure Set_In_Configuration (Value : Boolean) is
1229    begin
1230       Configuration_Mode := Value;
1231    end Set_In_Configuration;
1232
1233    --------------
1234    -- Set_Mode --
1235    --------------
1236
1237    procedure Set_Mode (New_Mode : Mode) is
1238    begin
1239       Current_Mode := New_Mode;
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       Element_Id  : Array_Element_Id;
1300       Element     : Array_Element;
1301       Suffix      : File_Name_Type := No_File;
1302       Lang        : Language_Index;
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       Element_Id := Naming.Spec_Suffix;
1311
1312       while Element_Id /= No_Array_Element loop
1313          Element := In_Tree.Array_Elements.Table (Element_Id);
1314
1315          if Element.Index = Language_Id then
1316             return File_Name_Type (Element.Value.Value);
1317          end if;
1318
1319          Element_Id := Element.Next;
1320       end loop;
1321
1322       if Current_Mode = Multi_Language then
1323          Lang := In_Tree.First_Language;
1324
1325          while Lang /= No_Language_Index loop
1326             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1327                Suffix :=
1328                  In_Tree.Languages_Data.Table
1329                    (Lang).Config.Naming_Data.Spec_Suffix;
1330                exit;
1331             end if;
1332
1333             Lang := In_Tree.Languages_Data.Table (Lang).Next;
1334          end loop;
1335       end if;
1336
1337       return Suffix;
1338    end Spec_Suffix_Id_Of;
1339
1340    --------------------
1341    -- Spec_Suffix_Of --
1342    --------------------
1343
1344    function Spec_Suffix_Of
1345      (In_Tree  : Project_Tree_Ref;
1346       Language : String;
1347       Naming   : Naming_Data) return String
1348    is
1349       Language_Id : Name_Id;
1350       Element_Id  : Array_Element_Id;
1351       Element     : Array_Element;
1352       Suffix      : File_Name_Type := No_File;
1353       Lang        : Language_Index;
1354
1355    begin
1356       Name_Len := 0;
1357       Add_Str_To_Name_Buffer (Language);
1358       To_Lower (Name_Buffer (1 .. Name_Len));
1359       Language_Id := Name_Find;
1360
1361       Element_Id := Naming.Spec_Suffix;
1362
1363       while Element_Id /= No_Array_Element loop
1364          Element := In_Tree.Array_Elements.Table (Element_Id);
1365
1366          if Element.Index = Language_Id then
1367             return Get_Name_String (Element.Value.Value);
1368          end if;
1369
1370          Element_Id := Element.Next;
1371       end loop;
1372
1373       if Current_Mode = Multi_Language then
1374          Lang := In_Tree.First_Language;
1375
1376          while Lang /= No_Language_Index loop
1377             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1378                Suffix :=
1379                  File_Name_Type
1380                    (In_Tree.Languages_Data.Table
1381                       (Lang).Config.Naming_Data.Spec_Suffix);
1382                exit;
1383             end if;
1384
1385             Lang := In_Tree.Languages_Data.Table (Lang).Next;
1386          end loop;
1387
1388          if Suffix /= No_File then
1389             return Get_Name_String (Suffix);
1390          end if;
1391       end if;
1392
1393       return "";
1394    end Spec_Suffix_Of;
1395
1396    --------------------------
1397    -- Standard_Naming_Data --
1398    --------------------------
1399
1400    function Standard_Naming_Data
1401      (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1402    is
1403    begin
1404       if Tree = No_Project_Tree then
1405          Prj.Initialize (Tree => No_Project_Tree);
1406          return Std_Naming_Data;
1407
1408       else
1409          return Tree.Private_Part.Default_Naming;
1410       end if;
1411    end Standard_Naming_Data;
1412
1413    ---------------
1414    -- Suffix_Of --
1415    ---------------
1416
1417    function Suffix_Of
1418      (Language   : Language_Index;
1419       In_Project : Project_Data;
1420       In_Tree    : Project_Tree_Ref) return File_Name_Type
1421    is
1422    begin
1423       case Language is
1424          when No_Language_Index =>
1425             return No_File;
1426
1427          when First_Language_Indexes =>
1428             return In_Project.Naming.Impl_Suffixes (Language);
1429
1430          when others =>
1431             declare
1432                Supp : Supp_Suffix;
1433                Supp_Index : Supp_Language_Index :=
1434                  In_Project.Naming.Supp_Suffixes;
1435
1436             begin
1437                while Supp_Index /= No_Supp_Language_Index loop
1438                   Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
1439
1440                   if Supp.Index = Language then
1441                      return Supp.Suffix;
1442                   end if;
1443
1444                   Supp_Index := Supp.Next;
1445                end loop;
1446
1447                return No_File;
1448             end;
1449       end case;
1450    end  Suffix_Of;
1451
1452    -------------------
1453    -- Switches_Name --
1454    -------------------
1455
1456    function Switches_Name
1457      (Source_File_Name : File_Name_Type) return File_Name_Type
1458    is
1459    begin
1460       return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1461    end Switches_Name;
1462
1463    ---------------------------
1464    -- There_Are_Ada_Sources --
1465    ---------------------------
1466
1467    function There_Are_Ada_Sources
1468      (In_Tree : Project_Tree_Ref;
1469       Project : Project_Id) return Boolean
1470    is
1471       Prj : Project_Id;
1472
1473    begin
1474       Prj := Project;
1475       while Prj /= No_Project loop
1476          if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
1477             return True;
1478          end if;
1479
1480          Prj := In_Tree.Projects.Table (Prj).Extends;
1481       end loop;
1482
1483       return False;
1484    end There_Are_Ada_Sources;
1485
1486    -----------
1487    -- Value --
1488    -----------
1489
1490    function Value (Image : String) return Casing_Type is
1491    begin
1492       for Casing in The_Casing_Images'Range loop
1493          if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1494             return Casing;
1495          end if;
1496       end loop;
1497
1498       raise Constraint_Error;
1499    end Value;
1500
1501 begin
1502    --  Make sure that the standard config and user project file extensions are
1503    --  compatible with canonical case file naming.
1504
1505    Canonical_Case_File_Name (Config_Project_File_Extension);
1506    Canonical_Case_File_Name (Project_File_Extension);
1507 end Prj;