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