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