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