gcc/ada/prj-strt.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . S T R T                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2003 Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Err_Vars;  use Err_Vars;
  28 with Namet;     use Namet;
  29 with Prj.Attr;  use Prj.Attr;
  30 with Prj.Err;   use Prj.Err;
  31 with Prj.Tree;  use Prj.Tree;
  32 with Scans;     use Scans;
  33 with Snames;
  34 with Table;
  35 with Types;     use Types;
  36
  37 package body Prj.Strt is
  38
  39    type Choice_String is record
  40       The_String   : Name_Id;
  41       Already_Used : Boolean := False;
  42    end record;
  43    --  The string of a case label, and an indication that it has already
  44    --  been used (to avoid duplicate case labels).
  45
  46    Choices_Initial   : constant := 10;
  47    Choices_Increment : constant := 50;
  48
  49    Choice_Node_Low_Bound  : constant := 0;
  50    Choice_Node_High_Bound : constant := 099_999_999;
  51    --  In practice, infinite
  52
  53    type Choice_Node_Id is
  54      range Choice_Node_Low_Bound .. Choice_Node_High_Bound;
  55
  56    First_Choice_Node_Id : constant Choice_Node_Id :=
  57      Choice_Node_Low_Bound;
  58
  59    package Choices is
  60       new Table.Table (Table_Component_Type => Choice_String,
  61                        Table_Index_Type     => Choice_Node_Id,
  62                        Table_Low_Bound      => First_Choice_Node_Id,
  63                        Table_Initial        => Choices_Initial,
  64                        Table_Increment      => Choices_Increment,
  65                        Table_Name           => "Prj.Strt.Choices");
  66    --  Used to store the case labels and check that there is no duplicate.
  67
  68    package Choice_Lasts is
  69       new Table.Table (Table_Component_Type => Choice_Node_Id,
  70                        Table_Index_Type     => Nat,
  71                        Table_Low_Bound      => 1,
  72                        Table_Initial        => 10,
  73                        Table_Increment      => 100,
  74                        Table_Name           => "Prj.Strt.Choice_Lasts");
  75    --  Used to store the indices of the choices in table Choices,
  76    --  to distinguish nested case constructions.
  77
  78    Choice_First : Choice_Node_Id := 0;
  79    --  Index in table Choices of the first case label of the current
  80    --  case construction. Zero means no current case construction.
  81
  82    type Name_Location is record
  83       Name     : Name_Id := No_Name;
  84       Location : Source_Ptr := No_Location;
  85    end record;
  86    --  Store the identifier and the location of a simple name
  87
  88    package Names is
  89       new Table.Table (Table_Component_Type => Name_Location,
  90                        Table_Index_Type     => Nat,
  91                        Table_Low_Bound      => 1,
  92                        Table_Initial        => 10,
  93                        Table_Increment      => 100,
  94                        Table_Name           => "Prj.Strt.Names");
  95    --  Used to accumulate the single names of a name
  96
  97    procedure Add (This_String : Name_Id);
  98    --  Add a string to the case label list, indicating that it has not
  99    --  yet been used.
 100
 101    procedure Add_To_Names (NL : Name_Location);
 102    --  Add one single names to table Names
 103
 104    procedure External_Reference (External_Value : out Project_Node_Id);
 105    --  Parse an external reference. Current token is "external".
 106
 107    procedure Attribute_Reference
 108      (Reference       : out Project_Node_Id;
 109       First_Attribute : Attribute_Node_Id;
 110       Current_Project : Project_Node_Id;
 111       Current_Package : Project_Node_Id);
 112    --  Parse an attribute reference. Current token is an apostrophe.
 113
 114    procedure Terms
 115      (Term            : out Project_Node_Id;
 116       Expr_Kind       : in out Variable_Kind;
 117       Current_Project : Project_Node_Id;
 118       Current_Package : Project_Node_Id);
 119    --  Recursive procedure to parse one term or several terms concatenated
 120    --  using "&".
 121
 122    ---------
 123    -- Add --
 124    ---------
 125
 126    procedure Add (This_String : Name_Id) is
 127    begin
 128       Choices.Increment_Last;
 129       Choices.Table (Choices.Last) :=
 130         (The_String   => This_String,
 131          Already_Used => False);
 132    end Add;
 133
 134    ------------------
 135    -- Add_To_Names --
 136    ------------------
 137
 138    procedure Add_To_Names (NL : Name_Location) is
 139    begin
 140       Names.Increment_Last;
 141       Names.Table (Names.Last) := NL;
 142    end Add_To_Names;
 143
 144    -------------------------
 145    -- Attribute_Reference --
 146    -------------------------
 147
 148    procedure Attribute_Reference
 149      (Reference       : out Project_Node_Id;
 150       First_Attribute : Attribute_Node_Id;
 151       Current_Project : Project_Node_Id;
 152       Current_Package : Project_Node_Id)
 153    is
 154       Current_Attribute : Attribute_Node_Id := First_Attribute;
 155
 156    begin
 157       --  Declare the node of the attribute reference
 158
 159       Reference :=  Default_Project_Node (Of_Kind => N_Attribute_Reference);
 160       Set_Location_Of (Reference, To => Token_Ptr);
 161       Scan; --  past apostrophe
 162
 163       --  Body may be an attribute name
 164
 165       if Token = Tok_Body then
 166          Token      := Tok_Identifier;
 167          Token_Name := Snames.Name_Body;
 168       end if;
 169
 170       Expect (Tok_Identifier, "identifier");
 171
 172       if Token = Tok_Identifier then
 173          Set_Name_Of (Reference, To => Token_Name);
 174
 175          --  Check if the identifier is one of the attribute identifiers in the
 176          --  context (package or project level attributes).
 177
 178          while Current_Attribute /= Empty_Attribute
 179            and then
 180              Attributes.Table (Current_Attribute).Name /= Token_Name
 181          loop
 182             Current_Attribute := Attributes.Table (Current_Attribute).Next;
 183          end loop;
 184
 185          --  If the identifier is not allowed, report an error
 186
 187          if Current_Attribute = Empty_Attribute then
 188             Error_Msg_Name_1 := Token_Name;
 189             Error_Msg ("unknown attribute %", Token_Ptr);
 190             Reference := Empty_Node;
 191
 192             --  Scan past the attribute name
 193
 194             Scan;
 195
 196          else
 197             --  Give its characteristics to this attribute reference
 198
 199             Set_Project_Node_Of (Reference, To => Current_Project);
 200             Set_Package_Node_Of (Reference, To => Current_Package);
 201             Set_Expression_Kind_Of
 202               (Reference, To => Attributes.Table (Current_Attribute).Kind_1);
 203             Set_Case_Insensitive
 204               (Reference, To => Attributes.Table (Current_Attribute).Kind_2 =
 205                                           Case_Insensitive_Associative_Array);
 206
 207             --  Scan past the attribute name
 208
 209             Scan;
 210
 211             --  If the attribute is an associative array, get the index
 212
 213             if Attributes.Table (Current_Attribute).Kind_2 /= Single then
 214                Expect (Tok_Left_Paren, "`(`");
 215
 216                if Token = Tok_Left_Paren then
 217                   Scan;
 218                   Expect (Tok_String_Literal, "literal string");
 219
 220                   if Token = Tok_String_Literal then
 221                      Set_Associative_Array_Index_Of
 222                        (Reference, To => Token_Name);
 223                      Scan;
 224                      Expect (Tok_Right_Paren, "`)`");
 225
 226                      if Token = Tok_Right_Paren then
 227                         Scan;
 228                      end if;
 229                   end if;
 230                end if;
 231             end if;
 232          end if;
 233
 234          --  Change name of obsolete attributes
 235
 236          if Reference /= Empty_Node then
 237             case Name_Of (Reference) is
 238                when Snames.Name_Specification =>
 239                   Set_Name_Of (Reference, To => Snames.Name_Spec);
 240
 241                when Snames.Name_Specification_Suffix =>
 242                   Set_Name_Of (Reference, To => Snames.Name_Spec_Suffix);
 243
 244                when Snames.Name_Implementation =>
 245                   Set_Name_Of (Reference, To => Snames.Name_Body);
 246
 247                when Snames.Name_Implementation_Suffix =>
 248                   Set_Name_Of (Reference, To => Snames.Name_Body_Suffix);
 249
 250                when others =>
 251                   null;
 252             end case;
 253          end if;
 254       end if;
 255    end Attribute_Reference;
 256
 257    ---------------------------
 258    -- End_Case_Construction --
 259    ---------------------------
 260
 261    procedure End_Case_Construction is
 262    begin
 263       --  If this is the only case construction, empty the tables
 264
 265       if Choice_Lasts.Last = 1 then
 266          Choice_Lasts.Set_Last (0);
 267          Choices.Set_Last (First_Choice_Node_Id);
 268          Choice_First := 0;
 269
 270       elsif Choice_Lasts.Last = 2 then
 271          --  This is the second case onstruction, set the tables to the first
 272
 273          Choice_Lasts.Set_Last (1);
 274          Choices.Set_Last (Choice_Lasts.Table (1));
 275          Choice_First := 1;
 276
 277       else
 278          --  This is the 3rd or more case construction, set the tables to the
 279          --  previous one.
 280
 281          Choice_Lasts.Decrement_Last;
 282          Choices.Set_Last (Choice_Lasts.Table (Choice_Lasts.Last));
 283          Choice_First := Choice_Lasts.Table (Choice_Lasts.Last - 1) + 1;
 284       end if;
 285    end End_Case_Construction;
 286
 287    ------------------------
 288    -- External_Reference --
 289    ------------------------
 290
 291    procedure External_Reference (External_Value : out Project_Node_Id) is
 292       Field_Id : Project_Node_Id := Empty_Node;
 293
 294    begin
 295       External_Value :=
 296         Default_Project_Node (Of_Kind       => N_External_Value,
 297                               And_Expr_Kind => Single);
 298       Set_Location_Of (External_Value, To => Token_Ptr);
 299
 300       --  The current token is External
 301
 302       --  Get the left parenthesis
 303
 304       Scan;
 305       Expect (Tok_Left_Paren, "`(`");
 306
 307       --  Scan past the left parenthesis
 308
 309       if Token = Tok_Left_Paren then
 310          Scan;
 311       end if;
 312
 313       --  Get the name of the external reference
 314
 315       Expect (Tok_String_Literal, "literal string");
 316
 317       if Token = Tok_String_Literal then
 318          Field_Id :=
 319            Default_Project_Node (Of_Kind       => N_Literal_String,
 320                                  And_Expr_Kind => Single);
 321          Set_String_Value_Of (Field_Id, To => Token_Name);
 322          Set_External_Reference_Of (External_Value, To => Field_Id);
 323
 324          --  Scan past the first argument
 325
 326          Scan;
 327
 328          case Token is
 329
 330             when Tok_Right_Paren =>
 331
 332                --  Scan past the right parenthesis
 333                Scan;
 334
 335             when Tok_Comma =>
 336
 337                --  Scan past the comma
 338
 339                Scan;
 340
 341                Expect (Tok_String_Literal, "literal string");
 342
 343                --  Get the default
 344
 345                if Token = Tok_String_Literal then
 346                   Field_Id :=
 347                     Default_Project_Node (Of_Kind       => N_Literal_String,
 348                                           And_Expr_Kind => Single);
 349                   Set_String_Value_Of (Field_Id, To => Token_Name);
 350                   Set_External_Default_Of (External_Value, To => Field_Id);
 351                   Scan;
 352                   Expect (Tok_Right_Paren, "`)`");
 353                end if;
 354
 355                --  Scan past the right parenthesis
 356                if Token = Tok_Right_Paren then
 357                   Scan;
 358                end if;
 359
 360             when others =>
 361                Error_Msg ("`,` or `)` expected", Token_Ptr);
 362          end case;
 363       end if;
 364    end External_Reference;
 365
 366    -----------------------
 367    -- Parse_Choice_List --
 368    -----------------------
 369
 370    procedure Parse_Choice_List (First_Choice : out Project_Node_Id) is
 371       Current_Choice : Project_Node_Id := Empty_Node;
 372       Next_Choice    : Project_Node_Id := Empty_Node;
 373       Choice_String  : Name_Id         := No_Name;
 374       Found          : Boolean         := False;
 375
 376    begin
 377       --  Declare the node of the first choice
 378
 379       First_Choice :=
 380         Default_Project_Node (Of_Kind       => N_Literal_String,
 381                               And_Expr_Kind => Single);
 382
 383       --  Initially Current_Choice is the same as First_Choice
 384
 385       Current_Choice := First_Choice;
 386
 387       loop
 388          Expect (Tok_String_Literal, "literal string");
 389          exit when Token /= Tok_String_Literal;
 390          Set_Location_Of (Current_Choice, To => Token_Ptr);
 391          Choice_String := Token_Name;
 392
 393          --  Give the string value to the current choice
 394
 395          Set_String_Value_Of (Current_Choice, To => Choice_String);
 396
 397          --  Check if the label is part of the string type and if it has not
 398          --  been already used.
 399
 400          Found := False;
 401          for Choice in Choice_First .. Choices.Last loop
 402             if Choices.Table (Choice).The_String = Choice_String then
 403                --  This label is part of the string type
 404
 405                Found := True;
 406
 407                if Choices.Table (Choice).Already_Used then
 408                   --  But it has already appeared in a choice list for this
 409                   --  case construction; report an error.
 410
 411                   Error_Msg_Name_1 := Choice_String;
 412                   Error_Msg ("duplicate case label {", Token_Ptr);
 413                else
 414                   Choices.Table (Choice).Already_Used := True;
 415                end if;
 416
 417                exit;
 418             end if;
 419          end loop;
 420
 421          --  If the label is not part of the string list, report an error
 422
 423          if not Found then
 424             Error_Msg_Name_1 := Choice_String;
 425             Error_Msg ("illegal case label {", Token_Ptr);
 426          end if;
 427
 428          --  Scan past the label
 429
 430          Scan;
 431
 432          --  If there is no '|', we are done
 433
 434          if Token = Tok_Vertical_Bar then
 435             --  Otherwise, declare the node of the next choice, link it to
 436             --  Current_Choice and set Current_Choice to this new node.
 437
 438             Next_Choice :=
 439               Default_Project_Node (Of_Kind       => N_Literal_String,
 440                                     And_Expr_Kind => Single);
 441             Set_Next_Literal_String (Current_Choice, To => Next_Choice);
 442             Current_Choice := Next_Choice;
 443             Scan;
 444          else
 445             exit;
 446          end if;
 447       end loop;
 448    end Parse_Choice_List;
 449
 450    ----------------------
 451    -- Parse_Expression --
 452    ----------------------
 453
 454    procedure Parse_Expression
 455      (Expression      : out Project_Node_Id;
 456       Current_Project : Project_Node_Id;
 457       Current_Package : Project_Node_Id)
 458    is
 459       First_Term      : Project_Node_Id := Empty_Node;
 460       Expression_Kind : Variable_Kind := Undefined;
 461
 462    begin
 463       --  Declare the node of the expression
 464
 465       Expression := Default_Project_Node (Of_Kind => N_Expression);
 466       Set_Location_Of (Expression, To => Token_Ptr);
 467
 468       --  Parse the term or terms of the expression
 469
 470       Terms (Term            => First_Term,
 471              Expr_Kind       => Expression_Kind,
 472              Current_Project => Current_Project,
 473              Current_Package => Current_Package);
 474
 475       --  Set the first term and the expression kind
 476
 477       Set_First_Term (Expression, To => First_Term);
 478       Set_Expression_Kind_Of (Expression, To => Expression_Kind);
 479    end Parse_Expression;
 480
 481    ----------------------------
 482    -- Parse_String_Type_List --
 483    ----------------------------
 484
 485    procedure Parse_String_Type_List (First_String : out Project_Node_Id) is
 486       Last_String  : Project_Node_Id := Empty_Node;
 487       Next_String  : Project_Node_Id := Empty_Node;
 488       String_Value : Name_Id         := No_Name;
 489
 490    begin
 491       --  Declare the node of the first string
 492
 493       First_String :=
 494         Default_Project_Node (Of_Kind       => N_Literal_String,
 495                               And_Expr_Kind => Single);
 496
 497       --  Initially, Last_String is the same as First_String
 498
 499       Last_String := First_String;
 500
 501       loop
 502          Expect (Tok_String_Literal, "literal string");
 503          exit when Token /= Tok_String_Literal;
 504          String_Value := Token_Name;
 505
 506          --  Give its string value to Last_String
 507
 508          Set_String_Value_Of (Last_String, To => String_Value);
 509          Set_Location_Of (Last_String, To => Token_Ptr);
 510
 511          --  Now, check if the string is already part of the string type
 512
 513          declare
 514             Current : Project_Node_Id := First_String;
 515
 516          begin
 517             while Current /= Last_String loop
 518                if String_Value_Of (Current) = String_Value then
 519                   --  This is a repetition, report an error
 520
 521                   Error_Msg_Name_1 := String_Value;
 522                   Error_Msg ("duplicate value { in type", Token_Ptr);
 523                   exit;
 524                end if;
 525
 526                Current := Next_Literal_String (Current);
 527             end loop;
 528          end;
 529
 530          --  Scan past the literal string
 531
 532          Scan;
 533
 534          --  If there is no comma following the literal string, we are done
 535
 536          if Token /= Tok_Comma then
 537             exit;
 538
 539          else
 540             --  Declare the next string, link it to Last_String and set
 541             --  Last_String to its node.
 542
 543             Next_String :=
 544               Default_Project_Node (Of_Kind       => N_Literal_String,
 545                                     And_Expr_Kind => Single);
 546             Set_Next_Literal_String (Last_String, To => Next_String);
 547             Last_String := Next_String;
 548             Scan;
 549          end if;
 550       end loop;
 551    end Parse_String_Type_List;
 552
 553    ------------------------------
 554    -- Parse_Variable_Reference --
 555    ------------------------------
 556
 557    procedure Parse_Variable_Reference
 558      (Variable        : out Project_Node_Id;
 559       Current_Project : Project_Node_Id;
 560       Current_Package : Project_Node_Id)
 561    is
 562       Current_Variable : Project_Node_Id := Empty_Node;
 563
 564       The_Package : Project_Node_Id := Current_Package;
 565       The_Project : Project_Node_Id := Current_Project;
 566
 567       Specified_Project : Project_Node_Id   := Empty_Node;
 568       Specified_Package : Project_Node_Id   := Empty_Node;
 569       Look_For_Variable : Boolean           := True;
 570       First_Attribute   : Attribute_Node_Id := Empty_Attribute;
 571       Variable_Name     : Name_Id;
 572
 573    begin
 574       Names.Init;
 575
 576       loop
 577          Expect (Tok_Identifier, "identifier");
 578
 579          if Token /= Tok_Identifier then
 580             Look_For_Variable := False;
 581             exit;
 582          end if;
 583
 584          Add_To_Names (NL => (Name => Token_Name, Location => Token_Ptr));
 585          Scan;
 586          exit when Token /= Tok_Dot;
 587          Scan;
 588       end loop;
 589
 590       if Look_For_Variable then
 591
 592          if Token = Tok_Apostrophe then
 593
 594             --  Attribute reference
 595
 596             case Names.Last is
 597                when 0 =>
 598
 599                   --  Cannot happen
 600
 601                   null;
 602
 603                when 1 =>
 604                   --  This may be a project name or a package name.
 605                   --  Project name have precedence.
 606
 607                   --  First, look if it can be a package name
 608
 609                   for Index in Package_First .. Package_Attributes.Last loop
 610                      if Package_Attributes.Table (Index).Name =
 611                                                       Names.Table (1).Name
 612                      then
 613                         First_Attribute :=
 614                           Package_Attributes.Table (Index).First_Attribute;
 615                         exit;
 616                      end if;
 617                   end loop;
 618
 619                   --  Now, look if it can be a project name
 620
 621                   The_Project := Imported_Or_Extended_Project_Of
 622                     (Current_Project, Names.Table (1).Name);
 623
 624                   if The_Project = Empty_Node then
 625                      --  If it is neither a project name nor a package name,
 626                      --  report an error
 627
 628                      if First_Attribute = Empty_Attribute then
 629                         Error_Msg_Name_1 := Names.Table (1).Name;
 630                         Error_Msg ("unknown project %",
 631                                    Names.Table (1).Location);
 632                         First_Attribute := Attribute_First;
 633
 634                      else
 635                         --  If it is a package name, check if the package
 636                         --  has already been declared in the current project.
 637
 638                         The_Package := First_Package_Of (Current_Project);
 639
 640                         while The_Package /= Empty_Node
 641                           and then Name_Of (The_Package) /=
 642                           Names.Table (1).Name
 643                         loop
 644                            The_Package :=
 645                              Next_Package_In_Project (The_Package);
 646                         end loop;
 647
 648                         --  If it has not been already declared, report an
 649                         --  error.
 650
 651                         if The_Package = Empty_Node then
 652                            Error_Msg_Name_1 := Names.Table (1).Name;
 653                            Error_Msg ("package % not yet defined",
 654                                       Names.Table (1).Location);
 655                         end if;
 656                      end if;
 657
 658                   else
 659                      --  It is a project name
 660
 661                      First_Attribute := Attribute_First;
 662                      The_Package     := Empty_Node;
 663                   end if;
 664
 665                when others =>
 666
 667                   --  We have either a project name made of several simple
 668                   --  names (long project), or a project name (short project)
 669                   --  followed by a package name. The long project name has
 670                   --  precedence.
 671
 672                   declare
 673                      Short_Project : Name_Id;
 674                      Long_Project  : Name_Id;
 675
 676                   begin
 677                      --  Clear the Buffer
 678
 679                      Buffer_Last := 0;
 680
 681                      --  Get the name of the short project
 682
 683                      for Index in 1 .. Names.Last - 1 loop
 684                         Add_To_Buffer
 685                           (Get_Name_String (Names.Table (Index).Name));
 686
 687                         if Index /= Names.Last - 1 then
 688                            Add_To_Buffer (".");
 689                         end if;
 690                      end loop;
 691
 692                      Name_Len := Buffer_Last;
 693                      Name_Buffer (1 .. Buffer_Last) :=
 694                        Buffer (1 .. Buffer_Last);
 695                      Short_Project := Name_Find;
 696
 697                      --  Now, add the last simple name to get the name of the
 698                      --  long project.
 699
 700                      Add_To_Buffer (".");
 701                      Add_To_Buffer
 702                        (Get_Name_String (Names.Table (Names.Last).Name));
 703                      Name_Len := Buffer_Last;
 704                      Name_Buffer (1 .. Buffer_Last) :=
 705                        Buffer (1 .. Buffer_Last);
 706                      Long_Project := Name_Find;
 707
 708                      --  Check if the long project is imported or extended
 709
 710                      The_Project := Imported_Or_Extended_Project_Of
 711                                       (Current_Project, Long_Project);
 712
 713                      --  If the long project exists, then this is the prefix
 714                      --  of the attribute.
 715
 716                      if The_Project /= Empty_Node then
 717                         First_Attribute := Attribute_First;
 718                         The_Package     := Empty_Node;
 719
 720                      else
 721                         --  Otherwise, check if the short project is imported
 722                         --  or extended.
 723
 724                         The_Project := Imported_Or_Extended_Project_Of
 725                                          (Current_Project, Short_Project);
 726
 727                         --  If the short project does not exist, we report an
 728                         --  error.
 729
 730                         if The_Project = Empty_Node then
 731                            Error_Msg_Name_1 := Long_Project;
 732                            Error_Msg_Name_2 := Short_Project;
 733                            Error_Msg ("unknown projects % or %",
 734                                       Names.Table (1).Location);
 735                            The_Package := Empty_Node;
 736                            First_Attribute := Attribute_First;
 737
 738                         else
 739                            --  Now, we check if the package has been declared
 740                            --  in this project.
 741
 742                            The_Package := First_Package_Of (The_Project);
 743                            while The_Package /= Empty_Node
 744                              and then Name_Of (The_Package) /=
 745                              Names.Table (Names.Last).Name
 746                            loop
 747                               The_Package :=
 748                                 Next_Package_In_Project (The_Package);
 749                            end loop;
 750
 751                            --  If it has not, then we report an error
 752
 753                            if The_Package = Empty_Node then
 754                               Error_Msg_Name_1 :=
 755                                 Names.Table (Names.Last).Name;
 756                               Error_Msg_Name_2 := Short_Project;
 757                               Error_Msg ("package % not declared in project %",
 758                                          Names.Table (Names.Last).Location);
 759                               First_Attribute := Attribute_First;
 760
 761                            else
 762                               --  Otherwise, we have the correct project and
 763                               --  package.
 764
 765                               First_Attribute :=
 766                                 Package_Attributes.Table
 767                                 (Package_Id_Of (The_Package)).First_Attribute;
 768                            end if;
 769                         end if;
 770                      end if;
 771                   end;
 772             end case;
 773
 774             Attribute_Reference
 775               (Variable,
 776                Current_Project => The_Project,
 777                Current_Package => The_Package,
 778                First_Attribute => First_Attribute);
 779             return;
 780          end if;
 781       end if;
 782
 783       Variable :=
 784         Default_Project_Node (Of_Kind => N_Variable_Reference);
 785
 786       if Look_For_Variable then
 787          case Names.Last is
 788             when 0 =>
 789
 790                --  Cannot happen
 791
 792                null;
 793
 794             when 1 =>
 795
 796                --  Simple variable name
 797
 798                Set_Name_Of (Variable, To => Names.Table (1).Name);
 799
 800             when 2 =>
 801
 802                --  Variable name with a simple name prefix that can be
 803                --  a project name or a package name. Project names have
 804                --  priority over package names.
 805
 806                Set_Name_Of (Variable, To => Names.Table (2).Name);
 807
 808                --  Check if it can be a package name
 809
 810                The_Package := First_Package_Of (Current_Project);
 811
 812                while The_Package /= Empty_Node
 813                  and then Name_Of (The_Package) /= Names.Table (1).Name
 814                loop
 815                   The_Package := Next_Package_In_Project (The_Package);
 816                end loop;
 817
 818                --  Now look for a possible project name
 819
 820                The_Project := Imported_Or_Extended_Project_Of
 821                                 (Current_Project, Names.Table (1).Name);
 822
 823                if The_Project /= Empty_Node then
 824                   Specified_Project := The_Project;
 825
 826                elsif The_Package = Empty_Node then
 827                   Error_Msg_Name_1 := Names.Table (1).Name;
 828                   Error_Msg ("unknown package or project %",
 829                              Names.Table (1).Location);
 830                   Look_For_Variable := False;
 831
 832                else
 833                   Specified_Package := The_Package;
 834                end if;
 835
 836             when others =>
 837
 838                --  Variable name with a prefix that is either a project name
 839                --  made of several simple names, or a project name followed
 840                --  by a package name.
 841
 842                Set_Name_Of (Variable, To => Names.Table (Names.Last).Name);
 843
 844                declare
 845                   Short_Project : Name_Id;
 846                   Long_Project  : Name_Id;
 847
 848                begin
 849                   --  First, we get the two possible project names
 850
 851                   --  Clear the buffer
 852
 853                   Buffer_Last := 0;
 854
 855                   --  Add all the simple names, except the last two
 856
 857                   for Index in 1 .. Names.Last - 2 loop
 858                      Add_To_Buffer
 859                        (Get_Name_String (Names.Table (Index).Name));
 860
 861                      if Index /= Names.Last - 2 then
 862                         Add_To_Buffer (".");
 863                      end if;
 864                   end loop;
 865
 866                   Name_Len := Buffer_Last;
 867                   Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
 868                   Short_Project := Name_Find;
 869
 870                   --  Add the simple name before the name of the variable
 871
 872                   Add_To_Buffer (".");
 873                   Add_To_Buffer
 874                     (Get_Name_String (Names.Table (Names.Last - 1).Name));
 875                   Name_Len := Buffer_Last;
 876                   Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
 877                   Long_Project := Name_Find;
 878
 879                   --  Check if the prefix is the name of an imported or
 880                   --  extended project.
 881
 882                   The_Project := Imported_Or_Extended_Project_Of
 883                                    (Current_Project, Long_Project);
 884
 885                   if The_Project /= Empty_Node then
 886                      Specified_Project := The_Project;
 887
 888                   else
 889                      --  Now check if the prefix may be a project name followed
 890                      --  by a package name.
 891
 892                      --  First check for a possible project name
 893
 894                      The_Project := Imported_Or_Extended_Project_Of
 895                                    (Current_Project, Short_Project);
 896
 897                      if The_Project = Empty_Node then
 898                         --  Unknown prefix, report an error
 899
 900                         Error_Msg_Name_1 := Long_Project;
 901                         Error_Msg_Name_2 := Short_Project;
 902                         Error_Msg ("unknown projects % or %",
 903                                    Names.Table (1).Location);
 904                         Look_For_Variable := False;
 905
 906                      else
 907                         Specified_Project := The_Project;
 908
 909                         --  Now look for the package in this project
 910
 911                         The_Package := First_Package_Of (The_Project);
 912
 913                         while The_Package /= Empty_Node
 914                           and then Name_Of (The_Package) /=
 915                                               Names.Table (Names.Last - 1).Name
 916                         loop
 917                            The_Package :=
 918                              Next_Package_In_Project (The_Package);
 919                         end loop;
 920
 921                         if The_Package = Empty_Node then
 922                            --  The package does not vexist, report an error
 923
 924                            Error_Msg_Name_1 := Names.Table (2).Name;
 925                            Error_Msg ("unknown package %",
 926                                    Names.Table (Names.Last - 1).Location);
 927                            Look_For_Variable := False;
 928
 929                         else
 930                            Specified_Package := The_Package;
 931                         end if;
 932                      end if;
 933                   end if;
 934                end;
 935          end case;
 936       end if;
 937
 938       if Look_For_Variable then
 939          Variable_Name := Name_Of (Variable);
 940          Set_Project_Node_Of (Variable, To => Specified_Project);
 941          Set_Package_Node_Of (Variable, To => Specified_Package);
 942
 943          if Specified_Project /= Empty_Node then
 944             The_Project := Specified_Project;
 945
 946          else
 947             The_Project := Current_Project;
 948          end if;
 949
 950          Current_Variable := Empty_Node;
 951
 952          --  Look for this variable
 953
 954          --  If a package was specified, check if the variable has been
 955          --  declared in this package.
 956
 957          if Specified_Package /= Empty_Node then
 958             Current_Variable := First_Variable_Of (Specified_Package);
 959
 960             while Current_Variable /= Empty_Node
 961               and then
 962               Name_Of (Current_Variable) /= Variable_Name
 963             loop
 964                Current_Variable := Next_Variable (Current_Variable);
 965             end loop;
 966
 967          else
 968             --  Otherwise, if no project has been specified and we are in
 969             --  a package, first check if the variable has been declared in
 970             --  the package.
 971
 972             if Specified_Project = Empty_Node
 973               and then Current_Package /= Empty_Node
 974             then
 975                Current_Variable := First_Variable_Of (Current_Package);
 976
 977                while Current_Variable /= Empty_Node
 978                  and then Name_Of (Current_Variable) /= Variable_Name
 979                loop
 980                   Current_Variable := Next_Variable (Current_Variable);
 981                end loop;
 982             end if;
 983
 984             --  If we have not found the variable in the package, check if the
 985             --  variable has been declared in the project.
 986
 987             if Current_Variable = Empty_Node then
 988                Current_Variable := First_Variable_Of (The_Project);
 989
 990                while Current_Variable /= Empty_Node
 991                  and then Name_Of (Current_Variable) /= Variable_Name
 992                loop
 993                   Current_Variable := Next_Variable (Current_Variable);
 994                end loop;
 995             end if;
 996          end if;
 997
 998          --  If the variable was not found, report an error
 999
1000          if Current_Variable = Empty_Node then
1001             Error_Msg_Name_1 := Variable_Name;
1002             Error_Msg
1003               ("unknown variable %", Names.Table (Names.Last).Location);
1004          end if;
1005       end if;
1006
1007       if Current_Variable /= Empty_Node then
1008          Set_Expression_Kind_Of
1009            (Variable, To => Expression_Kind_Of (Current_Variable));
1010
1011          if Kind_Of (Current_Variable) = N_Typed_Variable_Declaration then
1012             Set_String_Type_Of
1013               (Variable, To => String_Type_Of (Current_Variable));
1014          end if;
1015       end if;
1016
1017       --  If the variable is followed by a left parenthesis, report an error
1018       --  but attempt to scan the index.
1019
1020       if Token = Tok_Left_Paren then
1021          Error_Msg ("\variables cannot be associative arrays", Token_Ptr);
1022          Scan;
1023          Expect (Tok_String_Literal, "literal string");
1024
1025          if Token = Tok_String_Literal then
1026             Scan;
1027             Expect (Tok_Right_Paren, "`)`");
1028
1029             if Token = Tok_Right_Paren then
1030                Scan;
1031             end if;
1032          end if;
1033       end if;
1034    end Parse_Variable_Reference;
1035
1036    ---------------------------------
1037    -- Start_New_Case_Construction --
1038    ---------------------------------
1039
1040    procedure Start_New_Case_Construction (String_Type  : Project_Node_Id) is
1041       Current_String : Project_Node_Id;
1042
1043    begin
1044       --  Set Choice_First, depending on whether is the first case
1045       --  construction or not.
1046
1047       if Choice_First = 0 then
1048          Choice_First := 1;
1049          Choices.Set_Last (First_Choice_Node_Id);
1050       else
1051          Choice_First := Choices.Last + 1;
1052       end if;
1053
1054       --  Add to table Choices the literal of the string type
1055
1056       if String_Type /= Empty_Node then
1057          Current_String := First_Literal_String (String_Type);
1058
1059          while Current_String /= Empty_Node loop
1060             Add (This_String => String_Value_Of (Current_String));
1061             Current_String := Next_Literal_String (Current_String);
1062          end loop;
1063       end if;
1064
1065       --  Set the value of the last choice in table Choice_Lasts
1066
1067       Choice_Lasts.Increment_Last;
1068       Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last;
1069
1070    end Start_New_Case_Construction;
1071
1072    -----------
1073    -- Terms --
1074    -----------
1075
1076    procedure Terms
1077      (Term            : out Project_Node_Id;
1078       Expr_Kind       : in out Variable_Kind;
1079       Current_Project : Project_Node_Id;
1080       Current_Package : Project_Node_Id)
1081    is
1082       Next_Term          : Project_Node_Id := Empty_Node;
1083       Term_Id            : Project_Node_Id := Empty_Node;
1084       Current_Expression : Project_Node_Id := Empty_Node;
1085       Next_Expression    : Project_Node_Id := Empty_Node;
1086       Current_Location   : Source_Ptr      := No_Location;
1087       Reference          : Project_Node_Id := Empty_Node;
1088
1089    begin
1090       --  Declare a new node for the term
1091
1092       Term := Default_Project_Node (Of_Kind => N_Term);
1093       Set_Location_Of (Term, To => Token_Ptr);
1094
1095       case Token is
1096          when Tok_Left_Paren =>
1097
1098             --  If we have a left parenthesis and we don't know the expression
1099             --  kind, then this is a string list.
1100
1101             case Expr_Kind is
1102                when Undefined =>
1103                   Expr_Kind := List;
1104
1105                when List =>
1106                   null;
1107
1108                when Single =>
1109
1110                   --  If we already know that this is a single string, report
1111                   --  an error, but set the expression kind to string list to
1112                   --  avoid several errors.
1113
1114                   Expr_Kind := List;
1115                   Error_Msg
1116                     ("literal string list cannot appear in a string",
1117                      Token_Ptr);
1118             end case;
1119
1120             --  Declare a new node for this literal string list
1121
1122             Term_Id := Default_Project_Node
1123               (Of_Kind => N_Literal_String_List,
1124                And_Expr_Kind => List);
1125             Set_Current_Term (Term, To => Term_Id);
1126             Set_Location_Of (Term, To => Token_Ptr);
1127
1128             --  Scan past the left parenthesis
1129
1130             Scan;
1131
1132             --  If the left parenthesis is immediately followed by a right
1133             --  parenthesis, the literal string list is empty.
1134
1135             if Token = Tok_Right_Paren then
1136                Scan;
1137
1138             else
1139                --  Otherwise, we parse the expression(s) in the literal string
1140                --  list.
1141
1142                loop
1143                   Current_Location := Token_Ptr;
1144                   Parse_Expression (Expression      => Next_Expression,
1145                                     Current_Project => Current_Project,
1146                                     Current_Package => Current_Package);
1147
1148                   --  The expression kind is String list, report an error
1149
1150                   if Expression_Kind_Of (Next_Expression) = List then
1151                      Error_Msg ("single expression expected",
1152                                 Current_Location);
1153                   end if;
1154
1155                   --  If Current_Expression is empty, it means that the
1156                   --  expression is the first in the string list.
1157
1158                   if Current_Expression = Empty_Node then
1159                      Set_First_Expression_In_List
1160                        (Term_Id, To => Next_Expression);
1161                   else
1162                      Set_Next_Expression_In_List
1163                        (Current_Expression, To => Next_Expression);
1164                   end if;
1165
1166                   Current_Expression := Next_Expression;
1167
1168                   --  If there is a comma, continue with the next expression
1169
1170                   exit when Token /= Tok_Comma;
1171                   Scan; -- past the comma
1172                end loop;
1173
1174                --  We expect a closing right parenthesis
1175
1176                Expect (Tok_Right_Paren, "`)`");
1177
1178                if Token = Tok_Right_Paren then
1179                   Scan;
1180                end if;
1181             end if;
1182
1183          when Tok_String_Literal =>
1184
1185             --  If we don't know the expression kind (first term), then it is
1186             --  a simple string.
1187
1188             if Expr_Kind = Undefined then
1189                Expr_Kind := Single;
1190             end if;
1191
1192             --  Declare a new node for the string literal
1193
1194             Term_Id := Default_Project_Node (Of_Kind => N_Literal_String);
1195             Set_Current_Term (Term, To => Term_Id);
1196             Set_String_Value_Of (Term_Id, To => Token_Name);
1197
1198             --  Scan past the string literal
1199
1200             Scan;
1201
1202          when Tok_Identifier =>
1203             Current_Location := Token_Ptr;
1204
1205             --  Get the variable or attribute reference
1206
1207             Parse_Variable_Reference
1208               (Variable        => Reference,
1209                Current_Project => Current_Project,
1210                Current_Package => Current_Package);
1211             Set_Current_Term (Term, To => Reference);
1212
1213             if Reference /= Empty_Node then
1214
1215                --  If we don't know the expression kind (first term), then it
1216                --  has the kind of the variable or attribute reference.
1217
1218                if Expr_Kind = Undefined then
1219                   Expr_Kind := Expression_Kind_Of (Reference);
1220
1221                elsif Expr_Kind = Single
1222                  and then Expression_Kind_Of (Reference) = List
1223                then
1224                   --  If the expression is a single list, and the reference is
1225                   --  a string list, report an error, and set the expression
1226                   --  kind to string list to avoid multiple errors.
1227
1228                   Expr_Kind := List;
1229                   Error_Msg
1230                     ("list variable cannot appear in single string expression",
1231                      Current_Location);
1232                end if;
1233             end if;
1234
1235          when Tok_Project =>
1236
1237             --  project can appear in an expression as the prefix of an
1238             --  attribute reference of the current project.
1239
1240             Current_Location := Token_Ptr;
1241             Scan;
1242             Expect (Tok_Apostrophe, "`'`");
1243
1244             if Token = Tok_Apostrophe then
1245                Attribute_Reference
1246                  (Reference       => Reference,
1247                   First_Attribute => Prj.Attr.Attribute_First,
1248                   Current_Project => Current_Project,
1249                   Current_Package => Empty_Node);
1250                Set_Current_Term (Term, To => Reference);
1251             end if;
1252
1253             --  Same checks as above for the expression kind
1254
1255             if Reference /= Empty_Node then
1256                if Expr_Kind = Undefined then
1257                   Expr_Kind := Expression_Kind_Of (Reference);
1258
1259                elsif Expr_Kind = Single
1260                  and then Expression_Kind_Of (Reference) = List
1261                then
1262                   Error_Msg
1263                     ("lists cannot appear in single string expression",
1264                      Current_Location);
1265                end if;
1266             end if;
1267
1268          when Tok_External =>
1269             --  An external reference is always a single string
1270
1271             if Expr_Kind = Undefined then
1272                Expr_Kind := Single;
1273             end if;
1274
1275             External_Reference (External_Value => Reference);
1276             Set_Current_Term (Term, To => Reference);
1277
1278          when others =>
1279             Error_Msg ("cannot be part of an expression", Token_Ptr);
1280             Term := Empty_Node;
1281             return;
1282       end case;
1283
1284       --  If there is an '&', call Terms recursively
1285
1286       if Token = Tok_Ampersand then
1287
1288          --  Scan past the '&'
1289
1290          Scan;
1291
1292          Terms (Term            => Next_Term,
1293                 Expr_Kind       => Expr_Kind,
1294                 Current_Project => Current_Project,
1295                 Current_Package => Current_Package);
1296
1297          --  And link the next term to this term
1298
1299          Set_Next_Term (Term, To => Next_Term);
1300       end if;
1301    end Terms;
1302
1303 end Prj.Strt;