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-2005 Free Software Foundation, Inc.       --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Ada.Characters.Handling; use Ada.Characters.Handling;
  28
  29 with Namet;    use Namet;
  30 with Output;   use Output;
  31 with Osint;    use Osint;
  32 with Prj.Attr;
  33 with Prj.Env;
  34 with Prj.Err;  use Prj.Err;
  35 with Snames;   use Snames;
  36 with Uintp;    use Uintp;
  37
  38 with GNAT.Case_Util; use GNAT.Case_Util;
  39
  40 package body Prj is
  41
  42    Initial_Buffer_Size : constant := 100;
  43    --  Initial size for extensible buffer used in Add_To_Buffer
  44
  45    The_Empty_String : Name_Id;
  46
  47    Name_C_Plus_Plus : Name_Id;
  48
  49    Default_Ada_Spec_Suffix_Id : Name_Id;
  50    Default_Ada_Body_Suffix_Id : Name_Id;
  51    Slash_Id                   : Name_Id;
  52    --  Initialized in Prj.Initialized, then never modified
  53
  54    subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
  55
  56    The_Casing_Images : constant array (Known_Casing) of String_Access :=
  57      (All_Lower_Case => new String'("lowercase"),
  58       All_Upper_Case => new String'("UPPERCASE"),
  59       Mixed_Case     => new String'("MixedCase"));
  60
  61    Initialized : Boolean := False;
  62
  63    Standard_Dot_Replacement      : constant Name_Id :=
  64      First_Name_Id + Character'Pos ('-');
  65
  66    Std_Naming_Data : Naming_Data :=
  67      (Dot_Replacement           => Standard_Dot_Replacement,
  68       Dot_Repl_Loc              => No_Location,
  69       Casing                    => All_Lower_Case,
  70       Spec_Suffix               => No_Array_Element,
  71       Ada_Spec_Suffix           => No_Name,
  72       Spec_Suffix_Loc           => No_Location,
  73       Impl_Suffixes             => No_Impl_Suffixes,
  74       Supp_Suffixes             => No_Supp_Language_Index,
  75       Body_Suffix               => No_Array_Element,
  76       Ada_Body_Suffix           => No_Name,
  77       Body_Suffix_Loc           => No_Location,
  78       Separate_Suffix           => No_Name,
  79       Sep_Suffix_Loc            => No_Location,
  80       Specs                     => No_Array_Element,
  81       Bodies                    => No_Array_Element,
  82       Specification_Exceptions  => No_Array_Element,
  83       Implementation_Exceptions => No_Array_Element);
  84
  85    Project_Empty : Project_Data :=
  86      (Externally_Built               => False,
  87       Languages                      => No_Languages,
  88       Supp_Languages                 => No_Supp_Language_Index,
  89       First_Referred_By              => No_Project,
  90       Name                           => No_Name,
  91       Display_Name                   => No_Name,
  92       Path_Name                      => No_Name,
  93       Display_Path_Name              => No_Name,
  94       Virtual                        => False,
  95       Location                       => No_Location,
  96       Mains                          => Nil_String,
  97       Directory                      => No_Name,
  98       Display_Directory              => No_Name,
  99       Dir_Path                       => null,
 100       Library                        => False,
 101       Library_Dir                    => No_Name,
 102       Display_Library_Dir            => No_Name,
 103       Library_Src_Dir                => No_Name,
 104       Display_Library_Src_Dir        => No_Name,
 105       Library_Name                   => No_Name,
 106       Library_Kind                   => Static,
 107       Lib_Internal_Name              => No_Name,
 108       Standalone_Library             => False,
 109       Lib_Interface_ALIs             => Nil_String,
 110       Lib_Auto_Init                  => False,
 111       Symbol_Data                    => No_Symbols,
 112       Ada_Sources_Present            => True,
 113       Other_Sources_Present          => True,
 114       Sources                        => Nil_String,
 115       First_Other_Source             => No_Other_Source,
 116       Last_Other_Source              => No_Other_Source,
 117       Imported_Directories_Switches  => null,
 118       Include_Path                   => null,
 119       Include_Data_Set               => False,
 120       Source_Dirs                    => Nil_String,
 121       Known_Order_Of_Source_Dirs     => True,
 122       Object_Directory               => No_Name,
 123       Display_Object_Dir             => No_Name,
 124       Exec_Directory                 => No_Name,
 125       Display_Exec_Dir               => No_Name,
 126       Extends                        => No_Project,
 127       Extended_By                    => No_Project,
 128       Naming                         => Std_Naming_Data,
 129       First_Language_Processing      => Default_First_Language_Processing_Data,
 130       Supp_Language_Processing       => No_Supp_Language_Index,
 131       Default_Linker                 => No_Name,
 132       Default_Linker_Path            => No_Name,
 133       Decl                           => No_Declarations,
 134       Imported_Projects              => Empty_Project_List,
 135       Ada_Include_Path               => null,
 136       Ada_Objects_Path               => null,
 137       Include_Path_File              => No_Name,
 138       Objects_Path_File_With_Libs    => No_Name,
 139       Objects_Path_File_Without_Libs => No_Name,
 140       Config_File_Name               => No_Name,
 141       Config_File_Temp               => False,
 142       Config_Checked                 => False,
 143       Language_Independent_Checked   => False,
 144       Checked                        => False,
 145       Seen                           => False,
 146       Need_To_Build_Lib              => False,
 147       Depth                          => 0,
 148       Unkept_Comments                => False);
 149
 150    -----------------------
 151    -- Add_Language_Name --
 152    -----------------------
 153
 154    procedure Add_Language_Name (Name : Name_Id) is
 155    begin
 156       Last_Language_Index := Last_Language_Index + 1;
 157       Language_Indexes.Set (Name, Last_Language_Index);
 158       Language_Names.Increment_Last;
 159       Language_Names.Table (Last_Language_Index) := Name;
 160    end Add_Language_Name;
 161
 162    -------------------
 163    -- Add_To_Buffer --
 164    -------------------
 165
 166    procedure Add_To_Buffer
 167      (S    : String;
 168       To   : in out String_Access;
 169       Last : in out Natural)
 170    is
 171    begin
 172       if To = null then
 173          To := new String (1 .. Initial_Buffer_Size);
 174          Last := 0;
 175       end if;
 176
 177       --  If Buffer is too small, double its size
 178
 179       while Last + S'Length > To'Last loop
 180          declare
 181             New_Buffer : constant  String_Access :=
 182                            new String (1 .. 2 * Last);
 183
 184          begin
 185             New_Buffer (1 .. Last) := To (1 .. Last);
 186             Free (To);
 187             To := New_Buffer;
 188          end;
 189       end loop;
 190
 191       To (Last + 1 .. Last + S'Length) := S;
 192       Last := Last + S'Length;
 193    end Add_To_Buffer;
 194
 195    -----------------------------
 196    -- Default_Ada_Body_Suffix --
 197    -----------------------------
 198
 199    function Default_Ada_Body_Suffix return Name_Id is
 200    begin
 201       return Default_Ada_Body_Suffix_Id;
 202    end Default_Ada_Body_Suffix;
 203
 204    -----------------------------
 205    -- Default_Ada_Spec_Suffix --
 206    -----------------------------
 207
 208    function Default_Ada_Spec_Suffix return Name_Id is
 209    begin
 210       return Default_Ada_Spec_Suffix_Id;
 211    end Default_Ada_Spec_Suffix;
 212
 213    ---------------------------
 214    -- Display_Language_Name --
 215    ---------------------------
 216
 217    procedure Display_Language_Name (Language : Language_Index) is
 218    begin
 219       Get_Name_String (Language_Names.Table (Language));
 220       To_Upper (Name_Buffer (1 .. 1));
 221       Write_Str (Name_Buffer (1 .. Name_Len));
 222    end Display_Language_Name;
 223
 224    -------------------
 225    -- Empty_Project --
 226    -------------------
 227
 228    function Empty_Project (Tree : Project_Tree_Ref)  return Project_Data is
 229       Value : Project_Data;
 230    begin
 231       Prj.Initialize (Tree => No_Project_Tree);
 232       Value := Project_Empty;
 233       Value.Naming := Tree.Private_Part.Default_Naming;
 234       return Value;
 235    end Empty_Project;
 236
 237    ------------------
 238    -- Empty_String --
 239    ------------------
 240
 241    function Empty_String return Name_Id is
 242    begin
 243       return The_Empty_String;
 244    end Empty_String;
 245
 246    ------------
 247    -- Expect --
 248    ------------
 249
 250    procedure Expect (The_Token : Token_Type; Token_Image : String) is
 251    begin
 252       if Token /= The_Token then
 253          Error_Msg (Token_Image & " expected", Token_Ptr);
 254       end if;
 255    end Expect;
 256
 257    --------------------------------
 258    -- For_Every_Project_Imported --
 259    --------------------------------
 260
 261    procedure For_Every_Project_Imported
 262      (By         : Project_Id;
 263       In_Tree    : Project_Tree_Ref;
 264       With_State : in out State)
 265    is
 266
 267       procedure Recursive_Check (Project : Project_Id);
 268       --  Check if a project has already been seen. If not seen, mark it as
 269       --  Seen, Call Action, and check all its imported projects.
 270
 271       ---------------------
 272       -- Recursive_Check --
 273       ---------------------
 274
 275       procedure Recursive_Check (Project : Project_Id) is
 276          List : Project_List;
 277
 278       begin
 279          if not In_Tree.Projects.Table (Project).Seen then
 280             In_Tree.Projects.Table (Project).Seen := True;
 281             Action (Project, With_State);
 282
 283             List :=
 284               In_Tree.Projects.Table (Project).Imported_Projects;
 285             while List /= Empty_Project_List loop
 286                Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
 287                List := In_Tree.Project_Lists.Table (List).Next;
 288             end loop;
 289          end if;
 290       end Recursive_Check;
 291
 292    --  Start of processing for For_Every_Project_Imported
 293
 294    begin
 295       for Project in Project_Table.First ..
 296                      Project_Table.Last (In_Tree.Projects)
 297       loop
 298          In_Tree.Projects.Table (Project).Seen := False;
 299       end loop;
 300
 301       Recursive_Check (Project => By);
 302    end For_Every_Project_Imported;
 303
 304    ----------
 305    -- Hash --
 306    ----------
 307
 308    function Hash (Name : Name_Id) return Header_Num is
 309    begin
 310       return Hash (Get_Name_String (Name));
 311    end Hash;
 312
 313    -----------
 314    -- Image --
 315    -----------
 316
 317    function Image (Casing : Casing_Type) return String is
 318    begin
 319       return The_Casing_Images (Casing).all;
 320    end Image;
 321
 322    ----------------
 323    -- Initialize --
 324    ----------------
 325
 326    procedure Initialize (Tree : Project_Tree_Ref) is
 327    begin
 328       if not Initialized then
 329          Initialized := True;
 330          Uintp.Initialize;
 331          Name_Len := 0;
 332          The_Empty_String := Name_Find;
 333          Empty_Name := The_Empty_String;
 334          Name_Len := 4;
 335          Name_Buffer (1 .. 4) := ".ads";
 336          Default_Ada_Spec_Suffix_Id := Name_Find;
 337          Name_Len := 4;
 338          Name_Buffer (1 .. 4) := ".adb";
 339          Default_Ada_Body_Suffix_Id := Name_Find;
 340          Name_Len := 1;
 341          Name_Buffer (1) := '/';
 342          Slash_Id := Name_Find;
 343          Name_Len := 3;
 344          Name_Buffer (1 .. 3) := "c++";
 345          Name_C_Plus_Plus := Name_Find;
 346
 347          Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
 348          Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
 349          Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
 350          Project_Empty.Naming := Std_Naming_Data;
 351          Prj.Env.Initialize;
 352          Prj.Attr.Initialize;
 353          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
 354          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
 355          Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
 356
 357          Language_Indexes.Reset;
 358          Last_Language_Index := No_Language_Index;
 359          Language_Names.Init;
 360          Add_Language_Name (Name_Ada);
 361          Add_Language_Name (Name_C);
 362          Add_Language_Name (Name_C_Plus_Plus);
 363       end if;
 364
 365       if Tree /= No_Project_Tree then
 366          Reset (Tree);
 367       end if;
 368    end Initialize;
 369
 370    ----------------
 371    -- Is_Present --
 372    ----------------
 373
 374    function Is_Present
 375      (Language   : Language_Index;
 376       In_Project : Project_Data;
 377       In_Tree    : Project_Tree_Ref) return Boolean
 378    is
 379    begin
 380       case Language is
 381          when No_Language_Index =>
 382             return False;
 383
 384          when First_Language_Indexes =>
 385             return In_Project.Languages (Language);
 386
 387          when others =>
 388             declare
 389                Supp : Supp_Language;
 390                Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
 391
 392             begin
 393                while Supp_Index /= No_Supp_Language_Index loop
 394                   Supp := In_Tree.Present_Languages.Table (Supp_Index);
 395
 396                   if Supp.Index = Language then
 397                      return Supp.Present;
 398                   end if;
 399
 400                   Supp_Index := Supp.Next;
 401                end loop;
 402
 403                return False;
 404             end;
 405       end case;
 406    end Is_Present;
 407
 408    ---------------------------------
 409    -- Language_Processing_Data_Of --
 410    ---------------------------------
 411
 412    function Language_Processing_Data_Of
 413      (Language   : Language_Index;
 414       In_Project : Project_Data;
 415       In_Tree    : Project_Tree_Ref) return Language_Processing_Data
 416    is
 417    begin
 418       case Language is
 419          when No_Language_Index =>
 420             return Default_Language_Processing_Data;
 421
 422          when First_Language_Indexes =>
 423             return In_Project.First_Language_Processing (Language);
 424
 425          when others =>
 426             declare
 427                Supp : Supp_Language_Data;
 428                Supp_Index : Supp_Language_Index :=
 429                  In_Project.Supp_Language_Processing;
 430
 431             begin
 432                while Supp_Index /= No_Supp_Language_Index loop
 433                   Supp := In_Tree.Supp_Languages.Table (Supp_Index);
 434
 435                   if Supp.Index = Language then
 436                      return Supp.Data;
 437                   end if;
 438
 439                   Supp_Index := Supp.Next;
 440                end loop;
 441
 442                return Default_Language_Processing_Data;
 443             end;
 444       end case;
 445    end Language_Processing_Data_Of;
 446
 447    ------------------------------------
 448    -- Register_Default_Naming_Scheme --
 449    ------------------------------------
 450
 451    procedure Register_Default_Naming_Scheme
 452      (Language            : Name_Id;
 453       Default_Spec_Suffix : Name_Id;
 454       Default_Body_Suffix : Name_Id;
 455       In_Tree             : Project_Tree_Ref)
 456    is
 457       Lang : Name_Id;
 458       Suffix : Array_Element_Id;
 459       Found : Boolean := False;
 460       Element : Array_Element;
 461
 462    begin
 463       --  Get the language name in small letters
 464
 465       Get_Name_String (Language);
 466       Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
 467       Lang := Name_Find;
 468
 469       Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
 470       Found := False;
 471
 472       --  Look for an element of the spec sufix array indexed by the language
 473       --  name. If one is found, put the default value.
 474
 475       while Suffix /= No_Array_Element and then not Found loop
 476          Element := In_Tree.Array_Elements.Table (Suffix);
 477
 478          if Element.Index = Lang then
 479             Found := True;
 480             Element.Value.Value := Default_Spec_Suffix;
 481             In_Tree.Array_Elements.Table (Suffix) := Element;
 482
 483          else
 484             Suffix := Element.Next;
 485          end if;
 486       end loop;
 487
 488       --  If none can be found, create a new one.
 489
 490       if not Found then
 491          Element :=
 492            (Index     => Lang,
 493             Src_Index => 0,
 494             Index_Case_Sensitive => False,
 495             Value => (Project  => No_Project,
 496                       Kind     => Single,
 497                       Location => No_Location,
 498                       Default  => False,
 499                       Value    => Default_Spec_Suffix,
 500                       Index    => 0),
 501             Next  => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
 502          Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 503          In_Tree.Array_Elements.Table
 504            (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
 505             Element;
 506          In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
 507            Array_Element_Table.Last (In_Tree.Array_Elements);
 508       end if;
 509
 510       Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
 511       Found := False;
 512
 513       --  Look for an element of the body sufix array indexed by the language
 514       --  name. If one is found, put the default value.
 515
 516       while Suffix /= No_Array_Element and then not Found loop
 517          Element := In_Tree.Array_Elements.Table (Suffix);
 518
 519          if Element.Index = Lang then
 520             Found := True;
 521             Element.Value.Value := Default_Body_Suffix;
 522             In_Tree.Array_Elements.Table (Suffix) := Element;
 523
 524          else
 525             Suffix := Element.Next;
 526          end if;
 527       end loop;
 528
 529       --  If none can be found, create a new one.
 530
 531       if not Found then
 532          Element :=
 533            (Index     => Lang,
 534             Src_Index => 0,
 535             Index_Case_Sensitive => False,
 536             Value => (Project  => No_Project,
 537                       Kind     => Single,
 538                       Location => No_Location,
 539                       Default  => False,
 540                       Value    => Default_Body_Suffix,
 541                       Index    => 0),
 542             Next  => In_Tree.Private_Part.Default_Naming.Body_Suffix);
 543          Array_Element_Table.Increment_Last
 544            (In_Tree.Array_Elements);
 545          In_Tree.Array_Elements.Table
 546            (Array_Element_Table.Last (In_Tree.Array_Elements))
 547              := Element;
 548          In_Tree.Private_Part.Default_Naming.Body_Suffix :=
 549            Array_Element_Table.Last (In_Tree.Array_Elements);
 550       end if;
 551    end Register_Default_Naming_Scheme;
 552
 553    -----------
 554    -- Reset --
 555    -----------
 556
 557    procedure Reset (Tree : Project_Tree_Ref) is
 558    begin
 559       Prj.Env.Initialize;
 560       Present_Language_Table.Init (Tree.Present_Languages);
 561       Supp_Suffix_Table.Init      (Tree.Supp_Suffixes);
 562       Name_List_Table.Init        (Tree.Name_Lists);
 563       Supp_Language_Table.Init    (Tree.Supp_Languages);
 564       Other_Source_Table.Init     (Tree.Other_Sources);
 565       String_Element_Table.Init   (Tree.String_Elements);
 566       Variable_Element_Table.Init (Tree.Variable_Elements);
 567       Array_Element_Table.Init    (Tree.Array_Elements);
 568       Array_Table.Init            (Tree.Arrays);
 569       Package_Table.Init          (Tree.Packages);
 570       Project_List_Table.Init     (Tree.Project_Lists);
 571       Project_Table.Init          (Tree.Projects);
 572       Unit_Table.Init             (Tree.Units);
 573       Units_Htable.Reset          (Tree.Units_HT);
 574       Files_Htable.Reset          (Tree.Files_HT);
 575       Naming_Table.Init           (Tree.Private_Part.Namings);
 576       Path_File_Table.Init        (Tree.Private_Part.Path_Files);
 577       Source_Path_Table.Init      (Tree.Private_Part.Source_Paths);
 578       Object_Path_Table.Init      (Tree.Private_Part.Object_Paths);
 579       Tree.Private_Part.Default_Naming := Std_Naming_Data;
 580       Register_Default_Naming_Scheme
 581         (Language            => Name_Ada,
 582          Default_Spec_Suffix => Default_Ada_Spec_Suffix,
 583          Default_Body_Suffix => Default_Ada_Body_Suffix,
 584          In_Tree             => Tree);
 585    end Reset;
 586
 587    ------------------------
 588    -- Same_Naming_Scheme --
 589    ------------------------
 590
 591    function Same_Naming_Scheme
 592      (Left, Right : Naming_Data) return Boolean
 593    is
 594    begin
 595       return Left.Dot_Replacement = Right.Dot_Replacement
 596         and then Left.Casing = Right.Casing
 597         and then Left.Ada_Spec_Suffix = Right.Ada_Spec_Suffix
 598         and then Left.Ada_Body_Suffix = Right.Ada_Body_Suffix
 599         and then Left.Separate_Suffix = Right.Separate_Suffix;
 600    end Same_Naming_Scheme;
 601
 602    ---------
 603    -- Set --
 604    ---------
 605
 606    procedure Set
 607      (Language   : Language_Index;
 608       Present    : Boolean;
 609       In_Project : in out Project_Data;
 610       In_Tree    : Project_Tree_Ref)
 611    is
 612    begin
 613       case Language is
 614          when No_Language_Index =>
 615             null;
 616
 617          when First_Language_Indexes =>
 618             In_Project.Languages (Language) := Present;
 619
 620          when others =>
 621             declare
 622                Supp : Supp_Language;
 623                Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
 624
 625             begin
 626                while Supp_Index /= No_Supp_Language_Index loop
 627                   Supp := In_Tree.Present_Languages.Table
 628                                                                 (Supp_Index);
 629
 630                   if Supp.Index = Language then
 631                      In_Tree.Present_Languages.Table
 632                                             (Supp_Index).Present := Present;
 633                      return;
 634                   end if;
 635
 636                   Supp_Index := Supp.Next;
 637                end loop;
 638
 639                Supp := (Index => Language, Present => Present,
 640                         Next  => In_Project.Supp_Languages);
 641                Present_Language_Table.Increment_Last
 642                  (In_Tree.Present_Languages);
 643                Supp_Index := Present_Language_Table.Last
 644                  (In_Tree.Present_Languages);
 645                In_Tree.Present_Languages.Table (Supp_Index) :=
 646                  Supp;
 647                In_Project.Supp_Languages := Supp_Index;
 648             end;
 649       end case;
 650    end Set;
 651
 652    procedure Set
 653      (Language_Processing : Language_Processing_Data;
 654       For_Language        : Language_Index;
 655       In_Project          : in out Project_Data;
 656       In_Tree             : Project_Tree_Ref)
 657    is
 658    begin
 659       case For_Language is
 660          when No_Language_Index =>
 661             null;
 662
 663          when First_Language_Indexes =>
 664             In_Project.First_Language_Processing (For_Language) :=
 665               Language_Processing;
 666
 667          when others =>
 668             declare
 669                Supp : Supp_Language_Data;
 670                Supp_Index : Supp_Language_Index :=
 671                  In_Project.Supp_Language_Processing;
 672
 673             begin
 674                while Supp_Index /= No_Supp_Language_Index loop
 675                   Supp := In_Tree.Supp_Languages.Table (Supp_Index);
 676
 677                   if Supp.Index = For_Language then
 678                      In_Tree.Supp_Languages.Table
 679                        (Supp_Index).Data := Language_Processing;
 680                      return;
 681                   end if;
 682
 683                   Supp_Index := Supp.Next;
 684                end loop;
 685
 686                Supp := (Index => For_Language, Data => Language_Processing,
 687                         Next  => In_Project.Supp_Language_Processing);
 688                Supp_Language_Table.Increment_Last
 689                  (In_Tree.Supp_Languages);
 690                Supp_Index := Supp_Language_Table.Last
 691                                (In_Tree.Supp_Languages);
 692                In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
 693                In_Project.Supp_Language_Processing := Supp_Index;
 694             end;
 695       end case;
 696    end Set;
 697
 698    procedure Set
 699      (Suffix       : Name_Id;
 700       For_Language : Language_Index;
 701       In_Project   : in out Project_Data;
 702       In_Tree      : Project_Tree_Ref)
 703    is
 704    begin
 705       case For_Language is
 706          when No_Language_Index =>
 707             null;
 708
 709          when First_Language_Indexes =>
 710             In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
 711
 712          when others =>
 713             declare
 714                Supp : Supp_Suffix;
 715                Supp_Index : Supp_Language_Index :=
 716                  In_Project.Naming.Supp_Suffixes;
 717
 718             begin
 719                while Supp_Index /= No_Supp_Language_Index loop
 720                   Supp := In_Tree.Supp_Suffixes.Table
 721                                                             (Supp_Index);
 722
 723                   if Supp.Index = For_Language then
 724                      In_Tree.Supp_Suffixes.Table
 725                        (Supp_Index).Suffix := Suffix;
 726                      return;
 727                   end if;
 728
 729                   Supp_Index := Supp.Next;
 730                end loop;
 731
 732                Supp := (Index => For_Language, Suffix => Suffix,
 733                         Next  => In_Project.Naming.Supp_Suffixes);
 734                Supp_Suffix_Table.Increment_Last
 735                  (In_Tree.Supp_Suffixes);
 736                Supp_Index := Supp_Suffix_Table.Last
 737                  (In_Tree.Supp_Suffixes);
 738                In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
 739                In_Project.Naming.Supp_Suffixes := Supp_Index;
 740             end;
 741       end case;
 742    end Set;
 743
 744    -----------
 745    -- Slash --
 746    -----------
 747
 748    function Slash return Name_Id is
 749    begin
 750       return Slash_Id;
 751    end Slash;
 752
 753    --------------------------
 754    -- Standard_Naming_Data --
 755    --------------------------
 756
 757    function Standard_Naming_Data
 758      (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
 759    is
 760    begin
 761       if Tree = No_Project_Tree then
 762          Prj.Initialize (Tree => No_Project_Tree);
 763          return Std_Naming_Data;
 764
 765       else
 766          return Tree.Private_Part.Default_Naming;
 767       end if;
 768    end Standard_Naming_Data;
 769
 770    ---------------
 771    -- Suffix_Of --
 772    ---------------
 773
 774    function Suffix_Of
 775      (Language   : Language_Index;
 776       In_Project : Project_Data;
 777       In_Tree    : Project_Tree_Ref) return Name_Id
 778    is
 779    begin
 780       case Language is
 781          when No_Language_Index =>
 782             return No_Name;
 783
 784          when First_Language_Indexes =>
 785             return In_Project.Naming.Impl_Suffixes (Language);
 786
 787          when others =>
 788             declare
 789                Supp : Supp_Suffix;
 790                Supp_Index : Supp_Language_Index :=
 791                  In_Project.Naming.Supp_Suffixes;
 792
 793             begin
 794                while Supp_Index /= No_Supp_Language_Index loop
 795                   Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
 796
 797                   if Supp.Index = Language then
 798                      return Supp.Suffix;
 799                   end if;
 800
 801                   Supp_Index := Supp.Next;
 802                end loop;
 803
 804                return No_Name;
 805             end;
 806       end case;
 807    end  Suffix_Of;
 808
 809    -----------
 810    -- Value --
 811    -----------
 812
 813    function Value (Image : String) return Casing_Type is
 814    begin
 815       for Casing in The_Casing_Images'Range loop
 816          if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
 817             return Casing;
 818          end if;
 819       end loop;
 820
 821       raise Constraint_Error;
 822    end Value;
 823
 824 begin
 825    --  Make sure that the standard project file extension is compatible
 826    --  with canonical case file naming.
 827
 828    Canonical_Case_File_Name (Project_File_Extension);
 829 end Prj;