gcc/ada/prj-strt.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . S T R T                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Err_Vars; use Err_Vars;
  27 with Prj.Attr; use Prj.Attr;
  28 with Prj.Err;  use Prj.Err;
  29 with Snames;
  30 with Table;
  31 with Uintp;    use Uintp;
  32
  33 package body Prj.Strt is
  34
  35    Buffer      : String_Access;
  36    Buffer_Last : Natural := 0;
  37
  38    type Choice_String is record
  39       The_String   : Name_Id;
  40       Already_Used : Boolean := False;
  41    end record;
  42    --  The string of a case label, and an indication that it has already
  43    --  been used (to avoid duplicate case labels).
  44
  45    Choices_Initial   : constant := 10;
  46    Choices_Increment : constant := 100;
  47    --  These should be in alloc.ads
  48
  49    Choice_Node_Low_Bound  : constant := 0;
  50    Choice_Node_High_Bound : constant := 099_999_999;
  51    --  In practice, infinite
  52
  53    type Choice_Node_Id is
  54      range Choice_Node_Low_Bound .. Choice_Node_High_Bound;
  55
  56    First_Choice_Node_Id : constant Choice_Node_Id :=
  57      Choice_Node_Low_Bound;
  58
  59    package Choices is
  60      new Table.Table
  61        (Table_Component_Type => Choice_String,
  62         Table_Index_Type     => Choice_Node_Id'Base,
  63         Table_Low_Bound      => First_Choice_Node_Id,
  64         Table_Initial        => Choices_Initial,
  65         Table_Increment      => Choices_Increment,
  66         Table_Name           => "Prj.Strt.Choices");
  67    --  Used to store the case labels and check that there is no duplicate
  68
  69    package Choice_Lasts is
  70      new Table.Table
  71        (Table_Component_Type => Choice_Node_Id,
  72         Table_Index_Type     => Nat,
  73         Table_Low_Bound      => 1,
  74         Table_Initial        => 10,
  75         Table_Increment      => 100,
  76         Table_Name           => "Prj.Strt.Choice_Lasts");
  77    --  Used to store the indices of the choices in table Choices,
  78    --  to distinguish nested case constructions.
  79
  80    Choice_First : Choice_Node_Id := 0;
  81    --  Index in table Choices of the first case label of the current
  82    --  case construction. Zero means no current case construction.
  83
  84    type Name_Location is record
  85       Name     : Name_Id := No_Name;
  86       Location : Source_Ptr := No_Location;
  87    end record;
  88    --  Store the identifier and the location of a simple name
  89
  90    package Names is
  91      new Table.Table
  92        (Table_Component_Type => Name_Location,
  93         Table_Index_Type     => Nat,
  94         Table_Low_Bound      => 1,
  95         Table_Initial        => 10,
  96         Table_Increment      => 100,
  97         Table_Name           => "Prj.Strt.Names");
  98    --  Used to accumulate the single names of a name
  99
 100    procedure Add (This_String : Name_Id);
 101    --  Add a string to the case label list, indicating that it has not
 102    --  yet been used.
 103
 104    procedure Add_To_Names (NL : Name_Location);
 105    --  Add one single names to table Names
 106
 107    procedure External_Reference
 108      (In_Tree         : Project_Node_Tree_Ref;
 109       Current_Project : Project_Node_Id;
 110       Current_Package : Project_Node_Id;
 111       External_Value  : out Project_Node_Id);
 112    --  Parse an external reference. Current token is "external"
 113
 114    procedure Attribute_Reference
 115      (In_Tree         : Project_Node_Tree_Ref;
 116       Reference       : out Project_Node_Id;
 117       First_Attribute : Attribute_Node_Id;
 118       Current_Project : Project_Node_Id;
 119       Current_Package : Project_Node_Id);
 120    --  Parse an attribute reference. Current token is an apostrophe
 121
 122    procedure Terms
 123      (In_Tree         : Project_Node_Tree_Ref;
 124       Term            : out Project_Node_Id;
 125       Expr_Kind       : in out Variable_Kind;
 126       Current_Project : Project_Node_Id;
 127       Current_Package : Project_Node_Id;
 128       Optional_Index  : Boolean);
 129    --  Recursive procedure to parse one term or several terms concatenated
 130    --  using "&".
 131
 132    ---------
 133    -- Add --
 134    ---------
 135
 136    procedure Add (This_String : Name_Id) is
 137    begin
 138       Choices.Increment_Last;
 139       Choices.Table (Choices.Last) :=
 140         (The_String   => This_String,
 141          Already_Used => False);
 142    end Add;
 143
 144    ------------------
 145    -- Add_To_Names --
 146    ------------------
 147
 148    procedure Add_To_Names (NL : Name_Location) is
 149    begin
 150       Names.Increment_Last;
 151       Names.Table (Names.Last) := NL;
 152    end Add_To_Names;
 153
 154    -------------------------
 155    -- Attribute_Reference --
 156    -------------------------
 157
 158    procedure Attribute_Reference
 159      (In_Tree         : Project_Node_Tree_Ref;
 160       Reference       : out Project_Node_Id;
 161       First_Attribute : Attribute_Node_Id;
 162       Current_Project : Project_Node_Id;
 163       Current_Package : Project_Node_Id)
 164    is
 165       Current_Attribute : Attribute_Node_Id := First_Attribute;
 166
 167    begin
 168       --  Declare the node of the attribute reference
 169
 170       Reference :=
 171         Default_Project_Node
 172           (Of_Kind => N_Attribute_Reference, In_Tree => In_Tree);
 173       Set_Location_Of (Reference, In_Tree, To => Token_Ptr);
 174       Scan (In_Tree); --  past apostrophe
 175
 176       --  Body may be an attribute name
 177
 178       if Token = Tok_Body then
 179          Token      := Tok_Identifier;
 180          Token_Name := Snames.Name_Body;
 181       end if;
 182
 183       Expect (Tok_Identifier, "identifier");
 184
 185       if Token = Tok_Identifier then
 186          Set_Name_Of (Reference, In_Tree, To => Token_Name);
 187
 188          --  Check if the identifier is one of the attribute identifiers in the
 189          --  context (package or project level attributes).
 190
 191          Current_Attribute :=
 192            Attribute_Node_Id_Of (Token_Name, Starting_At => First_Attribute);
 193
 194          --  If the identifier is not allowed, report an error
 195
 196          if Current_Attribute = Empty_Attribute then
 197             Error_Msg_Name_1 := Token_Name;
 198             Error_Msg ("unknown attribute %%", Token_Ptr);
 199             Reference := Empty_Node;
 200
 201             --  Scan past the attribute name
 202
 203             Scan (In_Tree);
 204
 205          else
 206             --  Give its characteristics to this attribute reference
 207
 208             Set_Project_Node_Of (Reference, In_Tree, To => Current_Project);
 209             Set_Package_Node_Of (Reference, In_Tree, To => Current_Package);
 210             Set_Expression_Kind_Of
 211               (Reference, In_Tree, To => Variable_Kind_Of (Current_Attribute));
 212             Set_Case_Insensitive
 213               (Reference, In_Tree,
 214                To => Attribute_Kind_Of (Current_Attribute) in
 215                       Case_Insensitive_Associative_Array ..
 216                         Optional_Index_Case_Insensitive_Associative_Array);
 217
 218             --  Scan past the attribute name
 219
 220             Scan (In_Tree);
 221
 222             --  If the attribute is an associative array, get the index
 223
 224             if Attribute_Kind_Of (Current_Attribute) /= Single then
 225                Expect (Tok_Left_Paren, "`(`");
 226
 227                if Token = Tok_Left_Paren then
 228                   Scan (In_Tree);
 229                   Expect (Tok_String_Literal, "literal string");
 230
 231                   if Token = Tok_String_Literal then
 232                      Set_Associative_Array_Index_Of
 233                        (Reference, In_Tree, To => Token_Name);
 234                      Scan (In_Tree);
 235                      Expect (Tok_Right_Paren, "`)`");
 236
 237                      if Token = Tok_Right_Paren then
 238                         Scan (In_Tree);
 239                      end if;
 240                   end if;
 241                end if;
 242             end if;
 243          end if;
 244
 245          --  Change name of obsolete attributes
 246
 247          if Reference /= Empty_Node then
 248             case Name_Of (Reference, In_Tree) is
 249                when Snames.Name_Specification =>
 250                   Set_Name_Of (Reference, In_Tree, To => Snames.Name_Spec);
 251
 252                when Snames.Name_Specification_Suffix =>
 253                   Set_Name_Of
 254                     (Reference, In_Tree, To => Snames.Name_Spec_Suffix);
 255
 256                when Snames.Name_Implementation =>
 257                   Set_Name_Of (Reference, In_Tree, To => Snames.Name_Body);
 258
 259                when Snames.Name_Implementation_Suffix =>
 260                   Set_Name_Of
 261                     (Reference, In_Tree, To => Snames.Name_Body_Suffix);
 262
 263                when others =>
 264                   null;
 265             end case;
 266          end if;
 267       end if;
 268    end Attribute_Reference;
 269
 270    ---------------------------
 271    -- End_Case_Construction --
 272    ---------------------------
 273
 274    procedure End_Case_Construction
 275      (Check_All_Labels   : Boolean;
 276       Case_Location      : Source_Ptr)
 277    is
 278       Non_Used : Natural := 0;
 279       First_Non_Used : Choice_Node_Id := First_Choice_Node_Id;
 280    begin
 281       --  First, if Check_All_Labels is True, check if all values
 282       --  of the string type have been used.
 283
 284       if Check_All_Labels then
 285          for Choice in Choice_First .. Choices.Last loop
 286                if not Choices.Table (Choice).Already_Used then
 287                   Non_Used := Non_Used + 1;
 288
 289                   if Non_Used = 1 then
 290                      First_Non_Used := Choice;
 291                   end if;
 292                end if;
 293          end loop;
 294
 295          --  If only one is not used, report a single warning for this value
 296
 297          if Non_Used = 1 then
 298             Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
 299             Error_Msg ("?value %% is not used as label", Case_Location);
 300
 301          --  If several are not used, report a warning for each one of them
 302
 303          elsif Non_Used > 1 then
 304             Error_Msg
 305               ("?the following values are not used as labels:",
 306                Case_Location);
 307
 308             for Choice in First_Non_Used .. Choices.Last loop
 309                if not Choices.Table (Choice).Already_Used then
 310                   Error_Msg_Name_1 := Choices.Table (Choice).The_String;
 311                   Error_Msg ("\?%%", Case_Location);
 312                end if;
 313             end loop;
 314          end if;
 315       end if;
 316
 317       --  If this is the only case construction, empty the tables
 318
 319       if Choice_Lasts.Last = 1 then
 320          Choice_Lasts.Set_Last (0);
 321          Choices.Set_Last (First_Choice_Node_Id);
 322          Choice_First := 0;
 323
 324       elsif Choice_Lasts.Last = 2 then
 325
 326          --  This is the second case construction, set the tables to the first
 327
 328          Choice_Lasts.Set_Last (1);
 329          Choices.Set_Last (Choice_Lasts.Table (1));
 330          Choice_First := 1;
 331
 332       else
 333          --  This is the 3rd or more case construction, set the tables to the
 334          --  previous one.
 335
 336          Choice_Lasts.Decrement_Last;
 337          Choices.Set_Last (Choice_Lasts.Table (Choice_Lasts.Last));
 338          Choice_First := Choice_Lasts.Table (Choice_Lasts.Last - 1) + 1;
 339       end if;
 340    end End_Case_Construction;
 341
 342    ------------------------
 343    -- External_Reference --
 344    ------------------------
 345
 346    procedure External_Reference
 347      (In_Tree         : Project_Node_Tree_Ref;
 348       Current_Project : Project_Node_Id;
 349       Current_Package : Project_Node_Id;
 350       External_Value  : out Project_Node_Id)
 351    is
 352       Field_Id : Project_Node_Id := Empty_Node;
 353
 354    begin
 355       External_Value :=
 356         Default_Project_Node
 357           (Of_Kind       => N_External_Value,
 358            In_Tree       => In_Tree,
 359            And_Expr_Kind => Single);
 360       Set_Location_Of (External_Value, In_Tree, To => Token_Ptr);
 361
 362       --  The current token is External
 363
 364       --  Get the left parenthesis
 365
 366       Scan (In_Tree);
 367       Expect (Tok_Left_Paren, "`(`");
 368
 369       --  Scan past the left parenthesis
 370
 371       if Token = Tok_Left_Paren then
 372          Scan (In_Tree);
 373       end if;
 374
 375       --  Get the name of the external reference
 376
 377       Expect (Tok_String_Literal, "literal string");
 378
 379       if Token = Tok_String_Literal then
 380          Field_Id :=
 381            Default_Project_Node
 382              (Of_Kind       => N_Literal_String,
 383               In_Tree       => In_Tree,
 384               And_Expr_Kind => Single);
 385          Set_String_Value_Of (Field_Id, In_Tree, To => Token_Name);
 386          Set_External_Reference_Of (External_Value, In_Tree, To => Field_Id);
 387
 388          --  Scan past the first argument
 389
 390          Scan (In_Tree);
 391
 392          case Token is
 393
 394             when Tok_Right_Paren =>
 395                Scan (In_Tree); -- scan past right paren
 396
 397             when Tok_Comma =>
 398                Scan (In_Tree); -- scan past comma
 399
 400                --  Get the string expression for the default
 401
 402                declare
 403                   Loc : constant Source_Ptr := Token_Ptr;
 404
 405                begin
 406                   Parse_Expression
 407                     (In_Tree         => In_Tree,
 408                      Expression      => Field_Id,
 409                      Current_Project => Current_Project,
 410                      Current_Package => Current_Package,
 411                      Optional_Index  => False);
 412
 413                   if Expression_Kind_Of (Field_Id, In_Tree) = List then
 414                      Error_Msg ("expression must be a single string", Loc);
 415                   else
 416                      Set_External_Default_Of
 417                        (External_Value, In_Tree, To => Field_Id);
 418                   end if;
 419                end;
 420
 421                Expect (Tok_Right_Paren, "`)`");
 422
 423                if Token = Tok_Right_Paren then
 424                   Scan (In_Tree); -- scan past right paren
 425                end if;
 426
 427             when others =>
 428                Error_Msg ("`,` or `)` expected", Token_Ptr);
 429          end case;
 430       end if;
 431    end External_Reference;
 432
 433    -----------------------
 434    -- Parse_Choice_List --
 435    -----------------------
 436
 437    procedure Parse_Choice_List
 438      (In_Tree      : Project_Node_Tree_Ref;
 439       First_Choice : out Project_Node_Id)
 440    is
 441       Current_Choice : Project_Node_Id := Empty_Node;
 442       Next_Choice    : Project_Node_Id := Empty_Node;
 443       Choice_String  : Name_Id         := No_Name;
 444       Found          : Boolean         := False;
 445
 446    begin
 447       --  Declare the node of the first choice
 448
 449       First_Choice :=
 450         Default_Project_Node
 451           (Of_Kind       => N_Literal_String,
 452            In_Tree       => In_Tree,
 453            And_Expr_Kind => Single);
 454
 455       --  Initially Current_Choice is the same as First_Choice
 456
 457       Current_Choice := First_Choice;
 458
 459       loop
 460          Expect (Tok_String_Literal, "literal string");
 461          exit when Token /= Tok_String_Literal;
 462          Set_Location_Of (Current_Choice, In_Tree, To => Token_Ptr);
 463          Choice_String := Token_Name;
 464
 465          --  Give the string value to the current choice
 466
 467          Set_String_Value_Of (Current_Choice, In_Tree, To => Choice_String);
 468
 469          --  Check if the label is part of the string type and if it has not
 470          --  been already used.
 471
 472          Found := False;
 473          for Choice in Choice_First .. Choices.Last loop
 474             if Choices.Table (Choice).The_String = Choice_String then
 475
 476                --  This label is part of the string type
 477
 478                Found := True;
 479
 480                if Choices.Table (Choice).Already_Used then
 481
 482                   --  But it has already appeared in a choice list for this
 483                   --  case construction so report an error.
 484
 485                   Error_Msg_Name_1 := Choice_String;
 486                   Error_Msg ("duplicate case label %%", Token_Ptr);
 487
 488                else
 489                   Choices.Table (Choice).Already_Used := True;
 490                end if;
 491
 492                exit;
 493             end if;
 494          end loop;
 495
 496          --  If the label is not part of the string list, report an error
 497
 498          if not Found then
 499             Error_Msg_Name_1 := Choice_String;
 500             Error_Msg ("illegal case label %%", Token_Ptr);
 501          end if;
 502
 503          --  Scan past the label
 504
 505          Scan (In_Tree);
 506
 507          --  If there is no '|', we are done
 508
 509          if Token = Tok_Vertical_Bar then
 510
 511             --  Otherwise, declare the node of the next choice, link it to
 512             --  Current_Choice and set Current_Choice to this new node.
 513
 514             Next_Choice :=
 515               Default_Project_Node
 516                 (Of_Kind       => N_Literal_String,
 517                  In_Tree       => In_Tree,
 518                  And_Expr_Kind => Single);
 519             Set_Next_Literal_String
 520               (Current_Choice, In_Tree, To => Next_Choice);
 521             Current_Choice := Next_Choice;
 522             Scan (In_Tree);
 523          else
 524             exit;
 525          end if;
 526       end loop;
 527    end Parse_Choice_List;
 528
 529    ----------------------
 530    -- Parse_Expression --
 531    ----------------------
 532
 533    procedure Parse_Expression
 534      (In_Tree         : Project_Node_Tree_Ref;
 535       Expression      : out Project_Node_Id;
 536       Current_Project : Project_Node_Id;
 537       Current_Package : Project_Node_Id;
 538       Optional_Index  : Boolean)
 539    is
 540       First_Term      : Project_Node_Id := Empty_Node;
 541       Expression_Kind : Variable_Kind := Undefined;
 542
 543    begin
 544       --  Declare the node of the expression
 545
 546       Expression :=
 547         Default_Project_Node (Of_Kind => N_Expression, In_Tree => In_Tree);
 548       Set_Location_Of (Expression, In_Tree, To => Token_Ptr);
 549
 550       --  Parse the term or terms of the expression
 551
 552       Terms (In_Tree         => In_Tree,
 553              Term            => First_Term,
 554              Expr_Kind       => Expression_Kind,
 555              Current_Project => Current_Project,
 556              Current_Package => Current_Package,
 557              Optional_Index  => Optional_Index);
 558
 559       --  Set the first term and the expression kind
 560
 561       Set_First_Term (Expression, In_Tree, To => First_Term);
 562       Set_Expression_Kind_Of (Expression, In_Tree, To => Expression_Kind);
 563    end Parse_Expression;
 564
 565    ----------------------------
 566    -- Parse_String_Type_List --
 567    ----------------------------
 568
 569    procedure Parse_String_Type_List
 570      (In_Tree      : Project_Node_Tree_Ref;
 571       First_String : out Project_Node_Id)
 572    is
 573       Last_String  : Project_Node_Id := Empty_Node;
 574       Next_String  : Project_Node_Id := Empty_Node;
 575       String_Value : Name_Id         := No_Name;
 576
 577    begin
 578       --  Declare the node of the first string
 579
 580       First_String :=
 581         Default_Project_Node
 582           (Of_Kind       => N_Literal_String,
 583            In_Tree       => In_Tree,
 584            And_Expr_Kind => Single);
 585
 586       --  Initially, Last_String is the same as First_String
 587
 588       Last_String := First_String;
 589
 590       loop
 591          Expect (Tok_String_Literal, "literal string");
 592          exit when Token /= Tok_String_Literal;
 593          String_Value := Token_Name;
 594
 595          --  Give its string value to Last_String
 596
 597          Set_String_Value_Of (Last_String, In_Tree, To => String_Value);
 598          Set_Location_Of (Last_String, In_Tree, To => Token_Ptr);
 599
 600          --  Now, check if the string is already part of the string type
 601
 602          declare
 603             Current : Project_Node_Id := First_String;
 604
 605          begin
 606             while Current /= Last_String loop
 607                if String_Value_Of (Current, In_Tree) = String_Value then
 608
 609                   --  This is a repetition, report an error
 610
 611                   Error_Msg_Name_1 := String_Value;
 612                   Error_Msg ("duplicate value %% in type", Token_Ptr);
 613                   exit;
 614                end if;
 615
 616                Current := Next_Literal_String (Current, In_Tree);
 617             end loop;
 618          end;
 619
 620          --  Scan past the literal string
 621
 622          Scan (In_Tree);
 623
 624          --  If there is no comma following the literal string, we are done
 625
 626          if Token /= Tok_Comma then
 627             exit;
 628
 629          else
 630             --  Declare the next string, link it to Last_String and set
 631             --  Last_String to its node.
 632
 633             Next_String :=
 634               Default_Project_Node
 635                 (Of_Kind       => N_Literal_String,
 636                  In_Tree       => In_Tree,
 637                  And_Expr_Kind => Single);
 638             Set_Next_Literal_String (Last_String, In_Tree, To => Next_String);
 639             Last_String := Next_String;
 640             Scan (In_Tree);
 641          end if;
 642       end loop;
 643    end Parse_String_Type_List;
 644
 645    ------------------------------
 646    -- Parse_Variable_Reference --
 647    ------------------------------
 648
 649    procedure Parse_Variable_Reference
 650      (In_Tree         : Project_Node_Tree_Ref;
 651       Variable        : out Project_Node_Id;
 652       Current_Project : Project_Node_Id;
 653       Current_Package : Project_Node_Id)
 654    is
 655       Current_Variable : Project_Node_Id := Empty_Node;
 656
 657       The_Package : Project_Node_Id := Current_Package;
 658       The_Project : Project_Node_Id := Current_Project;
 659
 660       Specified_Project : Project_Node_Id   := Empty_Node;
 661       Specified_Package : Project_Node_Id   := Empty_Node;
 662       Look_For_Variable : Boolean           := True;
 663       First_Attribute   : Attribute_Node_Id := Empty_Attribute;
 664       Variable_Name     : Name_Id;
 665
 666    begin
 667       Names.Init;
 668
 669       loop
 670          Expect (Tok_Identifier, "identifier");
 671
 672          if Token /= Tok_Identifier then
 673             Look_For_Variable := False;
 674             exit;
 675          end if;
 676
 677          Add_To_Names (NL => (Name => Token_Name, Location => Token_Ptr));
 678          Scan (In_Tree);
 679          exit when Token /= Tok_Dot;
 680          Scan (In_Tree);
 681       end loop;
 682
 683       if Look_For_Variable then
 684
 685          if Token = Tok_Apostrophe then
 686
 687             --  Attribute reference
 688
 689             case Names.Last is
 690                when 0 =>
 691
 692                   --  Cannot happen
 693
 694                   null;
 695
 696                when 1 =>
 697                   --  This may be a project name or a package name.
 698                   --  Project name have precedence.
 699
 700                   --  First, look if it can be a package name
 701
 702                   First_Attribute :=
 703                     First_Attribute_Of
 704                       (Package_Node_Id_Of (Names.Table (1).Name));
 705
 706                   --  Now, look if it can be a project name
 707
 708                   if Names.Table (1).Name =
 709                        Name_Of (Current_Project, In_Tree)
 710                   then
 711                      The_Project := Current_Project;
 712
 713                   else
 714                      The_Project :=
 715                        Imported_Or_Extended_Project_Of
 716                          (Current_Project, In_Tree, Names.Table (1).Name);
 717                   end if;
 718
 719                   if The_Project = Empty_Node then
 720
 721                      --  If it is neither a project name nor a package name,
 722                      --  report an error.
 723
 724                      if First_Attribute = Empty_Attribute then
 725                         Error_Msg_Name_1 := Names.Table (1).Name;
 726                         Error_Msg ("unknown project %",
 727                                    Names.Table (1).Location);
 728                         First_Attribute := Attribute_First;
 729
 730                      else
 731                         --  If it is a package name, check if the package has
 732                         --  already been declared in the current project.
 733
 734                         The_Package :=
 735                           First_Package_Of (Current_Project, In_Tree);
 736
 737                         while The_Package /= Empty_Node
 738                           and then Name_Of (The_Package, In_Tree) /=
 739                                                       Names.Table (1).Name
 740                         loop
 741                            The_Package :=
 742                              Next_Package_In_Project (The_Package, In_Tree);
 743                         end loop;
 744
 745                         --  If it has not been already declared, report an
 746                         --  error.
 747
 748                         if The_Package = Empty_Node then
 749                            Error_Msg_Name_1 := Names.Table (1).Name;
 750                            Error_Msg ("package % not yet defined",
 751                                       Names.Table (1).Location);
 752                         end if;
 753                      end if;
 754
 755                   else
 756                      --  It is a project name
 757
 758                      First_Attribute := Attribute_First;
 759                      The_Package     := Empty_Node;
 760                   end if;
 761
 762                when others =>
 763
 764                   --  We have either a project name made of several simple
 765                   --  names (long project), or a project name (short project)
 766                   --  followed by a package name. The long project name has
 767                   --  precedence.
 768
 769                   declare
 770                      Short_Project : Name_Id;
 771                      Long_Project  : Name_Id;
 772
 773                   begin
 774                      --  Clear the Buffer
 775
 776                      Buffer_Last := 0;
 777
 778                      --  Get the name of the short project
 779
 780                      for Index in 1 .. Names.Last - 1 loop
 781                         Add_To_Buffer
 782                           (Get_Name_String (Names.Table (Index).Name),
 783                            Buffer, Buffer_Last);
 784
 785                         if Index /= Names.Last - 1 then
 786                            Add_To_Buffer (".", Buffer, Buffer_Last);
 787                         end if;
 788                      end loop;
 789
 790                      Name_Len := Buffer_Last;
 791                      Name_Buffer (1 .. Buffer_Last) :=
 792                        Buffer (1 .. Buffer_Last);
 793                      Short_Project := Name_Find;
 794
 795                      --  Now, add the last simple name to get the name of the
 796                      --  long project.
 797
 798                      Add_To_Buffer (".", Buffer, Buffer_Last);
 799                      Add_To_Buffer
 800                        (Get_Name_String (Names.Table (Names.Last).Name),
 801                         Buffer, Buffer_Last);
 802                      Name_Len := Buffer_Last;
 803                      Name_Buffer (1 .. Buffer_Last) :=
 804                        Buffer (1 .. Buffer_Last);
 805                      Long_Project := Name_Find;
 806
 807                      --  Check if the long project is imported or extended
 808
 809                      if Long_Project = Name_Of (Current_Project, In_Tree) then
 810                         The_Project := Current_Project;
 811
 812                      else
 813                         The_Project :=
 814                           Imported_Or_Extended_Project_Of
 815                             (Current_Project,
 816                              In_Tree,
 817                              Long_Project);
 818                      end if;
 819
 820                      --  If the long project exists, then this is the prefix
 821                      --  of the attribute.
 822
 823                      if The_Project /= Empty_Node then
 824                         First_Attribute := Attribute_First;
 825                         The_Package     := Empty_Node;
 826
 827                      else
 828                         --  Otherwise, check if the short project is imported
 829                         --  or extended.
 830
 831                         if Short_Project =
 832                              Name_Of (Current_Project, In_Tree)
 833                         then
 834                            The_Project := Current_Project;
 835
 836                         else
 837                            The_Project := Imported_Or_Extended_Project_Of
 838                                             (Current_Project, In_Tree,
 839                                              Short_Project);
 840                         end if;
 841
 842                         --  If short project does not exist, report an error
 843
 844                         if The_Project = Empty_Node then
 845                            Error_Msg_Name_1 := Long_Project;
 846                            Error_Msg_Name_2 := Short_Project;
 847                            Error_Msg ("unknown projects % or %",
 848                                       Names.Table (1).Location);
 849                            The_Package := Empty_Node;
 850                            First_Attribute := Attribute_First;
 851
 852                         else
 853                            --  Now, we check if the package has been declared
 854                            --  in this project.
 855
 856                            The_Package :=
 857                              First_Package_Of (The_Project, In_Tree);
 858                            while The_Package /= Empty_Node
 859                              and then Name_Of (The_Package, In_Tree) /=
 860                              Names.Table (Names.Last).Name
 861                            loop
 862                               The_Package :=
 863                                 Next_Package_In_Project (The_Package, In_Tree);
 864                            end loop;
 865
 866                            --  If it has not, then we report an error
 867
 868                            if The_Package = Empty_Node then
 869                               Error_Msg_Name_1 :=
 870                                 Names.Table (Names.Last).Name;
 871                               Error_Msg_Name_2 := Short_Project;
 872                               Error_Msg ("package % not declared in project %",
 873                                          Names.Table (Names.Last).Location);
 874                               First_Attribute := Attribute_First;
 875
 876                            else
 877                               --  Otherwise, we have the correct project and
 878                               --  package.
 879
 880                               First_Attribute :=
 881                                 First_Attribute_Of
 882                                   (Package_Id_Of (The_Package, In_Tree));
 883                            end if;
 884                         end if;
 885                      end if;
 886                   end;
 887             end case;
 888
 889             Attribute_Reference
 890               (In_Tree,
 891                Variable,
 892                Current_Project => The_Project,
 893                Current_Package => The_Package,
 894                First_Attribute => First_Attribute);
 895             return;
 896          end if;
 897       end if;
 898
 899       Variable :=
 900         Default_Project_Node
 901           (Of_Kind => N_Variable_Reference, In_Tree => In_Tree);
 902
 903       if Look_For_Variable then
 904          case Names.Last is
 905             when 0 =>
 906
 907                --  Cannot happen (so why null instead of raise PE???)
 908
 909                null;
 910
 911             when 1 =>
 912
 913                --  Simple variable name
 914
 915                Set_Name_Of (Variable, In_Tree, To => Names.Table (1).Name);
 916
 917             when 2 =>
 918
 919                --  Variable name with a simple name prefix that can be
 920                --  a project name or a package name. Project names have
 921                --  priority over package names.
 922
 923                Set_Name_Of (Variable, In_Tree, To => Names.Table (2).Name);
 924
 925                --  Check if it can be a package name
 926
 927                The_Package := First_Package_Of (Current_Project, In_Tree);
 928
 929                while The_Package /= Empty_Node
 930                  and then Name_Of (The_Package, In_Tree) /=
 931                             Names.Table (1).Name
 932                loop
 933                   The_Package :=
 934                     Next_Package_In_Project (The_Package, In_Tree);
 935                end loop;
 936
 937                --  Now look for a possible project name
 938
 939                The_Project := Imported_Or_Extended_Project_Of
 940                               (Current_Project, In_Tree, Names.Table (1).Name);
 941
 942                if The_Project /= Empty_Node then
 943                   Specified_Project := The_Project;
 944
 945                elsif The_Package = Empty_Node then
 946                   Error_Msg_Name_1 := Names.Table (1).Name;
 947                   Error_Msg ("unknown package or project %",
 948                              Names.Table (1).Location);
 949                   Look_For_Variable := False;
 950
 951                else
 952                   Specified_Package := The_Package;
 953                end if;
 954
 955             when others =>
 956
 957                --  Variable name with a prefix that is either a project name
 958                --  made of several simple names, or a project name followed
 959                --  by a package name.
 960
 961                Set_Name_Of
 962                  (Variable, In_Tree, To => Names.Table (Names.Last).Name);
 963
 964                declare
 965                   Short_Project : Name_Id;
 966                   Long_Project  : Name_Id;
 967
 968                begin
 969                   --  First, we get the two possible project names
 970
 971                   --  Clear the buffer
 972
 973                   Buffer_Last := 0;
 974
 975                   --  Add all the simple names, except the last two
 976
 977                   for Index in 1 .. Names.Last - 2 loop
 978                      Add_To_Buffer
 979                        (Get_Name_String (Names.Table (Index).Name),
 980                         Buffer, Buffer_Last);
 981
 982                      if Index /= Names.Last - 2 then
 983                         Add_To_Buffer (".", Buffer, Buffer_Last);
 984                      end if;
 985                   end loop;
 986
 987                   Name_Len := Buffer_Last;
 988                   Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
 989                   Short_Project := Name_Find;
 990
 991                   --  Add the simple name before the name of the variable
 992
 993                   Add_To_Buffer (".", Buffer, Buffer_Last);
 994                   Add_To_Buffer
 995                     (Get_Name_String (Names.Table (Names.Last - 1).Name),
 996                      Buffer, Buffer_Last);
 997                   Name_Len := Buffer_Last;
 998                   Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
 999                   Long_Project := Name_Find;
1000
1001                   --  Check if the prefix is the name of an imported or
1002                   --  extended project.
1003
1004                   The_Project := Imported_Or_Extended_Project_Of
1005                                    (Current_Project, In_Tree, Long_Project);
1006
1007                   if The_Project /= Empty_Node then
1008                      Specified_Project := The_Project;
1009
1010                   else
1011                      --  Now check if the prefix may be a project name followed
1012                      --  by a package name.
1013
1014                      --  First check for a possible project name
1015
1016                      The_Project :=
1017                        Imported_Or_Extended_Project_Of
1018                          (Current_Project, In_Tree, Short_Project);
1019
1020                      if The_Project = Empty_Node then
1021                         --  Unknown prefix, report an error
1022
1023                         Error_Msg_Name_1 := Long_Project;
1024                         Error_Msg_Name_2 := Short_Project;
1025                         Error_Msg
1026                           ("unknown projects % or %",
1027                            Names.Table (1).Location);
1028                         Look_For_Variable := False;
1029
1030                      else
1031                         Specified_Project := The_Project;
1032
1033                         --  Now look for the package in this project
1034
1035                         The_Package := First_Package_Of (The_Project, In_Tree);
1036
1037                         while The_Package /= Empty_Node
1038                           and then Name_Of (The_Package, In_Tree) /=
1039                                               Names.Table (Names.Last - 1).Name
1040                         loop
1041                            The_Package :=
1042                              Next_Package_In_Project (The_Package, In_Tree);
1043                         end loop;
1044
1045                         if The_Package = Empty_Node then
1046
1047                            --  The package does not exist, report an error
1048
1049                            Error_Msg_Name_1 := Names.Table (2).Name;
1050                            Error_Msg ("unknown package %",
1051                                    Names.Table (Names.Last - 1).Location);
1052                            Look_For_Variable := False;
1053
1054                         else
1055                            Specified_Package := The_Package;
1056                         end if;
1057                      end if;
1058                   end if;
1059                end;
1060          end case;
1061       end if;
1062
1063       if Look_For_Variable then
1064          Variable_Name := Name_Of (Variable, In_Tree);
1065          Set_Project_Node_Of (Variable, In_Tree, To => Specified_Project);
1066          Set_Package_Node_Of (Variable, In_Tree, To => Specified_Package);
1067
1068          if Specified_Project /= Empty_Node then
1069             The_Project := Specified_Project;
1070          else
1071             The_Project := Current_Project;
1072          end if;
1073
1074          Current_Variable := Empty_Node;
1075
1076          --  Look for this variable
1077
1078          --  If a package was specified, check if the variable has been
1079          --  declared in this package.
1080
1081          if Specified_Package /= Empty_Node then
1082             Current_Variable :=
1083               First_Variable_Of (Specified_Package, In_Tree);
1084             while Current_Variable /= Empty_Node
1085               and then
1086               Name_Of (Current_Variable, In_Tree) /= Variable_Name
1087             loop
1088                Current_Variable := Next_Variable (Current_Variable, In_Tree);
1089             end loop;
1090
1091          else
1092             --  Otherwise, if no project has been specified and we are in
1093             --  a package, first check if the variable has been declared in
1094             --  the package.
1095
1096             if Specified_Project = Empty_Node
1097               and then Current_Package /= Empty_Node
1098             then
1099                Current_Variable :=
1100                  First_Variable_Of (Current_Package, In_Tree);
1101                while Current_Variable /= Empty_Node
1102                  and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
1103                loop
1104                   Current_Variable :=
1105                     Next_Variable (Current_Variable, In_Tree);
1106                end loop;
1107             end if;
1108
1109             --  If we have not found the variable in the package, check if the
1110             --  variable has been declared in the project.
1111
1112             if Current_Variable = Empty_Node then
1113                Current_Variable := First_Variable_Of (The_Project, In_Tree);
1114                while Current_Variable /= Empty_Node
1115                  and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
1116                loop
1117                   Current_Variable :=
1118                     Next_Variable (Current_Variable, In_Tree);
1119                end loop;
1120             end if;
1121          end if;
1122
1123          --  If the variable was not found, report an error
1124
1125          if Current_Variable = Empty_Node then
1126             Error_Msg_Name_1 := Variable_Name;
1127             Error_Msg
1128               ("unknown variable %", Names.Table (Names.Last).Location);
1129          end if;
1130       end if;
1131
1132       if Current_Variable /= Empty_Node then
1133          Set_Expression_Kind_Of
1134            (Variable, In_Tree,
1135             To => Expression_Kind_Of (Current_Variable, In_Tree));
1136
1137          if Kind_Of (Current_Variable, In_Tree) =
1138                                       N_Typed_Variable_Declaration
1139          then
1140             Set_String_Type_Of
1141               (Variable, In_Tree,
1142                To => String_Type_Of (Current_Variable, In_Tree));
1143          end if;
1144       end if;
1145
1146       --  If the variable is followed by a left parenthesis, report an error
1147       --  but attempt to scan the index.
1148
1149       if Token = Tok_Left_Paren then
1150          Error_Msg ("\variables cannot be associative arrays", Token_Ptr);
1151          Scan (In_Tree);
1152          Expect (Tok_String_Literal, "literal string");
1153
1154          if Token = Tok_String_Literal then
1155             Scan (In_Tree);
1156             Expect (Tok_Right_Paren, "`)`");
1157
1158             if Token = Tok_Right_Paren then
1159                Scan (In_Tree);
1160             end if;
1161          end if;
1162       end if;
1163    end Parse_Variable_Reference;
1164
1165    ---------------------------------
1166    -- Start_New_Case_Construction --
1167    ---------------------------------
1168
1169    procedure Start_New_Case_Construction
1170      (In_Tree      : Project_Node_Tree_Ref;
1171       String_Type  : Project_Node_Id)
1172    is
1173       Current_String : Project_Node_Id;
1174
1175    begin
1176       --  Set Choice_First, depending on whether this is the first case
1177       --  construction or not.
1178
1179       if Choice_First = 0 then
1180          Choice_First := 1;
1181          Choices.Set_Last (First_Choice_Node_Id);
1182       else
1183          Choice_First := Choices.Last + 1;
1184       end if;
1185
1186       --  Add the literal of the string type to the Choices table
1187
1188       if String_Type /= Empty_Node then
1189          Current_String := First_Literal_String (String_Type, In_Tree);
1190          while Current_String /= Empty_Node loop
1191             Add (This_String => String_Value_Of (Current_String, In_Tree));
1192             Current_String := Next_Literal_String (Current_String, In_Tree);
1193          end loop;
1194       end if;
1195
1196       --  Set the value of the last choice in table Choice_Lasts
1197
1198       Choice_Lasts.Increment_Last;
1199       Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last;
1200    end Start_New_Case_Construction;
1201
1202    -----------
1203    -- Terms --
1204    -----------
1205
1206    procedure Terms
1207      (In_Tree         : Project_Node_Tree_Ref;
1208       Term            : out Project_Node_Id;
1209       Expr_Kind       : in out Variable_Kind;
1210       Current_Project : Project_Node_Id;
1211       Current_Package : Project_Node_Id;
1212       Optional_Index  : Boolean)
1213    is
1214       Next_Term          : Project_Node_Id := Empty_Node;
1215       Term_Id            : Project_Node_Id := Empty_Node;
1216       Current_Expression : Project_Node_Id := Empty_Node;
1217       Next_Expression    : Project_Node_Id := Empty_Node;
1218       Current_Location   : Source_Ptr      := No_Location;
1219       Reference          : Project_Node_Id := Empty_Node;
1220
1221    begin
1222       --  Declare a new node for the term
1223
1224       Term := Default_Project_Node (Of_Kind => N_Term, In_Tree => In_Tree);
1225       Set_Location_Of (Term, In_Tree, To => Token_Ptr);
1226
1227       case Token is
1228          when Tok_Left_Paren =>
1229
1230             --  If we have a left parenthesis and we don't know the expression
1231             --  kind, then this is a string list.
1232
1233             case Expr_Kind is
1234                when Undefined =>
1235                   Expr_Kind := List;
1236
1237                when List =>
1238                   null;
1239
1240                when Single =>
1241
1242                   --  If we already know that this is a single string, report
1243                   --  an error, but set the expression kind to string list to
1244                   --  avoid several errors.
1245
1246                   Expr_Kind := List;
1247                   Error_Msg
1248                     ("literal string list cannot appear in a string",
1249                      Token_Ptr);
1250             end case;
1251
1252             --  Declare a new node for this literal string list
1253
1254             Term_Id := Default_Project_Node
1255               (Of_Kind       => N_Literal_String_List,
1256                In_Tree       => In_Tree,
1257                And_Expr_Kind => List);
1258             Set_Current_Term (Term, In_Tree, To => Term_Id);
1259             Set_Location_Of  (Term, In_Tree, To => Token_Ptr);
1260
1261             --  Scan past the left parenthesis
1262
1263             Scan (In_Tree);
1264
1265             --  If the left parenthesis is immediately followed by a right
1266             --  parenthesis, the literal string list is empty.
1267
1268             if Token = Tok_Right_Paren then
1269                Scan (In_Tree);
1270
1271             else
1272                --  Otherwise parse the expression(s) in the literal string list
1273
1274                loop
1275                   Current_Location := Token_Ptr;
1276                   Parse_Expression
1277                     (In_Tree         => In_Tree,
1278                      Expression      => Next_Expression,
1279                      Current_Project => Current_Project,
1280                      Current_Package => Current_Package,
1281                      Optional_Index  => Optional_Index);
1282
1283                   --  The expression kind is String list, report an error
1284
1285                   if Expression_Kind_Of (Next_Expression, In_Tree) = List then
1286                      Error_Msg ("single expression expected",
1287                                 Current_Location);
1288                   end if;
1289
1290                   --  If Current_Expression is empty, it means that the
1291                   --  expression is the first in the string list.
1292
1293                   if Current_Expression = Empty_Node then
1294                      Set_First_Expression_In_List
1295                        (Term_Id, In_Tree, To => Next_Expression);
1296                   else
1297                      Set_Next_Expression_In_List
1298                        (Current_Expression, In_Tree, To => Next_Expression);
1299                   end if;
1300
1301                   Current_Expression := Next_Expression;
1302
1303                   --  If there is a comma, continue with the next expression
1304
1305                   exit when Token /= Tok_Comma;
1306                   Scan (In_Tree); -- past the comma
1307                end loop;
1308
1309                --  We expect a closing right parenthesis
1310
1311                Expect (Tok_Right_Paren, "`)`");
1312
1313                if Token = Tok_Right_Paren then
1314                   Scan (In_Tree);
1315                end if;
1316             end if;
1317
1318          when Tok_String_Literal =>
1319
1320             --  If we don't know the expression kind (first term), then it is
1321             --  a simple string.
1322
1323             if Expr_Kind = Undefined then
1324                Expr_Kind := Single;
1325             end if;
1326
1327             --  Declare a new node for the string literal
1328
1329             Term_Id :=
1330               Default_Project_Node
1331                 (Of_Kind => N_Literal_String, In_Tree => In_Tree);
1332             Set_Current_Term (Term, In_Tree, To => Term_Id);
1333             Set_String_Value_Of (Term_Id, In_Tree, To => Token_Name);
1334
1335             --  Scan past the string literal
1336
1337             Scan (In_Tree);
1338
1339             --  Check for possible index expression
1340
1341             if Token = Tok_At then
1342                if not Optional_Index then
1343                   Error_Msg ("index not allowed here", Token_Ptr);
1344                   Scan (In_Tree);
1345
1346                   if Token = Tok_Integer_Literal then
1347                      Scan (In_Tree);
1348                   end if;
1349
1350                --  Set the index value
1351
1352                else
1353                   Scan (In_Tree);
1354                   Expect (Tok_Integer_Literal, "integer literal");
1355
1356                   if Token = Tok_Integer_Literal then
1357                      declare
1358                         Index : constant Int := UI_To_Int (Int_Literal_Value);
1359                      begin
1360                         if Index = 0 then
1361                            Error_Msg ("index cannot be zero", Token_Ptr);
1362                         else
1363                            Set_Source_Index_Of
1364                              (Term_Id, In_Tree, To => Index);
1365                         end if;
1366                      end;
1367
1368                      Scan (In_Tree);
1369                   end if;
1370                end if;
1371             end if;
1372
1373          when Tok_Identifier =>
1374             Current_Location := Token_Ptr;
1375
1376             --  Get the variable or attribute reference
1377
1378             Parse_Variable_Reference
1379               (In_Tree         => In_Tree,
1380                Variable        => Reference,
1381                Current_Project => Current_Project,
1382                Current_Package => Current_Package);
1383             Set_Current_Term (Term, In_Tree, To => Reference);
1384
1385             if Reference /= Empty_Node then
1386
1387                --  If we don't know the expression kind (first term), then it
1388                --  has the kind of the variable or attribute reference.
1389
1390                if Expr_Kind = Undefined then
1391                   Expr_Kind := Expression_Kind_Of (Reference, In_Tree);
1392
1393                elsif Expr_Kind = Single
1394                  and then Expression_Kind_Of (Reference, In_Tree) = List
1395                then
1396                   --  If the expression is a single list, and the reference is
1397                   --  a string list, report an error, and set the expression
1398                   --  kind to string list to avoid multiple errors.
1399
1400                   Expr_Kind := List;
1401                   Error_Msg
1402                     ("list variable cannot appear in single string expression",
1403                      Current_Location);
1404                end if;
1405             end if;
1406
1407          when Tok_Project =>
1408
1409             --  Project can appear in an expression as the prefix of an
1410             --  attribute reference of the current project.
1411
1412             Current_Location := Token_Ptr;
1413             Scan (In_Tree);
1414             Expect (Tok_Apostrophe, "`'`");
1415
1416             if Token = Tok_Apostrophe then
1417                Attribute_Reference
1418                  (In_Tree         => In_Tree,
1419                   Reference       => Reference,
1420                   First_Attribute => Prj.Attr.Attribute_First,
1421                   Current_Project => Current_Project,
1422                   Current_Package => Empty_Node);
1423                Set_Current_Term (Term, In_Tree, To => Reference);
1424             end if;
1425
1426             --  Same checks as above for the expression kind
1427
1428             if Reference /= Empty_Node then
1429                if Expr_Kind = Undefined then
1430                   Expr_Kind := Expression_Kind_Of (Reference, In_Tree);
1431
1432                elsif Expr_Kind = Single
1433                  and then Expression_Kind_Of (Reference, In_Tree) = List
1434                then
1435                   Error_Msg
1436                     ("lists cannot appear in single string expression",
1437                      Current_Location);
1438                end if;
1439             end if;
1440
1441          when Tok_External =>
1442
1443             --  An external reference is always a single string
1444
1445             if Expr_Kind = Undefined then
1446                Expr_Kind := Single;
1447             end if;
1448
1449             External_Reference
1450               (In_Tree         => In_Tree,
1451                Current_Project => Current_Project,
1452                Current_Package => Current_Package,
1453                External_Value  => Reference);
1454             Set_Current_Term (Term, In_Tree, To => Reference);
1455
1456          when others =>
1457             Error_Msg ("cannot be part of an expression", Token_Ptr);
1458             Term := Empty_Node;
1459             return;
1460       end case;
1461
1462       --  If there is an '&', call Terms recursively
1463
1464       if Token = Tok_Ampersand then
1465          Scan (In_Tree); -- scan past ampersand
1466
1467          Terms
1468            (In_Tree         => In_Tree,
1469             Term            => Next_Term,
1470             Expr_Kind       => Expr_Kind,
1471             Current_Project => Current_Project,
1472             Current_Package => Current_Package,
1473             Optional_Index  => Optional_Index);
1474
1475          --  And link the next term to this term
1476
1477          Set_Next_Term (Term, In_Tree, To => Next_Term);
1478       end if;
1479    end Terms;
1480
1481 end Prj.Strt;