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