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