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