X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fprj-strt.adb;fp=gcc%2Fada%2Fprj-strt.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=9acc203deb32e2ee3cb52da702c64af621723445;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb deleted file mode 100644 index 9acc203d..00000000 --- a/gcc/ada/prj-strt.adb +++ /dev/null @@ -1,943 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- P R J . S T R T -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.1 $ --- -- --- Copyright (C) 2001 Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Errout; use Errout; -with Prj.Attr; use Prj.Attr; -with Prj.Tree; use Prj.Tree; -with Scans; use Scans; -with Sinfo; use Sinfo; -with Stringt; use Stringt; -with Table; -with Types; use Types; - -package body Prj.Strt is - - Initial_Size : constant := 8; - - type Name_Location is record - Name : Name_Id := No_Name; - Location : Source_Ptr := No_Location; - end record; - -- Store the identifier and the location of a simple name - - type Name_Range is range 0 .. 3; - subtype Name_Index is Name_Range range 1 .. Name_Range'Last; - -- A Name may contain up to 3 simple names - - type Names is array (Name_Index) of Name_Location; - -- Used to store 1 to 3 simple_names. 2 simple names are for - -- ., . or .. - -- 3 simple names are for ... - - type Choice_String is record - The_String : String_Id; - Already_Used : Boolean := False; - end record; - -- The string of a case label, and an indication that it has already - -- been used (to avoid duplicate case labels). - - Choices_Initial : constant := 10; - Choices_Increment : constant := 10; - - Choice_Node_Low_Bound : constant := 0; - Choice_Node_High_Bound : constant := 099_999_999; -- In practice, infinite - - type Choice_Node_Id is - range Choice_Node_Low_Bound .. Choice_Node_High_Bound; - - First_Choice_Node_Id : constant Choice_Node_Id := - Choice_Node_Low_Bound; - - Empty_Choice : constant Choice_Node_Id := - Choice_Node_Low_Bound; - - First_Choice_Id : constant Choice_Node_Id := First_Choice_Node_Id + 1; - - package Choices is - new Table.Table (Table_Component_Type => Choice_String, - Table_Index_Type => Choice_Node_Id, - Table_Low_Bound => First_Choice_Node_Id, - Table_Initial => Choices_Initial, - Table_Increment => Choices_Increment, - Table_Name => "Prj.Strt.Choices"); - -- Used to store the case labels and check that there is no duplicate. - - package Choice_Lasts is - new Table.Table (Table_Component_Type => Choice_Node_Id, - Table_Index_Type => Nat, - Table_Low_Bound => 1, - Table_Initial => 3, - Table_Increment => 3, - Table_Name => "Prj.Strt.Choice_Lasts"); - -- Used to store the indices of the choices in table Choices, - -- to distinguish nested case constructions. - - Choice_First : Choice_Node_Id := 0; - -- Index in table Choices of the first case label of the current - -- case construction. - -- 0 means no current case construction. - - procedure Add (This_String : String_Id); - -- Add a string to the case label list, indicating that it has not - -- yet been used. - - procedure External_Reference (External_Value : out Project_Node_Id); - -- Parse an external reference. Current token is "external". - - procedure Attribute_Reference - (Reference : out Project_Node_Id; - First_Attribute : Attribute_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); - -- Parse an attribute reference. Current token is an apostrophe. - - procedure Terms - (Term : out Project_Node_Id; - Expr_Kind : in out Variable_Kind; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); - -- Recursive procedure to parse one term or several terms concatenated - -- using "&". - - --------- - -- Add -- - --------- - - procedure Add (This_String : String_Id) is - begin - Choices.Increment_Last; - Choices.Table (Choices.Last) := - (The_String => This_String, - Already_Used => False); - end Add; - - ------------------------- - -- Attribute_Reference -- - ------------------------- - - procedure Attribute_Reference - (Reference : out Project_Node_Id; - First_Attribute : Attribute_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) - is - Current_Attribute : Attribute_Node_Id := First_Attribute; - - begin - Reference := Default_Project_Node (Of_Kind => N_Attribute_Reference); - Set_Location_Of (Reference, To => Token_Ptr); - Scan; -- past apostrophe - Expect (Tok_Identifier, "Identifier"); - - if Token = Tok_Identifier then - Set_Name_Of (Reference, To => Token_Name); - - while Current_Attribute /= Empty_Attribute - and then - Attributes.Table (Current_Attribute).Name /= Token_Name - loop - Current_Attribute := Attributes.Table (Current_Attribute).Next; - end loop; - - if Current_Attribute = Empty_Attribute then - Error_Msg ("unknown attribute", Token_Ptr); - Reference := Empty_Node; - - elsif - Attributes.Table (Current_Attribute).Kind_2 = Associative_Array - then - Error_Msg - ("associative array attribute cannot be referenced", - Token_Ptr); - Reference := Empty_Node; - - else - Set_Project_Node_Of (Reference, To => Current_Project); - Set_Package_Node_Of (Reference, To => Current_Package); - Set_Expression_Kind_Of - (Reference, To => Attributes.Table (Current_Attribute).Kind_1); - Scan; - end if; - end if; - end Attribute_Reference; - - --------------------------- - -- End_Case_Construction -- - --------------------------- - - procedure End_Case_Construction is - begin - if Choice_Lasts.Last = 1 then - Choice_Lasts.Set_Last (0); - Choices.Set_Last (First_Choice_Node_Id); - Choice_First := 0; - - elsif Choice_Lasts.Last = 2 then - Choice_Lasts.Set_Last (1); - Choices.Set_Last (Choice_Lasts.Table (1)); - Choice_First := 1; - - else - Choice_Lasts.Decrement_Last; - Choices.Set_Last (Choice_Lasts.Table (Choice_Lasts.Last)); - Choice_First := Choice_Lasts.Table (Choice_Lasts.Last - 1) + 1; - end if; - end End_Case_Construction; - - ------------------------ - -- External_Reference -- - ------------------------ - - procedure External_Reference (External_Value : out Project_Node_Id) is - Field_Id : Project_Node_Id := Empty_Node; - - begin - External_Value := - Default_Project_Node (Of_Kind => N_External_Value, - And_Expr_Kind => Single); - Set_Location_Of (External_Value, To => Token_Ptr); - - -- The current token is External - - -- Get the left parenthesis - - Scan; - Expect (Tok_Left_Paren, "("); - - -- Scan past the left parenthesis - - if Token = Tok_Left_Paren then - Scan; - end if; - - -- Get the name of the external reference - - Expect (Tok_String_Literal, "literal string"); - - if Token = Tok_String_Literal then - Field_Id := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_String_Value_Of (Field_Id, To => Strval (Token_Node)); - Set_External_Reference_Of (External_Value, To => Field_Id); - - -- Scan past the first argument - - Scan; - - case Token is - - when Tok_Right_Paren => - - -- Scan past the right parenthesis - Scan; - - when Tok_Comma => - - -- Scan past the comma - - Scan; - - Expect (Tok_String_Literal, "literal string"); - - -- Get the default - - if Token = Tok_String_Literal then - Field_Id := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_String_Value_Of (Field_Id, To => Strval (Token_Node)); - Set_External_Default_Of (External_Value, To => Field_Id); - Scan; - Expect (Tok_Right_Paren, ")"); - end if; - - -- Scan past the right parenthesis - if Token = Tok_Right_Paren then - Scan; - end if; - - when others => - Error_Msg ("',' or ')' expected", Token_Ptr); - end case; - end if; - end External_Reference; - - ----------------------- - -- Parse_Choice_List -- - ----------------------- - - procedure Parse_Choice_List (First_Choice : out Project_Node_Id) is - Current_Choice : Project_Node_Id := Empty_Node; - Next_Choice : Project_Node_Id := Empty_Node; - Choice_String : String_Id := No_String; - Found : Boolean := False; - - begin - First_Choice := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Current_Choice := First_Choice; - - loop - Expect (Tok_String_Literal, "literal string"); - exit when Token /= Tok_String_Literal; - Set_Location_Of (Current_Choice, To => Token_Ptr); - Choice_String := Strval (Token_Node); - Set_String_Value_Of (Current_Choice, To => Choice_String); - - Found := False; - for Choice in Choice_First .. Choices.Last loop - if String_Equal (Choices.Table (Choice).The_String, - Choice_String) - then - Found := True; - - if Choices.Table (Choice).Already_Used then - Error_Msg ("duplicate case label", Token_Ptr); - else - Choices.Table (Choice).Already_Used := True; - end if; - - exit; - end if; - end loop; - - if not Found then - Error_Msg ("illegal case label", Token_Ptr); - end if; - - Scan; - - if Token = Tok_Vertical_Bar then - Next_Choice := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_Next_Literal_String (Current_Choice, To => Next_Choice); - Current_Choice := Next_Choice; - Scan; - else - exit; - end if; - end loop; - end Parse_Choice_List; - - ---------------------- - -- Parse_Expression -- - ---------------------- - - procedure Parse_Expression - (Expression : out Project_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) - is - First_Term : Project_Node_Id := Empty_Node; - Expression_Kind : Variable_Kind := Undefined; - - begin - Expression := Default_Project_Node (Of_Kind => N_Expression); - Set_Location_Of (Expression, To => Token_Ptr); - Terms (Term => First_Term, - Expr_Kind => Expression_Kind, - Current_Project => Current_Project, - Current_Package => Current_Package); - Set_First_Term (Expression, To => First_Term); - Set_Expression_Kind_Of (Expression, To => Expression_Kind); - end Parse_Expression; - - ---------------------------- - -- Parse_String_Type_List -- - ---------------------------- - - procedure Parse_String_Type_List (First_String : out Project_Node_Id) is - Last_String : Project_Node_Id := Empty_Node; - Next_String : Project_Node_Id := Empty_Node; - String_Value : String_Id := No_String; - - begin - First_String := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Last_String := First_String; - - loop - Expect (Tok_String_Literal, "literal string"); - exit when Token /= Tok_String_Literal; - String_Value := Strval (Token_Node); - Set_String_Value_Of (Last_String, To => String_Value); - Set_Location_Of (Last_String, To => Token_Ptr); - - declare - Current : Project_Node_Id := First_String; - - begin - while Current /= Last_String loop - if String_Equal (String_Value_Of (Current), String_Value) then - Error_Msg ("duplicate value in type", Token_Ptr); - exit; - end if; - - Current := Next_Literal_String (Current); - end loop; - end; - - Scan; - - if Token /= Tok_Comma then - exit; - - else - Next_String := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_Next_Literal_String (Last_String, To => Next_String); - Last_String := Next_String; - Scan; - end if; - end loop; - end Parse_String_Type_List; - - ------------------------------ - -- Parse_Variable_Reference -- - ------------------------------ - - procedure Parse_Variable_Reference - (Variable : out Project_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) - is - The_Names : Names; - Last_Name : Name_Range := 0; - Current_Variable : Project_Node_Id := Empty_Node; - - The_Package : Project_Node_Id := Current_Package; - The_Project : Project_Node_Id := Current_Project; - - Specified_Project : Project_Node_Id := Empty_Node; - Specified_Package : Project_Node_Id := Empty_Node; - Look_For_Variable : Boolean := True; - First_Attribute : Attribute_Node_Id := Empty_Attribute; - Variable_Name : Name_Id; - - begin - for Index in The_Names'Range loop - Expect (Tok_Identifier, "identifier"); - - if Token /= Tok_Identifier then - Look_For_Variable := False; - exit; - end if; - - Last_Name := Last_Name + 1; - The_Names (Last_Name) := - (Name => Token_Name, - Location => Token_Ptr); - Scan; - exit when Token /= Tok_Dot; - Scan; - end loop; - - if Look_For_Variable then - if Token = Tok_Apostrophe then - - -- Attribute reference - - case Last_Name is - when 0 => - - -- Cannot happen - - null; - - when 1 => - for Index in Package_First .. Package_Attributes.Last loop - if Package_Attributes.Table (Index).Name = - The_Names (1).Name - then - First_Attribute := - Package_Attributes.Table (Index).First_Attribute; - exit; - end if; - end loop; - - if First_Attribute /= Empty_Attribute then - The_Package := First_Package_Of (Current_Project); - while The_Package /= Empty_Node - and then Name_Of (The_Package) /= The_Names (1).Name - loop - The_Package := Next_Package_In_Project (The_Package); - end loop; - - if The_Package = Empty_Node then - Error_Msg ("package not yet defined", - The_Names (1).Location); - end if; - - else - First_Attribute := Attribute_First; - The_Package := Empty_Node; - - declare - The_Project_Name_And_Node : - constant Tree_Private_Part.Project_Name_And_Node := - Tree_Private_Part.Projects_Htable.Get - (The_Names (1).Name); - - use Tree_Private_Part; - - begin - if The_Project_Name_And_Node = - Tree_Private_Part.No_Project_Name_And_Node - then - Error_Msg ("unknown project", - The_Names (1).Location); - else - The_Project := The_Project_Name_And_Node.Node; - end if; - end; - end if; - - when 2 => - declare - With_Clause : Project_Node_Id := - First_With_Clause_Of (Current_Project); - - begin - while With_Clause /= Empty_Node loop - The_Project := Project_Node_Of (With_Clause); - exit when Name_Of (The_Project) = The_Names (1).Name; - With_Clause := Next_With_Clause_Of (With_Clause); - end loop; - - if With_Clause = Empty_Node then - Error_Msg ("unknown project", - The_Names (1).Location); - The_Project := Empty_Node; - The_Package := Empty_Node; - First_Attribute := Attribute_First; - - else - The_Package := First_Package_Of (The_Project); - while The_Package /= Empty_Node - and then Name_Of (The_Package) /= The_Names (2).Name - loop - The_Package := - Next_Package_In_Project (The_Package); - end loop; - - if The_Package = Empty_Node then - Error_Msg ("package not declared in project", - The_Names (2).Location); - First_Attribute := Attribute_First; - - else - First_Attribute := - Package_Attributes.Table - (Package_Id_Of (The_Package)).First_Attribute; - end if; - end if; - end; - - when 3 => - Error_Msg - ("too many single names for an attribute reference", - The_Names (1).Location); - Scan; - Variable := Empty_Node; - return; - end case; - - Attribute_Reference - (Variable, - Current_Project => The_Project, - Current_Package => The_Package, - First_Attribute => First_Attribute); - return; - end if; - end if; - - Variable := - Default_Project_Node (Of_Kind => N_Variable_Reference); - - if Look_For_Variable then - case Last_Name is - when 0 => - - -- Cannot happen - - null; - - when 1 => - Set_Name_Of (Variable, To => The_Names (1).Name); - - -- Header comment needed ??? - - when 2 => - Set_Name_Of (Variable, To => The_Names (2).Name); - The_Package := First_Package_Of (Current_Project); - - while The_Package /= Empty_Node - and then Name_Of (The_Package) /= The_Names (1).Name - loop - The_Package := Next_Package_In_Project (The_Package); - end loop; - - if The_Package /= Empty_Node then - Specified_Package := The_Package; - The_Project := Empty_Node; - - else - declare - With_Clause : Project_Node_Id := - First_With_Clause_Of (Current_Project); - - begin - while With_Clause /= Empty_Node loop - The_Project := Project_Node_Of (With_Clause); - exit when Name_Of (The_Project) = The_Names (1).Name; - With_Clause := Next_With_Clause_Of (With_Clause); - end loop; - - if With_Clause = Empty_Node then - The_Project := - Modified_Project_Of - (Project_Declaration_Of (Current_Project)); - - if The_Project /= Empty_Node - and then - Name_Of (The_Project) /= The_Names (1).Name - then - The_Project := Empty_Node; - end if; - end if; - - if The_Project = Empty_Node then - Error_Msg ("unknown package or project", - The_Names (1).Location); - Look_For_Variable := False; - else - Specified_Project := The_Project; - end if; - end; - end if; - - -- Header comment needed ??? - - when 3 => - Set_Name_Of (Variable, To => The_Names (3).Name); - - declare - With_Clause : Project_Node_Id := - First_With_Clause_Of (Current_Project); - - begin - while With_Clause /= Empty_Node loop - The_Project := Project_Node_Of (With_Clause); - exit when Name_Of (The_Project) = The_Names (1).Name; - With_Clause := Next_With_Clause_Of (With_Clause); - end loop; - - if With_Clause = Empty_Node then - The_Project := - Modified_Project_Of - (Project_Declaration_Of (Current_Project)); - - if The_Project /= Empty_Node - and then Name_Of (The_Project) /= The_Names (1).Name - then - The_Project := Empty_Node; - end if; - end if; - - if The_Project = Empty_Node then - Error_Msg ("unknown package or project", - The_Names (1).Location); - Look_For_Variable := False; - - else - Specified_Project := The_Project; - The_Package := First_Package_Of (The_Project); - - while The_Package /= Empty_Node - and then Name_Of (The_Package) /= The_Names (2).Name - loop - The_Package := Next_Package_In_Project (The_Package); - end loop; - - if The_Package = Empty_Node then - Error_Msg ("unknown package", - The_Names (2).Location); - Look_For_Variable := False; - - else - Specified_Package := The_Package; - The_Project := Empty_Node; - end if; - end if; - end; - - end case; - end if; - - if Look_For_Variable then - Variable_Name := Name_Of (Variable); - Set_Project_Node_Of (Variable, To => Specified_Project); - Set_Package_Node_Of (Variable, To => Specified_Package); - - if The_Package /= Empty_Node then - Current_Variable := First_Variable_Of (The_Package); - - while Current_Variable /= Empty_Node - and then - Name_Of (Current_Variable) /= Variable_Name - loop - Current_Variable := Next_Variable (Current_Variable); - end loop; - end if; - - if Current_Variable = Empty_Node - and then The_Project /= Empty_Node - then - Current_Variable := First_Variable_Of (The_Project); - while Current_Variable /= Empty_Node - and then Name_Of (Current_Variable) /= Variable_Name - loop - Current_Variable := Next_Variable (Current_Variable); - end loop; - end if; - - if Current_Variable = Empty_Node then - Error_Msg ("unknown variable", The_Names (Last_Name).Location); - end if; - end if; - - if Current_Variable /= Empty_Node then - Set_Expression_Kind_Of - (Variable, To => Expression_Kind_Of (Current_Variable)); - - if Kind_Of (Current_Variable) = N_Typed_Variable_Declaration then - Set_String_Type_Of - (Variable, To => String_Type_Of (Current_Variable)); - end if; - end if; - end Parse_Variable_Reference; - - --------------------------------- - -- Start_New_Case_Construction -- - --------------------------------- - - procedure Start_New_Case_Construction (String_Type : Project_Node_Id) is - Current_String : Project_Node_Id; - - begin - if Choice_First = 0 then - Choice_First := 1; - Choices.Set_Last (First_Choice_Node_Id); - else - Choice_First := Choices.Last + 1; - end if; - - if String_Type /= Empty_Node then - Current_String := First_Literal_String (String_Type); - - while Current_String /= Empty_Node loop - Add (This_String => String_Value_Of (Current_String)); - Current_String := Next_Literal_String (Current_String); - end loop; - end if; - - Choice_Lasts.Increment_Last; - Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last; - - end Start_New_Case_Construction; - - ----------- - -- Terms -- - ----------- - - procedure Terms (Term : out Project_Node_Id; - Expr_Kind : in out Variable_Kind; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) - is - Next_Term : Project_Node_Id := Empty_Node; - Term_Id : Project_Node_Id := Empty_Node; - Current_Expression : Project_Node_Id := Empty_Node; - Next_Expression : Project_Node_Id := Empty_Node; - Current_Location : Source_Ptr := No_Location; - Reference : Project_Node_Id := Empty_Node; - - begin - Term := Default_Project_Node (Of_Kind => N_Term); - Set_Location_Of (Term, To => Token_Ptr); - - case Token is - - when Tok_Left_Paren => - case Expr_Kind is - when Undefined => - Expr_Kind := List; - when List => - null; - when Single => - Expr_Kind := List; - Error_Msg - ("literal string list cannot appear in a string", - Token_Ptr); - end case; - - Term_Id := Default_Project_Node - (Of_Kind => N_Literal_String_List, - And_Expr_Kind => List); - Set_Current_Term (Term, To => Term_Id); - Set_Location_Of (Term, To => Token_Ptr); - - Scan; - if Token = Tok_Right_Paren then - Scan; - - else - loop - Current_Location := Token_Ptr; - Parse_Expression (Expression => Next_Expression, - Current_Project => Current_Project, - Current_Package => Current_Package); - - if Expression_Kind_Of (Next_Expression) = List then - Error_Msg ("single expression expected", - Current_Location); - end if; - - if Current_Expression = Empty_Node then - Set_First_Expression_In_List - (Term_Id, To => Next_Expression); - else - Set_Next_Expression_In_List - (Current_Expression, To => Next_Expression); - end if; - - Current_Expression := Next_Expression; - exit when Token /= Tok_Comma; - Scan; -- past the comma - end loop; - - Expect (Tok_Right_Paren, "("); - - if Token = Tok_Right_Paren then - Scan; - end if; - end if; - - when Tok_String_Literal => - if Expr_Kind = Undefined then - Expr_Kind := Single; - end if; - - Term_Id := Default_Project_Node (Of_Kind => N_Literal_String); - Set_Current_Term (Term, To => Term_Id); - Set_String_Value_Of (Term_Id, To => Strval (Token_Node)); - - Scan; - - when Tok_Identifier => - Current_Location := Token_Ptr; - Parse_Variable_Reference - (Variable => Reference, - Current_Project => Current_Project, - Current_Package => Current_Package); - Set_Current_Term (Term, To => Reference); - - if Reference /= Empty_Node then - if Expr_Kind = Undefined then - Expr_Kind := Expression_Kind_Of (Reference); - - elsif Expr_Kind = Single - and then Expression_Kind_Of (Reference) = List - then - Expr_Kind := List; - Error_Msg - ("list variable cannot appear in single string expression", - Current_Location); - end if; - end if; - - when Tok_Project => - Current_Location := Token_Ptr; - Scan; - Expect (Tok_Apostrophe, "'"); - - if Token = Tok_Apostrophe then - Attribute_Reference - (Reference => Reference, - First_Attribute => Prj.Attr.Attribute_First, - Current_Project => Current_Project, - Current_Package => Empty_Node); - Set_Current_Term (Term, To => Reference); - end if; - - if Reference /= Empty_Node then - if Expr_Kind = Undefined then - Expr_Kind := Expression_Kind_Of (Reference); - - elsif Expr_Kind = Single - and then Expression_Kind_Of (Reference) = List - then - Error_Msg - ("lists cannot appear in single string expression", - Current_Location); - end if; - end if; - - when Tok_External => - if Expr_Kind = Undefined then - Expr_Kind := Single; - end if; - - External_Reference (External_Value => Reference); - Set_Current_Term (Term, To => Reference); - - when others => - Error_Msg ("cannot be part of an expression", Token_Ptr); - Term := Empty_Node; - return; - end case; - - if Token = Tok_Ampersand then - Scan; - - Terms (Term => Next_Term, - Expr_Kind => Expr_Kind, - Current_Project => Current_Project, - Current_Package => Current_Package); - Set_Next_Term (Term, To => Next_Term); - - end if; - - end Terms; - -end Prj.Strt;