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