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