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