gcc/ada/prj-tree.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . T R E E                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2014, 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 Osint;   use Osint;
  27 with Prj.Env; use Prj.Env;
  28 with Prj.Err;
  29
  30 with Ada.Unchecked_Deallocation;
  31
  32 package body Prj.Tree is
  33
  34    Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
  35      (N_Project                    => True,
  36       N_With_Clause                => True,
  37       N_Project_Declaration        => False,
  38       N_Declarative_Item           => False,
  39       N_Package_Declaration        => True,
  40       N_String_Type_Declaration    => True,
  41       N_Literal_String             => False,
  42       N_Attribute_Declaration      => True,
  43       N_Typed_Variable_Declaration => True,
  44       N_Variable_Declaration       => True,
  45       N_Expression                 => False,
  46       N_Term                       => False,
  47       N_Literal_String_List        => False,
  48       N_Variable_Reference         => False,
  49       N_External_Value             => False,
  50       N_Attribute_Reference        => False,
  51       N_Case_Construction          => True,
  52       N_Case_Item                  => True,
  53       N_Comment_Zones              => True,
  54       N_Comment                    => True);
  55    --  Indicates the kinds of node that may have associated comments
  56
  57    package Next_End_Nodes is new Table.Table
  58      (Table_Component_Type => Project_Node_Id,
  59       Table_Index_Type     => Natural,
  60       Table_Low_Bound      => 1,
  61       Table_Initial        => 10,
  62       Table_Increment      => 100,
  63       Table_Name           => "Next_End_Nodes");
  64    --  A stack of nodes to indicates to what node the next "end" is associated
  65
  66    use Tree_Private_Part;
  67
  68    End_Of_Line_Node   : Project_Node_Id := Empty_Node;
  69    --  The node an end of line comment may be associated with
  70
  71    Previous_Line_Node : Project_Node_Id := Empty_Node;
  72    --  The node an immediately following comment may be associated with
  73
  74    Previous_End_Node  : Project_Node_Id := Empty_Node;
  75    --  The node comments immediately following an "end" line may be
  76    --  associated with.
  77
  78    Unkept_Comments    : Boolean := False;
  79    --  Set to True when some comments may not be associated with any node
  80
  81    function Comment_Zones_Of
  82      (Node    : Project_Node_Id;
  83       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
  84    --  Returns the ID of the N_Comment_Zones node associated with node Node.
  85    --  If there is not already an N_Comment_Zones node, create one and
  86    --  associate it with node Node.
  87
  88    ------------------
  89    -- Add_Comments --
  90    ------------------
  91
  92    procedure Add_Comments
  93      (To       : Project_Node_Id;
  94       In_Tree  : Project_Node_Tree_Ref;
  95       Where    : Comment_Location) is
  96       Zone     : Project_Node_Id := Empty_Node;
  97       Previous : Project_Node_Id := Empty_Node;
  98
  99    begin
 100       pragma Assert
 101         (Present (To)
 102           and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
 103
 104       Zone := In_Tree.Project_Nodes.Table (To).Comments;
 105
 106       if No (Zone) then
 107
 108          --  Create new N_Comment_Zones node
 109
 110          Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 111          In_Tree.Project_Nodes.Table
 112            (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 113            (Kind         => N_Comment_Zones,
 114             Qualifier    => Unspecified,
 115             Expr_Kind    => Undefined,
 116             Location     => No_Location,
 117             Directory    => No_Path,
 118             Variables    => Empty_Node,
 119             Packages     => Empty_Node,
 120             Pkg_Id       => Empty_Package,
 121             Name         => No_Name,
 122             Display_Name => No_Name,
 123             Src_Index    => 0,
 124             Path_Name    => No_Path,
 125             Value        => No_Name,
 126             Default      => Empty_Value,
 127             Field1       => Empty_Node,
 128             Field2       => Empty_Node,
 129             Field3       => Empty_Node,
 130             Field4       => Empty_Node,
 131             Flag1        => False,
 132             Flag2        => False,
 133             Comments     => Empty_Node);
 134
 135          Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
 136          In_Tree.Project_Nodes.Table (To).Comments := Zone;
 137       end if;
 138
 139       if Where = End_Of_Line then
 140          In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
 141
 142       else
 143          --  Get each comments in the Comments table and link them to node To
 144
 145          for J in 1 .. Comments.Last loop
 146
 147             --  Create new N_Comment node
 148
 149             if (Where = After or else Where = After_End)
 150               and then Token /= Tok_EOF
 151               and then Comments.Table (J).Follows_Empty_Line
 152             then
 153                Comments.Table (1 .. Comments.Last - J + 1) :=
 154                  Comments.Table (J .. Comments.Last);
 155                Comments.Set_Last (Comments.Last - J + 1);
 156                return;
 157             end if;
 158
 159             Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 160             In_Tree.Project_Nodes.Table
 161               (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 162               (Kind             => N_Comment,
 163                Qualifier        => Unspecified,
 164                Expr_Kind        => Undefined,
 165                Flag1            => Comments.Table (J).Follows_Empty_Line,
 166                Flag2            =>
 167                  Comments.Table (J).Is_Followed_By_Empty_Line,
 168                Location         => No_Location,
 169                Directory        => No_Path,
 170                Variables        => Empty_Node,
 171                Packages         => Empty_Node,
 172                Pkg_Id           => Empty_Package,
 173                Name             => No_Name,
 174                Display_Name     => No_Name,
 175                Src_Index        => 0,
 176                Path_Name        => No_Path,
 177                Value            => Comments.Table (J).Value,
 178                Default          => Empty_Value,
 179                Field1           => Empty_Node,
 180                Field2           => Empty_Node,
 181                Field3           => Empty_Node,
 182                Field4           => Empty_Node,
 183                Comments         => Empty_Node);
 184
 185             --  If this is the first comment, put it in the right field of
 186             --  the node Zone.
 187
 188             if No (Previous) then
 189                case Where is
 190                   when Before =>
 191                      In_Tree.Project_Nodes.Table (Zone).Field1 :=
 192                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 193
 194                   when After =>
 195                      In_Tree.Project_Nodes.Table (Zone).Field2 :=
 196                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 197
 198                   when Before_End =>
 199                      In_Tree.Project_Nodes.Table (Zone).Field3 :=
 200                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 201
 202                   when After_End =>
 203                      In_Tree.Project_Nodes.Table (Zone).Comments :=
 204                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 205
 206                   when End_Of_Line =>
 207                      null;
 208                end case;
 209
 210             else
 211                --  When it is not the first, link it to the previous one
 212
 213                In_Tree.Project_Nodes.Table (Previous).Comments :=
 214                  Project_Node_Table.Last (In_Tree.Project_Nodes);
 215             end if;
 216
 217             --  This node becomes the previous one for the next comment, if
 218             --  there is one.
 219
 220             Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
 221          end loop;
 222       end if;
 223
 224       --  Empty the Comments table, so that there is no risk to link the same
 225       --  comments to another node.
 226
 227       Comments.Set_Last (0);
 228    end Add_Comments;
 229
 230    --------------------------------
 231    -- Associative_Array_Index_Of --
 232    --------------------------------
 233
 234    function Associative_Array_Index_Of
 235      (Node    : Project_Node_Id;
 236       In_Tree : Project_Node_Tree_Ref) return Name_Id
 237    is
 238    begin
 239       pragma Assert
 240         (Present (Node)
 241           and then
 242             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 243                or else
 244              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 245       return In_Tree.Project_Nodes.Table (Node).Value;
 246    end Associative_Array_Index_Of;
 247
 248    ----------------------------
 249    -- Associative_Package_Of --
 250    ----------------------------
 251
 252    function Associative_Package_Of
 253      (Node    : Project_Node_Id;
 254       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 255    is
 256    begin
 257       pragma Assert
 258         (Present (Node)
 259           and then
 260           (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
 261       return In_Tree.Project_Nodes.Table (Node).Field3;
 262    end Associative_Package_Of;
 263
 264    ----------------------------
 265    -- Associative_Project_Of --
 266    ----------------------------
 267
 268    function Associative_Project_Of
 269      (Node    : Project_Node_Id;
 270       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 271    is
 272    begin
 273       pragma Assert
 274         (Present (Node)
 275           and then
 276           (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
 277       return In_Tree.Project_Nodes.Table (Node).Field2;
 278    end Associative_Project_Of;
 279
 280    ----------------------
 281    -- Case_Insensitive --
 282    ----------------------
 283
 284    function Case_Insensitive
 285      (Node    : Project_Node_Id;
 286       In_Tree : Project_Node_Tree_Ref) return Boolean
 287    is
 288    begin
 289       pragma Assert
 290         (Present (Node)
 291           and then
 292             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 293                or else
 294              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 295       return In_Tree.Project_Nodes.Table (Node).Flag1;
 296    end Case_Insensitive;
 297
 298    --------------------------------
 299    -- Case_Variable_Reference_Of --
 300    --------------------------------
 301
 302    function Case_Variable_Reference_Of
 303      (Node    : Project_Node_Id;
 304       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 305    is
 306    begin
 307       pragma Assert
 308         (Present (Node)
 309           and then
 310             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
 311       return In_Tree.Project_Nodes.Table (Node).Field1;
 312    end Case_Variable_Reference_Of;
 313
 314    ----------------------
 315    -- Comment_Zones_Of --
 316    ----------------------
 317
 318    function Comment_Zones_Of
 319      (Node    : Project_Node_Id;
 320       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 321    is
 322       Zone : Project_Node_Id;
 323
 324    begin
 325       pragma Assert (Present (Node));
 326       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 327
 328       --  If there is not already an N_Comment_Zones associated, create a new
 329       --  one and associate it with node Node.
 330
 331       if No (Zone) then
 332          Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 333          Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
 334          In_Tree.Project_Nodes.Table (Zone) :=
 335         (Kind             => N_Comment_Zones,
 336          Qualifier        => Unspecified,
 337          Location         => No_Location,
 338          Directory        => No_Path,
 339          Expr_Kind        => Undefined,
 340          Variables        => Empty_Node,
 341          Packages         => Empty_Node,
 342          Pkg_Id           => Empty_Package,
 343          Name             => No_Name,
 344          Display_Name     => No_Name,
 345          Src_Index        => 0,
 346          Path_Name        => No_Path,
 347          Value            => No_Name,
 348          Default          => Empty_Value,
 349          Field1           => Empty_Node,
 350          Field2           => Empty_Node,
 351          Field3           => Empty_Node,
 352          Field4           => Empty_Node,
 353          Flag1            => False,
 354          Flag2            => False,
 355          Comments         => Empty_Node);
 356          In_Tree.Project_Nodes.Table (Node).Comments := Zone;
 357       end if;
 358
 359       return Zone;
 360    end Comment_Zones_Of;
 361
 362    -----------------------
 363    -- Current_Item_Node --
 364    -----------------------
 365
 366    function Current_Item_Node
 367      (Node    : Project_Node_Id;
 368       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 369    is
 370    begin
 371       pragma Assert
 372         (Present (Node)
 373           and then
 374             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
 375       return In_Tree.Project_Nodes.Table (Node).Field1;
 376    end Current_Item_Node;
 377
 378    ------------------
 379    -- Current_Term --
 380    ------------------
 381
 382    function Current_Term
 383      (Node    : Project_Node_Id;
 384       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 385    is
 386    begin
 387       pragma Assert
 388         (Present (Node)
 389           and then
 390             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
 391       return In_Tree.Project_Nodes.Table (Node).Field1;
 392    end Current_Term;
 393
 394    ----------------
 395    -- Default_Of --
 396    ----------------
 397
 398    function Default_Of
 399      (Node    : Project_Node_Id;
 400       In_Tree : Project_Node_Tree_Ref) return Attribute_Default_Value
 401    is
 402    begin
 403       pragma Assert
 404         (Present (Node)
 405           and then
 406             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference);
 407       return In_Tree.Project_Nodes.Table (Node).Default;
 408    end Default_Of;
 409
 410    --------------------------
 411    -- Default_Project_Node --
 412    --------------------------
 413
 414    function Default_Project_Node
 415      (In_Tree       : Project_Node_Tree_Ref;
 416       Of_Kind       : Project_Node_Kind;
 417       And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
 418    is
 419       Result   : Project_Node_Id;
 420       Zone     : Project_Node_Id;
 421       Previous : Project_Node_Id;
 422
 423    begin
 424       --  Create new node with specified kind and expression kind
 425
 426       Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 427       In_Tree.Project_Nodes.Table
 428         (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 429         (Kind             => Of_Kind,
 430          Qualifier        => Unspecified,
 431          Location         => No_Location,
 432          Directory        => No_Path,
 433          Expr_Kind        => And_Expr_Kind,
 434          Variables        => Empty_Node,
 435          Packages         => Empty_Node,
 436          Pkg_Id           => Empty_Package,
 437          Name             => No_Name,
 438          Display_Name     => No_Name,
 439          Src_Index        => 0,
 440          Path_Name        => No_Path,
 441          Value            => No_Name,
 442          Default          => Empty_Value,
 443          Field1           => Empty_Node,
 444          Field2           => Empty_Node,
 445          Field3           => Empty_Node,
 446          Field4           => Empty_Node,
 447          Flag1            => False,
 448          Flag2            => False,
 449          Comments         => Empty_Node);
 450
 451       --  Save the new node for the returned value
 452
 453       Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
 454
 455       if Comments.Last > 0 then
 456
 457          --  If this is not a node with comments, then set the flag
 458
 459          if not Node_With_Comments (Of_Kind) then
 460             Unkept_Comments := True;
 461
 462          elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
 463
 464             Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 465             In_Tree.Project_Nodes.Table
 466               (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 467               (Kind             => N_Comment_Zones,
 468                Qualifier        => Unspecified,
 469                Expr_Kind        => Undefined,
 470                Location         => No_Location,
 471                Directory        => No_Path,
 472                Variables        => Empty_Node,
 473                Packages         => Empty_Node,
 474                Pkg_Id           => Empty_Package,
 475                Name             => No_Name,
 476                Display_Name     => No_Name,
 477                Src_Index        => 0,
 478                Path_Name        => No_Path,
 479                Value            => No_Name,
 480                Default          => Empty_Value,
 481                Field1           => Empty_Node,
 482                Field2           => Empty_Node,
 483                Field3           => Empty_Node,
 484                Field4           => Empty_Node,
 485                Flag1            => False,
 486                Flag2            => False,
 487                Comments         => Empty_Node);
 488
 489             Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
 490             In_Tree.Project_Nodes.Table (Result).Comments := Zone;
 491             Previous := Empty_Node;
 492
 493             for J in 1 .. Comments.Last loop
 494
 495                --  Create a new N_Comment node
 496
 497                Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 498                In_Tree.Project_Nodes.Table
 499                  (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 500                  (Kind             => N_Comment,
 501                   Qualifier        => Unspecified,
 502                   Expr_Kind        => Undefined,
 503                   Flag1            => Comments.Table (J).Follows_Empty_Line,
 504                   Flag2            =>
 505                     Comments.Table (J).Is_Followed_By_Empty_Line,
 506                   Location         => No_Location,
 507                   Directory        => No_Path,
 508                   Variables        => Empty_Node,
 509                   Packages         => Empty_Node,
 510                   Pkg_Id           => Empty_Package,
 511                   Name             => No_Name,
 512                   Display_Name     => No_Name,
 513                   Src_Index        => 0,
 514                   Path_Name        => No_Path,
 515                   Value            => Comments.Table (J).Value,
 516                   Default          => Empty_Value,
 517                   Field1           => Empty_Node,
 518                   Field2           => Empty_Node,
 519                   Field3           => Empty_Node,
 520                   Field4           => Empty_Node,
 521                   Comments         => Empty_Node);
 522
 523                --  Link it to the N_Comment_Zones node, if it is the first,
 524                --  otherwise to the previous one.
 525
 526                if No (Previous) then
 527                   In_Tree.Project_Nodes.Table (Zone).Field1 :=
 528                     Project_Node_Table.Last (In_Tree.Project_Nodes);
 529
 530                else
 531                   In_Tree.Project_Nodes.Table (Previous).Comments :=
 532                     Project_Node_Table.Last (In_Tree.Project_Nodes);
 533                end if;
 534
 535                --  This new node will be the previous one for the next
 536                --  N_Comment node, if there is one.
 537
 538                Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
 539             end loop;
 540
 541             --  Empty the Comments table after all comments have been processed
 542
 543             Comments.Set_Last (0);
 544          end if;
 545       end if;
 546
 547       return Result;
 548    end Default_Project_Node;
 549
 550    ------------------
 551    -- Directory_Of --
 552    ------------------
 553
 554    function Directory_Of
 555      (Node    : Project_Node_Id;
 556       In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
 557    is
 558    begin
 559       pragma Assert
 560         (Present (Node)
 561           and then
 562             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 563       return In_Tree.Project_Nodes.Table (Node).Directory;
 564    end Directory_Of;
 565
 566    -------------------------
 567    -- End_Of_Line_Comment --
 568    -------------------------
 569
 570    function End_Of_Line_Comment
 571      (Node    : Project_Node_Id;
 572       In_Tree : Project_Node_Tree_Ref) return Name_Id
 573    is
 574       Zone : Project_Node_Id := Empty_Node;
 575
 576    begin
 577       pragma Assert (Present (Node));
 578       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 579
 580       if No (Zone) then
 581          return No_Name;
 582       else
 583          return In_Tree.Project_Nodes.Table (Zone).Value;
 584       end if;
 585    end End_Of_Line_Comment;
 586
 587    ------------------------
 588    -- Expression_Kind_Of --
 589    ------------------------
 590
 591    function Expression_Kind_Of
 592      (Node    : Project_Node_Id;
 593       In_Tree : Project_Node_Tree_Ref) return Variable_Kind
 594    is
 595    begin
 596       pragma Assert
 597         (Present (Node)
 598            and then -- should use Nkind_In here ??? why not???
 599              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
 600                 or else
 601               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 602                 or else
 603               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
 604                 or else
 605               In_Tree.Project_Nodes.Table (Node).Kind =
 606                                                   N_Typed_Variable_Declaration
 607                 or else
 608               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
 609                 or else
 610               In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
 611                 or else
 612               In_Tree.Project_Nodes.Table (Node).Kind = N_Term
 613                 or else
 614               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
 615                 or else
 616               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
 617                 or else
 618               In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
 619       return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
 620    end Expression_Kind_Of;
 621
 622    -------------------
 623    -- Expression_Of --
 624    -------------------
 625
 626    function Expression_Of
 627      (Node    : Project_Node_Id;
 628       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 629    is
 630    begin
 631       pragma Assert
 632         (Present (Node)
 633           and then
 634            (In_Tree.Project_Nodes.Table (Node).Kind =
 635               N_Attribute_Declaration
 636                or else
 637             In_Tree.Project_Nodes.Table (Node).Kind =
 638               N_Typed_Variable_Declaration
 639                or else
 640             In_Tree.Project_Nodes.Table (Node).Kind =
 641               N_Variable_Declaration));
 642
 643       return In_Tree.Project_Nodes.Table (Node).Field1;
 644    end Expression_Of;
 645
 646    -------------------------
 647    -- Extended_Project_Of --
 648    -------------------------
 649
 650    function Extended_Project_Of
 651      (Node    : Project_Node_Id;
 652       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 653    is
 654    begin
 655       pragma Assert
 656         (Present (Node)
 657           and then
 658             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
 659       return In_Tree.Project_Nodes.Table (Node).Field2;
 660    end Extended_Project_Of;
 661
 662    ------------------------------
 663    -- Extended_Project_Path_Of --
 664    ------------------------------
 665
 666    function Extended_Project_Path_Of
 667      (Node    : Project_Node_Id;
 668       In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
 669    is
 670    begin
 671       pragma Assert
 672         (Present (Node)
 673           and then
 674             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 675       return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
 676    end Extended_Project_Path_Of;
 677
 678    --------------------------
 679    -- Extending_Project_Of --
 680    --------------------------
 681    function Extending_Project_Of
 682      (Node    : Project_Node_Id;
 683       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 684    is
 685    begin
 686       pragma Assert
 687         (Present (Node)
 688           and then
 689             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
 690       return In_Tree.Project_Nodes.Table (Node).Field3;
 691    end Extending_Project_Of;
 692
 693    ---------------------------
 694    -- External_Reference_Of --
 695    ---------------------------
 696
 697    function External_Reference_Of
 698      (Node    : Project_Node_Id;
 699       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 700    is
 701    begin
 702       pragma Assert
 703         (Present (Node)
 704           and then
 705             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
 706       return In_Tree.Project_Nodes.Table (Node).Field1;
 707    end External_Reference_Of;
 708
 709    -------------------------
 710    -- External_Default_Of --
 711    -------------------------
 712
 713    function External_Default_Of
 714      (Node    : Project_Node_Id;
 715       In_Tree : Project_Node_Tree_Ref)
 716       return Project_Node_Id
 717    is
 718    begin
 719       pragma Assert
 720         (Present (Node)
 721           and then
 722             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
 723       return In_Tree.Project_Nodes.Table (Node).Field2;
 724    end External_Default_Of;
 725
 726    ------------------------
 727    -- First_Case_Item_Of --
 728    ------------------------
 729
 730    function First_Case_Item_Of
 731      (Node    : Project_Node_Id;
 732       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 733    is
 734    begin
 735       pragma Assert
 736         (Present (Node)
 737           and then
 738             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
 739       return In_Tree.Project_Nodes.Table (Node).Field2;
 740    end First_Case_Item_Of;
 741
 742    ---------------------
 743    -- First_Choice_Of --
 744    ---------------------
 745
 746    function First_Choice_Of
 747      (Node    : Project_Node_Id;
 748       In_Tree : Project_Node_Tree_Ref)
 749       return Project_Node_Id
 750    is
 751    begin
 752       pragma Assert
 753         (Present (Node)
 754           and then
 755             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
 756       return In_Tree.Project_Nodes.Table (Node).Field1;
 757    end First_Choice_Of;
 758
 759    -------------------------
 760    -- First_Comment_After --
 761    -------------------------
 762
 763    function First_Comment_After
 764      (Node    : Project_Node_Id;
 765       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 766    is
 767       Zone : Project_Node_Id := Empty_Node;
 768    begin
 769       pragma Assert (Present (Node));
 770       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 771
 772       if No (Zone) then
 773          return Empty_Node;
 774
 775       else
 776          return In_Tree.Project_Nodes.Table (Zone).Field2;
 777       end if;
 778    end First_Comment_After;
 779
 780    -----------------------------
 781    -- First_Comment_After_End --
 782    -----------------------------
 783
 784    function First_Comment_After_End
 785      (Node    : Project_Node_Id;
 786       In_Tree : Project_Node_Tree_Ref)
 787       return Project_Node_Id
 788    is
 789       Zone : Project_Node_Id := Empty_Node;
 790
 791    begin
 792       pragma Assert (Present (Node));
 793       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 794
 795       if No (Zone) then
 796          return Empty_Node;
 797
 798       else
 799          return In_Tree.Project_Nodes.Table (Zone).Comments;
 800       end if;
 801    end First_Comment_After_End;
 802
 803    --------------------------
 804    -- First_Comment_Before --
 805    --------------------------
 806
 807    function First_Comment_Before
 808      (Node    : Project_Node_Id;
 809       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 810    is
 811       Zone : Project_Node_Id := Empty_Node;
 812
 813    begin
 814       pragma Assert (Present (Node));
 815       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 816
 817       if No (Zone) then
 818          return Empty_Node;
 819
 820       else
 821          return In_Tree.Project_Nodes.Table (Zone).Field1;
 822       end if;
 823    end First_Comment_Before;
 824
 825    ------------------------------
 826    -- First_Comment_Before_End --
 827    ------------------------------
 828
 829    function First_Comment_Before_End
 830      (Node    : Project_Node_Id;
 831       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 832    is
 833       Zone : Project_Node_Id := Empty_Node;
 834
 835    begin
 836       pragma Assert (Present (Node));
 837       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 838
 839       if No (Zone) then
 840          return Empty_Node;
 841
 842       else
 843          return In_Tree.Project_Nodes.Table (Zone).Field3;
 844       end if;
 845    end First_Comment_Before_End;
 846
 847    -------------------------------
 848    -- First_Declarative_Item_Of --
 849    -------------------------------
 850
 851    function First_Declarative_Item_Of
 852      (Node    : Project_Node_Id;
 853       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 854    is
 855    begin
 856       pragma Assert
 857         (Present (Node)
 858           and then
 859             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
 860                or else
 861              In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
 862                or else
 863              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
 864
 865       if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
 866          return In_Tree.Project_Nodes.Table (Node).Field1;
 867       else
 868          return In_Tree.Project_Nodes.Table (Node).Field2;
 869       end if;
 870    end First_Declarative_Item_Of;
 871
 872    ------------------------------
 873    -- First_Expression_In_List --
 874    ------------------------------
 875
 876    function First_Expression_In_List
 877      (Node    : Project_Node_Id;
 878       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 879    is
 880    begin
 881       pragma Assert
 882         (Present (Node)
 883           and then
 884             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
 885       return In_Tree.Project_Nodes.Table (Node).Field1;
 886    end First_Expression_In_List;
 887
 888    --------------------------
 889    -- First_Literal_String --
 890    --------------------------
 891
 892    function First_Literal_String
 893      (Node    : Project_Node_Id;
 894       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 895    is
 896    begin
 897       pragma Assert
 898         (Present (Node)
 899           and then
 900          In_Tree.Project_Nodes.Table (Node).Kind =
 901            N_String_Type_Declaration);
 902       return In_Tree.Project_Nodes.Table (Node).Field1;
 903    end First_Literal_String;
 904
 905    ----------------------
 906    -- First_Package_Of --
 907    ----------------------
 908
 909    function First_Package_Of
 910      (Node    : Project_Node_Id;
 911       In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
 912    is
 913    begin
 914       pragma Assert
 915         (Present (Node)
 916           and then
 917             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 918       return In_Tree.Project_Nodes.Table (Node).Packages;
 919    end First_Package_Of;
 920
 921    --------------------------
 922    -- First_String_Type_Of --
 923    --------------------------
 924
 925    function First_String_Type_Of
 926      (Node    : Project_Node_Id;
 927       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 928    is
 929    begin
 930       pragma Assert
 931         (Present (Node)
 932           and then
 933             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 934       return In_Tree.Project_Nodes.Table (Node).Field3;
 935    end First_String_Type_Of;
 936
 937    ----------------
 938    -- First_Term --
 939    ----------------
 940
 941    function First_Term
 942      (Node    : Project_Node_Id;
 943       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 944    is
 945    begin
 946       pragma Assert
 947         (Present (Node)
 948           and then
 949             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
 950       return In_Tree.Project_Nodes.Table (Node).Field1;
 951    end First_Term;
 952
 953    -----------------------
 954    -- First_Variable_Of --
 955    -----------------------
 956
 957    function First_Variable_Of
 958      (Node    : Project_Node_Id;
 959       In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
 960    is
 961    begin
 962       pragma Assert
 963         (Present (Node)
 964           and then
 965             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
 966                or else
 967              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
 968
 969       return In_Tree.Project_Nodes.Table (Node).Variables;
 970    end First_Variable_Of;
 971
 972    --------------------------
 973    -- First_With_Clause_Of --
 974    --------------------------
 975
 976    function First_With_Clause_Of
 977      (Node    : Project_Node_Id;
 978       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 979    is
 980    begin
 981       pragma Assert
 982         (Present (Node)
 983           and then
 984             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 985       return In_Tree.Project_Nodes.Table (Node).Field1;
 986    end First_With_Clause_Of;
 987
 988    ------------------------
 989    -- Follows_Empty_Line --
 990    ------------------------
 991
 992    function Follows_Empty_Line
 993      (Node    : Project_Node_Id;
 994       In_Tree : Project_Node_Tree_Ref) return Boolean
 995    is
 996    begin
 997       pragma Assert
 998         (Present (Node)
 999          and then
1000          In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1001       return In_Tree.Project_Nodes.Table (Node).Flag1;
1002    end Follows_Empty_Line;
1003
1004    ----------
1005    -- Hash --
1006    ----------
1007
1008    function Hash (N : Project_Node_Id) return Header_Num is
1009    begin
1010       return Header_Num (N mod Project_Node_Id (Header_Num'Last));
1011    end Hash;
1012
1013    ----------------
1014    -- Initialize --
1015    ----------------
1016
1017    procedure Initialize (Tree : Project_Node_Tree_Ref) is
1018    begin
1019       Project_Node_Table.Init (Tree.Project_Nodes);
1020       Projects_Htable.Reset (Tree.Projects_HT);
1021    end Initialize;
1022
1023    --------------------
1024    -- Override_Flags --
1025    --------------------
1026
1027    procedure Override_Flags
1028      (Self  : in out Environment;
1029       Flags : Prj.Processing_Flags)
1030    is
1031    begin
1032       Self.Flags := Flags;
1033    end Override_Flags;
1034
1035    ----------------
1036    -- Initialize --
1037    ----------------
1038
1039    procedure Initialize
1040      (Self  : out Environment;
1041       Flags : Processing_Flags)
1042    is
1043    begin
1044       --  Do not reset the external references, in case we are reloading a
1045       --  project, since we want to preserve the current environment. But we
1046       --  still need to ensure that the external references are properly
1047       --  initialized.
1048
1049       Prj.Ext.Initialize (Self.External);
1050
1051       Self.Flags := Flags;
1052    end Initialize;
1053
1054    -------------------------
1055    -- Initialize_And_Copy --
1056    -------------------------
1057
1058    procedure Initialize_And_Copy
1059      (Self      : out Environment;
1060       Copy_From : Environment)
1061    is
1062    begin
1063       Self.Flags := Copy_From.Flags;
1064       Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External);
1065       Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path);
1066    end Initialize_And_Copy;
1067
1068    ----------
1069    -- Free --
1070    ----------
1071
1072    procedure Free (Self : in out Environment) is
1073    begin
1074       Prj.Ext.Free (Self.External);
1075       Free (Self.Project_Path);
1076    end Free;
1077
1078    ----------
1079    -- Free --
1080    ----------
1081
1082    procedure Free (Proj : in out Project_Node_Tree_Ref) is
1083       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1084         (Project_Node_Tree_Data, Project_Node_Tree_Ref);
1085    begin
1086       if Proj /= null then
1087          Project_Node_Table.Free (Proj.Project_Nodes);
1088          Projects_Htable.Reset (Proj.Projects_HT);
1089          Unchecked_Free (Proj);
1090       end if;
1091    end Free;
1092
1093    -------------------------------
1094    -- Is_Followed_By_Empty_Line --
1095    -------------------------------
1096
1097    function Is_Followed_By_Empty_Line
1098      (Node    : Project_Node_Id;
1099       In_Tree : Project_Node_Tree_Ref) return Boolean
1100    is
1101    begin
1102       pragma Assert
1103         (Present (Node)
1104           and then
1105             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1106       return In_Tree.Project_Nodes.Table (Node).Flag2;
1107    end Is_Followed_By_Empty_Line;
1108
1109    ----------------------
1110    -- Is_Extending_All --
1111    ----------------------
1112
1113    function Is_Extending_All
1114      (Node    : Project_Node_Id;
1115       In_Tree : Project_Node_Tree_Ref) return Boolean
1116    is
1117    begin
1118       pragma Assert
1119         (Present (Node)
1120           and then
1121            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1122               or else
1123             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1124       return In_Tree.Project_Nodes.Table (Node).Flag2;
1125    end Is_Extending_All;
1126
1127    -------------------------
1128    -- Is_Not_Last_In_List --
1129    -------------------------
1130
1131    function Is_Not_Last_In_List
1132      (Node    : Project_Node_Id;
1133       In_Tree : Project_Node_Tree_Ref) return Boolean
1134    is
1135    begin
1136       pragma Assert
1137         (Present (Node)
1138           and then
1139             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1140       return In_Tree.Project_Nodes.Table (Node).Flag1;
1141    end Is_Not_Last_In_List;
1142
1143    -------------------------------------
1144    -- Imported_Or_Extended_Project_Of --
1145    -------------------------------------
1146
1147    function Imported_Or_Extended_Project_Of
1148      (Project   : Project_Node_Id;
1149       In_Tree   : Project_Node_Tree_Ref;
1150       With_Name : Name_Id) return Project_Node_Id
1151    is
1152       With_Clause : Project_Node_Id;
1153       Result      : Project_Node_Id := Empty_Node;
1154
1155    begin
1156       --  First check all the imported projects
1157
1158       With_Clause := First_With_Clause_Of (Project, In_Tree);
1159       while Present (With_Clause) loop
1160
1161          --  Only non limited imported project may be used as prefix of
1162          --  variables or attributes.
1163
1164          Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1165          while Present (Result) loop
1166             if Name_Of (Result, In_Tree) = With_Name then
1167                return Result;
1168             end if;
1169
1170             Result :=
1171               Extended_Project_Of
1172                 (Project_Declaration_Of (Result, In_Tree), In_Tree);
1173          end loop;
1174
1175          With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1176       end loop;
1177
1178       --  If it is not an imported project, it might be an extended project
1179
1180       if No (With_Clause) then
1181          Result := Project;
1182          loop
1183             Result :=
1184               Extended_Project_Of
1185                 (Project_Declaration_Of (Result, In_Tree), In_Tree);
1186
1187             exit when No (Result)
1188               or else Name_Of (Result, In_Tree) = With_Name;
1189          end loop;
1190       end if;
1191
1192       return Result;
1193    end Imported_Or_Extended_Project_Of;
1194
1195    -------------
1196    -- Kind_Of --
1197    -------------
1198
1199    function Kind_Of
1200      (Node    : Project_Node_Id;
1201       In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind
1202    is
1203    begin
1204       pragma Assert (Present (Node));
1205       return In_Tree.Project_Nodes.Table (Node).Kind;
1206    end Kind_Of;
1207
1208    -----------------
1209    -- Location_Of --
1210    -----------------
1211
1212    function Location_Of
1213      (Node    : Project_Node_Id;
1214       In_Tree : Project_Node_Tree_Ref) return Source_Ptr
1215    is
1216    begin
1217       pragma Assert (Present (Node));
1218       return In_Tree.Project_Nodes.Table (Node).Location;
1219    end Location_Of;
1220
1221    -------------
1222    -- Name_Of --
1223    -------------
1224
1225    function Name_Of
1226      (Node    : Project_Node_Id;
1227       In_Tree : Project_Node_Tree_Ref) return Name_Id
1228    is
1229    begin
1230       pragma Assert (Present (Node));
1231       return In_Tree.Project_Nodes.Table (Node).Name;
1232    end Name_Of;
1233
1234    ---------------------
1235    -- Display_Name_Of --
1236    ---------------------
1237
1238    function Display_Name_Of
1239      (Node    : Project_Node_Id;
1240       In_Tree : Project_Node_Tree_Ref) return Name_Id
1241    is
1242    begin
1243       pragma Assert
1244         (Present (Node)
1245          and then
1246          In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1247       return In_Tree.Project_Nodes.Table (Node).Display_Name;
1248    end Display_Name_Of;
1249
1250    --------------------
1251    -- Next_Case_Item --
1252    --------------------
1253
1254    function Next_Case_Item
1255      (Node    : Project_Node_Id;
1256       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1257    is
1258    begin
1259       pragma Assert
1260         (Present (Node)
1261           and then
1262             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1263       return In_Tree.Project_Nodes.Table (Node).Field3;
1264    end Next_Case_Item;
1265
1266    ------------------
1267    -- Next_Comment --
1268    ------------------
1269
1270    function Next_Comment
1271      (Node    : Project_Node_Id;
1272       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1273    is
1274    begin
1275       pragma Assert
1276         (Present (Node)
1277           and then
1278             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1279       return In_Tree.Project_Nodes.Table (Node).Comments;
1280    end Next_Comment;
1281
1282    ---------------------------
1283    -- Next_Declarative_Item --
1284    ---------------------------
1285
1286    function Next_Declarative_Item
1287      (Node    : Project_Node_Id;
1288       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1289    is
1290    begin
1291       pragma Assert
1292         (Present (Node)
1293           and then
1294             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1295       return In_Tree.Project_Nodes.Table (Node).Field2;
1296    end Next_Declarative_Item;
1297
1298    -----------------------------
1299    -- Next_Expression_In_List --
1300    -----------------------------
1301
1302    function Next_Expression_In_List
1303      (Node    : Project_Node_Id;
1304       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1305    is
1306    begin
1307       pragma Assert
1308         (Present (Node)
1309           and then
1310             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1311       return In_Tree.Project_Nodes.Table (Node).Field2;
1312    end Next_Expression_In_List;
1313
1314    -------------------------
1315    -- Next_Literal_String --
1316    -------------------------
1317
1318    function Next_Literal_String
1319      (Node    : Project_Node_Id;
1320       In_Tree : Project_Node_Tree_Ref)
1321       return Project_Node_Id
1322    is
1323    begin
1324       pragma Assert
1325         (Present (Node)
1326           and then
1327             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1328       return In_Tree.Project_Nodes.Table (Node).Field1;
1329    end Next_Literal_String;
1330
1331    -----------------------------
1332    -- Next_Package_In_Project --
1333    -----------------------------
1334
1335    function Next_Package_In_Project
1336      (Node    : Project_Node_Id;
1337       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1338    is
1339    begin
1340       pragma Assert
1341         (Present (Node)
1342           and then
1343             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1344       return In_Tree.Project_Nodes.Table (Node).Field3;
1345    end Next_Package_In_Project;
1346
1347    ----------------------
1348    -- Next_String_Type --
1349    ----------------------
1350
1351    function Next_String_Type
1352      (Node    : Project_Node_Id;
1353       In_Tree : Project_Node_Tree_Ref)
1354       return Project_Node_Id
1355    is
1356    begin
1357       pragma Assert
1358         (Present (Node)
1359           and then
1360          In_Tree.Project_Nodes.Table (Node).Kind =
1361            N_String_Type_Declaration);
1362       return In_Tree.Project_Nodes.Table (Node).Field2;
1363    end Next_String_Type;
1364
1365    ---------------
1366    -- Next_Term --
1367    ---------------
1368
1369    function Next_Term
1370      (Node    : Project_Node_Id;
1371       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1372    is
1373    begin
1374       pragma Assert
1375         (Present (Node)
1376           and then In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1377       return In_Tree.Project_Nodes.Table (Node).Field2;
1378    end Next_Term;
1379
1380    -------------------
1381    -- Next_Variable --
1382    -------------------
1383
1384    function Next_Variable
1385      (Node    : Project_Node_Id;
1386       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1387    is
1388    begin
1389       pragma Assert
1390         (Present (Node)
1391           and then
1392             (In_Tree.Project_Nodes.Table (Node).Kind =
1393                                                   N_Typed_Variable_Declaration
1394                or else
1395              In_Tree.Project_Nodes.Table (Node).Kind =
1396                                                   N_Variable_Declaration));
1397
1398       return In_Tree.Project_Nodes.Table (Node).Field3;
1399    end Next_Variable;
1400
1401    -------------------------
1402    -- Next_With_Clause_Of --
1403    -------------------------
1404
1405    function Next_With_Clause_Of
1406      (Node    : Project_Node_Id;
1407       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1408    is
1409    begin
1410       pragma Assert
1411         (Present (Node)
1412           and then
1413             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1414       return In_Tree.Project_Nodes.Table (Node).Field2;
1415    end Next_With_Clause_Of;
1416
1417    --------
1418    -- No --
1419    --------
1420
1421    function No (Node : Project_Node_Id) return Boolean is
1422    begin
1423       return Node = Empty_Node;
1424    end No;
1425
1426    ---------------------------------
1427    -- Non_Limited_Project_Node_Of --
1428    ---------------------------------
1429
1430    function Non_Limited_Project_Node_Of
1431      (Node    : Project_Node_Id;
1432       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1433    is
1434    begin
1435       pragma Assert
1436         (Present (Node)
1437           and then
1438            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1439       return In_Tree.Project_Nodes.Table (Node).Field3;
1440    end Non_Limited_Project_Node_Of;
1441
1442    -------------------
1443    -- Package_Id_Of --
1444    -------------------
1445
1446    function Package_Id_Of
1447      (Node    : Project_Node_Id;
1448       In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1449    is
1450    begin
1451       pragma Assert
1452         (Present (Node)
1453           and then
1454             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1455       return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1456    end Package_Id_Of;
1457
1458    ---------------------
1459    -- Package_Node_Of --
1460    ---------------------
1461
1462    function Package_Node_Of
1463      (Node    : Project_Node_Id;
1464       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1465    is
1466    begin
1467       pragma Assert
1468         (Present (Node)
1469           and then
1470             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1471                or else
1472              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1473       return In_Tree.Project_Nodes.Table (Node).Field2;
1474    end Package_Node_Of;
1475
1476    ------------------
1477    -- Path_Name_Of --
1478    ------------------
1479
1480    function Path_Name_Of
1481      (Node    : Project_Node_Id;
1482       In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1483    is
1484    begin
1485       pragma Assert
1486         (Present (Node)
1487           and then
1488             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1489                or else
1490              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1491       return In_Tree.Project_Nodes.Table (Node).Path_Name;
1492    end Path_Name_Of;
1493
1494    -------------
1495    -- Present --
1496    -------------
1497
1498    function Present (Node : Project_Node_Id) return Boolean is
1499    begin
1500       return Node /= Empty_Node;
1501    end Present;
1502
1503    ----------------------------
1504    -- Project_Declaration_Of --
1505    ----------------------------
1506
1507    function Project_Declaration_Of
1508      (Node    : Project_Node_Id;
1509       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1510    is
1511    begin
1512       pragma Assert
1513         (Present (Node)
1514           and then
1515             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1516       return In_Tree.Project_Nodes.Table (Node).Field2;
1517    end Project_Declaration_Of;
1518
1519    --------------------------
1520    -- Project_Qualifier_Of --
1521    --------------------------
1522
1523    function Project_Qualifier_Of
1524      (Node    : Project_Node_Id;
1525       In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
1526    is
1527    begin
1528       pragma Assert
1529         (Present (Node)
1530           and then
1531             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1532       return In_Tree.Project_Nodes.Table (Node).Qualifier;
1533    end Project_Qualifier_Of;
1534
1535    -----------------------
1536    -- Parent_Project_Of --
1537    -----------------------
1538
1539    function Parent_Project_Of
1540      (Node    : Project_Node_Id;
1541       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1542    is
1543    begin
1544       pragma Assert
1545         (Present (Node)
1546           and then
1547             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1548       return In_Tree.Project_Nodes.Table (Node).Field4;
1549    end Parent_Project_Of;
1550
1551    -------------------------------------------
1552    -- Project_File_Includes_Unkept_Comments --
1553    -------------------------------------------
1554
1555    function Project_File_Includes_Unkept_Comments
1556      (Node    : Project_Node_Id;
1557       In_Tree : Project_Node_Tree_Ref) return Boolean
1558    is
1559       Declaration : constant Project_Node_Id :=
1560                       Project_Declaration_Of (Node, In_Tree);
1561    begin
1562       return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1563    end Project_File_Includes_Unkept_Comments;
1564
1565    ---------------------
1566    -- Project_Node_Of --
1567    ---------------------
1568
1569    function Project_Node_Of
1570      (Node    : Project_Node_Id;
1571       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1572    is
1573    begin
1574       pragma Assert
1575         (Present (Node)
1576           and then
1577            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1578               or else
1579             In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1580               or else
1581             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1582       return In_Tree.Project_Nodes.Table (Node).Field1;
1583    end Project_Node_Of;
1584
1585    -----------------------------------
1586    -- Project_Of_Renamed_Package_Of --
1587    -----------------------------------
1588
1589    function Project_Of_Renamed_Package_Of
1590      (Node    : Project_Node_Id;
1591       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1592    is
1593    begin
1594       pragma Assert
1595         (Present (Node)
1596           and then
1597             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1598       return In_Tree.Project_Nodes.Table (Node).Field1;
1599    end Project_Of_Renamed_Package_Of;
1600
1601    --------------------------
1602    -- Remove_Next_End_Node --
1603    --------------------------
1604
1605    procedure Remove_Next_End_Node is
1606    begin
1607       Next_End_Nodes.Decrement_Last;
1608    end Remove_Next_End_Node;
1609
1610    -----------------
1611    -- Reset_State --
1612    -----------------
1613
1614    procedure Reset_State is
1615    begin
1616       End_Of_Line_Node   := Empty_Node;
1617       Previous_Line_Node := Empty_Node;
1618       Previous_End_Node  := Empty_Node;
1619       Unkept_Comments    := False;
1620       Comments.Set_Last (0);
1621    end Reset_State;
1622
1623    ----------------------
1624    -- Restore_And_Free --
1625    ----------------------
1626
1627    procedure Restore_And_Free (S : in out Comment_State) is
1628       procedure Unchecked_Free is new
1629         Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
1630
1631    begin
1632       End_Of_Line_Node   := S.End_Of_Line_Node;
1633       Previous_Line_Node := S.Previous_Line_Node;
1634       Previous_End_Node  := S.Previous_End_Node;
1635       Next_End_Nodes.Set_Last (0);
1636       Unkept_Comments    := S.Unkept_Comments;
1637
1638       Comments.Set_Last (0);
1639
1640       for J in S.Comments'Range loop
1641          Comments.Increment_Last;
1642          Comments.Table (Comments.Last) := S.Comments (J);
1643       end loop;
1644
1645       Unchecked_Free (S.Comments);
1646    end Restore_And_Free;
1647
1648    ----------
1649    -- Save --
1650    ----------
1651
1652    procedure Save (S : out Comment_State) is
1653       Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1654
1655    begin
1656       for J in 1 .. Comments.Last loop
1657          Cmts (J) := Comments.Table (J);
1658       end loop;
1659
1660       S :=
1661         (End_Of_Line_Node   => End_Of_Line_Node,
1662          Previous_Line_Node => Previous_Line_Node,
1663          Previous_End_Node  => Previous_End_Node,
1664          Unkept_Comments    => Unkept_Comments,
1665          Comments           => Cmts);
1666    end Save;
1667
1668    ----------
1669    -- Scan --
1670    ----------
1671
1672    procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1673       Empty_Line : Boolean := False;
1674
1675    begin
1676       --  If there are comments, then they will not be kept. Set the flag and
1677       --  clear the comments.
1678
1679       if Comments.Last > 0 then
1680          Unkept_Comments := True;
1681          Comments.Set_Last (0);
1682       end if;
1683
1684       --  Loop until a token other that End_Of_Line or Comment is found
1685
1686       loop
1687          Prj.Err.Scanner.Scan;
1688
1689          case Token is
1690             when Tok_End_Of_Line =>
1691                if Prev_Token = Tok_End_Of_Line then
1692                   Empty_Line := True;
1693
1694                   if Comments.Last > 0 then
1695                      Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1696                      := True;
1697                   end if;
1698                end if;
1699
1700             when Tok_Comment =>
1701                --  If this is a line comment, add it to the comment table
1702
1703                if Prev_Token = Tok_End_Of_Line
1704                  or else Prev_Token = No_Token
1705                then
1706                   Comments.Increment_Last;
1707                   Comments.Table (Comments.Last) :=
1708                     (Value                     => Comment_Id,
1709                      Follows_Empty_Line        => Empty_Line,
1710                      Is_Followed_By_Empty_Line => False);
1711
1712                --  Otherwise, it is an end of line comment. If there is an
1713                --  end of line node specified, associate the comment with
1714                --  this node.
1715
1716                elsif Present (End_Of_Line_Node) then
1717                   declare
1718                      Zones : constant Project_Node_Id :=
1719                                Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1720                   begin
1721                      In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1722                   end;
1723
1724                --  Otherwise, this end of line node cannot be kept
1725
1726                else
1727                   Unkept_Comments := True;
1728                   Comments.Set_Last (0);
1729                end if;
1730
1731                Empty_Line := False;
1732
1733             when others =>
1734
1735                --  If there are comments, where the first comment is not
1736                --  following an empty line, put the initial uninterrupted
1737                --  comment zone with the node of the preceding line (either
1738                --  a Previous_Line or a Previous_End node), if any.
1739
1740                if Comments.Last > 0 and then
1741                  not Comments.Table (1).Follows_Empty_Line
1742                then
1743                   if Present (Previous_Line_Node) then
1744                      Add_Comments
1745                        (To      => Previous_Line_Node,
1746                         Where   => After,
1747                         In_Tree => In_Tree);
1748
1749                   elsif Present (Previous_End_Node) then
1750                      Add_Comments
1751                        (To      => Previous_End_Node,
1752                         Where   => After_End,
1753                         In_Tree => In_Tree);
1754                   end if;
1755                end if;
1756
1757                --  If there are still comments and the token is "end", then
1758                --  put these comments with the Next_End node, if any;
1759                --  otherwise, these comments cannot be kept. Always clear
1760                --  the comments.
1761
1762                if Comments.Last > 0 and then Token = Tok_End then
1763                   if Next_End_Nodes.Last > 0 then
1764                      Add_Comments
1765                        (To      => Next_End_Nodes.Table (Next_End_Nodes.Last),
1766                         Where   => Before_End,
1767                         In_Tree => In_Tree);
1768
1769                   else
1770                      Unkept_Comments := True;
1771                   end if;
1772
1773                   Comments.Set_Last (0);
1774                end if;
1775
1776                --  Reset the End_Of_Line, Previous_Line and Previous_End nodes
1777                --  so that they are not used again.
1778
1779                End_Of_Line_Node   := Empty_Node;
1780                Previous_Line_Node := Empty_Node;
1781                Previous_End_Node  := Empty_Node;
1782
1783                --  And return
1784
1785                exit;
1786          end case;
1787       end loop;
1788    end Scan;
1789
1790    ------------------------------------
1791    -- Set_Associative_Array_Index_Of --
1792    ------------------------------------
1793
1794    procedure Set_Associative_Array_Index_Of
1795      (Node    : Project_Node_Id;
1796       In_Tree : Project_Node_Tree_Ref;
1797       To      : Name_Id)
1798    is
1799    begin
1800       pragma Assert
1801         (Present (Node)
1802           and then
1803             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1804                or else
1805              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1806       In_Tree.Project_Nodes.Table (Node).Value := To;
1807    end Set_Associative_Array_Index_Of;
1808
1809    --------------------------------
1810    -- Set_Associative_Package_Of --
1811    --------------------------------
1812
1813    procedure Set_Associative_Package_Of
1814      (Node    : Project_Node_Id;
1815       In_Tree : Project_Node_Tree_Ref;
1816       To      : Project_Node_Id)
1817    is
1818    begin
1819       pragma Assert
1820          (Present (Node)
1821           and then
1822             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1823       In_Tree.Project_Nodes.Table (Node).Field3 := To;
1824    end Set_Associative_Package_Of;
1825
1826    --------------------------------
1827    -- Set_Associative_Project_Of --
1828    --------------------------------
1829
1830    procedure Set_Associative_Project_Of
1831      (Node    : Project_Node_Id;
1832       In_Tree : Project_Node_Tree_Ref;
1833       To      : Project_Node_Id)
1834    is
1835    begin
1836       pragma Assert
1837         (Present (Node)
1838           and then
1839            (In_Tree.Project_Nodes.Table (Node).Kind =
1840               N_Attribute_Declaration));
1841       In_Tree.Project_Nodes.Table (Node).Field2 := To;
1842    end Set_Associative_Project_Of;
1843
1844    --------------------------
1845    -- Set_Case_Insensitive --
1846    --------------------------
1847
1848    procedure Set_Case_Insensitive
1849      (Node    : Project_Node_Id;
1850       In_Tree : Project_Node_Tree_Ref;
1851       To      : Boolean)
1852    is
1853    begin
1854       pragma Assert
1855         (Present (Node)
1856           and then
1857            (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1858                or else
1859             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1860       In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1861    end Set_Case_Insensitive;
1862
1863    ------------------------------------
1864    -- Set_Case_Variable_Reference_Of --
1865    ------------------------------------
1866
1867    procedure Set_Case_Variable_Reference_Of
1868      (Node    : Project_Node_Id;
1869       In_Tree : Project_Node_Tree_Ref;
1870       To      : Project_Node_Id)
1871    is
1872    begin
1873       pragma Assert
1874         (Present (Node)
1875           and then
1876             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1877       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1878    end Set_Case_Variable_Reference_Of;
1879
1880    ---------------------------
1881    -- Set_Current_Item_Node --
1882    ---------------------------
1883
1884    procedure Set_Current_Item_Node
1885      (Node    : Project_Node_Id;
1886       In_Tree : Project_Node_Tree_Ref;
1887       To      : Project_Node_Id)
1888    is
1889    begin
1890       pragma Assert
1891         (Present (Node)
1892           and then
1893             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1894       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1895    end Set_Current_Item_Node;
1896
1897    ----------------------
1898    -- Set_Current_Term --
1899    ----------------------
1900
1901    procedure Set_Current_Term
1902      (Node    : Project_Node_Id;
1903       In_Tree : Project_Node_Tree_Ref;
1904       To      : Project_Node_Id)
1905    is
1906    begin
1907       pragma Assert
1908         (Present (Node)
1909           and then
1910             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1911       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1912    end Set_Current_Term;
1913
1914    --------------------
1915    -- Set_Default_Of --
1916    --------------------
1917
1918    procedure Set_Default_Of
1919      (Node    : Project_Node_Id;
1920       In_Tree : Project_Node_Tree_Ref;
1921       To      : Attribute_Default_Value)
1922    is
1923    begin
1924       pragma Assert
1925         (Present (Node)
1926           and then
1927             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference);
1928       In_Tree.Project_Nodes.Table (Node).Default := To;
1929    end Set_Default_Of;
1930
1931    ----------------------
1932    -- Set_Directory_Of --
1933    ----------------------
1934
1935    procedure Set_Directory_Of
1936      (Node    : Project_Node_Id;
1937       In_Tree : Project_Node_Tree_Ref;
1938       To      : Path_Name_Type)
1939    is
1940    begin
1941       pragma Assert
1942         (Present (Node)
1943           and then
1944             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1945       In_Tree.Project_Nodes.Table (Node).Directory := To;
1946    end Set_Directory_Of;
1947
1948    ---------------------
1949    -- Set_End_Of_Line --
1950    ---------------------
1951
1952    procedure Set_End_Of_Line (To : Project_Node_Id) is
1953    begin
1954       End_Of_Line_Node := To;
1955    end Set_End_Of_Line;
1956
1957    ----------------------------
1958    -- Set_Expression_Kind_Of --
1959    ----------------------------
1960
1961    procedure Set_Expression_Kind_Of
1962      (Node    : Project_Node_Id;
1963       In_Tree : Project_Node_Tree_Ref;
1964       To      : Variable_Kind)
1965    is
1966    begin
1967       pragma Assert
1968         (Present (Node)
1969            and then -- should use Nkind_In here ??? why not???
1970              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1971                 or else
1972               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1973                 or else
1974               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1975                 or else
1976               In_Tree.Project_Nodes.Table (Node).Kind =
1977                                                   N_Typed_Variable_Declaration
1978                 or else
1979               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1980                 or else
1981               In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1982                 or else
1983               In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1984                 or else
1985               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1986                 or else
1987               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
1988                 or else
1989               In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
1990       In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1991    end Set_Expression_Kind_Of;
1992
1993    -----------------------
1994    -- Set_Expression_Of --
1995    -----------------------
1996
1997    procedure Set_Expression_Of
1998      (Node    : Project_Node_Id;
1999       In_Tree : Project_Node_Tree_Ref;
2000       To      : Project_Node_Id)
2001    is
2002    begin
2003       pragma Assert
2004         (Present (Node)
2005           and then
2006            (In_Tree.Project_Nodes.Table (Node).Kind =
2007               N_Attribute_Declaration
2008                or else
2009             In_Tree.Project_Nodes.Table (Node).Kind =
2010               N_Typed_Variable_Declaration
2011                or else
2012             In_Tree.Project_Nodes.Table (Node).Kind =
2013               N_Variable_Declaration));
2014       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2015    end Set_Expression_Of;
2016
2017    -------------------------------
2018    -- Set_External_Reference_Of --
2019    -------------------------------
2020
2021    procedure Set_External_Reference_Of
2022      (Node    : Project_Node_Id;
2023       In_Tree : Project_Node_Tree_Ref;
2024       To      : Project_Node_Id)
2025    is
2026    begin
2027       pragma Assert
2028         (Present (Node)
2029           and then
2030             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
2031       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2032    end Set_External_Reference_Of;
2033
2034    -----------------------------
2035    -- Set_External_Default_Of --
2036    -----------------------------
2037
2038    procedure Set_External_Default_Of
2039      (Node    : Project_Node_Id;
2040       In_Tree : Project_Node_Tree_Ref;
2041       To      : Project_Node_Id)
2042    is
2043    begin
2044       pragma Assert
2045         (Present (Node)
2046           and then
2047             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
2048       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2049    end Set_External_Default_Of;
2050
2051    ----------------------------
2052    -- Set_First_Case_Item_Of --
2053    ----------------------------
2054
2055    procedure Set_First_Case_Item_Of
2056      (Node    : Project_Node_Id;
2057       In_Tree : Project_Node_Tree_Ref;
2058       To      : Project_Node_Id)
2059    is
2060    begin
2061       pragma Assert
2062         (Present (Node)
2063           and then
2064             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
2065       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2066    end Set_First_Case_Item_Of;
2067
2068    -------------------------
2069    -- Set_First_Choice_Of --
2070    -------------------------
2071
2072    procedure Set_First_Choice_Of
2073      (Node    : Project_Node_Id;
2074       In_Tree : Project_Node_Tree_Ref;
2075       To      : Project_Node_Id)
2076    is
2077    begin
2078       pragma Assert
2079         (Present (Node)
2080           and then
2081             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2082       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2083    end Set_First_Choice_Of;
2084
2085    -----------------------------
2086    -- Set_First_Comment_After --
2087    -----------------------------
2088
2089    procedure Set_First_Comment_After
2090      (Node    : Project_Node_Id;
2091       In_Tree : Project_Node_Tree_Ref;
2092       To      : Project_Node_Id)
2093    is
2094       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2095    begin
2096       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2097    end Set_First_Comment_After;
2098
2099    ---------------------------------
2100    -- Set_First_Comment_After_End --
2101    ---------------------------------
2102
2103    procedure Set_First_Comment_After_End
2104      (Node    : Project_Node_Id;
2105       In_Tree : Project_Node_Tree_Ref;
2106       To      : Project_Node_Id)
2107    is
2108       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2109    begin
2110       In_Tree.Project_Nodes.Table (Zone).Comments := To;
2111    end Set_First_Comment_After_End;
2112
2113    ------------------------------
2114    -- Set_First_Comment_Before --
2115    ------------------------------
2116
2117    procedure Set_First_Comment_Before
2118      (Node    : Project_Node_Id;
2119       In_Tree : Project_Node_Tree_Ref;
2120       To      : Project_Node_Id)
2121    is
2122       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2123    begin
2124       In_Tree.Project_Nodes.Table (Zone).Field1 := To;
2125    end Set_First_Comment_Before;
2126
2127    ----------------------------------
2128    -- Set_First_Comment_Before_End --
2129    ----------------------------------
2130
2131    procedure Set_First_Comment_Before_End
2132      (Node    : Project_Node_Id;
2133       In_Tree : Project_Node_Tree_Ref;
2134       To      : Project_Node_Id)
2135    is
2136       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2137    begin
2138       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2139    end Set_First_Comment_Before_End;
2140
2141    ------------------------
2142    -- Set_Next_Case_Item --
2143    ------------------------
2144
2145    procedure Set_Next_Case_Item
2146      (Node    : Project_Node_Id;
2147       In_Tree : Project_Node_Tree_Ref;
2148       To      : Project_Node_Id)
2149    is
2150    begin
2151       pragma Assert
2152         (Present (Node)
2153           and then
2154             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2155       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2156    end Set_Next_Case_Item;
2157
2158    ----------------------
2159    -- Set_Next_Comment --
2160    ----------------------
2161
2162    procedure Set_Next_Comment
2163      (Node    : Project_Node_Id;
2164       In_Tree : Project_Node_Tree_Ref;
2165       To      : Project_Node_Id)
2166    is
2167    begin
2168       pragma Assert
2169         (Present (Node)
2170           and then
2171             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
2172       In_Tree.Project_Nodes.Table (Node).Comments := To;
2173    end Set_Next_Comment;
2174
2175    -----------------------------------
2176    -- Set_First_Declarative_Item_Of --
2177    -----------------------------------
2178
2179    procedure Set_First_Declarative_Item_Of
2180      (Node    : Project_Node_Id;
2181       In_Tree : Project_Node_Tree_Ref;
2182       To      : Project_Node_Id)
2183    is
2184    begin
2185       pragma Assert
2186         (Present (Node)
2187           and then
2188             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
2189                or else
2190              In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
2191                or else
2192              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2193
2194       if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
2195          In_Tree.Project_Nodes.Table (Node).Field1 := To;
2196       else
2197          In_Tree.Project_Nodes.Table (Node).Field2 := To;
2198       end if;
2199    end Set_First_Declarative_Item_Of;
2200
2201    ----------------------------------
2202    -- Set_First_Expression_In_List --
2203    ----------------------------------
2204
2205    procedure Set_First_Expression_In_List
2206      (Node    : Project_Node_Id;
2207       In_Tree : Project_Node_Tree_Ref;
2208       To      : Project_Node_Id)
2209    is
2210    begin
2211       pragma Assert
2212         (Present (Node)
2213           and then
2214             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
2215       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2216    end Set_First_Expression_In_List;
2217
2218    ------------------------------
2219    -- Set_First_Literal_String --
2220    ------------------------------
2221
2222    procedure Set_First_Literal_String
2223      (Node    : Project_Node_Id;
2224       In_Tree : Project_Node_Tree_Ref;
2225       To      : Project_Node_Id)
2226    is
2227    begin
2228       pragma Assert
2229         (Present (Node)
2230           and then
2231          In_Tree.Project_Nodes.Table (Node).Kind =
2232            N_String_Type_Declaration);
2233       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2234    end Set_First_Literal_String;
2235
2236    --------------------------
2237    -- Set_First_Package_Of --
2238    --------------------------
2239
2240    procedure Set_First_Package_Of
2241      (Node    : Project_Node_Id;
2242       In_Tree : Project_Node_Tree_Ref;
2243       To      : Package_Declaration_Id)
2244    is
2245    begin
2246       pragma Assert
2247         (Present (Node)
2248           and then
2249             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2250       In_Tree.Project_Nodes.Table (Node).Packages := To;
2251    end Set_First_Package_Of;
2252
2253    ------------------------------
2254    -- Set_First_String_Type_Of --
2255    ------------------------------
2256
2257    procedure Set_First_String_Type_Of
2258      (Node    : Project_Node_Id;
2259       In_Tree : Project_Node_Tree_Ref;
2260       To      : Project_Node_Id)
2261    is
2262    begin
2263       pragma Assert
2264         (Present (Node)
2265           and then
2266             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2267       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2268    end Set_First_String_Type_Of;
2269
2270    --------------------
2271    -- Set_First_Term --
2272    --------------------
2273
2274    procedure Set_First_Term
2275      (Node    : Project_Node_Id;
2276       In_Tree : Project_Node_Tree_Ref;
2277       To      : Project_Node_Id)
2278    is
2279    begin
2280       pragma Assert
2281         (Present (Node)
2282           and then
2283             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2284       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2285    end Set_First_Term;
2286
2287    ---------------------------
2288    -- Set_First_Variable_Of --
2289    ---------------------------
2290
2291    procedure Set_First_Variable_Of
2292      (Node    : Project_Node_Id;
2293       In_Tree : Project_Node_Tree_Ref;
2294       To      : Variable_Node_Id)
2295    is
2296    begin
2297       pragma Assert
2298         (Present (Node)
2299           and then
2300             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2301                or else
2302              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2303       In_Tree.Project_Nodes.Table (Node).Variables := To;
2304    end Set_First_Variable_Of;
2305
2306    ------------------------------
2307    -- Set_First_With_Clause_Of --
2308    ------------------------------
2309
2310    procedure Set_First_With_Clause_Of
2311      (Node    : Project_Node_Id;
2312       In_Tree : Project_Node_Tree_Ref;
2313       To      : Project_Node_Id)
2314    is
2315    begin
2316       pragma Assert
2317         (Present (Node)
2318           and then
2319             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2320       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2321    end Set_First_With_Clause_Of;
2322
2323    --------------------------
2324    -- Set_Is_Extending_All --
2325    --------------------------
2326
2327    procedure Set_Is_Extending_All
2328      (Node    : Project_Node_Id;
2329       In_Tree : Project_Node_Tree_Ref)
2330    is
2331    begin
2332       pragma Assert
2333         (Present (Node)
2334           and then
2335             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2336                or else
2337              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2338       In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2339    end Set_Is_Extending_All;
2340
2341    -----------------------------
2342    -- Set_Is_Not_Last_In_List --
2343    -----------------------------
2344
2345    procedure Set_Is_Not_Last_In_List
2346      (Node    : Project_Node_Id;
2347       In_Tree : Project_Node_Tree_Ref)
2348    is
2349    begin
2350       pragma Assert
2351         (Present (Node)
2352           and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2353       In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2354    end Set_Is_Not_Last_In_List;
2355
2356    -----------------
2357    -- Set_Kind_Of --
2358    -----------------
2359
2360    procedure Set_Kind_Of
2361      (Node    : Project_Node_Id;
2362       In_Tree : Project_Node_Tree_Ref;
2363       To      : Project_Node_Kind)
2364    is
2365    begin
2366       pragma Assert (Present (Node));
2367       In_Tree.Project_Nodes.Table (Node).Kind := To;
2368    end Set_Kind_Of;
2369
2370    ---------------------
2371    -- Set_Location_Of --
2372    ---------------------
2373
2374    procedure Set_Location_Of
2375      (Node    : Project_Node_Id;
2376       In_Tree : Project_Node_Tree_Ref;
2377       To      : Source_Ptr)
2378    is
2379    begin
2380       pragma Assert (Present (Node));
2381       In_Tree.Project_Nodes.Table (Node).Location := To;
2382    end Set_Location_Of;
2383
2384    -----------------------------
2385    -- Set_Extended_Project_Of --
2386    -----------------------------
2387
2388    procedure Set_Extended_Project_Of
2389      (Node    : Project_Node_Id;
2390       In_Tree : Project_Node_Tree_Ref;
2391       To      : Project_Node_Id)
2392    is
2393    begin
2394       pragma Assert
2395         (Present (Node)
2396           and then
2397             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2398       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2399    end Set_Extended_Project_Of;
2400
2401    ----------------------------------
2402    -- Set_Extended_Project_Path_Of --
2403    ----------------------------------
2404
2405    procedure Set_Extended_Project_Path_Of
2406      (Node    : Project_Node_Id;
2407       In_Tree : Project_Node_Tree_Ref;
2408       To      : Path_Name_Type)
2409    is
2410    begin
2411       pragma Assert
2412         (Present (Node)
2413           and then
2414             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2415       In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2416    end Set_Extended_Project_Path_Of;
2417
2418    ------------------------------
2419    -- Set_Extending_Project_Of --
2420    ------------------------------
2421
2422    procedure Set_Extending_Project_Of
2423      (Node    : Project_Node_Id;
2424       In_Tree : Project_Node_Tree_Ref;
2425       To      : Project_Node_Id)
2426    is
2427    begin
2428       pragma Assert
2429         (Present (Node)
2430           and then
2431             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2432       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2433    end Set_Extending_Project_Of;
2434
2435    -----------------
2436    -- Set_Name_Of --
2437    -----------------
2438
2439    procedure Set_Name_Of
2440      (Node    : Project_Node_Id;
2441       In_Tree : Project_Node_Tree_Ref;
2442       To      : Name_Id)
2443    is
2444    begin
2445       pragma Assert (Present (Node));
2446       In_Tree.Project_Nodes.Table (Node).Name := To;
2447    end Set_Name_Of;
2448
2449    -------------------------
2450    -- Set_Display_Name_Of --
2451    -------------------------
2452
2453    procedure Set_Display_Name_Of
2454      (Node    : Project_Node_Id;
2455       In_Tree : Project_Node_Tree_Ref;
2456       To      : Name_Id)
2457    is
2458    begin
2459       pragma Assert
2460         (Present (Node)
2461          and then
2462          In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2463       In_Tree.Project_Nodes.Table (Node).Display_Name := To;
2464    end Set_Display_Name_Of;
2465
2466    -------------------------------
2467    -- Set_Next_Declarative_Item --
2468    -------------------------------
2469
2470    procedure Set_Next_Declarative_Item
2471      (Node    : Project_Node_Id;
2472       In_Tree : Project_Node_Tree_Ref;
2473       To      : Project_Node_Id)
2474    is
2475    begin
2476       pragma Assert
2477         (Present (Node)
2478           and then
2479             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2480       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2481    end Set_Next_Declarative_Item;
2482
2483    -----------------------
2484    -- Set_Next_End_Node --
2485    -----------------------
2486
2487    procedure Set_Next_End_Node (To : Project_Node_Id) is
2488    begin
2489       Next_End_Nodes.Increment_Last;
2490       Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2491    end Set_Next_End_Node;
2492
2493    ---------------------------------
2494    -- Set_Next_Expression_In_List --
2495    ---------------------------------
2496
2497    procedure Set_Next_Expression_In_List
2498      (Node    : Project_Node_Id;
2499       In_Tree : Project_Node_Tree_Ref;
2500       To      : Project_Node_Id)
2501    is
2502    begin
2503       pragma Assert
2504         (Present (Node)
2505           and then
2506             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2507       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2508    end Set_Next_Expression_In_List;
2509
2510    -----------------------------
2511    -- Set_Next_Literal_String --
2512    -----------------------------
2513
2514    procedure Set_Next_Literal_String
2515      (Node    : Project_Node_Id;
2516       In_Tree : Project_Node_Tree_Ref;
2517       To      : Project_Node_Id)
2518    is
2519    begin
2520       pragma Assert
2521         (Present (Node)
2522           and then
2523             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2524       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2525    end Set_Next_Literal_String;
2526
2527    ---------------------------------
2528    -- Set_Next_Package_In_Project --
2529    ---------------------------------
2530
2531    procedure Set_Next_Package_In_Project
2532      (Node    : Project_Node_Id;
2533       In_Tree : Project_Node_Tree_Ref;
2534       To      : Project_Node_Id)
2535    is
2536    begin
2537       pragma Assert
2538         (Present (Node)
2539           and then
2540             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2541       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2542    end Set_Next_Package_In_Project;
2543
2544    --------------------------
2545    -- Set_Next_String_Type --
2546    --------------------------
2547
2548    procedure Set_Next_String_Type
2549      (Node    : Project_Node_Id;
2550       In_Tree : Project_Node_Tree_Ref;
2551       To      : Project_Node_Id)
2552    is
2553    begin
2554       pragma Assert
2555         (Present (Node)
2556           and then
2557          In_Tree.Project_Nodes.Table (Node).Kind =
2558            N_String_Type_Declaration);
2559       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2560    end Set_Next_String_Type;
2561
2562    -------------------
2563    -- Set_Next_Term --
2564    -------------------
2565
2566    procedure Set_Next_Term
2567      (Node    : Project_Node_Id;
2568       In_Tree : Project_Node_Tree_Ref;
2569       To      : Project_Node_Id)
2570    is
2571    begin
2572       pragma Assert
2573         (Present (Node)
2574           and then
2575             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2576       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2577    end Set_Next_Term;
2578
2579    -----------------------
2580    -- Set_Next_Variable --
2581    -----------------------
2582
2583    procedure Set_Next_Variable
2584      (Node    : Project_Node_Id;
2585       In_Tree : Project_Node_Tree_Ref;
2586       To      : Project_Node_Id)
2587    is
2588    begin
2589       pragma Assert
2590         (Present (Node)
2591           and then
2592            (In_Tree.Project_Nodes.Table (Node).Kind =
2593               N_Typed_Variable_Declaration
2594                or else
2595             In_Tree.Project_Nodes.Table (Node).Kind =
2596               N_Variable_Declaration));
2597       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2598    end Set_Next_Variable;
2599
2600    -----------------------------
2601    -- Set_Next_With_Clause_Of --
2602    -----------------------------
2603
2604    procedure Set_Next_With_Clause_Of
2605      (Node    : Project_Node_Id;
2606       In_Tree : Project_Node_Tree_Ref;
2607       To      : Project_Node_Id)
2608    is
2609    begin
2610       pragma Assert
2611         (Present (Node)
2612           and then
2613             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2614       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2615    end Set_Next_With_Clause_Of;
2616
2617    -----------------------
2618    -- Set_Package_Id_Of --
2619    -----------------------
2620
2621    procedure Set_Package_Id_Of
2622      (Node    : Project_Node_Id;
2623       In_Tree : Project_Node_Tree_Ref;
2624       To      : Package_Node_Id)
2625    is
2626    begin
2627       pragma Assert
2628         (Present (Node)
2629           and then
2630             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2631       In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2632    end Set_Package_Id_Of;
2633
2634    -------------------------
2635    -- Set_Package_Node_Of --
2636    -------------------------
2637
2638    procedure Set_Package_Node_Of
2639      (Node    : Project_Node_Id;
2640       In_Tree : Project_Node_Tree_Ref;
2641       To      : Project_Node_Id)
2642    is
2643    begin
2644       pragma Assert
2645         (Present (Node)
2646           and then
2647             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2648                or else
2649              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2650       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2651    end Set_Package_Node_Of;
2652
2653    ----------------------
2654    -- Set_Path_Name_Of --
2655    ----------------------
2656
2657    procedure Set_Path_Name_Of
2658      (Node    : Project_Node_Id;
2659       In_Tree : Project_Node_Tree_Ref;
2660       To      : Path_Name_Type)
2661    is
2662    begin
2663       pragma Assert
2664         (Present (Node)
2665           and then
2666             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2667                or else
2668              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2669       In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2670    end Set_Path_Name_Of;
2671
2672    ---------------------------
2673    -- Set_Previous_End_Node --
2674    ---------------------------
2675    procedure Set_Previous_End_Node (To : Project_Node_Id) is
2676    begin
2677       Previous_End_Node := To;
2678    end Set_Previous_End_Node;
2679
2680    ----------------------------
2681    -- Set_Previous_Line_Node --
2682    ----------------------------
2683
2684    procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2685    begin
2686       Previous_Line_Node := To;
2687    end Set_Previous_Line_Node;
2688
2689    --------------------------------
2690    -- Set_Project_Declaration_Of --
2691    --------------------------------
2692
2693    procedure Set_Project_Declaration_Of
2694      (Node    : Project_Node_Id;
2695       In_Tree : Project_Node_Tree_Ref;
2696       To      : Project_Node_Id)
2697    is
2698    begin
2699       pragma Assert
2700         (Present (Node)
2701          and then
2702            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2703       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2704    end Set_Project_Declaration_Of;
2705
2706    ------------------------------
2707    -- Set_Project_Qualifier_Of --
2708    ------------------------------
2709
2710    procedure Set_Project_Qualifier_Of
2711      (Node    : Project_Node_Id;
2712       In_Tree : Project_Node_Tree_Ref;
2713       To      : Project_Qualifier)
2714    is
2715    begin
2716       pragma Assert
2717         (Present (Node)
2718           and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2719       In_Tree.Project_Nodes.Table (Node).Qualifier := To;
2720    end Set_Project_Qualifier_Of;
2721
2722    ---------------------------
2723    -- Set_Parent_Project_Of --
2724    ---------------------------
2725
2726    procedure Set_Parent_Project_Of
2727      (Node    : Project_Node_Id;
2728       In_Tree : Project_Node_Tree_Ref;
2729       To      : Project_Node_Id)
2730    is
2731    begin
2732       pragma Assert
2733         (Present (Node)
2734           and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2735       In_Tree.Project_Nodes.Table (Node).Field4 := To;
2736    end Set_Parent_Project_Of;
2737
2738    -----------------------------------------------
2739    -- Set_Project_File_Includes_Unkept_Comments --
2740    -----------------------------------------------
2741
2742    procedure Set_Project_File_Includes_Unkept_Comments
2743      (Node    : Project_Node_Id;
2744       In_Tree : Project_Node_Tree_Ref;
2745       To      : Boolean)
2746    is
2747       Declaration : constant Project_Node_Id :=
2748                       Project_Declaration_Of (Node, In_Tree);
2749    begin
2750       In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2751    end Set_Project_File_Includes_Unkept_Comments;
2752
2753    -------------------------
2754    -- Set_Project_Node_Of --
2755    -------------------------
2756
2757    procedure Set_Project_Node_Of
2758      (Node         : Project_Node_Id;
2759       In_Tree      : Project_Node_Tree_Ref;
2760       To           : Project_Node_Id;
2761       Limited_With : Boolean := False)
2762    is
2763    begin
2764       pragma Assert
2765         (Present (Node)
2766           and then
2767             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2768                or else
2769              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2770                or else
2771              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2772       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2773
2774       if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2775         and then not Limited_With
2776       then
2777          In_Tree.Project_Nodes.Table (Node).Field3 := To;
2778       end if;
2779    end Set_Project_Node_Of;
2780
2781    ---------------------------------------
2782    -- Set_Project_Of_Renamed_Package_Of --
2783    ---------------------------------------
2784
2785    procedure Set_Project_Of_Renamed_Package_Of
2786      (Node    : Project_Node_Id;
2787       In_Tree : Project_Node_Tree_Ref;
2788       To      : Project_Node_Id)
2789    is
2790    begin
2791       pragma Assert
2792         (Present (Node)
2793           and then
2794             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2795       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2796    end Set_Project_Of_Renamed_Package_Of;
2797
2798    -------------------------
2799    -- Set_Source_Index_Of --
2800    -------------------------
2801
2802    procedure Set_Source_Index_Of
2803      (Node    : Project_Node_Id;
2804       In_Tree : Project_Node_Tree_Ref;
2805       To      : Int)
2806    is
2807    begin
2808       pragma Assert
2809         (Present (Node)
2810           and then
2811            (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2812             or else
2813             In_Tree.Project_Nodes.Table (Node).Kind =
2814               N_Attribute_Declaration));
2815       In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2816    end Set_Source_Index_Of;
2817
2818    ------------------------
2819    -- Set_String_Type_Of --
2820    ------------------------
2821
2822    procedure Set_String_Type_Of
2823      (Node    : Project_Node_Id;
2824       In_Tree : Project_Node_Tree_Ref;
2825       To      : Project_Node_Id)
2826    is
2827    begin
2828       pragma Assert
2829         (Present (Node)
2830           and then
2831            (In_Tree.Project_Nodes.Table (Node).Kind =
2832               N_Variable_Reference
2833                or else
2834             In_Tree.Project_Nodes.Table (Node).Kind =
2835               N_Typed_Variable_Declaration)
2836           and then
2837             In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2838
2839       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2840          In_Tree.Project_Nodes.Table (Node).Field3 := To;
2841       else
2842          In_Tree.Project_Nodes.Table (Node).Field2 := To;
2843       end if;
2844    end Set_String_Type_Of;
2845
2846    -------------------------
2847    -- Set_String_Value_Of --
2848    -------------------------
2849
2850    procedure Set_String_Value_Of
2851      (Node    : Project_Node_Id;
2852       In_Tree : Project_Node_Tree_Ref;
2853       To      : Name_Id)
2854    is
2855    begin
2856       pragma Assert
2857         (Present (Node)
2858           and then
2859             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2860                or else
2861              In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2862                or else
2863              In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2864       In_Tree.Project_Nodes.Table (Node).Value := To;
2865    end Set_String_Value_Of;
2866
2867    ---------------------
2868    -- Source_Index_Of --
2869    ---------------------
2870
2871    function Source_Index_Of
2872      (Node    : Project_Node_Id;
2873       In_Tree : Project_Node_Tree_Ref) return Int
2874    is
2875    begin
2876       pragma Assert
2877         (Present (Node)
2878           and then
2879             (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2880               or else
2881              In_Tree.Project_Nodes.Table (Node).Kind =
2882                N_Attribute_Declaration));
2883       return In_Tree.Project_Nodes.Table (Node).Src_Index;
2884    end Source_Index_Of;
2885
2886    --------------------
2887    -- String_Type_Of --
2888    --------------------
2889
2890    function String_Type_Of
2891      (Node    : Project_Node_Id;
2892       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2893    is
2894    begin
2895       pragma Assert
2896         (Present (Node)
2897           and then
2898            (In_Tree.Project_Nodes.Table (Node).Kind =
2899               N_Variable_Reference
2900                or else
2901             In_Tree.Project_Nodes.Table (Node).Kind =
2902               N_Typed_Variable_Declaration));
2903
2904       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2905          return In_Tree.Project_Nodes.Table (Node).Field3;
2906       else
2907          return In_Tree.Project_Nodes.Table (Node).Field2;
2908       end if;
2909    end String_Type_Of;
2910
2911    ---------------------
2912    -- String_Value_Of --
2913    ---------------------
2914
2915    function String_Value_Of
2916      (Node    : Project_Node_Id;
2917       In_Tree : Project_Node_Tree_Ref) return Name_Id
2918    is
2919    begin
2920       pragma Assert
2921         (Present (Node)
2922           and then
2923            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2924               or else
2925             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2926                or else
2927             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2928       return In_Tree.Project_Nodes.Table (Node).Value;
2929    end String_Value_Of;
2930
2931    --------------------
2932    -- Value_Is_Valid --
2933    --------------------
2934
2935    function Value_Is_Valid
2936      (For_Typed_Variable : Project_Node_Id;
2937       In_Tree            : Project_Node_Tree_Ref;
2938       Value              : Name_Id) return Boolean
2939    is
2940    begin
2941       pragma Assert
2942         (Present (For_Typed_Variable)
2943           and then
2944            (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2945                                      N_Typed_Variable_Declaration));
2946
2947       declare
2948          Current_String : Project_Node_Id :=
2949                             First_Literal_String
2950                               (String_Type_Of (For_Typed_Variable, In_Tree),
2951                                In_Tree);
2952
2953       begin
2954          while Present (Current_String)
2955            and then
2956              String_Value_Of (Current_String, In_Tree) /= Value
2957          loop
2958             Current_String :=
2959               Next_Literal_String (Current_String, In_Tree);
2960          end loop;
2961
2962          return Present (Current_String);
2963       end;
2964
2965    end Value_Is_Valid;
2966
2967    -------------------------------
2968    -- There_Are_Unkept_Comments --
2969    -------------------------------
2970
2971    function There_Are_Unkept_Comments return Boolean is
2972    begin
2973       return Unkept_Comments;
2974    end There_Are_Unkept_Comments;
2975
2976    --------------------
2977    -- Create_Project --
2978    --------------------
2979
2980    function Create_Project
2981      (In_Tree        : Project_Node_Tree_Ref;
2982       Name           : Name_Id;
2983       Full_Path      : Path_Name_Type;
2984       Is_Config_File : Boolean := False) return Project_Node_Id
2985    is
2986       Project   : Project_Node_Id;
2987       Qualifier : Project_Qualifier := Unspecified;
2988    begin
2989       Project := Default_Project_Node (In_Tree, N_Project);
2990       Set_Name_Of (Project, In_Tree, Name);
2991       Set_Display_Name_Of (Project, In_Tree, Name);
2992       Set_Directory_Of
2993         (Project, In_Tree,
2994          Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
2995       Set_Path_Name_Of (Project, In_Tree, Full_Path);
2996
2997       Set_Project_Declaration_Of
2998         (Project, In_Tree,
2999          Default_Project_Node (In_Tree, N_Project_Declaration));
3000
3001       if Is_Config_File then
3002          Qualifier := Configuration;
3003       end if;
3004
3005       if not Is_Config_File then
3006          Prj.Tree.Tree_Private_Part.Projects_Htable.Set
3007            (In_Tree.Projects_HT,
3008             Name,
3009             Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
3010               (Name           => Name,
3011                Resolved_Path  => No_Path,
3012                Node           => Project,
3013                Extended       => False,
3014                From_Extended  => False,
3015                Proj_Qualifier => Qualifier));
3016       end if;
3017
3018       return Project;
3019    end Create_Project;
3020
3021    ----------------
3022    -- Add_At_End --
3023    ----------------
3024
3025    procedure Add_At_End
3026      (Tree                  : Project_Node_Tree_Ref;
3027       Parent                : Project_Node_Id;
3028       Expr                  : Project_Node_Id;
3029       Add_Before_First_Pkg  : Boolean := False;
3030       Add_Before_First_Case : Boolean := False)
3031    is
3032       Real_Parent          : Project_Node_Id;
3033       New_Decl, Decl, Next : Project_Node_Id;
3034       Last, L              : Project_Node_Id;
3035
3036    begin
3037       if Kind_Of (Expr, Tree) /= N_Declarative_Item then
3038          New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
3039          Set_Current_Item_Node (New_Decl, Tree, Expr);
3040       else
3041          New_Decl := Expr;
3042       end if;
3043
3044       if Kind_Of (Parent, Tree) = N_Project then
3045          Real_Parent := Project_Declaration_Of (Parent, Tree);
3046       else
3047          Real_Parent := Parent;
3048       end if;
3049
3050       Decl := First_Declarative_Item_Of (Real_Parent, Tree);
3051
3052       if Decl = Empty_Node then
3053          Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
3054       else
3055          loop
3056             Next := Next_Declarative_Item (Decl, Tree);
3057             exit when Next = Empty_Node
3058               or else
3059                (Add_Before_First_Pkg
3060                  and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3061                                                         N_Package_Declaration)
3062               or else
3063                (Add_Before_First_Case
3064                  and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3065                                                         N_Case_Construction);
3066             Decl := Next;
3067          end loop;
3068
3069          --  In case Expr is in fact a range of declarative items
3070
3071          Last := New_Decl;
3072          loop
3073             L := Next_Declarative_Item (Last, Tree);
3074             exit when L = Empty_Node;
3075             Last := L;
3076          end loop;
3077
3078          --  In case Expr is in fact a range of declarative items
3079
3080          Last := New_Decl;
3081          loop
3082             L := Next_Declarative_Item (Last, Tree);
3083             exit when L = Empty_Node;
3084             Last := L;
3085          end loop;
3086
3087          Set_Next_Declarative_Item (Last, Tree, Next);
3088          Set_Next_Declarative_Item (Decl, Tree, New_Decl);
3089       end if;
3090    end Add_At_End;
3091
3092    ---------------------------
3093    -- Create_Literal_String --
3094    ---------------------------
3095
3096    function Create_Literal_String
3097      (Str  : Namet.Name_Id;
3098       Tree : Project_Node_Tree_Ref) return Project_Node_Id
3099    is
3100       Node : Project_Node_Id;
3101    begin
3102       Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
3103       Set_Next_Literal_String (Node, Tree, Empty_Node);
3104       Set_String_Value_Of (Node, Tree, Str);
3105       return Node;
3106    end Create_Literal_String;
3107
3108    ---------------------------
3109    -- Enclose_In_Expression --
3110    ---------------------------
3111
3112    function Enclose_In_Expression
3113      (Node : Project_Node_Id;
3114       Tree : Project_Node_Tree_Ref) return Project_Node_Id
3115    is
3116       Expr : Project_Node_Id;
3117    begin
3118       if Kind_Of (Node, Tree) /= N_Expression then
3119          Expr := Default_Project_Node (Tree, N_Expression, Single);
3120          Set_First_Term
3121            (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
3122          Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
3123          return Expr;
3124       else
3125          return Node;
3126       end if;
3127    end Enclose_In_Expression;
3128
3129    --------------------
3130    -- Create_Package --
3131    --------------------
3132
3133    function Create_Package
3134      (Tree    : Project_Node_Tree_Ref;
3135       Project : Project_Node_Id;
3136       Pkg     : String) return Project_Node_Id
3137    is
3138       Pack : Project_Node_Id;
3139       N    : Name_Id;
3140
3141    begin
3142       Name_Len := Pkg'Length;
3143       Name_Buffer (1 .. Name_Len) := Pkg;
3144       N := Name_Find;
3145
3146       --  Check if the package already exists
3147
3148       Pack := First_Package_Of (Project, Tree);
3149       while Pack /= Empty_Node loop
3150          if Prj.Tree.Name_Of (Pack, Tree) = N then
3151             return Pack;
3152          end if;
3153
3154          Pack := Next_Package_In_Project (Pack, Tree);
3155       end loop;
3156
3157       --  Create the package and add it to the declarative item
3158
3159       Pack := Default_Project_Node (Tree, N_Package_Declaration);
3160       Set_Name_Of (Pack, Tree, N);
3161
3162       --  Find the correct package id to use
3163
3164       Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3165
3166       --  Add it to the list of packages
3167
3168       Set_Next_Package_In_Project
3169         (Pack, Tree, First_Package_Of (Project, Tree));
3170       Set_First_Package_Of (Project, Tree, Pack);
3171
3172       Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3173
3174       return Pack;
3175    end Create_Package;
3176
3177    ----------------------
3178    -- Create_Attribute --
3179    ----------------------
3180
3181    function Create_Attribute
3182      (Tree       : Project_Node_Tree_Ref;
3183       Prj_Or_Pkg : Project_Node_Id;
3184       Name       : Name_Id;
3185       Index_Name : Name_Id       := No_Name;
3186       Kind       : Variable_Kind := List;
3187       At_Index   : Integer       := 0;
3188       Value      : Project_Node_Id := Empty_Node) return Project_Node_Id
3189    is
3190       Node : constant Project_Node_Id :=
3191                Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3192
3193       Case_Insensitive : Boolean;
3194
3195       Pkg      : Package_Node_Id;
3196       Start_At : Attribute_Node_Id;
3197       Expr     : Project_Node_Id;
3198
3199    begin
3200       Set_Name_Of (Node, Tree, Name);
3201
3202       if Index_Name /= No_Name then
3203          Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3204       end if;
3205
3206       if Prj_Or_Pkg /= Empty_Node then
3207          Add_At_End (Tree, Prj_Or_Pkg, Node);
3208       end if;
3209
3210       --  Find out the case sensitivity of the attribute
3211
3212       if Prj_Or_Pkg /= Empty_Node
3213         and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3214       then
3215          Pkg      := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3216          Start_At := First_Attribute_Of (Pkg);
3217       else
3218          Start_At := Attribute_First;
3219       end if;
3220
3221       Start_At := Attribute_Node_Id_Of (Name, Start_At);
3222       Case_Insensitive :=
3223         Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3224       Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3225
3226       if At_Index /= 0 then
3227          if Attribute_Kind_Of (Start_At) =
3228               Optional_Index_Associative_Array
3229            or else Attribute_Kind_Of (Start_At) =
3230               Optional_Index_Case_Insensitive_Associative_Array
3231          then
3232             --  Results in:   for Name ("index" at index) use "value";
3233             --  This is currently only used for executables.
3234
3235             Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3236
3237          else
3238             --  Results in:   for Name ("index") use "value" at index;
3239
3240             --  ??? This limitation makes no sense, we should be able to
3241             --  set the source index on an expression.
3242
3243             pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
3244             Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
3245          end if;
3246       end if;
3247
3248       if Value /= Empty_Node then
3249          Expr := Enclose_In_Expression (Value, Tree);
3250          Set_Expression_Of (Node, Tree, Expr);
3251       end if;
3252
3253       return Node;
3254    end Create_Attribute;
3255
3256 end Prj.Tree;