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 Table;
  36 with Uintp;    use Uintp;
  37
  38 with System.Case_Util; use System.Case_Util;
  39 with System.HTable;
  40
  41 package body Prj is
  42
  43    Object_Suffix : constant String := Get_Target_Object_Suffix.all;
  44    --  File suffix for object files
  45
  46    Initial_Buffer_Size : constant := 100;
  47    --  Initial size for extensible buffer used in Add_To_Buffer
  48
  49    Current_Mode : Mode := Ada_Only;
  50
  51    Configuration_Mode : Boolean := False;
  52
  53    The_Empty_String : 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
  88    Project_Empty : constant Project_Data :=
  89                      (Qualifier                      => Unspecified,
  90                       Externally_Built               => False,
  91                       Config                         => Default_Project_Config,
  92                       Languages                      => No_Name_List,
  93                       First_Referred_By              => No_Project,
  94                       Name                           => No_Name,
  95                       Display_Name                   => No_Name,
  96                       Path                           => No_Path_Information,
  97                       Virtual                        => False,
  98                       Location                       => No_Location,
  99                       Mains                          => Nil_String,
 100                       Directory                      => No_Path_Information,
 101                       Dir_Path                       => null,
 102                       Library                        => False,
 103                       Library_Dir                    => No_Path_Information,
 104                       Library_Src_Dir                => No_Path_Information,
 105                       Library_ALI_Dir                => No_Path_Information,
 106                       Library_Name                   => No_Name,
 107                       Library_Kind                   => Static,
 108                       Lib_Internal_Name              => No_Name,
 109                       Standalone_Library             => False,
 110                       Lib_Interface_ALIs             => Nil_String,
 111                       Lib_Auto_Init                  => False,
 112                       Libgnarl_Needed                => Unknown,
 113                       Symbol_Data                    => No_Symbols,
 114                       Ada_Sources_Present            => True,
 115                       Other_Sources_Present          => True,
 116                       Ada_Sources                    => Nil_String,
 117                       First_Source                   => No_Source,
 118                       Last_Source                    => No_Source,
 119                       Interfaces_Defined             => False,
 120                       Unit_Based_Language_Name       => No_Name,
 121                       Unit_Based_Language_Index      => No_Language_Index,
 122                       Imported_Directories_Switches  => null,
 123                       Include_Path                   => null,
 124                       Include_Data_Set               => False,
 125                       Include_Language               => No_Language_Index,
 126                       Source_Dirs                    => Nil_String,
 127                       Known_Order_Of_Source_Dirs     => True,
 128                       Object_Directory               => No_Path_Information,
 129                       Library_TS                     => Empty_Time_Stamp,
 130                       Exec_Directory                 => No_Path_Information,
 131                       Extends                        => No_Project,
 132                       Extended_By                    => No_Project,
 133                       Naming                         => Std_Naming_Data,
 134                       First_Language_Processing      => No_Language_Index,
 135                       Decl                           => No_Declarations,
 136                       Imported_Projects              => Empty_Project_List,
 137                       All_Imported_Projects          => Empty_Project_List,
 138                       Ada_Include_Path               => null,
 139                       Ada_Objects_Path               => null,
 140                       Objects_Path                   => null,
 141                       Include_Path_File              => No_Path,
 142                       Objects_Path_File_With_Libs    => No_Path,
 143                       Objects_Path_File_Without_Libs => No_Path,
 144                       Config_File_Name               => No_Path,
 145                       Config_File_Temp               => False,
 146                       Config_Checked                 => False,
 147                       Checked                        => False,
 148                       Seen                           => False,
 149                       Need_To_Build_Lib              => False,
 150                       Depth                          => 0,
 151                       Unkept_Comments                => False);
 152
 153    package Temp_Files is new Table.Table
 154      (Table_Component_Type => Path_Name_Type,
 155       Table_Index_Type     => Integer,
 156       Table_Low_Bound      => 1,
 157       Table_Initial        => 20,
 158       Table_Increment      => 100,
 159       Table_Name           => "Makegpr.Temp_Files");
 160    --  Table to store the path name of all the created temporary files, so that
 161    --  they can be deleted at the end, or when the program is interrupted.
 162
 163    -------------------
 164    -- Add_To_Buffer --
 165    -------------------
 166
 167    procedure Add_To_Buffer
 168      (S    : String;
 169       To   : in out String_Access;
 170       Last : in out Natural)
 171    is
 172    begin
 173       if To = null then
 174          To := new String (1 .. Initial_Buffer_Size);
 175          Last := 0;
 176       end if;
 177
 178       --  If Buffer is too small, double its size
 179
 180       while Last + S'Length > To'Last loop
 181          declare
 182             New_Buffer : constant  String_Access :=
 183                            new String (1 .. 2 * Last);
 184
 185          begin
 186             New_Buffer (1 .. Last) := To (1 .. Last);
 187             Free (To);
 188             To := New_Buffer;
 189          end;
 190       end loop;
 191
 192       To (Last + 1 .. Last + S'Length) := S;
 193       Last := Last + S'Length;
 194    end Add_To_Buffer;
 195
 196    -----------------------
 197    -- Body_Suffix_Id_Of --
 198    -----------------------
 199
 200    function Body_Suffix_Id_Of
 201      (In_Tree  : Project_Tree_Ref;
 202       Language : String;
 203       Naming   : Naming_Data) return File_Name_Type
 204    is
 205       Language_Id : Name_Id;
 206
 207    begin
 208       Name_Len := 0;
 209       Add_Str_To_Name_Buffer (Language);
 210       To_Lower (Name_Buffer (1 .. Name_Len));
 211       Language_Id := Name_Find;
 212
 213       return
 214         Body_Suffix_Id_Of
 215           (In_Tree     => In_Tree,
 216            Language_Id => Language_Id,
 217            Naming      => Naming);
 218    end Body_Suffix_Id_Of;
 219
 220    -----------------------
 221    -- Body_Suffix_Id_Of --
 222    -----------------------
 223
 224    function Body_Suffix_Id_Of
 225      (In_Tree     : Project_Tree_Ref;
 226       Language_Id : Name_Id;
 227       Naming      : Naming_Data) return File_Name_Type
 228    is
 229       Element_Id : Array_Element_Id;
 230       Element    : Array_Element;
 231       Suffix     : File_Name_Type := No_File;
 232       Lang       : Language_Index;
 233
 234    begin
 235       --  ??? This seems to be only for Ada_Only mode...
 236       Element_Id := Naming.Body_Suffix;
 237       while Element_Id /= No_Array_Element loop
 238          Element := In_Tree.Array_Elements.Table (Element_Id);
 239
 240          if Element.Index = Language_Id then
 241             return File_Name_Type (Element.Value.Value);
 242          end if;
 243
 244          Element_Id := Element.Next;
 245       end loop;
 246
 247       if Current_Mode = Multi_Language then
 248          Lang := In_Tree.First_Language;
 249          while Lang /= No_Language_Index loop
 250             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 251                Suffix :=
 252                  In_Tree.Languages_Data.Table
 253                    (Lang).Config.Naming_Data.Body_Suffix;
 254                exit;
 255             end if;
 256
 257             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 258          end loop;
 259       end if;
 260
 261       return Suffix;
 262    end Body_Suffix_Id_Of;
 263
 264    --------------------
 265    -- Body_Suffix_Of --
 266    --------------------
 267
 268    function Body_Suffix_Of
 269      (In_Tree  : Project_Tree_Ref;
 270       Language : String;
 271       Naming   : Naming_Data) return String
 272    is
 273       Language_Id : Name_Id;
 274       Element_Id  : Array_Element_Id;
 275       Element     : Array_Element;
 276       Suffix      : File_Name_Type := No_File;
 277       Lang        : Language_Index;
 278
 279    begin
 280       Name_Len := 0;
 281       Add_Str_To_Name_Buffer (Language);
 282       To_Lower (Name_Buffer (1 .. Name_Len));
 283       Language_Id := Name_Find;
 284
 285       Element_Id := Naming.Body_Suffix;
 286       while Element_Id /= No_Array_Element loop
 287          Element := In_Tree.Array_Elements.Table (Element_Id);
 288
 289          if Element.Index = Language_Id then
 290             return Get_Name_String (Element.Value.Value);
 291          end if;
 292
 293          Element_Id := Element.Next;
 294       end loop;
 295
 296       if Current_Mode = Multi_Language then
 297          Lang := In_Tree.First_Language;
 298          while Lang /= No_Language_Index loop
 299             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 300                Suffix :=
 301                  File_Name_Type
 302                    (In_Tree.Languages_Data.Table
 303                         (Lang).Config.Naming_Data.Body_Suffix);
 304                exit;
 305             end if;
 306
 307             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 308          end loop;
 309
 310          if Suffix /= No_File then
 311             return Get_Name_String (Suffix);
 312          end if;
 313       end if;
 314
 315       return "";
 316    end Body_Suffix_Of;
 317
 318    -----------------------------
 319    -- Default_Ada_Body_Suffix --
 320    -----------------------------
 321
 322    function Default_Ada_Body_Suffix return File_Name_Type is
 323    begin
 324       return Default_Ada_Body_Suffix_Id;
 325    end Default_Ada_Body_Suffix;
 326
 327    -----------------------------
 328    -- Default_Ada_Spec_Suffix --
 329    -----------------------------
 330
 331    function Default_Ada_Spec_Suffix return File_Name_Type is
 332    begin
 333       return Default_Ada_Spec_Suffix_Id;
 334    end Default_Ada_Spec_Suffix;
 335
 336    ---------------------------
 337    -- Delete_All_Temp_Files --
 338    ---------------------------
 339
 340    procedure Delete_All_Temp_Files is
 341       Dont_Care : Boolean;
 342       pragma Warnings (Off, Dont_Care);
 343    begin
 344       if not Debug.Debug_Flag_N then
 345          for Index in 1 .. Temp_Files.Last loop
 346             Delete_File
 347               (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
 348          end loop;
 349       end if;
 350    end Delete_All_Temp_Files;
 351
 352    ---------------------
 353    -- Dependency_Name --
 354    ---------------------
 355
 356    function Dependency_Name
 357      (Source_File_Name : File_Name_Type;
 358       Dependency       : Dependency_File_Kind) return File_Name_Type
 359    is
 360    begin
 361       case Dependency is
 362          when None =>
 363             return No_File;
 364
 365          when Makefile =>
 366             return
 367               File_Name_Type
 368                 (Extend_Name
 369                    (Source_File_Name, Makefile_Dependency_Suffix));
 370
 371          when ALI_File =>
 372             return
 373               File_Name_Type
 374                 (Extend_Name
 375                    (Source_File_Name, ALI_Dependency_Suffix));
 376       end case;
 377    end Dependency_Name;
 378
 379    ---------------------------
 380    -- Display_Language_Name --
 381    ---------------------------
 382
 383    procedure Display_Language_Name
 384      (In_Tree  : Project_Tree_Ref;
 385       Language : Language_Index)
 386    is
 387    begin
 388       Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
 389       Write_Str (Name_Buffer (1 .. Name_Len));
 390    end Display_Language_Name;
 391
 392    ----------------
 393    -- Empty_File --
 394    ----------------
 395
 396    function Empty_File return File_Name_Type is
 397    begin
 398       return File_Name_Type (The_Empty_String);
 399    end Empty_File;
 400
 401    -------------------
 402    -- Empty_Project --
 403    -------------------
 404
 405    function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
 406       Value : Project_Data;
 407
 408    begin
 409       Prj.Initialize (Tree => No_Project_Tree);
 410       Value := Project_Empty;
 411       Value.Naming := Tree.Private_Part.Default_Naming;
 412
 413       return Value;
 414    end Empty_Project;
 415
 416    ------------------
 417    -- Empty_String --
 418    ------------------
 419
 420    function Empty_String return Name_Id is
 421    begin
 422       return The_Empty_String;
 423    end Empty_String;
 424
 425    ------------
 426    -- Expect --
 427    ------------
 428
 429    procedure Expect (The_Token : Token_Type; Token_Image : String) is
 430    begin
 431       if Token /= The_Token then
 432          Error_Msg (Token_Image & " expected", Token_Ptr);
 433       end if;
 434    end Expect;
 435
 436    -----------------
 437    -- Extend_Name --
 438    -----------------
 439
 440    function Extend_Name
 441      (File        : File_Name_Type;
 442       With_Suffix : String) return File_Name_Type
 443    is
 444       Last : Positive;
 445
 446    begin
 447       Get_Name_String (File);
 448       Last := Name_Len + 1;
 449
 450       while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
 451          Name_Len := Name_Len - 1;
 452       end loop;
 453
 454       if Name_Len <= 1 then
 455          Name_Len := Last;
 456       end if;
 457
 458       for J in With_Suffix'Range loop
 459          Name_Buffer (Name_Len) := With_Suffix (J);
 460          Name_Len := Name_Len + 1;
 461       end loop;
 462
 463       Name_Len := Name_Len - 1;
 464       return Name_Find;
 465
 466    end Extend_Name;
 467
 468    --------------------------------
 469    -- For_Every_Project_Imported --
 470    --------------------------------
 471
 472    procedure For_Every_Project_Imported
 473      (By         : Project_Id;
 474       In_Tree    : Project_Tree_Ref;
 475       With_State : in out State)
 476    is
 477
 478       procedure Recursive_Check (Project : Project_Id);
 479       --  Check if a project has already been seen. If not seen, mark it as
 480       --  Seen, Call Action, and check all its imported projects.
 481
 482       ---------------------
 483       -- Recursive_Check --
 484       ---------------------
 485
 486       procedure Recursive_Check (Project : Project_Id) is
 487          List : Project_List;
 488       begin
 489          if not In_Tree.Projects.Table (Project).Seen then
 490             In_Tree.Projects.Table (Project).Seen := True;
 491             Action (Project, With_State);
 492
 493             List := In_Tree.Projects.Table (Project).Imported_Projects;
 494             while List /= Empty_Project_List loop
 495                Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
 496                List := In_Tree.Project_Lists.Table (List).Next;
 497             end loop;
 498          end if;
 499       end Recursive_Check;
 500
 501    --  Start of processing for For_Every_Project_Imported
 502
 503    begin
 504       for Project in Project_Table.First ..
 505                      Project_Table.Last (In_Tree.Projects)
 506       loop
 507          In_Tree.Projects.Table (Project).Seen := False;
 508       end loop;
 509
 510       Recursive_Check (Project => By);
 511    end For_Every_Project_Imported;
 512
 513    --------------
 514    -- Get_Mode --
 515    --------------
 516
 517    function Get_Mode return Mode is
 518    begin
 519       return Current_Mode;
 520    end Get_Mode;
 521
 522    ----------
 523    -- Hash --
 524    ----------
 525
 526    function Hash is new System.HTable.Hash (Header_Num => Header_Num);
 527    --  Used in implementation of other functions Hash below
 528
 529    function Hash (Name : File_Name_Type) return Header_Num is
 530    begin
 531       return Hash (Get_Name_String (Name));
 532    end Hash;
 533
 534    function Hash (Name : Name_Id) return Header_Num is
 535    begin
 536       return Hash (Get_Name_String (Name));
 537    end Hash;
 538
 539    function Hash (Name : Path_Name_Type) return Header_Num is
 540    begin
 541       return Hash (Get_Name_String (Name));
 542    end Hash;
 543
 544    function Hash (Project : Project_Id) return Header_Num is
 545    begin
 546       return Header_Num (Project mod Max_Header_Num);
 547    end Hash;
 548
 549    -----------
 550    -- Image --
 551    -----------
 552
 553    function Image (Casing : Casing_Type) return String is
 554    begin
 555       return The_Casing_Images (Casing).all;
 556    end Image;
 557
 558    ----------------------
 559    -- In_Configuration --
 560    ----------------------
 561
 562    function In_Configuration return Boolean is
 563    begin
 564       return Configuration_Mode;
 565    end In_Configuration;
 566
 567    ----------------
 568    -- Initialize --
 569    ----------------
 570
 571    procedure Initialize (Tree : Project_Tree_Ref) is
 572    begin
 573       if not Initialized then
 574          Initialized := True;
 575          Uintp.Initialize;
 576          Name_Len := 0;
 577          The_Empty_String := Name_Find;
 578          Empty_Name := The_Empty_String;
 579          Empty_File_Name := File_Name_Type (The_Empty_String);
 580          Name_Len := 4;
 581          Name_Buffer (1 .. 4) := ".ads";
 582          Default_Ada_Spec_Suffix_Id := Name_Find;
 583          Name_Len := 4;
 584          Name_Buffer (1 .. 4) := ".adb";
 585          Default_Ada_Body_Suffix_Id := Name_Find;
 586          Name_Len := 1;
 587          Name_Buffer (1) := '/';
 588          Slash_Id := Name_Find;
 589
 590          Prj.Env.Initialize;
 591          Prj.Attr.Initialize;
 592          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
 593          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
 594          Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
 595       end if;
 596
 597       if Tree /= No_Project_Tree then
 598          Reset (Tree);
 599       end if;
 600    end Initialize;
 601
 602    -------------------
 603    -- Is_A_Language --
 604    -------------------
 605
 606    function Is_A_Language
 607      (Tree          : Project_Tree_Ref;
 608       Data          : Project_Data;
 609       Language_Name : Name_Id) return Boolean
 610    is
 611    begin
 612       if Get_Mode = Ada_Only then
 613          declare
 614             List : Name_List_Index := Data.Languages;
 615          begin
 616             while List /= No_Name_List loop
 617                if Tree.Name_Lists.Table (List).Name = Language_Name then
 618                   return True;
 619                else
 620                   List := Tree.Name_Lists.Table (List).Next;
 621                end if;
 622             end loop;
 623          end;
 624
 625       else
 626          declare
 627             Lang_Ind  : Language_Index := Data.First_Language_Processing;
 628             Lang_Data : Language_Data;
 629
 630          begin
 631             while Lang_Ind /= No_Language_Index loop
 632                Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
 633
 634                if Lang_Data.Name = Language_Name then
 635                   return True;
 636                end if;
 637
 638                Lang_Ind := Lang_Data.Next;
 639             end loop;
 640          end;
 641       end if;
 642
 643       return False;
 644    end Is_A_Language;
 645
 646    ------------------
 647    -- Is_Extending --
 648    ------------------
 649
 650    function Is_Extending
 651      (Extending : Project_Id;
 652       Extended  : Project_Id;
 653       In_Tree   : Project_Tree_Ref) return Boolean
 654    is
 655       Proj : Project_Id;
 656
 657    begin
 658       Proj := Extending;
 659       while Proj /= No_Project loop
 660          if Proj = Extended then
 661             return True;
 662          end if;
 663
 664          Proj := In_Tree.Projects.Table (Proj).Extends;
 665       end loop;
 666
 667       return False;
 668    end Is_Extending;
 669
 670    -----------------------
 671    -- Objects_Exist_For --
 672    -----------------------
 673
 674    function Objects_Exist_For
 675      (Language : String;
 676       In_Tree  : Project_Tree_Ref) return Boolean
 677    is
 678       Language_Id : Name_Id;
 679       Lang        : Language_Index;
 680
 681    begin
 682       if Current_Mode = Multi_Language then
 683          Name_Len := 0;
 684          Add_Str_To_Name_Buffer (Language);
 685          To_Lower (Name_Buffer (1 .. Name_Len));
 686          Language_Id := Name_Find;
 687
 688          Lang := In_Tree.First_Language;
 689          while Lang /= No_Language_Index loop
 690             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
 691                return
 692                  In_Tree.Languages_Data.Table
 693                    (Lang).Config.Object_Generated;
 694             end if;
 695
 696             Lang := In_Tree.Languages_Data.Table (Lang).Next;
 697          end loop;
 698       end if;
 699
 700       return True;
 701    end Objects_Exist_For;
 702
 703    -----------------
 704    -- Object_Name --
 705    -----------------
 706
 707    function Object_Name
 708      (Source_File_Name : File_Name_Type)
 709       return File_Name_Type
 710    is
 711    begin
 712       return Extend_Name (Source_File_Name, Object_Suffix);
 713    end Object_Name;
 714
 715    ----------------------
 716    -- Record_Temp_File --
 717    ----------------------
 718
 719    procedure Record_Temp_File (Path : Path_Name_Type) is
 720    begin
 721       Temp_Files.Increment_Last;
 722       Temp_Files.Table (Temp_Files.Last) := Path;
 723    end Record_Temp_File;
 724
 725    ------------------------------------
 726    -- Register_Default_Naming_Scheme --
 727    ------------------------------------
 728
 729    procedure Register_Default_Naming_Scheme
 730      (Language            : Name_Id;
 731       Default_Spec_Suffix : File_Name_Type;
 732       Default_Body_Suffix : File_Name_Type;
 733       In_Tree             : Project_Tree_Ref)
 734    is
 735       Lang : Name_Id;
 736       Suffix : Array_Element_Id;
 737       Found : Boolean := False;
 738       Element : Array_Element;
 739
 740    begin
 741       --  Get the language name in small letters
 742
 743       Get_Name_String (Language);
 744       Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
 745       Lang := Name_Find;
 746
 747       --  Look for an element of the spec suffix array indexed by the language
 748       --  name. If one is found, put the default value.
 749
 750       Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
 751       Found := False;
 752       while Suffix /= No_Array_Element and then not Found loop
 753          Element := In_Tree.Array_Elements.Table (Suffix);
 754
 755          if Element.Index = Lang then
 756             Found := True;
 757             Element.Value.Value := Name_Id (Default_Spec_Suffix);
 758             In_Tree.Array_Elements.Table (Suffix) := Element;
 759
 760          else
 761             Suffix := Element.Next;
 762          end if;
 763       end loop;
 764
 765       --  If none can be found, create a new one
 766
 767       if not Found then
 768          Element :=
 769            (Index     => Lang,
 770             Src_Index => 0,
 771             Index_Case_Sensitive => False,
 772             Value => (Project  => No_Project,
 773                       Kind     => Single,
 774                       Location => No_Location,
 775                       Default  => False,
 776                       Value    => Name_Id (Default_Spec_Suffix),
 777                       Index    => 0),
 778             Next  => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
 779          Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 780          In_Tree.Array_Elements.Table
 781            (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
 782             Element;
 783          In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
 784            Array_Element_Table.Last (In_Tree.Array_Elements);
 785       end if;
 786
 787       --  Look for an element of the body suffix array indexed by the language
 788       --  name. If one is found, put the default value.
 789
 790       Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
 791       Found := False;
 792       while Suffix /= No_Array_Element and then not Found loop
 793          Element := In_Tree.Array_Elements.Table (Suffix);
 794
 795          if Element.Index = Lang then
 796             Found := True;
 797             Element.Value.Value := Name_Id (Default_Body_Suffix);
 798             In_Tree.Array_Elements.Table (Suffix) := Element;
 799
 800          else
 801             Suffix := Element.Next;
 802          end if;
 803       end loop;
 804
 805       --  If none can be found, create a new one
 806
 807       if not Found then
 808          Element :=
 809            (Index     => Lang,
 810             Src_Index => 0,
 811             Index_Case_Sensitive => False,
 812             Value => (Project  => No_Project,
 813                       Kind     => Single,
 814                       Location => No_Location,
 815                       Default  => False,
 816                       Value    => Name_Id (Default_Body_Suffix),
 817                       Index    => 0),
 818             Next  => In_Tree.Private_Part.Default_Naming.Body_Suffix);
 819          Array_Element_Table.Increment_Last
 820            (In_Tree.Array_Elements);
 821          In_Tree.Array_Elements.Table
 822            (Array_Element_Table.Last (In_Tree.Array_Elements))
 823              := Element;
 824          In_Tree.Private_Part.Default_Naming.Body_Suffix :=
 825            Array_Element_Table.Last (In_Tree.Array_Elements);
 826       end if;
 827    end Register_Default_Naming_Scheme;
 828
 829    -----------
 830    -- Reset --
 831    -----------
 832
 833    procedure Reset (Tree : Project_Tree_Ref) is
 834
 835       --  Def_Lang : constant Name_Node :=
 836       --             (Name => Name_Ada,
 837       --              Next => No_Name_List);
 838       --  Why is the above commented out ???
 839
 840    begin
 841       Prj.Env.Initialize;
 842
 843       --  Visible tables
 844
 845       Language_Data_Table.Init      (Tree.Languages_Data);
 846       Name_List_Table.Init          (Tree.Name_Lists);
 847       String_Element_Table.Init     (Tree.String_Elements);
 848       Variable_Element_Table.Init   (Tree.Variable_Elements);
 849       Array_Element_Table.Init      (Tree.Array_Elements);
 850       Array_Table.Init              (Tree.Arrays);
 851       Package_Table.Init            (Tree.Packages);
 852       Project_List_Table.Init       (Tree.Project_Lists);
 853       Project_Table.Init            (Tree.Projects);
 854       Source_Data_Table.Init        (Tree.Sources);
 855       Alternate_Language_Table.Init (Tree.Alt_Langs);
 856       Unit_Table.Init               (Tree.Units);
 857       Units_Htable.Reset            (Tree.Units_HT);
 858       Files_Htable.Reset            (Tree.Files_HT);
 859       Source_Paths_Htable.Reset     (Tree.Source_Paths_HT);
 860
 861       --  Private part table
 862
 863       Naming_Table.Init             (Tree.Private_Part.Namings);
 864       Naming_Table.Increment_Last   (Tree.Private_Part.Namings);
 865       Tree.Private_Part.Namings.Table
 866         (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
 867       Path_File_Table.Init        (Tree.Private_Part.Path_Files);
 868       Source_Path_Table.Init      (Tree.Private_Part.Source_Paths);
 869       Object_Path_Table.Init      (Tree.Private_Part.Object_Paths);
 870       Tree.Private_Part.Default_Naming := Std_Naming_Data;
 871
 872       if Current_Mode = Ada_Only then
 873          Register_Default_Naming_Scheme
 874            (Language            => Name_Ada,
 875             Default_Spec_Suffix => Default_Ada_Spec_Suffix,
 876             Default_Body_Suffix => Default_Ada_Body_Suffix,
 877             In_Tree             => Tree);
 878          Tree.Private_Part.Default_Naming.Separate_Suffix :=
 879            Default_Ada_Body_Suffix;
 880       end if;
 881    end Reset;
 882
 883    ------------------------
 884    -- Same_Naming_Scheme --
 885    ------------------------
 886
 887    function Same_Naming_Scheme
 888      (Left, Right : Naming_Data) return Boolean
 889    is
 890    begin
 891       return Left.Dot_Replacement = Right.Dot_Replacement
 892         and then Left.Casing = Right.Casing
 893         and then Left.Separate_Suffix = Right.Separate_Suffix;
 894    end Same_Naming_Scheme;
 895
 896    ---------------------
 897    -- Set_Body_Suffix --
 898    ---------------------
 899
 900    procedure Set_Body_Suffix
 901      (In_Tree  : Project_Tree_Ref;
 902       Language : String;
 903       Naming   : in out Naming_Data;
 904       Suffix   : File_Name_Type)
 905    is
 906       Language_Id : Name_Id;
 907       Element     : Array_Element;
 908
 909    begin
 910       Name_Len := 0;
 911       Add_Str_To_Name_Buffer (Language);
 912       To_Lower (Name_Buffer (1 .. Name_Len));
 913       Language_Id := Name_Find;
 914
 915       Element :=
 916         (Index                => Language_Id,
 917          Src_Index            => 0,
 918          Index_Case_Sensitive => False,
 919          Value                =>
 920            (Kind     => Single,
 921             Project  => No_Project,
 922             Location => No_Location,
 923             Default  => False,
 924             Value    => Name_Id (Suffix),
 925             Index    => 0),
 926          Next                 => Naming.Body_Suffix);
 927
 928       Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 929       Naming.Body_Suffix :=
 930          Array_Element_Table.Last (In_Tree.Array_Elements);
 931       In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
 932    end Set_Body_Suffix;
 933
 934    --------------------------
 935    -- Set_In_Configuration --
 936    --------------------------
 937
 938    procedure Set_In_Configuration (Value : Boolean) is
 939    begin
 940       Configuration_Mode := Value;
 941    end Set_In_Configuration;
 942
 943    --------------
 944    -- Set_Mode --
 945    --------------
 946
 947    procedure Set_Mode (New_Mode : Mode) is
 948    begin
 949       Current_Mode := New_Mode;
 950       case New_Mode is
 951          when Ada_Only =>
 952             Default_Language_Is_Ada := True;
 953             Must_Check_Configuration := False;
 954          when Multi_Language =>
 955             Default_Language_Is_Ada := False;
 956             Must_Check_Configuration := True;
 957       end case;
 958    end Set_Mode;
 959
 960    ---------------------
 961    -- Set_Spec_Suffix --
 962    ---------------------
 963
 964    procedure Set_Spec_Suffix
 965      (In_Tree  : Project_Tree_Ref;
 966       Language : String;
 967       Naming   : in out Naming_Data;
 968       Suffix   : File_Name_Type)
 969    is
 970       Language_Id : Name_Id;
 971       Element     : Array_Element;
 972
 973    begin
 974       Name_Len := 0;
 975       Add_Str_To_Name_Buffer (Language);
 976       To_Lower (Name_Buffer (1 .. Name_Len));
 977       Language_Id := Name_Find;
 978
 979       Element :=
 980         (Index                => Language_Id,
 981          Src_Index            => 0,
 982          Index_Case_Sensitive => False,
 983          Value                =>
 984            (Kind     => Single,
 985             Project  => No_Project,
 986             Location => No_Location,
 987             Default  => False,
 988             Value    => Name_Id (Suffix),
 989             Index    => 0),
 990          Next                 => Naming.Spec_Suffix);
 991
 992       Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 993       Naming.Spec_Suffix :=
 994         Array_Element_Table.Last (In_Tree.Array_Elements);
 995       In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
 996    end Set_Spec_Suffix;
 997
 998    -----------
 999    -- Slash --
1000    -----------
1001
1002    function Slash return Path_Name_Type is
1003    begin
1004       return Slash_Id;
1005    end Slash;
1006
1007    -----------------------
1008    -- Spec_Suffix_Id_Of --
1009    -----------------------
1010
1011    function Spec_Suffix_Id_Of
1012      (In_Tree  : Project_Tree_Ref;
1013       Language : String;
1014       Naming   : Naming_Data) return File_Name_Type
1015    is
1016       Language_Id : Name_Id;
1017
1018    begin
1019       Name_Len := 0;
1020       Add_Str_To_Name_Buffer (Language);
1021       To_Lower (Name_Buffer (1 .. Name_Len));
1022       Language_Id := Name_Find;
1023
1024       return
1025         Spec_Suffix_Id_Of
1026           (In_Tree     => In_Tree,
1027            Language_Id => Language_Id,
1028            Naming      => Naming);
1029    end Spec_Suffix_Id_Of;
1030
1031    -----------------------
1032    -- Spec_Suffix_Id_Of --
1033    -----------------------
1034
1035    function Spec_Suffix_Id_Of
1036      (In_Tree     : Project_Tree_Ref;
1037       Language_Id : Name_Id;
1038       Naming      : Naming_Data) return File_Name_Type
1039    is
1040       Element_Id : Array_Element_Id;
1041       Element    : Array_Element;
1042       Suffix     : File_Name_Type := No_File;
1043       Lang       : Language_Index;
1044
1045    begin
1046       Element_Id := Naming.Spec_Suffix;
1047       while Element_Id /= No_Array_Element loop
1048          Element := In_Tree.Array_Elements.Table (Element_Id);
1049
1050          if Element.Index = Language_Id then
1051             return File_Name_Type (Element.Value.Value);
1052          end if;
1053
1054          Element_Id := Element.Next;
1055       end loop;
1056
1057       if Current_Mode = Multi_Language then
1058          Lang := In_Tree.First_Language;
1059          while Lang /= No_Language_Index loop
1060             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1061                Suffix :=
1062                  In_Tree.Languages_Data.Table
1063                    (Lang).Config.Naming_Data.Spec_Suffix;
1064                exit;
1065             end if;
1066
1067             Lang := In_Tree.Languages_Data.Table (Lang).Next;
1068          end loop;
1069       end if;
1070
1071       return Suffix;
1072    end Spec_Suffix_Id_Of;
1073
1074    --------------------
1075    -- Spec_Suffix_Of --
1076    --------------------
1077
1078    function Spec_Suffix_Of
1079      (In_Tree  : Project_Tree_Ref;
1080       Language : String;
1081       Naming   : Naming_Data) return String
1082    is
1083       Language_Id : Name_Id;
1084       Element_Id  : Array_Element_Id;
1085       Element     : Array_Element;
1086       Suffix      : File_Name_Type := No_File;
1087       Lang        : Language_Index;
1088
1089    begin
1090       Name_Len := 0;
1091       Add_Str_To_Name_Buffer (Language);
1092       To_Lower (Name_Buffer (1 .. Name_Len));
1093       Language_Id := Name_Find;
1094
1095       Element_Id := Naming.Spec_Suffix;
1096       while Element_Id /= No_Array_Element loop
1097          Element := In_Tree.Array_Elements.Table (Element_Id);
1098
1099          if Element.Index = Language_Id then
1100             return Get_Name_String (Element.Value.Value);
1101          end if;
1102
1103          Element_Id := Element.Next;
1104       end loop;
1105
1106       if Current_Mode = Multi_Language then
1107          Lang := In_Tree.First_Language;
1108          while Lang /= No_Language_Index loop
1109             if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1110                Suffix :=
1111                  File_Name_Type
1112                    (In_Tree.Languages_Data.Table
1113                       (Lang).Config.Naming_Data.Spec_Suffix);
1114                exit;
1115             end if;
1116
1117             Lang := In_Tree.Languages_Data.Table (Lang).Next;
1118          end loop;
1119
1120          if Suffix /= No_File then
1121             return Get_Name_String (Suffix);
1122          end if;
1123       end if;
1124
1125       return "";
1126    end Spec_Suffix_Of;
1127
1128    --------------------------
1129    -- Standard_Naming_Data --
1130    --------------------------
1131
1132    function Standard_Naming_Data
1133      (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1134    is
1135    begin
1136       if Tree = No_Project_Tree then
1137          Prj.Initialize (Tree => No_Project_Tree);
1138          return Std_Naming_Data;
1139       else
1140          return Tree.Private_Part.Default_Naming;
1141       end if;
1142    end Standard_Naming_Data;
1143
1144    -------------------
1145    -- Switches_Name --
1146    -------------------
1147
1148    function Switches_Name
1149      (Source_File_Name : File_Name_Type) return File_Name_Type
1150    is
1151    begin
1152       return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1153    end Switches_Name;
1154
1155    -----------
1156    -- Value --
1157    -----------
1158
1159    function Value (Image : String) return Casing_Type is
1160    begin
1161       for Casing in The_Casing_Images'Range loop
1162          if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1163             return Casing;
1164          end if;
1165       end loop;
1166
1167       raise Constraint_Error;
1168    end Value;
1169
1170 begin
1171    --  Make sure that the standard config and user project file extensions are
1172    --  compatible with canonical case file naming.
1173
1174    Canonical_Case_File_Name (Config_Project_File_Extension);
1175    Canonical_Case_File_Name (Project_File_Extension);
1176 end Prj;