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