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