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