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