gcc/ada/prj-proc.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P R J . P R O C                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2008, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Err_Vars; use Err_Vars;
  27 with Opt;      use Opt;
  28 with Osint;    use Osint;
  29 with Output;   use Output;
  30 with Prj.Attr; use Prj.Attr;
  31 with Prj.Err;  use Prj.Err;
  32 with Prj.Ext;  use Prj.Ext;
  33 with Prj.Nmsc; use Prj.Nmsc;
  34 with Sinput;   use Sinput;
  35 with Snames;
  36
  37 with GNAT.Case_Util; use GNAT.Case_Util;
  38 with GNAT.HTable;
  39
  40 package body Prj.Proc is
  41
  42    Error_Report : Put_Line_Access := null;
  43
  44    package Processed_Projects is new GNAT.HTable.Simple_HTable
  45      (Header_Num => Header_Num,
  46       Element    => Project_Id,
  47       No_Element => No_Project,
  48       Key        => Name_Id,
  49       Hash       => Hash,
  50       Equal      => "=");
  51    --  This hash table contains all processed projects
  52
  53    package Unit_Htable is new GNAT.HTable.Simple_HTable
  54      (Header_Num => Header_Num,
  55       Element    => Source_Id,
  56       No_Element => No_Source,
  57       Key        => Name_Id,
  58       Hash       => Hash,
  59       Equal      => "=");
  60    --  This hash table contains all processed projects
  61
  62    procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
  63    --  Concatenate two strings and returns another string if both
  64    --  arguments are not null string.
  65
  66    procedure Add_Attributes
  67      (Project       : Project_Id;
  68       Project_Name  : Name_Id;
  69       In_Tree       : Project_Tree_Ref;
  70       Decl          : in out Declarations;
  71       First         : Attribute_Node_Id;
  72       Project_Level : Boolean);
  73    --  Add all attributes, starting with First, with their default
  74    --  values to the package or project with declarations Decl.
  75
  76    procedure Check
  77      (In_Tree         : Project_Tree_Ref;
  78       Project         : Project_Id;
  79       Current_Dir     : String;
  80       When_No_Sources : Error_Warning);
  81    --  Set all projects to not checked, then call Recursive_Check for the
  82    --  main project Project. Project is set to No_Project if errors occurred.
  83    --  Current_Dir is for optimization purposes, avoiding extra system calls.
  84
  85    procedure Copy_Package_Declarations
  86      (From              : Declarations;
  87       To                : in out Declarations;
  88       New_Loc           : Source_Ptr;
  89       Naming_Restricted : Boolean;
  90       In_Tree           : Project_Tree_Ref);
  91    --  Copy a package declaration From to To for a renamed package. Change the
  92    --  locations of all the attributes to New_Loc. When Naming_Restricted is
  93    --  True, do not copy attributes Body, Spec, Implementation and
  94    --  Specification.
  95
  96    function Expression
  97      (Project                : Project_Id;
  98       In_Tree                : Project_Tree_Ref;
  99       From_Project_Node      : Project_Node_Id;
 100       From_Project_Node_Tree : Project_Node_Tree_Ref;
 101       Pkg                    : Package_Id;
 102       First_Term             : Project_Node_Id;
 103       Kind                   : Variable_Kind) return Variable_Value;
 104    --  From N_Expression project node From_Project_Node, compute the value
 105    --  of an expression and return it as a Variable_Value.
 106
 107    function Imported_Or_Extended_Project_From
 108      (Project   : Project_Id;
 109       In_Tree   : Project_Tree_Ref;
 110       With_Name : Name_Id) return Project_Id;
 111    --  Find an imported or extended project of Project whose name is With_Name
 112
 113    function Package_From
 114      (Project   : Project_Id;
 115       In_Tree   : Project_Tree_Ref;
 116       With_Name : Name_Id) return Package_Id;
 117    --  Find the package of Project whose name is With_Name
 118
 119    procedure Process_Declarative_Items
 120      (Project                : Project_Id;
 121       In_Tree                : Project_Tree_Ref;
 122       From_Project_Node      : Project_Node_Id;
 123       From_Project_Node_Tree : Project_Node_Tree_Ref;
 124       Pkg                    : Package_Id;
 125       Item                   : Project_Node_Id);
 126    --  Process declarative items starting with From_Project_Node, and put them
 127    --  in declarations Decl. This is a recursive procedure; it calls itself for
 128    --  a package declaration or a case construction.
 129
 130    procedure Recursive_Process
 131      (In_Tree                : Project_Tree_Ref;
 132       Project                : out Project_Id;
 133       From_Project_Node      : Project_Node_Id;
 134       From_Project_Node_Tree : Project_Node_Tree_Ref;
 135       Extended_By            : Project_Id);
 136    --  Process project with node From_Project_Node in the tree.
 137    --  Do nothing if From_Project_Node is Empty_Node.
 138    --  If project has already been processed, simply return its project id.
 139    --  Otherwise create a new project id, mark it as processed, call itself
 140    --  recursively for all imported projects and a extended project, if any.
 141    --  Then process the declarative items of the project.
 142
 143    procedure Recursive_Check
 144      (Project         : Project_Id;
 145       In_Tree         : Project_Tree_Ref;
 146       Current_Dir     : String;
 147       When_No_Sources : Error_Warning);
 148    --  If Project is not marked as checked, mark it as checked, call
 149    --  Check_Naming_Scheme for the project, then call itself for a
 150    --  possible extended project and all the imported projects of Project.
 151    --  Current_Dir is for optimization purposes, avoiding extra system calls.
 152
 153    ---------
 154    -- Add --
 155    ---------
 156
 157    procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
 158    begin
 159       if To_Exp = No_Name or else To_Exp = Empty_String then
 160
 161          --  To_Exp is nil or empty. The result is Str
 162
 163          To_Exp := Str;
 164
 165       --  If Str is nil, then do not change To_Ext
 166
 167       elsif Str /= No_Name and then Str /= Empty_String then
 168          declare
 169             S : constant String := Get_Name_String (Str);
 170
 171          begin
 172             Get_Name_String (To_Exp);
 173             Add_Str_To_Name_Buffer (S);
 174             To_Exp := Name_Find;
 175          end;
 176       end if;
 177    end Add;
 178
 179    --------------------
 180    -- Add_Attributes --
 181    --------------------
 182
 183    procedure Add_Attributes
 184      (Project       : Project_Id;
 185       Project_Name  : Name_Id;
 186       In_Tree       : Project_Tree_Ref;
 187       Decl          : in out Declarations;
 188       First         : Attribute_Node_Id;
 189       Project_Level : Boolean)
 190    is
 191       The_Attribute  : Attribute_Node_Id := First;
 192
 193    begin
 194       while The_Attribute /= Empty_Attribute loop
 195          if Attribute_Kind_Of (The_Attribute) = Single then
 196             declare
 197                New_Attribute : Variable_Value;
 198
 199             begin
 200                case Variable_Kind_Of (The_Attribute) is
 201
 202                   --  Undefined should not happen
 203
 204                   when Undefined =>
 205                      pragma Assert
 206                        (False, "attribute with an undefined kind");
 207                      raise Program_Error;
 208
 209                   --  Single attributes have a default value of empty string
 210
 211                   when Single =>
 212                      New_Attribute :=
 213                        (Project  => Project,
 214                         Kind     => Single,
 215                         Location => No_Location,
 216                         Default  => True,
 217                         Value    => Empty_String,
 218                         Index    => 0);
 219
 220                      --  Special case of <project>'Name
 221
 222                      if Project_Level
 223                        and then Attribute_Name_Of (The_Attribute) =
 224                                   Snames.Name_Name
 225                      then
 226                         New_Attribute.Value := Project_Name;
 227                      end if;
 228
 229                   --  List attributes have a default value of nil list
 230
 231                   when List =>
 232                      New_Attribute :=
 233                        (Project  => Project,
 234                         Kind     => List,
 235                         Location => No_Location,
 236                         Default  => True,
 237                         Values   => Nil_String);
 238
 239                end case;
 240
 241                Variable_Element_Table.Increment_Last
 242                  (In_Tree.Variable_Elements);
 243                In_Tree.Variable_Elements.Table
 244                  (Variable_Element_Table.Last
 245                    (In_Tree.Variable_Elements)) :=
 246                  (Next  => Decl.Attributes,
 247                   Name  => Attribute_Name_Of (The_Attribute),
 248                   Value => New_Attribute);
 249                Decl.Attributes := Variable_Element_Table.Last
 250                  (In_Tree.Variable_Elements);
 251             end;
 252          end if;
 253
 254          The_Attribute := Next_Attribute (After => The_Attribute);
 255       end loop;
 256    end Add_Attributes;
 257
 258    -----------
 259    -- Check --
 260    -----------
 261
 262    procedure Check
 263      (In_Tree         : Project_Tree_Ref;
 264       Project         : Project_Id;
 265       Current_Dir     : String;
 266       When_No_Sources : Error_Warning)
 267    is
 268    begin
 269       --  Make sure that all projects are marked as not checked
 270
 271       for Index in Project_Table.First ..
 272                    Project_Table.Last (In_Tree.Projects)
 273       loop
 274          In_Tree.Projects.Table (Index).Checked := False;
 275       end loop;
 276
 277       Recursive_Check (Project, In_Tree, Current_Dir, When_No_Sources);
 278
 279       --  Set the Other_Part field for the units
 280
 281       declare
 282          Source1 : Source_Id;
 283          Name    : Name_Id;
 284          Source2 : Source_Id;
 285
 286       begin
 287          Unit_Htable.Reset;
 288
 289          Source1 := In_Tree.First_Source;
 290          while Source1 /= No_Source loop
 291             Name := In_Tree.Sources.Table (Source1).Unit;
 292
 293             if Name /= No_Name then
 294                Source2 := Unit_Htable.Get (Name);
 295
 296                if Source2 = No_Source then
 297                   Unit_Htable.Set (K => Name, E => Source1);
 298
 299                else
 300                   Unit_Htable.Remove (Name);
 301                   In_Tree.Sources.Table (Source1).Other_Part := Source2;
 302                   In_Tree.Sources.Table (Source2).Other_Part := Source1;
 303                end if;
 304             end if;
 305
 306             Source1 := In_Tree.Sources.Table (Source1).Next_In_Sources;
 307          end loop;
 308       end;
 309    end Check;
 310
 311    -------------------------------
 312    -- Copy_Package_Declarations --
 313    -------------------------------
 314
 315    procedure Copy_Package_Declarations
 316      (From              : Declarations;
 317       To                : in out Declarations;
 318       New_Loc           : Source_Ptr;
 319       Naming_Restricted : Boolean;
 320       In_Tree           : Project_Tree_Ref)
 321    is
 322       V1  : Variable_Id := From.Attributes;
 323       V2  : Variable_Id := No_Variable;
 324       Var : Variable;
 325       A1  : Array_Id := From.Arrays;
 326       A2  : Array_Id := No_Array;
 327       Arr : Array_Data;
 328       E1  : Array_Element_Id;
 329       E2  : Array_Element_Id := No_Array_Element;
 330       Elm : Array_Element;
 331
 332    begin
 333       --  To avoid references in error messages to attribute declarations in
 334       --  an original package that has been renamed, copy all the attribute
 335       --  declarations of the package and change all locations to New_Loc,
 336       --  the location of the renamed package.
 337
 338       --  First single attributes
 339
 340       while V1 /= No_Variable loop
 341
 342          --  Copy the attribute
 343
 344          Var := In_Tree.Variable_Elements.Table (V1);
 345          V1  := Var.Next;
 346
 347          --  Remove the Next component
 348
 349          Var.Next := No_Variable;
 350
 351          --  Change the location to New_Loc
 352
 353          Var.Value.Location := New_Loc;
 354          Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
 355
 356          --  Put in new declaration
 357
 358          if To.Attributes = No_Variable then
 359             To.Attributes :=
 360               Variable_Element_Table.Last (In_Tree.Variable_Elements);
 361
 362          else
 363             In_Tree.Variable_Elements.Table (V2).Next :=
 364               Variable_Element_Table.Last (In_Tree.Variable_Elements);
 365          end if;
 366
 367          V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements);
 368          In_Tree.Variable_Elements.Table (V2) := Var;
 369       end loop;
 370
 371       --  Then the associated array attributes
 372
 373       while A1 /= No_Array loop
 374
 375          Arr := In_Tree.Arrays.Table (A1);
 376          A1  := Arr.Next;
 377
 378          if not Naming_Restricted or else
 379            (Arr.Name /= Snames.Name_Body
 380             and then Arr.Name /= Snames.Name_Spec
 381             and then Arr.Name /= Snames.Name_Implementation
 382             and then Arr.Name /= Snames.Name_Specification)
 383          then
 384             --  Remove the Next component
 385
 386             Arr.Next := No_Array;
 387
 388             Array_Table.Increment_Last (In_Tree.Arrays);
 389
 390             --  Create new Array declaration
 391
 392             if To.Arrays = No_Array then
 393                To.Arrays := Array_Table.Last (In_Tree.Arrays);
 394
 395             else
 396                In_Tree.Arrays.Table (A2).Next :=
 397                  Array_Table.Last (In_Tree.Arrays);
 398             end if;
 399
 400             A2 := Array_Table.Last (In_Tree.Arrays);
 401
 402             --  Don't store the array as its first element has not been set yet
 403
 404             --  Copy the array elements of the array
 405
 406             E1 := Arr.Value;
 407             Arr.Value := No_Array_Element;
 408             while E1 /= No_Array_Element loop
 409
 410                --  Copy the array element
 411
 412                Elm := In_Tree.Array_Elements.Table (E1);
 413                E1 := Elm.Next;
 414
 415                --  Remove the Next component
 416
 417                Elm.Next := No_Array_Element;
 418
 419                --  Change the location
 420
 421                Elm.Value.Location := New_Loc;
 422                Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
 423
 424                --  Create new array element
 425
 426                if Arr.Value = No_Array_Element then
 427                   Arr.Value :=
 428                     Array_Element_Table.Last (In_Tree.Array_Elements);
 429                else
 430                   In_Tree.Array_Elements.Table (E2).Next :=
 431                     Array_Element_Table.Last (In_Tree.Array_Elements);
 432                end if;
 433
 434                E2 := Array_Element_Table.Last (In_Tree.Array_Elements);
 435                In_Tree.Array_Elements.Table (E2) := Elm;
 436             end loop;
 437
 438             --  Finally, store the new array
 439
 440             In_Tree.Arrays.Table (A2) := Arr;
 441          end if;
 442       end loop;
 443    end Copy_Package_Declarations;
 444
 445    ----------------
 446    -- Expression --
 447    ----------------
 448
 449    function Expression
 450      (Project                : Project_Id;
 451       In_Tree                : Project_Tree_Ref;
 452       From_Project_Node      : Project_Node_Id;
 453       From_Project_Node_Tree : Project_Node_Tree_Ref;
 454       Pkg                    : Package_Id;
 455       First_Term             : Project_Node_Id;
 456       Kind                   : Variable_Kind) return Variable_Value
 457    is
 458       The_Term : Project_Node_Id := First_Term;
 459       --  The term in the expression list
 460
 461       The_Current_Term : Project_Node_Id := Empty_Node;
 462       --  The current term node id
 463
 464       Result : Variable_Value (Kind => Kind);
 465       --  The returned result
 466
 467       Last : String_List_Id := Nil_String;
 468       --  Reference to the last string elements in Result, when Kind is List
 469
 470    begin
 471       Result.Project := Project;
 472       Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
 473
 474       --  Process each term of the expression, starting with First_Term
 475
 476       while Present (The_Term) loop
 477          The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
 478
 479          case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
 480
 481             when N_Literal_String =>
 482
 483                case Kind is
 484
 485                   when Undefined =>
 486
 487                      --  Should never happen
 488
 489                      pragma Assert (False, "Undefined expression kind");
 490                      raise Program_Error;
 491
 492                   when Single =>
 493                      Add (Result.Value,
 494                           String_Value_Of
 495                             (The_Current_Term, From_Project_Node_Tree));
 496                      Result.Index :=
 497                        Source_Index_Of
 498                          (The_Current_Term, From_Project_Node_Tree);
 499
 500                   when List =>
 501
 502                      String_Element_Table.Increment_Last
 503                        (In_Tree.String_Elements);
 504
 505                      if Last = Nil_String then
 506
 507                         --  This can happen in an expression like () & "toto"
 508
 509                         Result.Values := String_Element_Table.Last
 510                           (In_Tree.String_Elements);
 511
 512                      else
 513                         In_Tree.String_Elements.Table
 514                           (Last).Next := String_Element_Table.Last
 515                                        (In_Tree.String_Elements);
 516                      end if;
 517
 518                      Last := String_Element_Table.Last
 519                        (In_Tree.String_Elements);
 520                      In_Tree.String_Elements.Table (Last) :=
 521                        (Value    =>
 522                           String_Value_Of
 523                             (The_Current_Term,
 524                              From_Project_Node_Tree),
 525                         Index    =>
 526                           Source_Index_Of
 527                             (The_Current_Term, From_Project_Node_Tree),
 528                         Display_Value => No_Name,
 529                         Location      =>
 530                           Location_Of
 531                             (The_Current_Term,
 532                              From_Project_Node_Tree),
 533                         Flag     => False,
 534                         Next     => Nil_String);
 535                end case;
 536
 537             when N_Literal_String_List =>
 538
 539                declare
 540                   String_Node : Project_Node_Id :=
 541                                   First_Expression_In_List
 542                                     (The_Current_Term,
 543                                      From_Project_Node_Tree);
 544
 545                   Value : Variable_Value;
 546
 547                begin
 548                   if Present (String_Node) then
 549
 550                      --  If String_Node is nil, it is an empty list,
 551                      --  there is nothing to do
 552
 553                      Value := Expression
 554                        (Project                => Project,
 555                         In_Tree                => In_Tree,
 556                         From_Project_Node      => From_Project_Node,
 557                         From_Project_Node_Tree => From_Project_Node_Tree,
 558                         Pkg                    => Pkg,
 559                         First_Term             =>
 560                           Tree.First_Term
 561                             (String_Node, From_Project_Node_Tree),
 562                         Kind                   => Single);
 563                      String_Element_Table.Increment_Last
 564                        (In_Tree.String_Elements);
 565
 566                      if Result.Values = Nil_String then
 567
 568                         --  This literal string list is the first term
 569                         --  in a string list expression
 570
 571                         Result.Values :=
 572                           String_Element_Table.Last (In_Tree.String_Elements);
 573
 574                      else
 575                         In_Tree.String_Elements.Table
 576                           (Last).Next :=
 577                           String_Element_Table.Last (In_Tree.String_Elements);
 578                      end if;
 579
 580                      Last :=
 581                        String_Element_Table.Last (In_Tree.String_Elements);
 582
 583                      In_Tree.String_Elements.Table (Last) :=
 584                        (Value    => Value.Value,
 585                         Display_Value => No_Name,
 586                         Location => Value.Location,
 587                         Flag     => False,
 588                         Next     => Nil_String,
 589                         Index    => Value.Index);
 590
 591                      loop
 592                         --  Add the other element of the literal string list
 593                         --  one after the other
 594
 595                         String_Node :=
 596                           Next_Expression_In_List
 597                             (String_Node, From_Project_Node_Tree);
 598
 599                         exit when No (String_Node);
 600
 601                         Value :=
 602                           Expression
 603                             (Project                => Project,
 604                              In_Tree                => In_Tree,
 605                              From_Project_Node      => From_Project_Node,
 606                              From_Project_Node_Tree => From_Project_Node_Tree,
 607                              Pkg                    => Pkg,
 608                              First_Term             =>
 609                                Tree.First_Term
 610                                  (String_Node, From_Project_Node_Tree),
 611                              Kind                   => Single);
 612
 613                         String_Element_Table.Increment_Last
 614                           (In_Tree.String_Elements);
 615                         In_Tree.String_Elements.Table
 616                           (Last).Next := String_Element_Table.Last
 617                                         (In_Tree.String_Elements);
 618                         Last := String_Element_Table.Last
 619                           (In_Tree.String_Elements);
 620                         In_Tree.String_Elements.Table (Last) :=
 621                           (Value    => Value.Value,
 622                            Display_Value => No_Name,
 623                            Location => Value.Location,
 624                            Flag     => False,
 625                            Next     => Nil_String,
 626                            Index    => Value.Index);
 627                      end loop;
 628                   end if;
 629                end;
 630
 631             when N_Variable_Reference | N_Attribute_Reference =>
 632
 633                declare
 634                   The_Project     : Project_Id  := Project;
 635                   The_Package     : Package_Id  := Pkg;
 636                   The_Name        : Name_Id     := No_Name;
 637                   The_Variable_Id : Variable_Id := No_Variable;
 638                   The_Variable    : Variable_Value;
 639                   Term_Project    : constant Project_Node_Id :=
 640                                       Project_Node_Of
 641                                         (The_Current_Term,
 642                                          From_Project_Node_Tree);
 643                   Term_Package    : constant Project_Node_Id :=
 644                                       Package_Node_Of
 645                                         (The_Current_Term,
 646                                          From_Project_Node_Tree);
 647                   Index           : Name_Id := No_Name;
 648
 649                begin
 650                   if Present (Term_Project) and then
 651                      Term_Project /= From_Project_Node
 652                   then
 653                      --  This variable or attribute comes from another project
 654
 655                      The_Name :=
 656                        Name_Of (Term_Project, From_Project_Node_Tree);
 657                      The_Project := Imported_Or_Extended_Project_From
 658                                       (Project   => Project,
 659                                        In_Tree   => In_Tree,
 660                                        With_Name => The_Name);
 661                   end if;
 662
 663                   if Present (Term_Package) then
 664
 665                      --  This is an attribute of a package
 666
 667                      The_Name :=
 668                        Name_Of (Term_Package, From_Project_Node_Tree);
 669                      The_Package := In_Tree.Projects.Table
 670                                       (The_Project).Decl.Packages;
 671
 672                      while The_Package /= No_Package
 673                        and then In_Tree.Packages.Table
 674                                   (The_Package).Name /= The_Name
 675                      loop
 676                         The_Package :=
 677                           In_Tree.Packages.Table
 678                             (The_Package).Next;
 679                      end loop;
 680
 681                      pragma Assert
 682                        (The_Package /= No_Package,
 683                         "package not found.");
 684
 685                   elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 686                           N_Attribute_Reference
 687                   then
 688                      The_Package := No_Package;
 689                   end if;
 690
 691                   The_Name :=
 692                     Name_Of (The_Current_Term, From_Project_Node_Tree);
 693
 694                   if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 695                        N_Attribute_Reference
 696                   then
 697                      Index :=
 698                        Associative_Array_Index_Of
 699                          (The_Current_Term, From_Project_Node_Tree);
 700                   end if;
 701
 702                   --  If it is not an associative array attribute
 703
 704                   if Index = No_Name then
 705
 706                      --  It is not an associative array attribute
 707
 708                      if The_Package /= No_Package then
 709
 710                         --  First, if there is a package, look into the package
 711
 712                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 713                              N_Variable_Reference
 714                         then
 715                            The_Variable_Id :=
 716                              In_Tree.Packages.Table
 717                                (The_Package).Decl.Variables;
 718                         else
 719                            The_Variable_Id :=
 720                              In_Tree.Packages.Table
 721                                (The_Package).Decl.Attributes;
 722                         end if;
 723
 724                         while The_Variable_Id /= No_Variable
 725                           and then
 726                             In_Tree.Variable_Elements.Table
 727                               (The_Variable_Id).Name /= The_Name
 728                         loop
 729                            The_Variable_Id :=
 730                              In_Tree.Variable_Elements.Table
 731                                (The_Variable_Id).Next;
 732                         end loop;
 733
 734                      end if;
 735
 736                      if The_Variable_Id = No_Variable then
 737
 738                         --  If we have not found it, look into the project
 739
 740                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
 741                              N_Variable_Reference
 742                         then
 743                            The_Variable_Id :=
 744                              In_Tree.Projects.Table
 745                                (The_Project).Decl.Variables;
 746                         else
 747                            The_Variable_Id :=
 748                              In_Tree.Projects.Table
 749                                (The_Project).Decl.Attributes;
 750                         end if;
 751
 752                         while The_Variable_Id /= No_Variable
 753                           and then
 754                           In_Tree.Variable_Elements.Table
 755                             (The_Variable_Id).Name /= The_Name
 756                         loop
 757                            The_Variable_Id :=
 758                              In_Tree.Variable_Elements.Table
 759                                (The_Variable_Id).Next;
 760                         end loop;
 761
 762                      end if;
 763
 764                      pragma Assert (The_Variable_Id /= No_Variable,
 765                                       "variable or attribute not found");
 766
 767                      The_Variable :=
 768                        In_Tree.Variable_Elements.Table
 769                                                     (The_Variable_Id).Value;
 770
 771                   else
 772
 773                      --  It is an associative array attribute
 774
 775                      declare
 776                         The_Array   : Array_Id := No_Array;
 777                         The_Element : Array_Element_Id := No_Array_Element;
 778                         Array_Index : Name_Id := No_Name;
 779                         Lower       : Boolean;
 780
 781                      begin
 782                         if The_Package /= No_Package then
 783                            The_Array :=
 784                              In_Tree.Packages.Table
 785                                (The_Package).Decl.Arrays;
 786                         else
 787                            The_Array :=
 788                              In_Tree.Projects.Table
 789                                (The_Project).Decl.Arrays;
 790                         end if;
 791
 792                         while The_Array /= No_Array
 793                           and then In_Tree.Arrays.Table
 794                                      (The_Array).Name /= The_Name
 795                         loop
 796                            The_Array := In_Tree.Arrays.Table
 797                                           (The_Array).Next;
 798                         end loop;
 799
 800                         if The_Array /= No_Array then
 801                            The_Element := In_Tree.Arrays.Table
 802                                             (The_Array).Value;
 803
 804                            Get_Name_String (Index);
 805
 806                            Lower :=
 807                              Case_Insensitive
 808                                (The_Current_Term, From_Project_Node_Tree);
 809
 810                            --  In multi-language mode (gprbuild), the index is
 811                            --  always case insensitive if it does not include
 812                            --  any dot.
 813
 814                            if Get_Mode = Multi_Language and then not Lower then
 815                               Lower := True;
 816
 817                               for J in 1 .. Name_Len loop
 818                                  if Name_Buffer (J) = '.' then
 819                                     Lower := False;
 820                                     exit;
 821                                  end if;
 822                               end loop;
 823                            end if;
 824
 825                            if Lower then
 826                               To_Lower (Name_Buffer (1 .. Name_Len));
 827                            end if;
 828
 829                            Array_Index := Name_Find;
 830
 831                            while The_Element /= No_Array_Element
 832                              and then
 833                              In_Tree.Array_Elements.Table
 834                                (The_Element).Index /= Array_Index
 835                            loop
 836                               The_Element :=
 837                                 In_Tree.Array_Elements.Table
 838                                   (The_Element).Next;
 839                            end loop;
 840
 841                         end if;
 842
 843                         if The_Element /= No_Array_Element then
 844                            The_Variable :=
 845                              In_Tree.Array_Elements.Table
 846                                (The_Element).Value;
 847
 848                         else
 849                            if Expression_Kind_Of
 850                              (The_Current_Term, From_Project_Node_Tree) =
 851                                                                         List
 852                            then
 853                               The_Variable :=
 854                                 (Project  => Project,
 855                                  Kind     => List,
 856                                  Location => No_Location,
 857                                  Default  => True,
 858                                  Values   => Nil_String);
 859                            else
 860                               The_Variable :=
 861                                 (Project  => Project,
 862                                  Kind     => Single,
 863                                  Location => No_Location,
 864                                  Default  => True,
 865                                  Value    => Empty_String,
 866                                  Index    => 0);
 867                            end if;
 868                         end if;
 869                      end;
 870                   end if;
 871
 872                   case Kind is
 873
 874                      when Undefined =>
 875
 876                         --  Should never happen
 877
 878                         pragma Assert (False, "undefined expression kind");
 879                         null;
 880
 881                      when Single =>
 882
 883                         case The_Variable.Kind is
 884
 885                            when Undefined =>
 886                               null;
 887
 888                            when Single =>
 889                               Add (Result.Value, The_Variable.Value);
 890
 891                            when List =>
 892
 893                               --  Should never happen
 894
 895                               pragma Assert
 896                                 (False,
 897                                  "list cannot appear in single " &
 898                                  "string expression");
 899                               null;
 900                         end case;
 901
 902                      when List =>
 903                         case The_Variable.Kind is
 904
 905                            when Undefined =>
 906                               null;
 907
 908                            when Single =>
 909                               String_Element_Table.Increment_Last
 910                                 (In_Tree.String_Elements);
 911
 912                               if Last = Nil_String then
 913
 914                                  --  This can happen in an expression such as
 915                                  --  () & Var
 916
 917                                  Result.Values :=
 918                                    String_Element_Table.Last
 919                                      (In_Tree.String_Elements);
 920
 921                               else
 922                                  In_Tree.String_Elements.Table
 923                                    (Last).Next :=
 924                                      String_Element_Table.Last
 925                                        (In_Tree.String_Elements);
 926                               end if;
 927
 928                               Last :=
 929                                 String_Element_Table.Last
 930                                   (In_Tree.String_Elements);
 931
 932                               In_Tree.String_Elements.Table (Last) :=
 933                                 (Value         => The_Variable.Value,
 934                                  Display_Value => No_Name,
 935                                  Location      => Location_Of
 936                                                     (The_Current_Term,
 937                                                      From_Project_Node_Tree),
 938                                  Flag          => False,
 939                                  Next          => Nil_String,
 940                                  Index         => 0);
 941
 942                            when List =>
 943
 944                               declare
 945                                  The_List : String_List_Id :=
 946                                               The_Variable.Values;
 947
 948                               begin
 949                                  while The_List /= Nil_String loop
 950                                     String_Element_Table.Increment_Last
 951                                       (In_Tree.String_Elements);
 952
 953                                     if Last = Nil_String then
 954                                        Result.Values :=
 955                                          String_Element_Table.Last
 956                                            (In_Tree.
 957                                                 String_Elements);
 958
 959                                     else
 960                                        In_Tree.
 961                                          String_Elements.Table (Last).Next :=
 962                                          String_Element_Table.Last
 963                                            (In_Tree.
 964                                                 String_Elements);
 965
 966                                     end if;
 967
 968                                     Last :=
 969                                       String_Element_Table.Last
 970                                         (In_Tree.String_Elements);
 971
 972                                     In_Tree.String_Elements.Table (Last) :=
 973                                       (Value         =>
 974                                          In_Tree.String_Elements.Table
 975                                            (The_List).Value,
 976                                        Display_Value => No_Name,
 977                                        Location      =>
 978                                          Location_Of
 979                                            (The_Current_Term,
 980                                             From_Project_Node_Tree),
 981                                        Flag         => False,
 982                                        Next         => Nil_String,
 983                                        Index        => 0);
 984
 985                                     The_List :=
 986                                       In_Tree. String_Elements.Table
 987                                         (The_List).Next;
 988                                  end loop;
 989                               end;
 990                         end case;
 991                   end case;
 992                end;
 993
 994             when N_External_Value =>
 995                Get_Name_String
 996                  (String_Value_Of
 997                     (External_Reference_Of
 998                        (The_Current_Term, From_Project_Node_Tree),
 999                      From_Project_Node_Tree));
1000
1001                declare
1002                   Name    : constant Name_Id  := Name_Find;
1003                   Default : Name_Id           := No_Name;
1004                   Value   : Name_Id           := No_Name;
1005
1006                   Def_Var : Variable_Value;
1007
1008                   Default_Node : constant Project_Node_Id :=
1009                     External_Default_Of
1010                       (The_Current_Term, From_Project_Node_Tree);
1011
1012                begin
1013                   --  If there is a default value for the external reference,
1014                   --  get its value.
1015
1016                   if Present (Default_Node) then
1017                      Def_Var := Expression
1018                        (Project                => Project,
1019                         In_Tree                => In_Tree,
1020                         From_Project_Node      => From_Project_Node,
1021                         From_Project_Node_Tree => From_Project_Node_Tree,
1022                         Pkg                    => Pkg,
1023                         First_Term             =>
1024                           Tree.First_Term
1025                             (Default_Node, From_Project_Node_Tree),
1026                         Kind                   => Single);
1027
1028                      if Def_Var /= Nil_Variable_Value then
1029                         Default := Def_Var.Value;
1030                      end if;
1031                   end if;
1032
1033                   Value := Prj.Ext.Value_Of (Name, Default);
1034
1035                   if Value = No_Name then
1036                      if not Quiet_Output then
1037                         if Error_Report = null then
1038                            Error_Msg
1039                              ("?undefined external reference",
1040                               Location_Of
1041                                 (The_Current_Term, From_Project_Node_Tree));
1042                         else
1043                            Error_Report
1044                              ("warning: """ & Get_Name_String (Name) &
1045                               """ is an undefined external reference",
1046                               Project, In_Tree);
1047                         end if;
1048                      end if;
1049
1050                      Value := Empty_String;
1051                   end if;
1052
1053                   case Kind is
1054
1055                      when Undefined =>
1056                         null;
1057
1058                      when Single =>
1059                         Add (Result.Value, Value);
1060
1061                      when List =>
1062                         String_Element_Table.Increment_Last
1063                           (In_Tree.String_Elements);
1064
1065                         if Last = Nil_String then
1066                            Result.Values := String_Element_Table.Last
1067                              (In_Tree.String_Elements);
1068
1069                         else
1070                            In_Tree.String_Elements.Table
1071                              (Last).Next := String_Element_Table.Last
1072                                        (In_Tree.String_Elements);
1073                         end if;
1074
1075                         Last := String_Element_Table.Last
1076                                   (In_Tree.String_Elements);
1077                         In_Tree.String_Elements.Table (Last) :=
1078                           (Value    => Value,
1079                            Display_Value => No_Name,
1080                            Location      =>
1081                              Location_Of
1082                                (The_Current_Term, From_Project_Node_Tree),
1083                            Flag     => False,
1084                            Next     => Nil_String,
1085                            Index    => 0);
1086
1087                   end case;
1088                end;
1089
1090             when others =>
1091
1092                --  Should never happen
1093
1094                pragma Assert
1095                  (False,
1096                   "illegal node kind in an expression");
1097                raise Program_Error;
1098
1099          end case;
1100
1101          The_Term := Next_Term (The_Term, From_Project_Node_Tree);
1102       end loop;
1103
1104       return Result;
1105    end Expression;
1106
1107    ---------------------------------------
1108    -- Imported_Or_Extended_Project_From --
1109    ---------------------------------------
1110
1111    function Imported_Or_Extended_Project_From
1112      (Project   : Project_Id;
1113       In_Tree   : Project_Tree_Ref;
1114       With_Name : Name_Id) return Project_Id
1115    is
1116       Data        : constant Project_Data := In_Tree.Projects.Table (Project);
1117       List        : Project_List;
1118       Result      : Project_Id;
1119       Temp_Result : Project_Id;
1120
1121    begin
1122       --  First check if it is the name of an extended project
1123
1124       Result := Data.Extends;
1125       while Result /= No_Project loop
1126          if In_Tree.Projects.Table (Result).Name = With_Name then
1127             return Result;
1128          else
1129             Result := In_Tree.Projects.Table (Result).Extends;
1130          end if;
1131       end loop;
1132
1133       --  Then check the name of each imported project
1134
1135       Temp_Result := No_Project;
1136       List := Data.Imported_Projects;
1137       while List /= Empty_Project_List loop
1138          Result := In_Tree.Project_Lists.Table (List).Project;
1139
1140          --  If the project is directly imported, then returns its ID
1141
1142          if In_Tree.Projects.Table (Result).Name = With_Name then
1143             return Result;
1144          end if;
1145
1146          --  If a project extending the project is imported, then keep this
1147          --  extending project as a possibility. It will be the returned ID
1148          --  if the project is not imported directly.
1149
1150          declare
1151             Proj : Project_Id := In_Tree.Projects.Table (Result).Extends;
1152
1153          begin
1154             while Proj /= No_Project loop
1155                if In_Tree.Projects.Table (Proj).Name = With_Name then
1156                   Temp_Result := Result;
1157                   exit;
1158                end if;
1159
1160                Proj := In_Tree.Projects.Table (Proj).Extends;
1161             end loop;
1162          end;
1163
1164          List := In_Tree.Project_Lists.Table (List).Next;
1165       end loop;
1166
1167       pragma Assert (Temp_Result /= No_Project, "project not found");
1168       return Temp_Result;
1169    end Imported_Or_Extended_Project_From;
1170
1171    ------------------
1172    -- Package_From --
1173    ------------------
1174
1175    function Package_From
1176      (Project   : Project_Id;
1177       In_Tree   : Project_Tree_Ref;
1178       With_Name : Name_Id) return Package_Id
1179    is
1180       Data   : constant Project_Data :=
1181         In_Tree.Projects.Table (Project);
1182       Result : Package_Id := Data.Decl.Packages;
1183
1184    begin
1185       --  Check the name of each existing package of Project
1186
1187       while Result /= No_Package
1188         and then In_Tree.Packages.Table (Result).Name /= With_Name
1189       loop
1190          Result := In_Tree.Packages.Table (Result).Next;
1191       end loop;
1192
1193       if Result = No_Package then
1194
1195          --  Should never happen
1196
1197          Write_Line ("package """ & Get_Name_String (With_Name) &
1198                      """ not found");
1199          raise Program_Error;
1200
1201       else
1202          return Result;
1203       end if;
1204    end Package_From;
1205
1206    -------------
1207    -- Process --
1208    -------------
1209
1210    procedure Process
1211      (In_Tree                : Project_Tree_Ref;
1212       Project                : out Project_Id;
1213       Success                : out Boolean;
1214       From_Project_Node      : Project_Node_Id;
1215       From_Project_Node_Tree : Project_Node_Tree_Ref;
1216       Report_Error           : Put_Line_Access;
1217       When_No_Sources        : Error_Warning := Error;
1218       Reset_Tree             : Boolean := True;
1219       Current_Dir            : String := "")
1220    is
1221    begin
1222       Process_Project_Tree_Phase_1
1223         (In_Tree                => In_Tree,
1224          Project                => Project,
1225          Success                => Success,
1226          From_Project_Node      => From_Project_Node,
1227          From_Project_Node_Tree => From_Project_Node_Tree,
1228          Report_Error           => Report_Error,
1229          Reset_Tree             => Reset_Tree);
1230
1231       if not In_Configuration then
1232          Process_Project_Tree_Phase_2
1233            (In_Tree                => In_Tree,
1234             Project                => Project,
1235             Success                => Success,
1236             From_Project_Node      => From_Project_Node,
1237             From_Project_Node_Tree => From_Project_Node_Tree,
1238             Report_Error           => Report_Error,
1239             When_No_Sources        => When_No_Sources,
1240             Current_Dir            => Current_Dir);
1241       end if;
1242    end Process;
1243
1244    -------------------------------
1245    -- Process_Declarative_Items --
1246    -------------------------------
1247
1248    procedure Process_Declarative_Items
1249      (Project                : Project_Id;
1250       In_Tree                : Project_Tree_Ref;
1251       From_Project_Node      : Project_Node_Id;
1252       From_Project_Node_Tree : Project_Node_Tree_Ref;
1253       Pkg                    : Package_Id;
1254       Item                   : Project_Node_Id)
1255    is
1256       Current_Declarative_Item : Project_Node_Id;
1257       Current_Item             : Project_Node_Id;
1258
1259    begin
1260       --  Loop through declarative items
1261
1262       Current_Item := Empty_Node;
1263
1264       Current_Declarative_Item := Item;
1265       while Present (Current_Declarative_Item) loop
1266
1267          --  Get its data
1268
1269          Current_Item :=
1270            Current_Item_Node
1271              (Current_Declarative_Item, From_Project_Node_Tree);
1272
1273          --  And set Current_Declarative_Item to the next declarative item
1274          --  ready for the next iteration.
1275
1276          Current_Declarative_Item :=
1277            Next_Declarative_Item
1278              (Current_Declarative_Item, From_Project_Node_Tree);
1279
1280          case Kind_Of (Current_Item, From_Project_Node_Tree) is
1281
1282             when N_Package_Declaration =>
1283
1284                --  Do not process a package declaration that should be ignored
1285
1286                if Expression_Kind_Of
1287                     (Current_Item, From_Project_Node_Tree) /= Ignored
1288                then
1289                   --  Create the new package
1290
1291                   Package_Table.Increment_Last (In_Tree.Packages);
1292
1293                   declare
1294                      New_Pkg         : constant Package_Id :=
1295                                          Package_Table.Last (In_Tree.Packages);
1296                      The_New_Package : Package_Element;
1297
1298                      Project_Of_Renamed_Package :
1299                        constant Project_Node_Id :=
1300                          Project_Of_Renamed_Package_Of
1301                            (Current_Item, From_Project_Node_Tree);
1302
1303                   begin
1304                      --  Set the name of the new package
1305
1306                      The_New_Package.Name :=
1307                        Name_Of (Current_Item, From_Project_Node_Tree);
1308
1309                      --  Insert the new package in the appropriate list
1310
1311                      if Pkg /= No_Package then
1312                         The_New_Package.Next :=
1313                           In_Tree.Packages.Table (Pkg).Decl.Packages;
1314                         In_Tree.Packages.Table (Pkg).Decl.Packages :=
1315                           New_Pkg;
1316
1317                      else
1318                         The_New_Package.Next :=
1319                           In_Tree.Projects.Table (Project).Decl.Packages;
1320                         In_Tree.Projects.Table (Project).Decl.Packages :=
1321                           New_Pkg;
1322                      end if;
1323
1324                      In_Tree.Packages.Table (New_Pkg) :=
1325                        The_New_Package;
1326
1327                      if Present (Project_Of_Renamed_Package) then
1328
1329                         --  Renamed package
1330
1331                         declare
1332                            Project_Name : constant Name_Id :=
1333                                             Name_Of
1334                                               (Project_Of_Renamed_Package,
1335                                                From_Project_Node_Tree);
1336
1337                            Renamed_Project :
1338                              constant Project_Id :=
1339                                Imported_Or_Extended_Project_From
1340                                (Project, In_Tree, Project_Name);
1341
1342                            Renamed_Package : constant Package_Id :=
1343                                                Package_From
1344                                                  (Renamed_Project, In_Tree,
1345                                                   Name_Of
1346                                                     (Current_Item,
1347                                                      From_Project_Node_Tree));
1348
1349                         begin
1350                            --  For a renamed package, copy the declarations of
1351                            --  the renamed package, but set all the locations
1352                            --  to the location of the package name in the
1353                            --  renaming declaration.
1354
1355                            Copy_Package_Declarations
1356                              (From              =>
1357                                 In_Tree.Packages.Table (Renamed_Package).Decl,
1358                               To                =>
1359                                 In_Tree.Packages.Table (New_Pkg).Decl,
1360                               New_Loc           =>
1361                                 Location_Of
1362                                   (Current_Item, From_Project_Node_Tree),
1363                               Naming_Restricted => False,
1364                               In_Tree           => In_Tree);
1365                         end;
1366
1367                      --  Standard package declaration, not renaming
1368
1369                      else
1370                         --  Set the default values of the attributes
1371
1372                         Add_Attributes
1373                           (Project,
1374                            In_Tree.Projects.Table (Project).Name,
1375                            In_Tree,
1376                            In_Tree.Packages.Table (New_Pkg).Decl,
1377                            First_Attribute_Of
1378                              (Package_Id_Of
1379                                 (Current_Item, From_Project_Node_Tree)),
1380                            Project_Level => False);
1381
1382                         --  And process declarative items of the new package
1383
1384                         Process_Declarative_Items
1385                           (Project                => Project,
1386                            In_Tree                => In_Tree,
1387                            From_Project_Node      => From_Project_Node,
1388                            From_Project_Node_Tree => From_Project_Node_Tree,
1389                            Pkg                    => New_Pkg,
1390                            Item                   =>
1391                              First_Declarative_Item_Of
1392                                (Current_Item, From_Project_Node_Tree));
1393                      end if;
1394                   end;
1395                end if;
1396
1397             when N_String_Type_Declaration =>
1398
1399                --  There is nothing to process
1400
1401                null;
1402
1403             when N_Attribute_Declaration      |
1404                  N_Typed_Variable_Declaration |
1405                  N_Variable_Declaration       =>
1406
1407                if Expression_Of (Current_Item, From_Project_Node_Tree) =
1408                                                                   Empty_Node
1409                then
1410
1411                   --  It must be a full associative array attribute declaration
1412
1413                   declare
1414                      Current_Item_Name : constant Name_Id :=
1415                                            Name_Of
1416                                              (Current_Item,
1417                                               From_Project_Node_Tree);
1418                      --  The name of the attribute
1419
1420                      Current_Location  : constant Source_Ptr :=
1421                                            Location_Of
1422                                              (Current_Item,
1423                                               From_Project_Node_Tree);
1424
1425                      New_Array : Array_Id;
1426                      --  The new associative array created
1427
1428                      Orig_Array : Array_Id;
1429                      --  The associative array value
1430
1431                      Orig_Project_Name : Name_Id := No_Name;
1432                      --  The name of the project where the associative array
1433                      --  value is.
1434
1435                      Orig_Project : Project_Id := No_Project;
1436                      --  The id of the project where the associative array
1437                      --  value is.
1438
1439                      Orig_Package_Name : Name_Id := No_Name;
1440                      --  The name of the package, if any, where the associative
1441                      --  array value is.
1442
1443                      Orig_Package : Package_Id := No_Package;
1444                      --  The id of the package, if any, where the associative
1445                      --  array value is.
1446
1447                      New_Element : Array_Element_Id := No_Array_Element;
1448                      --  Id of a new array element created
1449
1450                      Prev_Element : Array_Element_Id := No_Array_Element;
1451                      --  Last new element id created
1452
1453                      Orig_Element : Array_Element_Id := No_Array_Element;
1454                      --  Current array element in original associative array
1455
1456                      Next_Element : Array_Element_Id := No_Array_Element;
1457                      --  Id of the array element that follows the new element.
1458                      --  This is not always nil, because values for the
1459                      --  associative array attribute may already have been
1460                      --  declared, and the array elements declared are reused.
1461
1462                   begin
1463                      --  First find if the associative array attribute already
1464                      --  has elements declared.
1465
1466                      if Pkg /= No_Package then
1467                         New_Array := In_Tree.Packages.Table
1468                                        (Pkg).Decl.Arrays;
1469
1470                      else
1471                         New_Array := In_Tree.Projects.Table
1472                                        (Project).Decl.Arrays;
1473                      end if;
1474
1475                      while New_Array /= No_Array
1476                        and then In_Tree.Arrays.Table (New_Array).Name /=
1477                                                            Current_Item_Name
1478                      loop
1479                         New_Array := In_Tree.Arrays.Table (New_Array).Next;
1480                      end loop;
1481
1482                      --  If the attribute has never been declared add new entry
1483                      --  in the arrays of the project/package and link it.
1484
1485                      if New_Array = No_Array then
1486                         Array_Table.Increment_Last (In_Tree.Arrays);
1487                         New_Array := Array_Table.Last (In_Tree.Arrays);
1488
1489                         if Pkg /= No_Package then
1490                            In_Tree.Arrays.Table (New_Array) :=
1491                              (Name     => Current_Item_Name,
1492                               Location => Current_Location,
1493                               Value    => No_Array_Element,
1494                               Next     => In_Tree.Packages.Table
1495                                             (Pkg).Decl.Arrays);
1496
1497                            In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1498                              New_Array;
1499
1500                         else
1501                            In_Tree.Arrays.Table (New_Array) :=
1502                              (Name     => Current_Item_Name,
1503                               Location => Current_Location,
1504                               Value    => No_Array_Element,
1505                               Next     => In_Tree.Projects.Table
1506                                             (Project).Decl.Arrays);
1507
1508                            In_Tree.Projects.Table (Project).Decl.Arrays :=
1509                              New_Array;
1510                         end if;
1511                      end if;
1512
1513                      --  Find the project where the value is declared
1514
1515                      Orig_Project_Name :=
1516                        Name_Of
1517                          (Associative_Project_Of
1518                               (Current_Item, From_Project_Node_Tree),
1519                           From_Project_Node_Tree);
1520
1521                      for Index in Project_Table.First ..
1522                                   Project_Table.Last
1523                                     (In_Tree.Projects)
1524                      loop
1525                         if In_Tree.Projects.Table (Index).Name =
1526                                                            Orig_Project_Name
1527                         then
1528                            Orig_Project := Index;
1529                            exit;
1530                         end if;
1531                      end loop;
1532
1533                      pragma Assert (Orig_Project /= No_Project,
1534                                     "original project not found");
1535
1536                      if No (Associative_Package_Of
1537                               (Current_Item, From_Project_Node_Tree))
1538                      then
1539                         Orig_Array :=
1540                           In_Tree.Projects.Table
1541                             (Orig_Project).Decl.Arrays;
1542
1543                      else
1544                         --  If in a package, find the package where the value
1545                         --  is declared.
1546
1547                         Orig_Package_Name :=
1548                           Name_Of
1549                             (Associative_Package_Of
1550                                  (Current_Item, From_Project_Node_Tree),
1551                              From_Project_Node_Tree);
1552
1553                         Orig_Package :=
1554                           In_Tree.Projects.Table
1555                             (Orig_Project).Decl.Packages;
1556                         pragma Assert (Orig_Package /= No_Package,
1557                                        "original package not found");
1558
1559                         while In_Tree.Packages.Table
1560                                 (Orig_Package).Name /= Orig_Package_Name
1561                         loop
1562                            Orig_Package := In_Tree.Packages.Table
1563                                              (Orig_Package).Next;
1564                            pragma Assert (Orig_Package /= No_Package,
1565                                           "original package not found");
1566                         end loop;
1567
1568                         Orig_Array :=
1569                           In_Tree.Packages.Table
1570                             (Orig_Package).Decl.Arrays;
1571                      end if;
1572
1573                      --  Now look for the array
1574
1575                      while Orig_Array /= No_Array
1576                        and then In_Tree.Arrays.Table (Orig_Array).Name /=
1577                                                          Current_Item_Name
1578                      loop
1579                         Orig_Array := In_Tree.Arrays.Table
1580                                         (Orig_Array).Next;
1581                      end loop;
1582
1583                      if Orig_Array = No_Array then
1584                         if Error_Report = null then
1585                            Error_Msg
1586                              ("associative array value cannot be found",
1587                               Location_Of
1588                                 (Current_Item, From_Project_Node_Tree));
1589                         else
1590                            Error_Report
1591                              ("associative array value cannot be found",
1592                               Project, In_Tree);
1593                         end if;
1594
1595                      else
1596                         Orig_Element :=
1597                           In_Tree.Arrays.Table (Orig_Array).Value;
1598
1599                         --  Copy each array element
1600
1601                         while Orig_Element /= No_Array_Element loop
1602
1603                            --  Case of first element
1604
1605                            if Prev_Element = No_Array_Element then
1606
1607                               --  And there is no array element declared yet,
1608                               --  create a new first array element.
1609
1610                               if In_Tree.Arrays.Table (New_Array).Value =
1611                                                               No_Array_Element
1612                               then
1613                                  Array_Element_Table.Increment_Last
1614                                    (In_Tree.Array_Elements);
1615                                  New_Element := Array_Element_Table.Last
1616                                    (In_Tree.Array_Elements);
1617                                  In_Tree.Arrays.Table
1618                                    (New_Array).Value := New_Element;
1619                                  Next_Element := No_Array_Element;
1620
1621                               --  Otherwise, the new element is the first
1622
1623                               else
1624                                  New_Element := In_Tree.Arrays.
1625                                                   Table (New_Array).Value;
1626                                  Next_Element :=
1627                                    In_Tree.Array_Elements.Table
1628                                      (New_Element).Next;
1629                               end if;
1630
1631                            --  Otherwise, reuse an existing element, or create
1632                            --  one if necessary.
1633
1634                            else
1635                               Next_Element :=
1636                                 In_Tree.Array_Elements.Table
1637                                   (Prev_Element).Next;
1638
1639                               if Next_Element = No_Array_Element then
1640                                  Array_Element_Table.Increment_Last
1641                                    (In_Tree.Array_Elements);
1642                                  New_Element :=
1643                                    Array_Element_Table.Last
1644                                     (In_Tree.Array_Elements);
1645                                  In_Tree.Array_Elements.Table
1646                                    (Prev_Element).Next := New_Element;
1647
1648                               else
1649                                  New_Element := Next_Element;
1650                                  Next_Element :=
1651                                    In_Tree.Array_Elements.Table
1652                                      (New_Element).Next;
1653                               end if;
1654                            end if;
1655
1656                            --  Copy the value of the element
1657
1658                            In_Tree.Array_Elements.Table
1659                              (New_Element) :=
1660                                In_Tree.Array_Elements.Table (Orig_Element);
1661                            In_Tree.Array_Elements.Table
1662                              (New_Element).Value.Project := Project;
1663
1664                            --  Adjust the Next link
1665
1666                            In_Tree.Array_Elements.Table
1667                              (New_Element).Next := Next_Element;
1668
1669                            --  Adjust the previous id for the next element
1670
1671                            Prev_Element := New_Element;
1672
1673                            --  Go to the next element in the original array
1674
1675                            Orig_Element :=
1676                              In_Tree.Array_Elements.Table
1677                                (Orig_Element).Next;
1678                         end loop;
1679
1680                         --  Make sure that the array ends here, in case there
1681                         --  previously a greater number of elements.
1682
1683                         In_Tree.Array_Elements.Table
1684                           (New_Element).Next := No_Array_Element;
1685                      end if;
1686                   end;
1687
1688                --  Declarations other that full associative arrays
1689
1690                else
1691                   declare
1692                      New_Value : constant Variable_Value :=
1693                        Expression
1694                          (Project                => Project,
1695                           In_Tree                => In_Tree,
1696                           From_Project_Node      => From_Project_Node,
1697                           From_Project_Node_Tree => From_Project_Node_Tree,
1698                           Pkg                    => Pkg,
1699                           First_Term             =>
1700                             Tree.First_Term
1701                               (Expression_Of
1702                                    (Current_Item, From_Project_Node_Tree),
1703                                From_Project_Node_Tree),
1704                           Kind                   =>
1705                             Expression_Kind_Of
1706                               (Current_Item, From_Project_Node_Tree));
1707                      --  The expression value
1708
1709                      The_Variable : Variable_Id := No_Variable;
1710
1711                      Current_Item_Name : constant Name_Id :=
1712                                            Name_Of
1713                                              (Current_Item,
1714                                               From_Project_Node_Tree);
1715
1716                      Current_Location : constant Source_Ptr :=
1717                                           Location_Of
1718                                             (Current_Item,
1719                                              From_Project_Node_Tree);
1720
1721                   begin
1722                      --  Process a typed variable declaration
1723
1724                      if Kind_Of (Current_Item, From_Project_Node_Tree) =
1725                           N_Typed_Variable_Declaration
1726                      then
1727                         --  Report an error for an empty string
1728
1729                         if New_Value.Value = Empty_String then
1730                            Error_Msg_Name_1 :=
1731                              Name_Of (Current_Item, From_Project_Node_Tree);
1732
1733                            if Error_Report = null then
1734                               Error_Msg
1735                                 ("no value defined for %%",
1736                                  Location_Of
1737                                    (Current_Item, From_Project_Node_Tree));
1738                            else
1739                               Error_Report
1740                                 ("no value defined for " &
1741                                  Get_Name_String (Error_Msg_Name_1),
1742                                  Project, In_Tree);
1743                            end if;
1744
1745                         else
1746                            declare
1747                               Current_String : Project_Node_Id;
1748
1749                            begin
1750                               --  Loop through all the valid strings for the
1751                               --  string type and compare to the string value.
1752
1753                               Current_String :=
1754                                 First_Literal_String
1755                                   (String_Type_Of (Current_Item,
1756                                                    From_Project_Node_Tree),
1757                                                    From_Project_Node_Tree);
1758                               while Present (Current_String)
1759                                 and then
1760                                   String_Value_Of
1761                                     (Current_String, From_Project_Node_Tree) /=
1762                                                                New_Value.Value
1763                               loop
1764                                  Current_String :=
1765                                    Next_Literal_String
1766                                      (Current_String, From_Project_Node_Tree);
1767                               end loop;
1768
1769                               --  Report an error if the string value is not
1770                               --  one for the string type.
1771
1772                               if No (Current_String) then
1773                                  Error_Msg_Name_1 := New_Value.Value;
1774                                  Error_Msg_Name_2 :=
1775                                    Name_Of
1776                                      (Current_Item, From_Project_Node_Tree);
1777
1778                                  if Error_Report = null then
1779                                     Error_Msg
1780                                       ("value %% is illegal " &
1781                                        "for typed string %%",
1782                                        Location_Of
1783                                          (Current_Item,
1784                                           From_Project_Node_Tree));
1785
1786                                  else
1787                                     Error_Report
1788                                       ("value """ &
1789                                        Get_Name_String (Error_Msg_Name_1) &
1790                                        """ is illegal for typed string """ &
1791                                        Get_Name_String (Error_Msg_Name_2) &
1792                                        """",
1793                                        Project, In_Tree);
1794                                  end if;
1795                               end if;
1796                            end;
1797                         end if;
1798                      end if;
1799
1800                      --  Comment here ???
1801
1802                      if Kind_Of (Current_Item, From_Project_Node_Tree) /=
1803                           N_Attribute_Declaration
1804                        or else
1805                          Associative_Array_Index_Of
1806                            (Current_Item, From_Project_Node_Tree) = No_Name
1807                      then
1808                         --  Case of a variable declaration or of a not
1809                         --  associative array attribute.
1810
1811                         --  First, find the list where to find the variable
1812                         --  or attribute.
1813
1814                         if Kind_Of (Current_Item, From_Project_Node_Tree) =
1815                              N_Attribute_Declaration
1816                         then
1817                            if Pkg /= No_Package then
1818                               The_Variable :=
1819                                 In_Tree.Packages.Table
1820                                   (Pkg).Decl.Attributes;
1821                            else
1822                               The_Variable :=
1823                                 In_Tree.Projects.Table
1824                                   (Project).Decl.Attributes;
1825                            end if;
1826
1827                         else
1828                            if Pkg /= No_Package then
1829                               The_Variable :=
1830                                 In_Tree.Packages.Table
1831                                   (Pkg).Decl.Variables;
1832                            else
1833                               The_Variable :=
1834                                 In_Tree.Projects.Table
1835                                   (Project).Decl.Variables;
1836                            end if;
1837
1838                         end if;
1839
1840                         --  Loop through the list, to find if it has already
1841                         --  been declared.
1842
1843                         while The_Variable /= No_Variable
1844                           and then
1845                             In_Tree.Variable_Elements.Table
1846                               (The_Variable).Name /= Current_Item_Name
1847                         loop
1848                            The_Variable :=
1849                              In_Tree.Variable_Elements.Table
1850                                (The_Variable).Next;
1851                         end loop;
1852
1853                         --  If it has not been declared, create a new entry
1854                         --  in the list.
1855
1856                         if The_Variable = No_Variable then
1857
1858                            --  All single string attribute should already have
1859                            --  been declared with a default empty string value.
1860
1861                            pragma Assert
1862                              (Kind_Of (Current_Item, From_Project_Node_Tree) /=
1863                                 N_Attribute_Declaration,
1864                               "illegal attribute declaration");
1865
1866                            Variable_Element_Table.Increment_Last
1867                              (In_Tree.Variable_Elements);
1868                            The_Variable := Variable_Element_Table.Last
1869                              (In_Tree.Variable_Elements);
1870
1871                            --  Put the new variable in the appropriate list
1872
1873                            if Pkg /= No_Package then
1874                               In_Tree.Variable_Elements.Table (The_Variable) :=
1875                                 (Next   =>
1876                                    In_Tree.Packages.Table
1877                                      (Pkg).Decl.Variables,
1878                                  Name   => Current_Item_Name,
1879                                  Value  => New_Value);
1880                               In_Tree.Packages.Table
1881                                 (Pkg).Decl.Variables := The_Variable;
1882
1883                            else
1884                               In_Tree.Variable_Elements.Table (The_Variable) :=
1885                                 (Next   =>
1886                                    In_Tree.Projects.Table
1887                                      (Project).Decl.Variables,
1888                                  Name   => Current_Item_Name,
1889                                  Value  => New_Value);
1890                               In_Tree.Projects.Table
1891                                 (Project).Decl.Variables :=
1892                                   The_Variable;
1893                            end if;
1894
1895                         --  If the variable/attribute has already been
1896                         --  declared, just change the value.
1897
1898                         else
1899                            In_Tree.Variable_Elements.Table
1900                              (The_Variable).Value := New_Value;
1901                         end if;
1902
1903                      --  Associative array attribute
1904
1905                      else
1906                         declare
1907                            Index_Name : Name_Id :=
1908                              Associative_Array_Index_Of
1909                                (Current_Item, From_Project_Node_Tree);
1910                            Lower      : Boolean;
1911                            The_Array : Array_Id;
1912
1913                            The_Array_Element : Array_Element_Id :=
1914                                                  No_Array_Element;
1915
1916                         begin
1917                            if Index_Name /= All_Other_Names then
1918                               --  Get the string index
1919
1920                               Get_Name_String
1921                                 (Associative_Array_Index_Of
1922                                    (Current_Item, From_Project_Node_Tree));
1923
1924                               --  Put in lower case, if necessary
1925
1926                               Lower :=
1927                                 Case_Insensitive
1928                                   (Current_Item, From_Project_Node_Tree);
1929
1930                               --  In multi-language mode (gprbuild), the index
1931                               --  is always case insensitive if it does not
1932                               --  include any dot.
1933
1934                               if Get_Mode = Multi_Language
1935                                 and then not Lower
1936                               then
1937                                  for J in 1 .. Name_Len loop
1938                                     if Name_Buffer (J) = '.' then
1939                                        Lower := False;
1940                                        exit;
1941                                     end if;
1942                                  end loop;
1943                               end if;
1944
1945                               if Lower then
1946                                  GNAT.Case_Util.To_Lower
1947                                    (Name_Buffer (1 .. Name_Len));
1948                               end if;
1949
1950                               Index_Name := Name_Find;
1951                            end if;
1952
1953                            --  Look for the array in the appropriate list
1954
1955                            if Pkg /= No_Package then
1956                               The_Array :=
1957                                 In_Tree.Packages.Table (Pkg).Decl.Arrays;
1958
1959                            else
1960                               The_Array :=
1961                                 In_Tree.Projects.Table (Project).Decl.Arrays;
1962                            end if;
1963
1964                            while
1965                              The_Array /= No_Array
1966                                and then
1967                                  In_Tree.Arrays.Table (The_Array).Name /=
1968                                                             Current_Item_Name
1969                            loop
1970                               The_Array := In_Tree.Arrays.Table
1971                                              (The_Array).Next;
1972                            end loop;
1973
1974                            --  If the array cannot be found, create a new entry
1975                            --  in the list. As The_Array_Element is initialized
1976                            --  to No_Array_Element, a new element will be
1977                            --  created automatically later
1978
1979                            if The_Array = No_Array then
1980                               Array_Table.Increment_Last (In_Tree.Arrays);
1981                               The_Array := Array_Table.Last (In_Tree.Arrays);
1982
1983                               if Pkg /= No_Package then
1984                                  In_Tree.Arrays.Table (The_Array) :=
1985                                    (Name     => Current_Item_Name,
1986                                     Location => Current_Location,
1987                                     Value    => No_Array_Element,
1988                                     Next     => In_Tree.Packages.Table
1989                                                   (Pkg).Decl.Arrays);
1990
1991                                  In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1992                                      The_Array;
1993
1994                               else
1995                                  In_Tree.Arrays.Table (The_Array) :=
1996                                    (Name     => Current_Item_Name,
1997                                     Location => Current_Location,
1998                                     Value    => No_Array_Element,
1999                                     Next     => In_Tree.Projects.Table
2000                                                   (Project).Decl.Arrays);
2001
2002                                  In_Tree.Projects.Table
2003                                    (Project).Decl.Arrays := The_Array;
2004                               end if;
2005
2006                            --  Otherwise initialize The_Array_Element as the
2007                            --  head of the element list.
2008
2009                            else
2010                               The_Array_Element :=
2011                                 In_Tree.Arrays.Table (The_Array).Value;
2012                            end if;
2013
2014                            --  Look in the list, if any, to find an element
2015                            --  with the same index.
2016
2017                            while The_Array_Element /= No_Array_Element
2018                              and then
2019                                In_Tree.Array_Elements.Table
2020                                  (The_Array_Element).Index /= Index_Name
2021                            loop
2022                               The_Array_Element :=
2023                                 In_Tree.Array_Elements.Table
2024                                   (The_Array_Element).Next;
2025                            end loop;
2026
2027                            --  If no such element were found, create a new one
2028                            --  and insert it in the element list, with the
2029                            --  proper value.
2030
2031                            if The_Array_Element = No_Array_Element then
2032                               Array_Element_Table.Increment_Last
2033                                 (In_Tree.Array_Elements);
2034                               The_Array_Element := Array_Element_Table.Last
2035                                 (In_Tree.Array_Elements);
2036
2037                               In_Tree.Array_Elements.Table
2038                                 (The_Array_Element) :=
2039                                   (Index  => Index_Name,
2040                                    Src_Index =>
2041                                      Source_Index_Of
2042                                        (Current_Item, From_Project_Node_Tree),
2043                                    Index_Case_Sensitive =>
2044                                      not Case_Insensitive
2045                                        (Current_Item, From_Project_Node_Tree),
2046                                    Value  => New_Value,
2047                                    Next   => In_Tree.Arrays.Table
2048                                              (The_Array).Value);
2049                               In_Tree.Arrays.Table
2050                                 (The_Array).Value := The_Array_Element;
2051
2052                            --  An element with the same index already exists,
2053                            --  just replace its value with the new one.
2054
2055                            else
2056                               In_Tree.Array_Elements.Table
2057                                 (The_Array_Element).Value := New_Value;
2058                            end if;
2059                         end;
2060                      end if;
2061                   end;
2062                end if;
2063
2064             when N_Case_Construction =>
2065                declare
2066                   The_Project : Project_Id := Project;
2067                   --  The id of the project of the case variable
2068
2069                   The_Package : Package_Id := Pkg;
2070                   --  The id of the package, if any, of the case variable
2071
2072                   The_Variable : Variable_Value := Nil_Variable_Value;
2073                   --  The case variable
2074
2075                   Case_Value : Name_Id := No_Name;
2076                   --  The case variable value
2077
2078                   Case_Item     : Project_Node_Id := Empty_Node;
2079                   Choice_String : Project_Node_Id := Empty_Node;
2080                   Decl_Item     : Project_Node_Id := Empty_Node;
2081
2082                begin
2083                   declare
2084                      Variable_Node : constant Project_Node_Id :=
2085                                        Case_Variable_Reference_Of
2086                                          (Current_Item,
2087                                           From_Project_Node_Tree);
2088
2089                      Var_Id : Variable_Id := No_Variable;
2090                      Name   : Name_Id     := No_Name;
2091
2092                   begin
2093                      --  If a project was specified for the case variable,
2094                      --  get its id.
2095
2096                      if Present (Project_Node_Of
2097                                    (Variable_Node, From_Project_Node_Tree))
2098                      then
2099                         Name :=
2100                           Name_Of
2101                             (Project_Node_Of
2102                                (Variable_Node, From_Project_Node_Tree),
2103                              From_Project_Node_Tree);
2104                         The_Project :=
2105                           Imported_Or_Extended_Project_From
2106                             (Project, In_Tree, Name);
2107                      end if;
2108
2109                      --  If a package were specified for the case variable,
2110                      --  get its id.
2111
2112                      if Present (Package_Node_Of
2113                                    (Variable_Node, From_Project_Node_Tree))
2114                      then
2115                         Name :=
2116                           Name_Of
2117                             (Package_Node_Of
2118                                (Variable_Node, From_Project_Node_Tree),
2119                              From_Project_Node_Tree);
2120                         The_Package :=
2121                           Package_From (The_Project, In_Tree, Name);
2122                      end if;
2123
2124                      Name := Name_Of (Variable_Node, From_Project_Node_Tree);
2125
2126                      --  First, look for the case variable into the package,
2127                      --  if any.
2128
2129                      if The_Package /= No_Package then
2130                         Var_Id := In_Tree.Packages.Table
2131                                     (The_Package).Decl.Variables;
2132                         Name :=
2133                           Name_Of (Variable_Node, From_Project_Node_Tree);
2134                         while Var_Id /= No_Variable
2135                           and then
2136                             In_Tree.Variable_Elements.Table
2137                               (Var_Id).Name /= Name
2138                         loop
2139                            Var_Id := In_Tree.Variable_Elements.
2140                                        Table (Var_Id).Next;
2141                         end loop;
2142                      end if;
2143
2144                      --  If not found in the package, or if there is no
2145                      --  package, look at the project level.
2146
2147                      if Var_Id = No_Variable
2148                         and then
2149                         No (Package_Node_Of
2150                               (Variable_Node, From_Project_Node_Tree))
2151                      then
2152                         Var_Id := In_Tree.Projects.Table
2153                                     (The_Project).Decl.Variables;
2154                         while Var_Id /= No_Variable
2155                           and then
2156                             In_Tree.Variable_Elements.Table
2157                               (Var_Id).Name /= Name
2158                         loop
2159                            Var_Id := In_Tree.Variable_Elements.
2160                                        Table (Var_Id).Next;
2161                         end loop;
2162                      end if;
2163
2164                      if Var_Id = No_Variable then
2165
2166                         --  Should never happen, because this has already been
2167                         --  checked during parsing.
2168
2169                         Write_Line ("variable """ &
2170                                     Get_Name_String (Name) &
2171                                     """ not found");
2172                         raise Program_Error;
2173                      end if;
2174
2175                      --  Get the case variable
2176
2177                      The_Variable := In_Tree.Variable_Elements.
2178                                        Table (Var_Id).Value;
2179
2180                      if The_Variable.Kind /= Single then
2181
2182                         --  Should never happen, because this has already been
2183                         --  checked during parsing.
2184
2185                         Write_Line ("variable""" &
2186                                     Get_Name_String (Name) &
2187                                     """ is not a single string variable");
2188                         raise Program_Error;
2189                      end if;
2190
2191                      --  Get the case variable value
2192                      Case_Value := The_Variable.Value;
2193                   end;
2194
2195                   --  Now look into all the case items of the case construction
2196
2197                   Case_Item :=
2198                     First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
2199                   Case_Item_Loop :
2200                      while Present (Case_Item) loop
2201                         Choice_String :=
2202                           First_Choice_Of (Case_Item, From_Project_Node_Tree);
2203
2204                         --  When Choice_String is nil, it means that it is
2205                         --  the "when others =>" alternative.
2206
2207                         if No (Choice_String) then
2208                            Decl_Item :=
2209                              First_Declarative_Item_Of
2210                                (Case_Item, From_Project_Node_Tree);
2211                            exit Case_Item_Loop;
2212                         end if;
2213
2214                         --  Look into all the alternative of this case item
2215
2216                         Choice_Loop :
2217                            while Present (Choice_String) loop
2218                               if Case_Value =
2219                                 String_Value_Of
2220                                   (Choice_String, From_Project_Node_Tree)
2221                               then
2222                                  Decl_Item :=
2223                                    First_Declarative_Item_Of
2224                                      (Case_Item, From_Project_Node_Tree);
2225                                  exit Case_Item_Loop;
2226                               end if;
2227
2228                               Choice_String :=
2229                                 Next_Literal_String
2230                                   (Choice_String, From_Project_Node_Tree);
2231                            end loop Choice_Loop;
2232
2233                         Case_Item :=
2234                           Next_Case_Item (Case_Item, From_Project_Node_Tree);
2235                      end loop Case_Item_Loop;
2236
2237                   --  If there is an alternative, then we process it
2238
2239                   if Present (Decl_Item) then
2240                      Process_Declarative_Items
2241                        (Project                => Project,
2242                         In_Tree                => In_Tree,
2243                         From_Project_Node      => From_Project_Node,
2244                         From_Project_Node_Tree => From_Project_Node_Tree,
2245                         Pkg                    => Pkg,
2246                         Item                   => Decl_Item);
2247                   end if;
2248                end;
2249
2250             when others =>
2251
2252                --  Should never happen
2253
2254                Write_Line ("Illegal declarative item: " &
2255                            Project_Node_Kind'Image
2256                              (Kind_Of
2257                                 (Current_Item, From_Project_Node_Tree)));
2258                raise Program_Error;
2259          end case;
2260       end loop;
2261    end Process_Declarative_Items;
2262
2263    ----------------------------------
2264    -- Process_Project_Tree_Phase_1 --
2265    ----------------------------------
2266
2267    procedure Process_Project_Tree_Phase_1
2268      (In_Tree                : Project_Tree_Ref;
2269       Project                : out Project_Id;
2270       Success                : out Boolean;
2271       From_Project_Node      : Project_Node_Id;
2272       From_Project_Node_Tree : Project_Node_Tree_Ref;
2273       Report_Error           : Put_Line_Access;
2274       Reset_Tree             : Boolean := True)
2275    is
2276    begin
2277       Error_Report := Report_Error;
2278
2279       if Reset_Tree then
2280
2281          --  Make sure there are no projects in the data structure
2282
2283          Project_Table.Set_Last (In_Tree.Projects, No_Project);
2284       end if;
2285
2286       Processed_Projects.Reset;
2287
2288       --  And process the main project and all of the projects it depends on,
2289       --  recursively.
2290
2291       Recursive_Process
2292         (Project                => Project,
2293          In_Tree                => In_Tree,
2294          From_Project_Node      => From_Project_Node,
2295          From_Project_Node_Tree => From_Project_Node_Tree,
2296          Extended_By            => No_Project);
2297
2298       Success :=
2299         Total_Errors_Detected = 0
2300           and then
2301             (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2302    end Process_Project_Tree_Phase_1;
2303
2304    ----------------------------------
2305    -- Process_Project_Tree_Phase_2 --
2306    ----------------------------------
2307
2308    procedure Process_Project_Tree_Phase_2
2309      (In_Tree                : Project_Tree_Ref;
2310       Project                : Project_Id;
2311       Success                : out Boolean;
2312       From_Project_Node      : Project_Node_Id;
2313       From_Project_Node_Tree : Project_Node_Tree_Ref;
2314       Report_Error           : Put_Line_Access;
2315       When_No_Sources        : Error_Warning := Error;
2316       Current_Dir            : String)
2317    is
2318       Obj_Dir    : Path_Name_Type;
2319       Extending  : Project_Id;
2320       Extending2 : Project_Id;
2321
2322    --  Start of processing for Process_Project_Tree_Phase_2
2323
2324    begin
2325       Error_Report := Report_Error;
2326       Success := True;
2327
2328       if Project /= No_Project then
2329          Check (In_Tree, Project, Current_Dir, When_No_Sources);
2330       end if;
2331
2332       --  If main project is an extending all project, set the object
2333       --  directory of all virtual extending projects to the object
2334       --  directory of the main project.
2335
2336       if Project /= No_Project
2337         and then
2338           Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
2339       then
2340          declare
2341             Object_Dir : constant Path_Name_Type :=
2342                            In_Tree.Projects.Table
2343                              (Project).Object_Directory.Name;
2344          begin
2345             for Index in
2346               Project_Table.First .. Project_Table.Last (In_Tree.Projects)
2347             loop
2348                if In_Tree.Projects.Table (Index).Virtual then
2349                   In_Tree.Projects.Table (Index).Object_Directory.Name :=
2350                     Object_Dir;
2351                end if;
2352             end loop;
2353          end;
2354       end if;
2355
2356       --  Check that no extending project shares its object directory with
2357       --  the project(s) it extends.
2358
2359       if Project /= No_Project then
2360          for Proj in
2361            Project_Table.First .. Project_Table.Last (In_Tree.Projects)
2362          loop
2363             Extending := In_Tree.Projects.Table (Proj).Extended_By;
2364
2365             if Extending /= No_Project then
2366                Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory.Name;
2367
2368                --  Check that a project being extended does not share its
2369                --  object directory with any project that extends it, directly
2370                --  or indirectly, including a virtual extending project.
2371
2372                --  Start with the project directly extending it
2373
2374                Extending2 := Extending;
2375                while Extending2 /= No_Project loop
2376                   if In_Tree.Projects.Table (Extending2).Ada_Sources /=
2377                     Nil_String
2378                     and then
2379                       In_Tree.Projects.Table
2380                         (Extending2).Object_Directory.Name = Obj_Dir
2381                   then
2382                      if In_Tree.Projects.Table (Extending2).Virtual then
2383                         Error_Msg_Name_1 :=
2384                           In_Tree.Projects.Table (Proj).Display_Name;
2385
2386                         if Error_Report = null then
2387                            Error_Msg
2388                              ("project %% cannot be extended by a virtual" &
2389                               " project with the same object directory",
2390                               In_Tree.Projects.Table (Proj).Location);
2391                         else
2392                            Error_Report
2393                              ("project """ &
2394                               Get_Name_String (Error_Msg_Name_1) &
2395                               """ cannot be extended by a virtual " &
2396                               "project with the same object directory",
2397                               Project, In_Tree);
2398                         end if;
2399
2400                      else
2401                         Error_Msg_Name_1 :=
2402                           In_Tree.Projects.Table (Extending2).Display_Name;
2403                         Error_Msg_Name_2 :=
2404                           In_Tree.Projects.Table (Proj).Display_Name;
2405
2406                         if Error_Report = null then
2407                            Error_Msg
2408                              ("project %% cannot extend project %%",
2409                               In_Tree.Projects.Table (Extending2).Location);
2410                            Error_Msg
2411                              ("\they share the same object directory",
2412                               In_Tree.Projects.Table (Extending2).Location);
2413
2414                         else
2415                            Error_Report
2416                              ("project """ &
2417                               Get_Name_String (Error_Msg_Name_1) &
2418                               """ cannot extend project """ &
2419                               Get_Name_String (Error_Msg_Name_2) & """",
2420                               Project, In_Tree);
2421                            Error_Report
2422                              ("they share the same object directory",
2423                               Project, In_Tree);
2424                         end if;
2425                      end if;
2426                   end if;
2427
2428                   --  Continue with the next extending project, if any
2429
2430                   Extending2 :=
2431                     In_Tree.Projects.Table (Extending2).Extended_By;
2432                end loop;
2433             end if;
2434          end loop;
2435       end if;
2436
2437       Success :=
2438         Total_Errors_Detected = 0
2439           and then
2440             (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2441    end Process_Project_Tree_Phase_2;
2442
2443    ---------------------
2444    -- Recursive_Check --
2445    ---------------------
2446
2447    procedure Recursive_Check
2448      (Project         : Project_Id;
2449       In_Tree         : Project_Tree_Ref;
2450       Current_Dir     : String;
2451       When_No_Sources : Error_Warning)
2452    is
2453       Data                  : Project_Data;
2454       Imported_Project_List : Project_List := Empty_Project_List;
2455
2456    begin
2457       --  Do nothing if Project is No_Project, or Project has already
2458       --  been marked as checked.
2459
2460       if Project /= No_Project
2461         and then not In_Tree.Projects.Table (Project).Checked
2462       then
2463          --  Mark project as checked, to avoid infinite recursion in
2464          --  ill-formed trees, where a project imports itself.
2465
2466          In_Tree.Projects.Table (Project).Checked := True;
2467
2468          Data := In_Tree.Projects.Table (Project);
2469
2470          --  Call itself for a possible extended project.
2471          --  (if there is no extended project, then nothing happens).
2472
2473          Recursive_Check (Data.Extends, In_Tree, Current_Dir, When_No_Sources);
2474
2475          --  Call itself for all imported projects
2476
2477          Imported_Project_List := Data.Imported_Projects;
2478          while Imported_Project_List /= Empty_Project_List loop
2479             Recursive_Check
2480               (In_Tree.Project_Lists.Table
2481                  (Imported_Project_List).Project,
2482                In_Tree, Current_Dir, When_No_Sources);
2483             Imported_Project_List :=
2484               In_Tree.Project_Lists.Table
2485                 (Imported_Project_List).Next;
2486          end loop;
2487
2488          if Verbose_Mode then
2489             Write_Str ("Checking project file """);
2490             Write_Str (Get_Name_String (Data.Name));
2491             Write_Line ("""");
2492          end if;
2493
2494          Prj.Nmsc.Check
2495            (Project, In_Tree, Error_Report, When_No_Sources,
2496             Current_Dir);
2497       end if;
2498    end Recursive_Check;
2499
2500    -----------------------
2501    -- Recursive_Process --
2502    -----------------------
2503
2504    procedure Recursive_Process
2505      (In_Tree                : Project_Tree_Ref;
2506       Project                : out Project_Id;
2507       From_Project_Node      : Project_Node_Id;
2508       From_Project_Node_Tree : Project_Node_Tree_Ref;
2509       Extended_By            : Project_Id)
2510    is
2511       With_Clause : Project_Node_Id;
2512
2513    begin
2514       if No (From_Project_Node) then
2515          Project := No_Project;
2516
2517       else
2518          declare
2519             Processed_Data   : Project_Data     := Empty_Project (In_Tree);
2520             Imported         : Project_List     := Empty_Project_List;
2521             Declaration_Node : Project_Node_Id  := Empty_Node;
2522             Tref             : Source_Buffer_Ptr;
2523             Name             : constant Name_Id :=
2524                                  Name_Of
2525                                    (From_Project_Node, From_Project_Node_Tree);
2526             Location         : Source_Ptr :=
2527                                  Location_Of
2528                                    (From_Project_Node, From_Project_Node_Tree);
2529
2530          begin
2531             Project := Processed_Projects.Get (Name);
2532
2533             if Project /= No_Project then
2534
2535                --  Make sure that, when a project is extended, the project id
2536                --  of the project extending it is recorded in its data, even
2537                --  when it has already been processed as an imported project.
2538                --  This is for virtually extended projects.
2539
2540                if Extended_By /= No_Project then
2541                   In_Tree.Projects.Table (Project).Extended_By := Extended_By;
2542                end if;
2543
2544                return;
2545             end if;
2546
2547             Project_Table.Increment_Last (In_Tree.Projects);
2548             Project := Project_Table.Last (In_Tree.Projects);
2549             Processed_Projects.Set (Name, Project);
2550
2551             Processed_Data.Name := Name;
2552             Processed_Data.Qualifier :=
2553               Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
2554             In_Tree.Projects.Table (Project).Name := Name;
2555             In_Tree.Projects.Table (Project).Qualifier :=
2556               Processed_Data.Qualifier;
2557
2558             Get_Name_String (Name);
2559
2560             --  If name starts with the virtual prefix, flag the project as
2561             --  being a virtual extending project.
2562
2563             if Name_Len > Virtual_Prefix'Length
2564               and then Name_Buffer (1 .. Virtual_Prefix'Length) =
2565                          Virtual_Prefix
2566             then
2567                Processed_Data.Virtual := True;
2568                Processed_Data.Display_Name := Name;
2569
2570             --  If there is no file, for example when the project node tree is
2571             --  built in memory by GPS, the Display_Name cannot be found in
2572             --  the source, so its value is the same as Name.
2573
2574             elsif Location = No_Location then
2575                Processed_Data.Display_Name := Name;
2576
2577             --  Get the spelling of the project name from the project file
2578
2579             else
2580                Tref := Source_Text (Get_Source_File_Index (Location));
2581
2582                for J in 1 .. Name_Len loop
2583                   Name_Buffer (J) := Tref (Location);
2584                   Location := Location + 1;
2585                end loop;
2586
2587                Processed_Data.Display_Name := Name_Find;
2588             end if;
2589
2590             Processed_Data.Path.Display_Name :=
2591               Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
2592             Get_Name_String (Processed_Data.Path.Display_Name);
2593             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2594             Processed_Data.Path.Name := Name_Find;
2595
2596             Processed_Data.Location :=
2597               Location_Of (From_Project_Node, From_Project_Node_Tree);
2598
2599             Processed_Data.Directory.Display_Name :=
2600               Directory_Of (From_Project_Node, From_Project_Node_Tree);
2601             Get_Name_String (Processed_Data.Directory.Display_Name);
2602             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2603             Processed_Data.Directory.Name := Name_Find;
2604
2605             Processed_Data.Extended_By := Extended_By;
2606
2607             Add_Attributes
2608               (Project,
2609                Name,
2610                In_Tree,
2611                Processed_Data.Decl,
2612                Prj.Attr.Attribute_First,
2613                Project_Level => True);
2614
2615             --  Process non limited withed projects
2616
2617             With_Clause :=
2618               First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
2619             while Present (With_Clause) loop
2620                declare
2621                   New_Project : Project_Id;
2622                   New_Data    : Project_Data;
2623                   Proj_Node   : Project_Node_Id;
2624
2625                begin
2626                   Proj_Node :=
2627                     Non_Limited_Project_Node_Of
2628                       (With_Clause, From_Project_Node_Tree);
2629
2630                   if Present (Proj_Node) then
2631                      Recursive_Process
2632                        (In_Tree                => In_Tree,
2633                         Project                => New_Project,
2634                         From_Project_Node      =>
2635                           Project_Node_Of
2636                             (With_Clause, From_Project_Node_Tree),
2637                         From_Project_Node_Tree => From_Project_Node_Tree,
2638                         Extended_By            => No_Project);
2639
2640                      New_Data :=
2641                        In_Tree.Projects.Table (New_Project);
2642
2643                      --  If we were the first project to import it,
2644                      --  set First_Referred_By to us.
2645
2646                      if New_Data.First_Referred_By = No_Project then
2647                         New_Data.First_Referred_By := Project;
2648                         In_Tree.Projects.Table (New_Project) :=
2649                           New_Data;
2650                      end if;
2651
2652                      --  Add this project to our list of imported projects
2653
2654                      Project_List_Table.Increment_Last
2655                        (In_Tree.Project_Lists);
2656
2657                      In_Tree.Project_Lists.Table
2658                        (Project_List_Table.Last
2659                           (In_Tree.Project_Lists)) :=
2660                        (Project => New_Project, Next => Empty_Project_List);
2661
2662                      --  Imported is the id of the last imported project. If it
2663                      --  is nil, then this imported project is our first.
2664
2665                      if Imported = Empty_Project_List then
2666                         Processed_Data.Imported_Projects :=
2667                           Project_List_Table.Last
2668                             (In_Tree.Project_Lists);
2669
2670                      else
2671                         In_Tree.Project_Lists.Table
2672                           (Imported).Next := Project_List_Table.Last
2673                           (In_Tree.Project_Lists);
2674                      end if;
2675
2676                      Imported := Project_List_Table.Last
2677                        (In_Tree.Project_Lists);
2678                   end if;
2679
2680                   With_Clause :=
2681                     Next_With_Clause_Of
2682                       (With_Clause, From_Project_Node_Tree);
2683                end;
2684             end loop;
2685
2686             Declaration_Node :=
2687               Project_Declaration_Of
2688                 (From_Project_Node, From_Project_Node_Tree);
2689
2690             Recursive_Process
2691               (In_Tree                => In_Tree,
2692                Project                => Processed_Data.Extends,
2693                From_Project_Node      => Extended_Project_Of
2694                                           (Declaration_Node,
2695                                            From_Project_Node_Tree),
2696                From_Project_Node_Tree => From_Project_Node_Tree,
2697                Extended_By            => Project);
2698
2699             In_Tree.Projects.Table (Project) := Processed_Data;
2700
2701             Process_Declarative_Items
2702               (Project                => Project,
2703                In_Tree                => In_Tree,
2704                From_Project_Node      => From_Project_Node,
2705                From_Project_Node_Tree => From_Project_Node_Tree,
2706                Pkg                    => No_Package,
2707                Item                   => First_Declarative_Item_Of
2708                                           (Declaration_Node,
2709                                            From_Project_Node_Tree));
2710
2711             --  If it is an extending project, inherit all packages
2712             --  from the extended project that are not explicitly defined
2713             --  or renamed. Also inherit the languages, if attribute Languages
2714             --  is not explicitly defined.
2715
2716             Processed_Data := In_Tree.Projects.Table (Project);
2717
2718             if Processed_Data.Extends /= No_Project then
2719                declare
2720                   Extended_Pkg : Package_Id;
2721                   Current_Pkg  : Package_Id;
2722                   Element      : Package_Element;
2723                   First        : constant Package_Id :=
2724                                    Processed_Data.Decl.Packages;
2725                   Attribute1   : Variable_Id;
2726                   Attribute2   : Variable_Id;
2727                   Attr_Value1  : Variable;
2728                   Attr_Value2  : Variable;
2729
2730                begin
2731                   Extended_Pkg :=
2732                     In_Tree.Projects.Table
2733                       (Processed_Data.Extends).Decl.Packages;
2734                   while Extended_Pkg /= No_Package loop
2735                      Element :=
2736                        In_Tree.Packages.Table (Extended_Pkg);
2737
2738                      Current_Pkg := First;
2739                      while Current_Pkg /= No_Package
2740                        and then In_Tree.Packages.Table (Current_Pkg).Name /=
2741                                                                  Element.Name
2742                      loop
2743                         Current_Pkg :=
2744                           In_Tree.Packages.Table (Current_Pkg).Next;
2745                      end loop;
2746
2747                      if Current_Pkg = No_Package then
2748                         Package_Table.Increment_Last
2749                           (In_Tree.Packages);
2750                         Current_Pkg := Package_Table.Last (In_Tree.Packages);
2751                         In_Tree.Packages.Table (Current_Pkg) :=
2752                           (Name   => Element.Name,
2753                            Decl   => No_Declarations,
2754                            Parent => No_Package,
2755                            Next   => Processed_Data.Decl.Packages);
2756                         Processed_Data.Decl.Packages := Current_Pkg;
2757                         Copy_Package_Declarations
2758                           (From              => Element.Decl,
2759                            To                =>
2760                              In_Tree.Packages.Table (Current_Pkg).Decl,
2761                            New_Loc           => No_Location,
2762                            Naming_Restricted =>
2763                              Element.Name = Snames.Name_Naming,
2764                            In_Tree           => In_Tree);
2765                      end if;
2766
2767                      Extended_Pkg := Element.Next;
2768                   end loop;
2769
2770                   --  Check if attribute Languages is declared in the
2771                   --  extending project.
2772
2773                   Attribute1 := Processed_Data.Decl.Attributes;
2774                   while Attribute1 /= No_Variable loop
2775                      Attr_Value1 := In_Tree.Variable_Elements.
2776                                       Table (Attribute1);
2777                      exit when Attr_Value1.Name = Snames.Name_Languages;
2778                      Attribute1 := Attr_Value1.Next;
2779                   end loop;
2780
2781                   if Attribute1 = No_Variable or else
2782                      Attr_Value1.Value.Default
2783                   then
2784                      --  Attribute Languages is not declared in the extending
2785                      --  project. Check if it is declared in the project being
2786                      --  extended.
2787
2788                      Attribute2 :=
2789                        In_Tree.Projects.Table
2790                          (Processed_Data.Extends).Decl.Attributes;
2791                      while Attribute2 /= No_Variable loop
2792                         Attr_Value2 := In_Tree.Variable_Elements.
2793                                          Table (Attribute2);
2794                         exit when Attr_Value2.Name = Snames.Name_Languages;
2795                         Attribute2 := Attr_Value2.Next;
2796                      end loop;
2797
2798                      if Attribute2 /= No_Variable and then
2799                         not Attr_Value2.Value.Default
2800                      then
2801                         --  As attribute Languages is declared in the project
2802                         --  being extended, copy its value for the extending
2803                         --  project.
2804
2805                         if Attribute1 = No_Variable then
2806                            Variable_Element_Table.Increment_Last
2807                              (In_Tree.Variable_Elements);
2808                            Attribute1 := Variable_Element_Table.Last
2809                              (In_Tree.Variable_Elements);
2810                            Attr_Value1.Next := Processed_Data.Decl.Attributes;
2811                            Processed_Data.Decl.Attributes := Attribute1;
2812                         end if;
2813
2814                         Attr_Value1.Name := Snames.Name_Languages;
2815                         Attr_Value1.Value := Attr_Value2.Value;
2816                         In_Tree.Variable_Elements.Table
2817                           (Attribute1) := Attr_Value1;
2818                      end if;
2819                   end if;
2820                end;
2821
2822                In_Tree.Projects.Table (Project) := Processed_Data;
2823             end if;
2824
2825             --  Process limited withed projects
2826
2827             With_Clause :=
2828               First_With_Clause_Of
2829                 (From_Project_Node, From_Project_Node_Tree);
2830             while Present (With_Clause) loop
2831                declare
2832                   New_Project : Project_Id;
2833                   New_Data    : Project_Data;
2834                   Proj_Node   : Project_Node_Id;
2835
2836                begin
2837                   Proj_Node :=
2838                     Non_Limited_Project_Node_Of
2839                       (With_Clause, From_Project_Node_Tree);
2840
2841                   if No (Proj_Node) then
2842                      Recursive_Process
2843                        (In_Tree                => In_Tree,
2844                         Project                => New_Project,
2845                         From_Project_Node      =>
2846                           Project_Node_Of
2847                             (With_Clause, From_Project_Node_Tree),
2848                         From_Project_Node_Tree => From_Project_Node_Tree,
2849                         Extended_By            => No_Project);
2850
2851                      New_Data :=
2852                        In_Tree.Projects.Table (New_Project);
2853
2854                      --  If we were the first project to import it, set
2855                      --  First_Referred_By to us.
2856
2857                      if New_Data.First_Referred_By = No_Project then
2858                         New_Data.First_Referred_By := Project;
2859                         In_Tree.Projects.Table (New_Project) :=
2860                           New_Data;
2861                      end if;
2862
2863                      --  Add this project to our list of imported projects
2864
2865                      Project_List_Table.Increment_Last
2866                        (In_Tree.Project_Lists);
2867
2868                      In_Tree.Project_Lists.Table
2869                        (Project_List_Table.Last
2870                           (In_Tree.Project_Lists)) :=
2871                        (Project => New_Project, Next => Empty_Project_List);
2872
2873                      --  Imported is the id of the last imported project. If
2874                      --  it is nil, then this imported project is our first.
2875
2876                      if Imported = Empty_Project_List then
2877                         In_Tree.Projects.Table (Project).Imported_Projects :=
2878                           Project_List_Table.Last
2879                             (In_Tree.Project_Lists);
2880                      else
2881                         In_Tree.Project_Lists.Table
2882                           (Imported).Next := Project_List_Table.Last
2883                           (In_Tree.Project_Lists);
2884                      end if;
2885
2886                      Imported := Project_List_Table.Last
2887                        (In_Tree.Project_Lists);
2888                   end if;
2889
2890                   With_Clause :=
2891                     Next_With_Clause_Of
2892                       (With_Clause, From_Project_Node_Tree);
2893                end;
2894             end loop;
2895          end;
2896       end if;
2897    end Recursive_Process;
2898
2899 end Prj.Proc;