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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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 Scans;    use Scans;
  36 with Snames;   use Snames;
  37 with Uintp;    use Uintp;
  38
  39 with GNAT.Case_Util; use GNAT.Case_Util;
  40 with GNAT.OS_Lib;    use GNAT.OS_Lib;
  41
  42 package body Prj is
  43
  44    Initial_Buffer_Size : constant := 100;
  45    --  Initial size for extensible buffer used in Add_To_Buffer
  46
  47    The_Empty_String : Name_Id;
  48
  49    Name_C_Plus_Plus : Name_Id;
  50
  51    Default_Ada_Spec_Suffix_Id : Name_Id;
  52    Default_Ada_Body_Suffix_Id : Name_Id;
  53    Slash_Id                   : Name_Id;
  54    --  Initialized in Prj.Initialized, then never modified
  55
  56    subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
  57
  58    The_Casing_Images : constant array (Known_Casing) of String_Access :=
  59      (All_Lower_Case => new String'("lowercase"),
  60       All_Upper_Case => new String'("UPPERCASE"),
  61       Mixed_Case     => new String'("MixedCase"));
  62
  63    Initialized : Boolean := False;
  64
  65    Standard_Dot_Replacement      : constant Name_Id :=
  66      First_Name_Id + Character'Pos ('-');
  67
  68    Std_Naming_Data : Naming_Data :=
  69      (Dot_Replacement           => Standard_Dot_Replacement,
  70       Dot_Repl_Loc              => No_Location,
  71       Casing                    => All_Lower_Case,
  72       Spec_Suffix               => No_Array_Element,
  73       Ada_Spec_Suffix           => No_Name,
  74       Spec_Suffix_Loc           => No_Location,
  75       Impl_Suffixes             => No_Impl_Suffixes,
  76       Supp_Suffixes             => No_Supp_Language_Index,
  77       Body_Suffix               => No_Array_Element,
  78       Ada_Body_Suffix           => No_Name,
  79       Body_Suffix_Loc           => No_Location,
  80       Separate_Suffix           => No_Name,
  81       Sep_Suffix_Loc            => No_Location,
  82       Specs                     => No_Array_Element,
  83       Bodies                    => No_Array_Element,
  84       Specification_Exceptions  => No_Array_Element,
  85       Implementation_Exceptions => No_Array_Element);
  86
  87    Project_Empty : Project_Data :=
  88      (Externally_Built               => False,
  89       Languages                      => No_Languages,
  90       Supp_Languages                 => No_Supp_Language_Index,
  91       First_Referred_By              => No_Project,
  92       Name                           => No_Name,
  93       Path_Name                      => No_Name,
  94       Display_Path_Name              => No_Name,
  95       Virtual                        => False,
  96       Location                       => No_Location,
  97       Mains                          => Nil_String,
  98       Directory                      => No_Name,
  99       Display_Directory              => No_Name,
 100       Dir_Path                       => null,
 101       Library                        => False,
 102       Library_Dir                    => No_Name,
 103       Display_Library_Dir            => No_Name,
 104       Library_Src_Dir                => No_Name,
 105       Display_Library_Src_Dir        => No_Name,
 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       Symbol_Data                    => No_Symbols,
 113       Ada_Sources_Present            => True,
 114       Other_Sources_Present          => True,
 115       Sources                        => Nil_String,
 116       First_Other_Source             => No_Other_Source,
 117       Last_Other_Source              => No_Other_Source,
 118       Imported_Directories_Switches  => null,
 119       Include_Path                   => null,
 120       Include_Data_Set               => False,
 121       Source_Dirs                    => Nil_String,
 122       Known_Order_Of_Source_Dirs     => True,
 123       Object_Directory               => No_Name,
 124       Display_Object_Dir             => No_Name,
 125       Exec_Directory                 => No_Name,
 126       Display_Exec_Dir               => No_Name,
 127       Extends                        => No_Project,
 128       Extended_By                    => No_Project,
 129       Naming                         => Std_Naming_Data,
 130       First_Language_Processing      => Default_First_Language_Processing_Data,
 131       Supp_Language_Processing       => No_Supp_Language_Index,
 132       Default_Linker                 => No_Name,
 133       Default_Linker_Path            => No_Name,
 134       Decl                           => No_Declarations,
 135       Imported_Projects              => Empty_Project_List,
 136       Ada_Include_Path               => null,
 137       Ada_Objects_Path               => null,
 138       Include_Path_File              => No_Name,
 139       Objects_Path_File_With_Libs    => No_Name,
 140       Objects_Path_File_Without_Libs => No_Name,
 141       Config_File_Name               => No_Name,
 142       Config_File_Temp               => False,
 143       Config_Checked                 => False,
 144       Language_Independent_Checked   => False,
 145       Checked                        => False,
 146       Seen                           => False,
 147       Need_To_Build_Lib              => False,
 148       Depth                          => 0,
 149       Unkept_Comments                => False);
 150
 151    -----------------------
 152    -- Add_Language_Name --
 153    -----------------------
 154
 155    procedure Add_Language_Name (Name : Name_Id) is
 156    begin
 157       Last_Language_Index := Last_Language_Index + 1;
 158       Language_Indexes.Set (Name, Last_Language_Index);
 159       Language_Names.Increment_Last;
 160       Language_Names.Table (Last_Language_Index) := Name;
 161    end Add_Language_Name;
 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    -- Default_Ada_Body_Suffix --
 198    -----------------------------
 199
 200    function Default_Ada_Body_Suffix return Name_Id is
 201    begin
 202       return Default_Ada_Body_Suffix_Id;
 203    end Default_Ada_Body_Suffix;
 204
 205    -----------------------------
 206    -- Default_Ada_Spec_Suffix --
 207    -----------------------------
 208
 209    function Default_Ada_Spec_Suffix return Name_Id is
 210    begin
 211       return Default_Ada_Spec_Suffix_Id;
 212    end Default_Ada_Spec_Suffix;
 213
 214    ---------------------------
 215    -- Display_Language_Name --
 216    ---------------------------
 217
 218    procedure Display_Language_Name (Language : Language_Index) is
 219    begin
 220       Get_Name_String (Language_Names.Table (Language));
 221       To_Upper (Name_Buffer (1 .. 1));
 222       Write_Str (Name_Buffer (1 .. Name_Len));
 223    end Display_Language_Name;
 224
 225    -------------------
 226    -- Empty_Project --
 227    -------------------
 228
 229    function Empty_Project (Tree : Project_Tree_Ref)  return Project_Data is
 230       Value : Project_Data := Project_Empty;
 231    begin
 232       Prj.Initialize (Tree => No_Project_Tree);
 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 : in 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
 676                                                                 (Supp_Index);
 677
 678                   if Supp.Index = For_Language then
 679                      In_Tree.Supp_Languages.Table
 680                        (Supp_Index).Data := Language_Processing;
 681                      return;
 682                   end if;
 683
 684                   Supp_Index := Supp.Next;
 685                end loop;
 686
 687                Supp := (Index => For_Language, Data => Language_Processing,
 688                         Next  => In_Project.Supp_Language_Processing);
 689                Supp_Language_Table.Increment_Last
 690                  (In_Tree.Supp_Languages);
 691                Supp_Index := Supp_Language_Table.Last
 692                                (In_Tree.Supp_Languages);
 693                In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
 694                In_Project.Supp_Language_Processing := Supp_Index;
 695             end;
 696       end case;
 697    end Set;
 698
 699    procedure Set
 700      (Suffix       : Name_Id;
 701       For_Language : Language_Index;
 702       In_Project   : in out Project_Data;
 703       In_Tree      : Project_Tree_Ref)
 704    is
 705    begin
 706       case For_Language is
 707          when No_Language_Index =>
 708             null;
 709
 710          when First_Language_Indexes =>
 711             In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
 712
 713          when others =>
 714             declare
 715                Supp : Supp_Suffix;
 716                Supp_Index : Supp_Language_Index :=
 717                  In_Project.Naming.Supp_Suffixes;
 718
 719             begin
 720                while Supp_Index /= No_Supp_Language_Index loop
 721                   Supp := In_Tree.Supp_Suffixes.Table
 722                                                             (Supp_Index);
 723
 724                   if Supp.Index = For_Language then
 725                      In_Tree.Supp_Suffixes.Table
 726                        (Supp_Index).Suffix := Suffix;
 727                      return;
 728                   end if;
 729
 730                   Supp_Index := Supp.Next;
 731                end loop;
 732
 733                Supp := (Index => For_Language, Suffix => Suffix,
 734                         Next  => In_Project.Naming.Supp_Suffixes);
 735                Supp_Suffix_Table.Increment_Last
 736                  (In_Tree.Supp_Suffixes);
 737                Supp_Index := Supp_Suffix_Table.Last
 738                  (In_Tree.Supp_Suffixes);
 739                In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
 740                In_Project.Naming.Supp_Suffixes := Supp_Index;
 741             end;
 742       end case;
 743    end Set;
 744
 745    -----------
 746    -- Slash --
 747    -----------
 748
 749    function Slash return Name_Id is
 750    begin
 751       return Slash_Id;
 752    end Slash;
 753
 754    --------------------------
 755    -- Standard_Naming_Data --
 756    --------------------------
 757
 758    function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree)
 759                                   return Naming_Data
 760    is
 761    begin
 762       if Tree = No_Project_Tree then
 763          Prj.Initialize (Tree => No_Project_Tree);
 764          return Std_Naming_Data;
 765
 766       else
 767          return Tree.Private_Part.Default_Naming;
 768       end if;
 769    end Standard_Naming_Data;
 770
 771    ---------------
 772    -- Suffix_Of --
 773    ---------------
 774
 775    function Suffix_Of
 776      (Language   : Language_Index;
 777       In_Project : Project_Data;
 778       In_Tree    : Project_Tree_Ref) return Name_Id
 779    is
 780    begin
 781       case Language is
 782          when No_Language_Index =>
 783             return No_Name;
 784
 785          when First_Language_Indexes =>
 786             return In_Project.Naming.Impl_Suffixes (Language);
 787
 788          when others =>
 789             declare
 790                Supp : Supp_Suffix;
 791                Supp_Index : Supp_Language_Index :=
 792                  In_Project.Naming.Supp_Suffixes;
 793
 794             begin
 795                while Supp_Index /= No_Supp_Language_Index loop
 796                   Supp := In_Tree.Supp_Suffixes.Table
 797                                                              (Supp_Index);
 798
 799                   if Supp.Index = Language then
 800                      return Supp.Suffix;
 801                   end if;
 802
 803                   Supp_Index := Supp.Next;
 804                end loop;
 805
 806                return No_Name;
 807             end;
 808       end case;
 809    end  Suffix_Of;
 810
 811    -----------
 812    -- Value --
 813    -----------
 814
 815    function Value (Image : String) return Casing_Type is
 816    begin
 817       for Casing in The_Casing_Images'Range loop
 818          if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
 819             return Casing;
 820          end if;
 821       end loop;
 822
 823       raise Constraint_Error;
 824    end Value;
 825
 826 begin
 827    --  Make sure that the standard project file extension is compatible
 828    --  with canonical case file naming.
 829
 830    Canonical_Case_File_Name (Project_File_Extension);
 831 end Prj;