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