+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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
- -- <project>.<package>, <project>.<variable> or <package>.<variable>.
- -- 3 simple names are for <project>.<package>.<variable>.
-
- 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;
projects / msp430-gcc.git / blobdiff