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-2007, 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 Output;   use Output;
  30 with Osint;    use Osint;
  31 with Prj.Attr;
  32 with Prj.Env;
  33 with Prj.Err;  use Prj.Err;
  34 with Snames;   use Snames;
  35 with Uintp;    use Uintp;
  36
  37 with GNAT.Case_Util; use GNAT.Case_Util;
  38
  39 package body Prj is
  40
  41    Initial_Buffer_Size : constant := 100;
  42    --  Initial size for extensible buffer used in Add_To_Buffer
  43
  44    The_Empty_String : Name_Id;
  45
  46    Name_C_Plus_Plus : Name_Id;
  47
  48    Default_Ada_Spec_Suffix_Id : File_Name_Type;
  49    Default_Ada_Body_Suffix_Id : File_Name_Type;
  50    Slash_Id                   : File_Name_Type;
  51    --  Initialized in Prj.Initialized, then never modified
  52
  53    subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
  54
  55    The_Casing_Images : constant array (Known_Casing) of String_Access :=
  56      (All_Lower_Case => new String'("lowercase"),
  57       All_Upper_Case => new String'("UPPERCASE"),
  58       Mixed_Case     => new String'("MixedCase"));
  59
  60    Initialized : Boolean := False;
  61
  62    Standard_Dot_Replacement : constant File_Name_Type :=
  63                                 File_Name_Type
  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_File,
  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_File,
  77       Body_Suffix_Loc           => No_Location,
  78       Separate_Suffix           => No_File,
  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_Path,
  93       Display_Path_Name              => No_Path,
  94       Virtual                        => False,
  95       Location                       => No_Location,
  96       Mains                          => Nil_String,
  97       Directory                      => No_Path,
  98       Display_Directory              => No_Path,
  99       Dir_Path                       => null,
 100       Library                        => False,
 101       Library_Dir                    => No_Path,
 102       Display_Library_Dir            => No_Path,
 103       Library_Src_Dir                => No_Path,
 104       Display_Library_Src_Dir        => No_Path,
 105       Library_ALI_Dir                => No_Path,
 106       Display_Library_ALI_Dir        => No_Path,
 107       Library_Name                   => No_File,
 108       Library_Kind                   => Static,
 109       Lib_Internal_Name              => No_File,
 110       Standalone_Library             => False,
 111       Lib_Interface_ALIs             => Nil_String,
 112       Lib_Auto_Init                  => False,
 113       Libgnarl_Needed                => Unknown,
 114       Symbol_Data                    => No_Symbols,
 115       Ada_Sources_Present            => True,
 116       Other_Sources_Present          => True,
 117       Sources                        => Nil_String,
 118       First_Other_Source             => No_Other_Source,
 119       Last_Other_Source              => No_Other_Source,
 120       Imported_Directories_Switches  => null,
 121       Include_Path                   => null,
 122       Include_Data_Set               => False,
 123       Source_Dirs                    => Nil_String,
 124       Known_Order_Of_Source_Dirs     => True,
 125       Object_Directory               => No_Path,
 126       Display_Object_Dir             => No_Path,
 127       Library_TS                     => Empty_Time_Stamp,
 128       Exec_Directory                 => No_Path,
 129       Display_Exec_Dir               => No_Path,
 130       Extends                        => No_Project,
 131       Extended_By                    => No_Project,
 132       Naming                         => Std_Naming_Data,
 133       First_Language_Processing      => Default_First_Language_Processing_Data,
 134       Supp_Language_Processing       => No_Supp_Language_Index,
 135       Default_Linker                 => No_File,
 136       Default_Linker_Path            => No_Path,
 137       Decl                           => No_Declarations,
 138       Imported_Projects              => Empty_Project_List,
 139       All_Imported_Projects          => Empty_Project_List,
 140       Ada_Include_Path               => null,
 141       Ada_Objects_Path               => null,
 142       Include_Path_File              => No_Path,
 143       Objects_Path_File_With_Libs    => No_Path,
 144       Objects_Path_File_Without_Libs => No_Path,
 145       Config_File_Name               => No_Path,
 146       Config_File_Temp               => False,
 147       Config_Checked                 => False,
 148       Language_Independent_Checked   => False,
 149       Checked                        => False,
 150       Seen                           => False,
 151       Need_To_Build_Lib              => False,
 152       Depth                          => 0,
 153       Unkept_Comments                => False);
 154
 155    -----------------------
 156    -- Add_Language_Name --
 157    -----------------------
 158
 159    procedure Add_Language_Name (Name : Name_Id) is
 160    begin
 161       Last_Language_Index := Last_Language_Index + 1;
 162       Language_Indexes.Set (Name, Last_Language_Index);
 163       Language_Names.Increment_Last;
 164       Language_Names.Table (Last_Language_Index) := Name;
 165    end Add_Language_Name;
 166
 167    -------------------
 168    -- Add_To_Buffer --
 169    -------------------
 170
 171    procedure Add_To_Buffer
 172      (S    : String;
 173       To   : in out String_Access;
 174       Last : in out Natural)
 175    is
 176    begin
 177       if To = null then
 178          To := new String (1 .. Initial_Buffer_Size);
 179          Last := 0;
 180       end if;
 181
 182       --  If Buffer is too small, double its size
 183
 184       while Last + S'Length > To'Last loop
 185          declare
 186             New_Buffer : constant  String_Access := 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 File_Name_Type 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 File_Name_Type 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    function Hash (Name : File_Name_Type) return Header_Num is
 318    begin
 319       return Hash (Get_Name_String (Name));
 320    end Hash;
 321
 322    -----------
 323    -- Image --
 324    -----------
 325
 326    function Image (Casing : Casing_Type) return String is
 327    begin
 328       return The_Casing_Images (Casing).all;
 329    end Image;
 330
 331    ----------------
 332    -- Initialize --
 333    ----------------
 334
 335    procedure Initialize (Tree : Project_Tree_Ref) is
 336    begin
 337       if not Initialized then
 338          Initialized := True;
 339          Uintp.Initialize;
 340          Name_Len := 0;
 341          The_Empty_String := Name_Find;
 342          Empty_Name := The_Empty_String;
 343          Name_Len := 4;
 344          Name_Buffer (1 .. 4) := ".ads";
 345          Default_Ada_Spec_Suffix_Id := Name_Find;
 346          Name_Len := 4;
 347          Name_Buffer (1 .. 4) := ".adb";
 348          Default_Ada_Body_Suffix_Id := Name_Find;
 349          Name_Len := 1;
 350          Name_Buffer (1) := '/';
 351          Slash_Id := Name_Find;
 352          Name_Len := 3;
 353          Name_Buffer (1 .. 3) := "c++";
 354          Name_C_Plus_Plus := Name_Find;
 355
 356          Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
 357          Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
 358          Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
 359          Project_Empty.Naming := Std_Naming_Data;
 360          Prj.Env.Initialize;
 361          Prj.Attr.Initialize;
 362          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
 363          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
 364          Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
 365
 366          Language_Indexes.Reset;
 367          Last_Language_Index := No_Language_Index;
 368          Language_Names.Init;
 369          Add_Language_Name (Name_Ada);
 370          Add_Language_Name (Name_C);
 371          Add_Language_Name (Name_C_Plus_Plus);
 372       end if;
 373
 374       if Tree /= No_Project_Tree then
 375          Reset (Tree);
 376       end if;
 377    end Initialize;
 378
 379    ----------------
 380    -- Is_Present --
 381    ----------------
 382
 383    function Is_Present
 384      (Language   : Language_Index;
 385       In_Project : Project_Data;
 386       In_Tree    : Project_Tree_Ref) return Boolean
 387    is
 388    begin
 389       case Language is
 390          when No_Language_Index =>
 391             return False;
 392
 393          when First_Language_Indexes =>
 394             return In_Project.Languages (Language);
 395
 396          when others =>
 397             declare
 398                Supp : Supp_Language;
 399                Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
 400
 401             begin
 402                while Supp_Index /= No_Supp_Language_Index loop
 403                   Supp := In_Tree.Present_Languages.Table (Supp_Index);
 404
 405                   if Supp.Index = Language then
 406                      return Supp.Present;
 407                   end if;
 408
 409                   Supp_Index := Supp.Next;
 410                end loop;
 411
 412                return False;
 413             end;
 414       end case;
 415    end Is_Present;
 416
 417    ---------------------------------
 418    -- Language_Processing_Data_Of --
 419    ---------------------------------
 420
 421    function Language_Processing_Data_Of
 422      (Language   : Language_Index;
 423       In_Project : Project_Data;
 424       In_Tree    : Project_Tree_Ref) return Language_Processing_Data
 425    is
 426    begin
 427       case Language is
 428          when No_Language_Index =>
 429             return Default_Language_Processing_Data;
 430
 431          when First_Language_Indexes =>
 432             return In_Project.First_Language_Processing (Language);
 433
 434          when others =>
 435             declare
 436                Supp : Supp_Language_Data;
 437                Supp_Index : Supp_Language_Index :=
 438                  In_Project.Supp_Language_Processing;
 439
 440             begin
 441                while Supp_Index /= No_Supp_Language_Index loop
 442                   Supp := In_Tree.Supp_Languages.Table (Supp_Index);
 443
 444                   if Supp.Index = Language then
 445                      return Supp.Data;
 446                   end if;
 447
 448                   Supp_Index := Supp.Next;
 449                end loop;
 450
 451                return Default_Language_Processing_Data;
 452             end;
 453       end case;
 454    end Language_Processing_Data_Of;
 455
 456    ------------------------------------
 457    -- Register_Default_Naming_Scheme --
 458    ------------------------------------
 459
 460    procedure Register_Default_Naming_Scheme
 461      (Language            : Name_Id;
 462       Default_Spec_Suffix : File_Name_Type;
 463       Default_Body_Suffix : File_Name_Type;
 464       In_Tree             : Project_Tree_Ref)
 465    is
 466       Lang    : Name_Id;
 467       Suffix  : Array_Element_Id;
 468       Found   : Boolean := False;
 469       Element : Array_Element;
 470
 471    begin
 472       --  Get the language name in small letters
 473
 474       Get_Name_String (Language);
 475       Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
 476       Lang := Name_Find;
 477
 478       Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
 479       Found := False;
 480
 481       --  Look for an element of the spec sufix array indexed by the language
 482       --  name. If one is found, put the default value.
 483
 484       while Suffix /= No_Array_Element and then not Found loop
 485          Element := In_Tree.Array_Elements.Table (Suffix);
 486
 487          if Element.Index = Lang then
 488             Found := True;
 489             Element.Value.Value := Name_Id (Default_Spec_Suffix);
 490             In_Tree.Array_Elements.Table (Suffix) := Element;
 491
 492          else
 493             Suffix := Element.Next;
 494          end if;
 495       end loop;
 496
 497       --  If none can be found, create a new one
 498
 499       if not Found then
 500          Element :=
 501            (Index     => Lang,
 502             Src_Index => 0,
 503             Index_Case_Sensitive => False,
 504             Value => (Project  => No_Project,
 505                       Kind     => Single,
 506                       Location => No_Location,
 507                       Default  => False,
 508                       Value    => Name_Id (Default_Spec_Suffix),
 509                       Index    => 0),
 510             Next  => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
 511
 512          Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 513
 514          In_Tree.Array_Elements.Table
 515            (Array_Element_Table.Last (In_Tree.Array_Elements)) := Element;
 516
 517          In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
 518            Array_Element_Table.Last (In_Tree.Array_Elements);
 519       end if;
 520
 521       Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
 522       Found := False;
 523
 524       --  Look for an element of the body sufix array indexed by the language
 525       --  name. If one is found, put the default value.
 526
 527       while Suffix /= No_Array_Element and then not Found loop
 528          Element := In_Tree.Array_Elements.Table (Suffix);
 529
 530          if Element.Index = Lang then
 531             Found := True;
 532             Element.Value.Value := Name_Id (Default_Body_Suffix);
 533             In_Tree.Array_Elements.Table (Suffix) := Element;
 534
 535          else
 536             Suffix := Element.Next;
 537          end if;
 538       end loop;
 539
 540       --  If none can be found, create a new one
 541
 542       if not Found then
 543          Element :=
 544            (Index     => Lang,
 545             Src_Index => 0,
 546             Index_Case_Sensitive => False,
 547             Value => (Project  => No_Project,
 548                       Kind     => Single,
 549                       Location => No_Location,
 550                       Default  => False,
 551                       Value    => Name_Id (Default_Body_Suffix),
 552                       Index    => 0),
 553             Next  => In_Tree.Private_Part.Default_Naming.Body_Suffix);
 554          Array_Element_Table.Increment_Last
 555            (In_Tree.Array_Elements);
 556          In_Tree.Array_Elements.Table
 557            (Array_Element_Table.Last (In_Tree.Array_Elements))
 558              := Element;
 559          In_Tree.Private_Part.Default_Naming.Body_Suffix :=
 560            Array_Element_Table.Last (In_Tree.Array_Elements);
 561       end if;
 562    end Register_Default_Naming_Scheme;
 563
 564    -----------
 565    -- Reset --
 566    -----------
 567
 568    procedure Reset (Tree : Project_Tree_Ref) is
 569    begin
 570       Prj.Env.Initialize;
 571       Present_Language_Table.Init (Tree.Present_Languages);
 572       Supp_Suffix_Table.Init      (Tree.Supp_Suffixes);
 573       Name_List_Table.Init        (Tree.Name_Lists);
 574       Supp_Language_Table.Init    (Tree.Supp_Languages);
 575       Other_Source_Table.Init     (Tree.Other_Sources);
 576       String_Element_Table.Init   (Tree.String_Elements);
 577       Variable_Element_Table.Init (Tree.Variable_Elements);
 578       Array_Element_Table.Init    (Tree.Array_Elements);
 579       Array_Table.Init            (Tree.Arrays);
 580       Package_Table.Init          (Tree.Packages);
 581       Project_List_Table.Init     (Tree.Project_Lists);
 582       Project_Table.Init          (Tree.Projects);
 583       Unit_Table.Init             (Tree.Units);
 584       Units_Htable.Reset          (Tree.Units_HT);
 585       Files_Htable.Reset          (Tree.Files_HT);
 586       Naming_Table.Init           (Tree.Private_Part.Namings);
 587       Naming_Table.Increment_Last (Tree.Private_Part.Namings);
 588       Tree.Private_Part.Namings.Table
 589         (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
 590       Path_File_Table.Init        (Tree.Private_Part.Path_Files);
 591       Source_Path_Table.Init      (Tree.Private_Part.Source_Paths);
 592       Object_Path_Table.Init      (Tree.Private_Part.Object_Paths);
 593       Tree.Private_Part.Default_Naming := Std_Naming_Data;
 594       Register_Default_Naming_Scheme
 595         (Language            => Name_Ada,
 596          Default_Spec_Suffix => Default_Ada_Spec_Suffix,
 597          Default_Body_Suffix => Default_Ada_Body_Suffix,
 598          In_Tree             => Tree);
 599    end Reset;
 600
 601    ------------------------
 602    -- Same_Naming_Scheme --
 603    ------------------------
 604
 605    function Same_Naming_Scheme
 606      (Left, Right : Naming_Data) return Boolean
 607    is
 608    begin
 609       return Left.Dot_Replacement = Right.Dot_Replacement
 610         and then Left.Casing = Right.Casing
 611         and then Left.Ada_Spec_Suffix = Right.Ada_Spec_Suffix
 612         and then Left.Ada_Body_Suffix = Right.Ada_Body_Suffix
 613         and then Left.Separate_Suffix = Right.Separate_Suffix;
 614    end Same_Naming_Scheme;
 615
 616    ---------
 617    -- Set --
 618    ---------
 619
 620    procedure Set
 621      (Language   : Language_Index;
 622       Present    : Boolean;
 623       In_Project : in out Project_Data;
 624       In_Tree    : Project_Tree_Ref)
 625    is
 626    begin
 627       case Language is
 628          when No_Language_Index =>
 629             null;
 630
 631          when First_Language_Indexes =>
 632             In_Project.Languages (Language) := Present;
 633
 634          when others =>
 635             declare
 636                Supp : Supp_Language;
 637                Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
 638
 639             begin
 640                while Supp_Index /= No_Supp_Language_Index loop
 641                   Supp := In_Tree.Present_Languages.Table
 642                                                                 (Supp_Index);
 643
 644                   if Supp.Index = Language then
 645                      In_Tree.Present_Languages.Table
 646                                             (Supp_Index).Present := Present;
 647                      return;
 648                   end if;
 649
 650                   Supp_Index := Supp.Next;
 651                end loop;
 652
 653                Supp := (Index => Language, Present => Present,
 654                         Next  => In_Project.Supp_Languages);
 655                Present_Language_Table.Increment_Last
 656                  (In_Tree.Present_Languages);
 657                Supp_Index := Present_Language_Table.Last
 658                  (In_Tree.Present_Languages);
 659                In_Tree.Present_Languages.Table (Supp_Index) :=
 660                  Supp;
 661                In_Project.Supp_Languages := Supp_Index;
 662             end;
 663       end case;
 664    end Set;
 665
 666    procedure Set
 667      (Language_Processing : Language_Processing_Data;
 668       For_Language        : Language_Index;
 669       In_Project          : in out Project_Data;
 670       In_Tree             : Project_Tree_Ref)
 671    is
 672    begin
 673       case For_Language is
 674          when No_Language_Index =>
 675             null;
 676
 677          when First_Language_Indexes =>
 678             In_Project.First_Language_Processing (For_Language) :=
 679               Language_Processing;
 680
 681          when others =>
 682             declare
 683                Supp : Supp_Language_Data;
 684                Supp_Index : Supp_Language_Index :=
 685                  In_Project.Supp_Language_Processing;
 686
 687             begin
 688                while Supp_Index /= No_Supp_Language_Index loop
 689                   Supp := In_Tree.Supp_Languages.Table (Supp_Index);
 690
 691                   if Supp.Index = For_Language then
 692                      In_Tree.Supp_Languages.Table
 693                        (Supp_Index).Data := Language_Processing;
 694                      return;
 695                   end if;
 696
 697                   Supp_Index := Supp.Next;
 698                end loop;
 699
 700                Supp := (Index => For_Language, Data => Language_Processing,
 701                         Next  => In_Project.Supp_Language_Processing);
 702                Supp_Language_Table.Increment_Last
 703                  (In_Tree.Supp_Languages);
 704                Supp_Index := Supp_Language_Table.Last
 705                                (In_Tree.Supp_Languages);
 706                In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
 707                In_Project.Supp_Language_Processing := Supp_Index;
 708             end;
 709       end case;
 710    end Set;
 711
 712    procedure Set
 713      (Suffix       : File_Name_Type;
 714       For_Language : Language_Index;
 715       In_Project   : in out Project_Data;
 716       In_Tree      : Project_Tree_Ref)
 717    is
 718    begin
 719       case For_Language is
 720          when No_Language_Index =>
 721             null;
 722
 723          when First_Language_Indexes =>
 724             In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
 725
 726          when others =>
 727             declare
 728                Supp : Supp_Suffix;
 729                Supp_Index : Supp_Language_Index :=
 730                  In_Project.Naming.Supp_Suffixes;
 731
 732             begin
 733                while Supp_Index /= No_Supp_Language_Index loop
 734                   Supp := In_Tree.Supp_Suffixes.Table
 735                                                             (Supp_Index);
 736
 737                   if Supp.Index = For_Language then
 738                      In_Tree.Supp_Suffixes.Table
 739                        (Supp_Index).Suffix := Suffix;
 740                      return;
 741                   end if;
 742
 743                   Supp_Index := Supp.Next;
 744                end loop;
 745
 746                Supp := (Index => For_Language, Suffix => Suffix,
 747                         Next  => In_Project.Naming.Supp_Suffixes);
 748                Supp_Suffix_Table.Increment_Last
 749                  (In_Tree.Supp_Suffixes);
 750                Supp_Index := Supp_Suffix_Table.Last
 751                  (In_Tree.Supp_Suffixes);
 752                In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
 753                In_Project.Naming.Supp_Suffixes := Supp_Index;
 754             end;
 755       end case;
 756    end Set;
 757
 758    -----------
 759    -- Slash --
 760    -----------
 761
 762    function Slash return File_Name_Type is
 763    begin
 764       return Slash_Id;
 765    end Slash;
 766
 767    --------------------------
 768    -- Standard_Naming_Data --
 769    --------------------------
 770
 771    function Standard_Naming_Data
 772      (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
 773    is
 774    begin
 775       if Tree = No_Project_Tree then
 776          Prj.Initialize (Tree => No_Project_Tree);
 777          return Std_Naming_Data;
 778
 779       else
 780          return Tree.Private_Part.Default_Naming;
 781       end if;
 782    end Standard_Naming_Data;
 783
 784    ---------------
 785    -- Suffix_Of --
 786    ---------------
 787
 788    function Suffix_Of
 789      (Language   : Language_Index;
 790       In_Project : Project_Data;
 791       In_Tree    : Project_Tree_Ref) return File_Name_Type
 792    is
 793    begin
 794       case Language is
 795          when No_Language_Index =>
 796             return No_File;
 797
 798          when First_Language_Indexes =>
 799             return In_Project.Naming.Impl_Suffixes (Language);
 800
 801          when others =>
 802             declare
 803                Supp : Supp_Suffix;
 804                Supp_Index : Supp_Language_Index :=
 805                  In_Project.Naming.Supp_Suffixes;
 806
 807             begin
 808                while Supp_Index /= No_Supp_Language_Index loop
 809                   Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
 810
 811                   if Supp.Index = Language then
 812                      return Supp.Suffix;
 813                   end if;
 814
 815                   Supp_Index := Supp.Next;
 816                end loop;
 817
 818                return No_File;
 819             end;
 820       end case;
 821    end  Suffix_Of;
 822
 823    -----------
 824    -- Value --
 825    -----------
 826
 827    function Value (Image : String) return Casing_Type is
 828    begin
 829       for Casing in The_Casing_Images'Range loop
 830          if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
 831             return Casing;
 832          end if;
 833       end loop;
 834
 835       raise Constraint_Error;
 836    end Value;
 837
 838 begin
 839    --  Make sure that the standard project file extension is compatible
 840    --  with canonical case file naming.
 841
 842    Canonical_Case_File_Name (Project_File_Extension);
 843 end Prj;