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