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