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 --                                                                          --
  10 --          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Errout;    use Errout;
  29 with Namet;     use Namet;
  30 with Prj.Attr;  use Prj.Attr;
  31 with Prj.Tree;  use Prj.Tree;
  32 with Scans;     use Scans;
  33 with Sinfo;     use Sinfo;
  34 with Stringt;   use Stringt;
  35 with Table;
  36 with Types;     use Types;
  37
  38 package body Prj.Strt is
  39
  40    type Name_Location is record
  41       Name     : Name_Id := No_Name;
  42       Location : Source_Ptr := No_Location;
  43    end record;
  44    --  Store the identifier and the location of a simple name
  45
  46    type Name_Range is range 0 .. 3;
  47    subtype Name_Index is Name_Range range 1 .. Name_Range'Last;
  48    --  A Name may contain up to 3 simple names
  49
  50    type Names is array (Name_Index) of Name_Location;
  51    --  Used to store 1 to 3 simple_names. 2 simple names are for
  52    --  <project>.<package>, <project>.<variable> or <package>.<variable>.
  53    --  3 simple names are for <project>.<package>.<variable>.
  54
  55    type Choice_String is record
  56       The_String : String_Id;
  57       Already_Used : Boolean := False;
  58    end record;
  59    --  The string of a case label, and an indication that it has already
  60    --  been used (to avoid duplicate case labels).
  61
  62    Choices_Initial   : constant := 10;
  63    Choices_Increment : constant := 10;
  64
  65    Choice_Node_Low_Bound  : constant := 0;
  66    Choice_Node_High_Bound : constant := 099_999_999; --  In practice, infinite
  67
  68    type Choice_Node_Id is
  69      range Choice_Node_Low_Bound .. Choice_Node_High_Bound;
  70
  71    First_Choice_Node_Id : constant Choice_Node_Id :=
  72      Choice_Node_Low_Bound;
  73
  74    package Choices is
  75       new Table.Table (Table_Component_Type => Choice_String,
  76                        Table_Index_Type     => Choice_Node_Id,
  77                        Table_Low_Bound      => First_Choice_Node_Id,
  78                        Table_Initial        => Choices_Initial,
  79                        Table_Increment      => Choices_Increment,
  80                        Table_Name           => "Prj.Strt.Choices");
  81    --  Used to store the case labels and check that there is no duplicate.
  82
  83    package Choice_Lasts is
  84       new Table.Table (Table_Component_Type => Choice_Node_Id,
  85                        Table_Index_Type     => Nat,
  86                        Table_Low_Bound      => 1,
  87                        Table_Initial        => 3,
  88                        Table_Increment      => 3,
  89                        Table_Name           => "Prj.Strt.Choice_Lasts");
  90    --  Used to store the indices of the choices in table Choices,
  91    --  to distinguish nested case constructions.
  92
  93    Choice_First : Choice_Node_Id := 0;
  94    --  Index in table Choices of the first case label of the current
  95    --  case construction.
  96    --  0 means no current case construction.
  97
  98    procedure Add (This_String : String_Id);
  99    --  Add a string to the case label list, indicating that it has not
 100    --  yet been used.
 101
 102    procedure External_Reference (External_Value : out Project_Node_Id);
 103    --  Parse an external reference. Current token is "external".
 104
 105    procedure Attribute_Reference
 106      (Reference       : out Project_Node_Id;
 107       First_Attribute : Attribute_Node_Id;
 108       Current_Project : Project_Node_Id;
 109       Current_Package : Project_Node_Id);
 110    --  Parse an attribute reference. Current token is an apostrophe.
 111
 112    procedure Terms
 113      (Term            : out Project_Node_Id;
 114       Expr_Kind       : in out Variable_Kind;
 115       Current_Project : Project_Node_Id;
 116       Current_Package : Project_Node_Id);
 117    --  Recursive procedure to parse one term or several terms concatenated
 118    --  using "&".
 119
 120    ---------
 121    -- Add --
 122    ---------
 123
 124    procedure Add (This_String : String_Id) is
 125    begin
 126       Choices.Increment_Last;
 127       Choices.Table (Choices.Last) :=
 128         (The_String   => This_String,
 129          Already_Used => False);
 130    end Add;
 131
 132    -------------------------
 133    -- Attribute_Reference --
 134    -------------------------
 135
 136    procedure Attribute_Reference
 137      (Reference       : out Project_Node_Id;
 138       First_Attribute : Attribute_Node_Id;
 139       Current_Project : Project_Node_Id;
 140       Current_Package : Project_Node_Id)
 141    is
 142       Current_Attribute : Attribute_Node_Id := First_Attribute;
 143
 144    begin
 145       Reference :=  Default_Project_Node (Of_Kind => N_Attribute_Reference);
 146       Set_Location_Of (Reference, To => Token_Ptr);
 147       Scan; --  past apostrophe
 148       Expect (Tok_Identifier, "Identifier");
 149
 150       if Token = Tok_Identifier then
 151          Set_Name_Of (Reference, To => Token_Name);
 152
 153          while Current_Attribute /= Empty_Attribute
 154            and then
 155              Attributes.Table (Current_Attribute).Name /= Token_Name
 156          loop
 157             Current_Attribute := Attributes.Table (Current_Attribute).Next;
 158          end loop;
 159
 160          if Current_Attribute = Empty_Attribute then
 161             Error_Msg_Name_1 := Token_Name;
 162             Error_Msg ("unknown attribute %", Token_Ptr);
 163             Reference := Empty_Node;
 164
 165          else
 166             Set_Project_Node_Of (Reference, To => Current_Project);
 167             Set_Package_Node_Of (Reference, To => Current_Package);
 168             Set_Expression_Kind_Of
 169               (Reference, To => Attributes.Table (Current_Attribute).Kind_1);
 170             Set_Case_Insensitive
 171               (Reference, To => Attributes.Table (Current_Attribute).Kind_2 =
 172                                           Case_Insensitive_Associative_Array);
 173             Scan;
 174
 175             if Attributes.Table (Current_Attribute).Kind_2 /= Single then
 176                Expect (Tok_Left_Paren, "(");
 177
 178                if Token = Tok_Left_Paren then
 179                   Scan;
 180                   Expect (Tok_String_Literal, "literal string");
 181
 182                   if Token = Tok_String_Literal then
 183                      Set_Associative_Array_Index_Of
 184                        (Reference, To => Strval (Token_Node));
 185                      Scan;
 186                      Expect (Tok_Right_Paren, ")");
 187
 188                      if Token = Tok_Right_Paren then
 189                         Scan;
 190                      end if;
 191                   end if;
 192                end if;
 193             end if;
 194          end if;
 195       end if;
 196    end Attribute_Reference;
 197
 198    ---------------------------
 199    -- End_Case_Construction --
 200    ---------------------------
 201
 202    procedure End_Case_Construction is
 203    begin
 204       if Choice_Lasts.Last = 1 then
 205          Choice_Lasts.Set_Last (0);
 206          Choices.Set_Last (First_Choice_Node_Id);
 207          Choice_First := 0;
 208
 209       elsif Choice_Lasts.Last = 2 then
 210          Choice_Lasts.Set_Last (1);
 211          Choices.Set_Last (Choice_Lasts.Table (1));
 212          Choice_First := 1;
 213
 214       else
 215          Choice_Lasts.Decrement_Last;
 216          Choices.Set_Last (Choice_Lasts.Table (Choice_Lasts.Last));
 217          Choice_First := Choice_Lasts.Table (Choice_Lasts.Last - 1) + 1;
 218       end if;
 219    end End_Case_Construction;
 220
 221    ------------------------
 222    -- External_Reference --
 223    ------------------------
 224
 225    procedure External_Reference (External_Value : out Project_Node_Id) is
 226       Field_Id : Project_Node_Id := Empty_Node;
 227
 228    begin
 229       External_Value :=
 230         Default_Project_Node (Of_Kind       => N_External_Value,
 231                               And_Expr_Kind => Single);
 232       Set_Location_Of (External_Value, To => Token_Ptr);
 233
 234       --  The current token is External
 235
 236       --  Get the left parenthesis
 237
 238       Scan;
 239       Expect (Tok_Left_Paren, "(");
 240
 241       --  Scan past the left parenthesis
 242
 243       if Token = Tok_Left_Paren then
 244          Scan;
 245       end if;
 246
 247       --  Get the name of the external reference
 248
 249       Expect (Tok_String_Literal, "literal string");
 250
 251       if Token = Tok_String_Literal then
 252          Field_Id :=
 253            Default_Project_Node (Of_Kind       => N_Literal_String,
 254                                  And_Expr_Kind => Single);
 255          Set_String_Value_Of (Field_Id, To => Strval (Token_Node));
 256          Set_External_Reference_Of (External_Value, To => Field_Id);
 257
 258          --  Scan past the first argument
 259
 260          Scan;
 261
 262          case Token is
 263
 264             when Tok_Right_Paren =>
 265
 266                --  Scan past the right parenthesis
 267                Scan;
 268
 269             when Tok_Comma =>
 270
 271                --  Scan past the comma
 272
 273                Scan;
 274
 275                Expect (Tok_String_Literal, "literal string");
 276
 277                --  Get the default
 278
 279                if Token = Tok_String_Literal then
 280                   Field_Id :=
 281                     Default_Project_Node (Of_Kind       => N_Literal_String,
 282                                           And_Expr_Kind => Single);
 283                   Set_String_Value_Of (Field_Id, To => Strval (Token_Node));
 284                   Set_External_Default_Of (External_Value, To => Field_Id);
 285                   Scan;
 286                   Expect (Tok_Right_Paren, ")");
 287                end if;
 288
 289                --  Scan past the right parenthesis
 290                if Token = Tok_Right_Paren then
 291                   Scan;
 292                end if;
 293
 294             when others =>
 295                Error_Msg ("',' or ')' expected", Token_Ptr);
 296          end case;
 297       end if;
 298    end External_Reference;
 299
 300    -----------------------
 301    -- Parse_Choice_List --
 302    -----------------------
 303
 304    procedure Parse_Choice_List (First_Choice : out Project_Node_Id) is
 305       Current_Choice : Project_Node_Id := Empty_Node;
 306       Next_Choice    : Project_Node_Id := Empty_Node;
 307       Choice_String  : String_Id       := No_String;
 308       Found          : Boolean         := False;
 309
 310    begin
 311       First_Choice :=
 312         Default_Project_Node (Of_Kind       => N_Literal_String,
 313                               And_Expr_Kind => Single);
 314       Current_Choice := First_Choice;
 315
 316       loop
 317          Expect (Tok_String_Literal, "literal string");
 318          exit when Token /= Tok_String_Literal;
 319          Set_Location_Of (Current_Choice, To => Token_Ptr);
 320          Choice_String := Strval (Token_Node);
 321          Set_String_Value_Of (Current_Choice, To => Choice_String);
 322
 323          Found := False;
 324          for Choice in Choice_First .. Choices.Last loop
 325             if String_Equal (Choices.Table (Choice).The_String,
 326                              Choice_String)
 327             then
 328                Found := True;
 329
 330                if Choices.Table (Choice).Already_Used then
 331                   String_To_Name_Buffer (Choice_String);
 332                   Error_Msg_Name_1 := Name_Find;
 333                   Error_Msg ("duplicate case label {", Token_Ptr);
 334                else
 335                   Choices.Table (Choice).Already_Used := True;
 336                end if;
 337
 338                exit;
 339             end if;
 340          end loop;
 341
 342          if not Found then
 343             String_To_Name_Buffer (Choice_String);
 344             Error_Msg_Name_1 := Name_Find;
 345             Error_Msg ("illegal case label {", Token_Ptr);
 346          end if;
 347
 348          Scan;
 349
 350          if Token = Tok_Vertical_Bar then
 351             Next_Choice :=
 352               Default_Project_Node (Of_Kind       => N_Literal_String,
 353                                     And_Expr_Kind => Single);
 354             Set_Next_Literal_String (Current_Choice, To => Next_Choice);
 355             Current_Choice := Next_Choice;
 356             Scan;
 357          else
 358             exit;
 359          end if;
 360       end loop;
 361    end Parse_Choice_List;
 362
 363    ----------------------
 364    -- Parse_Expression --
 365    ----------------------
 366
 367    procedure Parse_Expression
 368      (Expression      : out Project_Node_Id;
 369       Current_Project : Project_Node_Id;
 370       Current_Package : Project_Node_Id)
 371    is
 372       First_Term      : Project_Node_Id := Empty_Node;
 373       Expression_Kind : Variable_Kind := Undefined;
 374
 375    begin
 376       Expression := Default_Project_Node (Of_Kind => N_Expression);
 377       Set_Location_Of (Expression, To => Token_Ptr);
 378       Terms (Term            => First_Term,
 379              Expr_Kind       => Expression_Kind,
 380              Current_Project => Current_Project,
 381              Current_Package => Current_Package);
 382       Set_First_Term (Expression, To => First_Term);
 383       Set_Expression_Kind_Of (Expression, To => Expression_Kind);
 384    end Parse_Expression;
 385
 386    ----------------------------
 387    -- Parse_String_Type_List --
 388    ----------------------------
 389
 390    procedure Parse_String_Type_List (First_String : out Project_Node_Id) is
 391       Last_String  : Project_Node_Id := Empty_Node;
 392       Next_String  : Project_Node_Id := Empty_Node;
 393       String_Value : String_Id := No_String;
 394
 395    begin
 396       First_String :=
 397         Default_Project_Node (Of_Kind       => N_Literal_String,
 398                               And_Expr_Kind => Single);
 399       Last_String := First_String;
 400
 401       loop
 402          Expect (Tok_String_Literal, "literal string");
 403          exit when Token /= Tok_String_Literal;
 404          String_Value := Strval (Token_Node);
 405          Set_String_Value_Of (Last_String, To => String_Value);
 406          Set_Location_Of (Last_String, To => Token_Ptr);
 407
 408          declare
 409             Current : Project_Node_Id := First_String;
 410
 411          begin
 412             while Current /= Last_String loop
 413                if String_Equal (String_Value_Of (Current), String_Value) then
 414                   String_To_Name_Buffer (String_Value);
 415                   Error_Msg_Name_1 := Name_Find;
 416                   Error_Msg ("duplicate value { in type", Token_Ptr);
 417                   exit;
 418                end if;
 419
 420                Current := Next_Literal_String (Current);
 421             end loop;
 422          end;
 423
 424          Scan;
 425
 426          if Token /= Tok_Comma then
 427             exit;
 428
 429          else
 430             Next_String :=
 431               Default_Project_Node (Of_Kind       => N_Literal_String,
 432                                     And_Expr_Kind => Single);
 433             Set_Next_Literal_String (Last_String, To => Next_String);
 434             Last_String := Next_String;
 435             Scan;
 436          end if;
 437       end loop;
 438    end Parse_String_Type_List;
 439
 440    ------------------------------
 441    -- Parse_Variable_Reference --
 442    ------------------------------
 443
 444    procedure Parse_Variable_Reference
 445      (Variable        : out Project_Node_Id;
 446       Current_Project : Project_Node_Id;
 447       Current_Package : Project_Node_Id)
 448    is
 449       The_Names        : Names;
 450       Last_Name        : Name_Range := 0;
 451       Current_Variable : Project_Node_Id := Empty_Node;
 452
 453       The_Package : Project_Node_Id := Current_Package;
 454       The_Project : Project_Node_Id := Current_Project;
 455
 456       Specified_Project : Project_Node_Id   := Empty_Node;
 457       Specified_Package : Project_Node_Id   := Empty_Node;
 458       Look_For_Variable : Boolean           := True;
 459       First_Attribute   : Attribute_Node_Id := Empty_Attribute;
 460       Variable_Name     : Name_Id;
 461
 462    begin
 463       for Index in The_Names'Range loop
 464          Expect (Tok_Identifier, "identifier");
 465
 466          if Token /= Tok_Identifier then
 467             Look_For_Variable := False;
 468             exit;
 469          end if;
 470
 471          Last_Name := Last_Name + 1;
 472          The_Names (Last_Name) :=
 473            (Name     => Token_Name,
 474             Location => Token_Ptr);
 475          Scan;
 476          exit when Token /= Tok_Dot;
 477          Scan;
 478       end loop;
 479
 480       if Look_For_Variable then
 481          if Token = Tok_Apostrophe then
 482
 483             --  Attribute reference
 484
 485             case Last_Name is
 486                when 0 =>
 487
 488                   --  Cannot happen
 489
 490                   null;
 491
 492                when 1 =>
 493                   for Index in Package_First .. Package_Attributes.Last loop
 494                      if Package_Attributes.Table (Index).Name =
 495                                                       The_Names (1).Name
 496                      then
 497                         First_Attribute :=
 498                           Package_Attributes.Table (Index).First_Attribute;
 499                         exit;
 500                      end if;
 501                   end loop;
 502
 503                   if First_Attribute /= Empty_Attribute then
 504                      The_Package := First_Package_Of (Current_Project);
 505                      while The_Package /= Empty_Node
 506                        and then Name_Of (The_Package) /= The_Names (1).Name
 507                      loop
 508                         The_Package := Next_Package_In_Project (The_Package);
 509                      end loop;
 510
 511                      if The_Package = Empty_Node then
 512                         Error_Msg_Name_1 := The_Names (1).Name;
 513                         Error_Msg ("package % not yet defined",
 514                                    The_Names (1).Location);
 515                      end if;
 516
 517                   else
 518                      First_Attribute := Attribute_First;
 519                      The_Package     := Empty_Node;
 520
 521                      declare
 522                         The_Project_Name_And_Node :
 523                           constant Tree_Private_Part.Project_Name_And_Node :=
 524                             Tree_Private_Part.Projects_Htable.Get
 525                                                           (The_Names (1).Name);
 526
 527                         use Tree_Private_Part;
 528
 529                      begin
 530                         if The_Project_Name_And_Node =
 531                                    Tree_Private_Part.No_Project_Name_And_Node
 532                         then
 533                            Error_Msg_Name_1 := The_Names (1).Name;
 534                            Error_Msg ("unknown project %",
 535                                       The_Names (1).Location);
 536                         else
 537                            The_Project := The_Project_Name_And_Node.Node;
 538                         end if;
 539                      end;
 540                   end if;
 541
 542                when 2 =>
 543                   declare
 544                      With_Clause : Project_Node_Id :=
 545                                      First_With_Clause_Of (Current_Project);
 546
 547                   begin
 548                      while With_Clause /= Empty_Node loop
 549                         The_Project := Project_Node_Of (With_Clause);
 550                         exit when Name_Of (The_Project) = The_Names (1).Name;
 551                         With_Clause := Next_With_Clause_Of (With_Clause);
 552                      end loop;
 553
 554                      if With_Clause = Empty_Node then
 555                         Error_Msg_Name_1 := The_Names (1).Name;
 556                         Error_Msg ("unknown project %",
 557                                    The_Names (1).Location);
 558                         The_Project := Empty_Node;
 559                         The_Package := Empty_Node;
 560                         First_Attribute := Attribute_First;
 561
 562                      else
 563                         The_Package := First_Package_Of (The_Project);
 564                         while The_Package /= Empty_Node
 565                           and then Name_Of (The_Package) /= The_Names (2).Name
 566                         loop
 567                            The_Package :=
 568                              Next_Package_In_Project (The_Package);
 569                         end loop;
 570
 571                         if The_Package = Empty_Node then
 572                            Error_Msg_Name_1 := The_Names (2).Name;
 573                            Error_Msg_Name_2 := The_Names (1).Name;
 574                            Error_Msg ("package % not declared in project %",
 575                                       The_Names (2).Location);
 576                            First_Attribute := Attribute_First;
 577
 578                         else
 579                            First_Attribute :=
 580                              Package_Attributes.Table
 581                              (Package_Id_Of (The_Package)).First_Attribute;
 582                         end if;
 583                      end if;
 584                   end;
 585
 586                when 3 =>
 587                   Error_Msg
 588                     ("too many single names for an attribute reference",
 589                      The_Names (1).Location);
 590                   Scan;
 591                   Variable := Empty_Node;
 592                   return;
 593             end case;
 594
 595             Attribute_Reference
 596               (Variable,
 597                Current_Project => The_Project,
 598                Current_Package => The_Package,
 599                First_Attribute => First_Attribute);
 600             return;
 601          end if;
 602       end if;
 603
 604       Variable :=
 605         Default_Project_Node (Of_Kind => N_Variable_Reference);
 606
 607       if Look_For_Variable then
 608          case Last_Name is
 609             when 0 =>
 610
 611                --  Cannot happen
 612
 613                null;
 614
 615             when 1 =>
 616                Set_Name_Of (Variable, To => The_Names (1).Name);
 617
 618             --  Header comment needed ???
 619
 620             when 2 =>
 621                Set_Name_Of (Variable, To => The_Names (2).Name);
 622                The_Package := First_Package_Of (Current_Project);
 623
 624                while The_Package /= Empty_Node
 625                  and then Name_Of (The_Package) /= The_Names (1).Name
 626                loop
 627                   The_Package := Next_Package_In_Project (The_Package);
 628                end loop;
 629
 630                if The_Package /= Empty_Node then
 631                   Specified_Package := The_Package;
 632                   The_Project := Empty_Node;
 633
 634                else
 635                   declare
 636                      With_Clause : Project_Node_Id :=
 637                                      First_With_Clause_Of (Current_Project);
 638
 639                   begin
 640                      while With_Clause /= Empty_Node loop
 641                         The_Project := Project_Node_Of (With_Clause);
 642                         exit when Name_Of (The_Project) = The_Names (1).Name;
 643                         With_Clause := Next_With_Clause_Of (With_Clause);
 644                      end loop;
 645
 646                      if With_Clause = Empty_Node then
 647                         The_Project :=
 648                           Modified_Project_Of
 649                                  (Project_Declaration_Of (Current_Project));
 650
 651                         if The_Project /= Empty_Node
 652                           and then
 653                             Name_Of (The_Project) /= The_Names (1).Name
 654                         then
 655                            The_Project := Empty_Node;
 656                         end if;
 657                      end if;
 658
 659                      if The_Project = Empty_Node then
 660                         Error_Msg_Name_1 := The_Names (1).Name;
 661                         Error_Msg ("unknown package or project %",
 662                                    The_Names (1).Location);
 663                         Look_For_Variable := False;
 664                      else
 665                         Specified_Project := The_Project;
 666                      end if;
 667                   end;
 668                end if;
 669
 670             --  Header comment needed ???
 671
 672             when 3 =>
 673                Set_Name_Of (Variable, To => The_Names (3).Name);
 674
 675                declare
 676                   With_Clause : Project_Node_Id :=
 677                                   First_With_Clause_Of (Current_Project);
 678
 679                begin
 680                   while With_Clause /= Empty_Node loop
 681                      The_Project := Project_Node_Of (With_Clause);
 682                      exit when Name_Of (The_Project) = The_Names (1).Name;
 683                      With_Clause := Next_With_Clause_Of (With_Clause);
 684                   end loop;
 685
 686                   if With_Clause = Empty_Node then
 687                      The_Project :=
 688                        Modified_Project_Of
 689                           (Project_Declaration_Of (Current_Project));
 690
 691                      if The_Project /= Empty_Node
 692                        and then Name_Of (The_Project) /= The_Names (1).Name
 693                      then
 694                         The_Project := Empty_Node;
 695                      end if;
 696                   end if;
 697
 698                   if The_Project = Empty_Node then
 699                      Error_Msg_Name_1 := The_Names (1).Name;
 700                      Error_Msg ("unknown package or project %",
 701                                 The_Names (1).Location);
 702                      Look_For_Variable := False;
 703
 704                   else
 705                      Specified_Project := The_Project;
 706                      The_Package := First_Package_Of (The_Project);
 707
 708                      while The_Package /= Empty_Node
 709                        and then Name_Of (The_Package) /= The_Names (2).Name
 710                      loop
 711                         The_Package := Next_Package_In_Project (The_Package);
 712                      end loop;
 713
 714                      if The_Package = Empty_Node then
 715                         Error_Msg_Name_1 := The_Names (2).Name;
 716                         Error_Msg ("unknown package %",
 717                                    The_Names (2).Location);
 718                         Look_For_Variable := False;
 719
 720                      else
 721                         Specified_Package := The_Package;
 722                         The_Project := Empty_Node;
 723                      end if;
 724                   end if;
 725                end;
 726
 727          end case;
 728       end if;
 729
 730       if Look_For_Variable then
 731          Variable_Name := Name_Of (Variable);
 732          Set_Project_Node_Of (Variable, To => Specified_Project);
 733          Set_Package_Node_Of (Variable, To => Specified_Package);
 734
 735          if The_Package /= Empty_Node then
 736             Current_Variable := First_Variable_Of (The_Package);
 737
 738             while Current_Variable /= Empty_Node
 739               and then
 740               Name_Of (Current_Variable) /= Variable_Name
 741             loop
 742                Current_Variable := Next_Variable (Current_Variable);
 743             end loop;
 744          end if;
 745
 746          if Current_Variable = Empty_Node
 747            and then The_Project /= Empty_Node
 748          then
 749             Current_Variable := First_Variable_Of (The_Project);
 750             while Current_Variable /= Empty_Node
 751               and then Name_Of (Current_Variable) /= Variable_Name
 752             loop
 753                Current_Variable := Next_Variable (Current_Variable);
 754             end loop;
 755          end if;
 756
 757          if Current_Variable = Empty_Node then
 758             Error_Msg_Name_1 := Variable_Name;
 759             Error_Msg ("unknown variable %", The_Names (Last_Name).Location);
 760          end if;
 761       end if;
 762
 763       if Current_Variable /= Empty_Node then
 764          Set_Expression_Kind_Of
 765            (Variable, To => Expression_Kind_Of (Current_Variable));
 766
 767          if Kind_Of (Current_Variable) = N_Typed_Variable_Declaration then
 768             Set_String_Type_Of
 769               (Variable, To => String_Type_Of (Current_Variable));
 770          end if;
 771       end if;
 772
 773       if Token = Tok_Left_Paren then
 774          Error_Msg ("\variables cannot be associative arrays", Token_Ptr);
 775          Scan;
 776          Expect (Tok_String_Literal, "literal string");
 777
 778          if Token = Tok_String_Literal then
 779             Scan;
 780             Expect (Tok_Right_Paren, ")");
 781
 782             if Token = Tok_Right_Paren then
 783                Scan;
 784             end if;
 785          end if;
 786       end if;
 787    end Parse_Variable_Reference;
 788
 789    ---------------------------------
 790    -- Start_New_Case_Construction --
 791    ---------------------------------
 792
 793    procedure Start_New_Case_Construction (String_Type  : Project_Node_Id) is
 794       Current_String : Project_Node_Id;
 795
 796    begin
 797       if Choice_First = 0 then
 798          Choice_First := 1;
 799          Choices.Set_Last (First_Choice_Node_Id);
 800       else
 801          Choice_First := Choices.Last + 1;
 802       end if;
 803
 804       if String_Type /= Empty_Node then
 805          Current_String := First_Literal_String (String_Type);
 806
 807          while Current_String /= Empty_Node loop
 808             Add (This_String => String_Value_Of (Current_String));
 809             Current_String := Next_Literal_String (Current_String);
 810          end loop;
 811       end if;
 812
 813       Choice_Lasts.Increment_Last;
 814       Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last;
 815
 816    end Start_New_Case_Construction;
 817
 818    -----------
 819    -- Terms --
 820    -----------
 821
 822    procedure Terms (Term            : out Project_Node_Id;
 823                     Expr_Kind       : in out Variable_Kind;
 824                     Current_Project : Project_Node_Id;
 825                     Current_Package : Project_Node_Id)
 826    is
 827       Next_Term          : Project_Node_Id := Empty_Node;
 828       Term_Id            : Project_Node_Id := Empty_Node;
 829       Current_Expression : Project_Node_Id := Empty_Node;
 830       Next_Expression    : Project_Node_Id := Empty_Node;
 831       Current_Location   : Source_Ptr      := No_Location;
 832       Reference          : Project_Node_Id := Empty_Node;
 833
 834    begin
 835       Term := Default_Project_Node (Of_Kind => N_Term);
 836       Set_Location_Of (Term, To => Token_Ptr);
 837
 838       case Token is
 839
 840          when Tok_Left_Paren =>
 841             case Expr_Kind is
 842                when Undefined =>
 843                   Expr_Kind := List;
 844                when List =>
 845                   null;
 846                when Single =>
 847                   Expr_Kind := List;
 848                   Error_Msg
 849                     ("literal string list cannot appear in a string",
 850                      Token_Ptr);
 851             end case;
 852
 853             Term_Id := Default_Project_Node
 854               (Of_Kind => N_Literal_String_List,
 855                And_Expr_Kind => List);
 856             Set_Current_Term (Term, To => Term_Id);
 857             Set_Location_Of (Term, To => Token_Ptr);
 858
 859             Scan;
 860             if Token = Tok_Right_Paren then
 861                Scan;
 862
 863             else
 864                loop
 865                   Current_Location := Token_Ptr;
 866                   Parse_Expression (Expression      => Next_Expression,
 867                                     Current_Project => Current_Project,
 868                                     Current_Package => Current_Package);
 869
 870                   if Expression_Kind_Of (Next_Expression) = List then
 871                      Error_Msg ("single expression expected",
 872                                 Current_Location);
 873                   end if;
 874
 875                   if Current_Expression = Empty_Node then
 876                      Set_First_Expression_In_List
 877                        (Term_Id, To => Next_Expression);
 878                   else
 879                      Set_Next_Expression_In_List
 880                        (Current_Expression, To => Next_Expression);
 881                   end if;
 882
 883                   Current_Expression := Next_Expression;
 884                   exit when Token /= Tok_Comma;
 885                   Scan; -- past the comma
 886                end loop;
 887
 888                Expect (Tok_Right_Paren, "(");
 889
 890                if Token = Tok_Right_Paren then
 891                   Scan;
 892                end if;
 893             end if;
 894
 895          when Tok_String_Literal =>
 896             if Expr_Kind = Undefined then
 897                Expr_Kind := Single;
 898             end if;
 899
 900             Term_Id := Default_Project_Node (Of_Kind => N_Literal_String);
 901             Set_Current_Term (Term, To => Term_Id);
 902             Set_String_Value_Of (Term_Id, To => Strval (Token_Node));
 903
 904             Scan;
 905
 906          when Tok_Identifier =>
 907             Current_Location := Token_Ptr;
 908             Parse_Variable_Reference
 909               (Variable        => Reference,
 910                Current_Project => Current_Project,
 911                Current_Package => Current_Package);
 912             Set_Current_Term (Term, To => Reference);
 913
 914             if Reference /= Empty_Node then
 915                if Expr_Kind = Undefined then
 916                   Expr_Kind := Expression_Kind_Of (Reference);
 917
 918                elsif Expr_Kind = Single
 919                  and then Expression_Kind_Of (Reference) = List
 920                then
 921                   Expr_Kind := List;
 922                   Error_Msg
 923                     ("list variable cannot appear in single string expression",
 924                      Current_Location);
 925                end if;
 926             end if;
 927
 928          when Tok_Project =>
 929             Current_Location := Token_Ptr;
 930             Scan;
 931             Expect (Tok_Apostrophe, "'");
 932
 933             if Token = Tok_Apostrophe then
 934                Attribute_Reference
 935                  (Reference       => Reference,
 936                   First_Attribute => Prj.Attr.Attribute_First,
 937                   Current_Project => Current_Project,
 938                   Current_Package => Empty_Node);
 939                Set_Current_Term (Term, To => Reference);
 940             end if;
 941
 942             if Reference /= Empty_Node then
 943                if Expr_Kind = Undefined then
 944                   Expr_Kind := Expression_Kind_Of (Reference);
 945
 946                elsif Expr_Kind = Single
 947                  and then Expression_Kind_Of (Reference) = List
 948                then
 949                   Error_Msg
 950                     ("lists cannot appear in single string expression",
 951                      Current_Location);
 952                end if;
 953             end if;
 954
 955          when Tok_External =>
 956             if Expr_Kind = Undefined then
 957                Expr_Kind := Single;
 958             end if;
 959
 960             External_Reference (External_Value => Reference);
 961             Set_Current_Term (Term, To => Reference);
 962
 963          when others =>
 964             Error_Msg ("cannot be part of an expression", Token_Ptr);
 965             Term := Empty_Node;
 966             return;
 967       end case;
 968
 969       if Token = Tok_Ampersand then
 970          Scan;
 971
 972          Terms (Term            => Next_Term,
 973                 Expr_Kind       => Expr_Kind,
 974                 Current_Project => Current_Project,
 975                 Current_Package => Current_Package);
 976          Set_Next_Term (Term, To => Next_Term);
 977
 978       end if;
 979
 980    end Terms;
 981
 982 end Prj.Strt;