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