gcc/ada/prj.adb

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