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