-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, 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- --
(In_Tree : Project_Node_Tree_Ref;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
- External_Value : out Project_Node_Id);
+ External_Value : out Project_Node_Id;
+ Flags : Processing_Flags);
-- 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);
+ Current_Package : Project_Node_Id;
+ Flags : Processing_Flags);
-- Parse an attribute reference. Current token is an apostrophe
procedure Terms
Expr_Kind : in out Variable_Kind;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
- Optional_Index : Boolean);
+ Optional_Index : Boolean;
+ Flags : Processing_Flags);
-- Recursive procedure to parse one term or several terms concatenated
-- using "&".
Reference : out Project_Node_Id;
First_Attribute : Attribute_Node_Id;
Current_Project : Project_Node_Id;
- Current_Package : Project_Node_Id)
+ Current_Package : Project_Node_Id;
+ Flags : Processing_Flags)
is
Current_Attribute : Attribute_Node_Id := First_Attribute;
if Current_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Token_Name;
- Error_Msg ("unknown attribute %%", Token_Ptr);
+ Error_Msg (Flags, "unknown attribute %%", Token_Ptr);
Reference := Empty_Node;
-- Scan past the attribute name
procedure End_Case_Construction
(Check_All_Labels : Boolean;
- Case_Location : Source_Ptr)
+ Case_Location : Source_Ptr;
+ Flags : Processing_Flags)
is
Non_Used : Natural := 0;
First_Non_Used : Choice_Node_Id := First_Choice_Node_Id;
if Non_Used = 1 then
Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
- Error_Msg ("?value %% is not used as label", Case_Location);
+ Error_Msg (Flags, "?value %% is not used as label", Case_Location);
-- If several are not used, report a warning for each one of them
elsif Non_Used > 1 then
Error_Msg
- ("?the following values are not used as labels:",
+ (Flags, "?the following values are not used as labels:",
Case_Location);
for Choice in First_Non_Used .. Choices.Last loop
if not Choices.Table (Choice).Already_Used then
Error_Msg_Name_1 := Choices.Table (Choice).The_String;
- Error_Msg ("\?%%", Case_Location);
+ Error_Msg (Flags, "\?%%", Case_Location);
end if;
end loop;
end if;
(In_Tree : Project_Node_Tree_Ref;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
- External_Value : out Project_Node_Id)
+ External_Value : out Project_Node_Id;
+ Flags : Processing_Flags)
is
Field_Id : Project_Node_Id := Empty_Node;
Parse_Expression
(In_Tree => In_Tree,
Expression => Field_Id,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
Optional_Index => False);
if Expression_Kind_Of (Field_Id, In_Tree) = List then
- Error_Msg ("expression must be a single string", Loc);
+ Error_Msg
+ (Flags, "expression must be a single string", Loc);
else
Set_External_Default_Of
(External_Value, In_Tree, To => Field_Id);
end if;
when others =>
- Error_Msg ("`,` or `)` expected", Token_Ptr);
+ Error_Msg (Flags, "`,` or `)` expected", Token_Ptr);
end case;
end if;
end External_Reference;
procedure Parse_Choice_List
(In_Tree : Project_Node_Tree_Ref;
- First_Choice : out Project_Node_Id)
+ First_Choice : out Project_Node_Id;
+ Flags : Processing_Flags)
is
Current_Choice : Project_Node_Id := Empty_Node;
Next_Choice : Project_Node_Id := Empty_Node;
-- case construction so report an error.
Error_Msg_Name_1 := Choice_String;
- Error_Msg ("duplicate case label %%", Token_Ptr);
+ Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
else
Choices.Table (Choice).Already_Used := True;
if not Found then
Error_Msg_Name_1 := Choice_String;
- Error_Msg ("illegal case label %%", Token_Ptr);
+ Error_Msg (Flags, "illegal case label %%", Token_Ptr);
end if;
-- Scan past the label
Expression : out Project_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
- Optional_Index : Boolean)
+ Optional_Index : Boolean;
+ Flags : Processing_Flags)
is
First_Term : Project_Node_Id := Empty_Node;
Expression_Kind : Variable_Kind := Undefined;
Terms (In_Tree => In_Tree,
Term => First_Term,
Expr_Kind => Expression_Kind,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
Optional_Index => Optional_Index);
procedure Parse_String_Type_List
(In_Tree : Project_Node_Tree_Ref;
- First_String : out Project_Node_Id)
+ First_String : out Project_Node_Id;
+ Flags : Processing_Flags)
is
Last_String : Project_Node_Id := Empty_Node;
Next_String : Project_Node_Id := Empty_Node;
-- This is a repetition, report an error
Error_Msg_Name_1 := String_Value;
- Error_Msg ("duplicate value %% in type", Token_Ptr);
+ Error_Msg (Flags, "duplicate value %% in type", Token_Ptr);
exit;
end if;
(In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id;
Current_Project : Project_Node_Id;
- Current_Package : Project_Node_Id)
+ Current_Package : Project_Node_Id;
+ Flags : Processing_Flags)
is
Current_Variable : Project_Node_Id := Empty_Node;
if First_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Names.Table (1).Name;
- Error_Msg ("unknown project %",
+ Error_Msg (Flags, "unknown project %",
Names.Table (1).Location);
First_Attribute := Attribute_First;
if No (The_Package) then
Error_Msg_Name_1 := Names.Table (1).Name;
- Error_Msg ("package % not yet defined",
+ Error_Msg (Flags, "package % not yet defined",
Names.Table (1).Location);
end if;
end if;
if No (The_Project) then
Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project;
- Error_Msg ("unknown projects % or %",
+ Error_Msg (Flags, "unknown projects % or %",
Names.Table (1).Location);
The_Package := Empty_Node;
First_Attribute := Attribute_First;
Error_Msg_Name_1 :=
Names.Table (Names.Last).Name;
Error_Msg_Name_2 := Short_Project;
- Error_Msg ("package % not declared in project %",
+ Error_Msg (Flags,
+ "package % not declared in project %",
Names.Table (Names.Last).Location);
First_Attribute := Attribute_First;
Attribute_Reference
(In_Tree,
Variable,
+ Flags => Flags,
Current_Project => The_Project,
Current_Package => The_Package,
First_Attribute => First_Attribute);
elsif No (The_Package) then
Error_Msg_Name_1 := Names.Table (1).Name;
- Error_Msg ("unknown package or project %",
+ Error_Msg (Flags, "unknown package or project %",
Names.Table (1).Location);
Look_For_Variable := False;
Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project;
Error_Msg
- ("unknown projects % or %",
+ (Flags, "unknown projects % or %",
Names.Table (1).Location);
Look_For_Variable := False;
-- The package does not exist, report an error
Error_Msg_Name_1 := Names.Table (2).Name;
- Error_Msg ("unknown package %",
+ Error_Msg (Flags, "unknown package %",
Names.Table (Names.Last - 1).Location);
Look_For_Variable := False;
if No (Current_Variable) then
Error_Msg_Name_1 := Variable_Name;
Error_Msg
- ("unknown variable %", Names.Table (Names.Last).Location);
+ (Flags, "unknown variable %", Names.Table (Names.Last).Location);
end if;
end if;
-- but attempt to scan the index.
if Token = Tok_Left_Paren then
- Error_Msg ("\variables cannot be associative arrays", Token_Ptr);
+ Error_Msg
+ (Flags, "\variables cannot be associative arrays", Token_Ptr);
Scan (In_Tree);
Expect (Tok_String_Literal, "literal string");
Expr_Kind : in out Variable_Kind;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
- Optional_Index : Boolean)
+ Optional_Index : Boolean;
+ Flags : Processing_Flags)
is
Next_Term : Project_Node_Id := Empty_Node;
Term_Id : Project_Node_Id := Empty_Node;
Expr_Kind := List;
Error_Msg
- ("literal string list cannot appear in a string",
+ (Flags, "literal string list cannot appear in a string",
Token_Ptr);
end case;
Parse_Expression
(In_Tree => In_Tree,
Expression => Next_Expression,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
Optional_Index => Optional_Index);
-- The expression kind is String list, report an error
if Expression_Kind_Of (Next_Expression, In_Tree) = List then
- Error_Msg ("single expression expected",
+ Error_Msg (Flags, "single expression expected",
Current_Location);
end if;
if Token = Tok_At then
if not Optional_Index then
- Error_Msg ("index not allowed here", Token_Ptr);
+ Error_Msg (Flags, "index not allowed here", Token_Ptr);
Scan (In_Tree);
if Token = Tok_Integer_Literal then
Index : constant Int := UI_To_Int (Int_Literal_Value);
begin
if Index = 0 then
- Error_Msg ("index cannot be zero", Token_Ptr);
+ Error_Msg
+ (Flags, "index cannot be zero", Token_Ptr);
else
Set_Source_Index_Of
(Term_Id, In_Tree, To => Index);
Parse_Variable_Reference
(In_Tree => In_Tree,
Variable => Reference,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package);
Set_Current_Term (Term, In_Tree, To => Reference);
Expr_Kind := List;
Error_Msg
- ("list variable cannot appear in single string expression",
+ (Flags,
+ "list variable cannot appear in single string expression",
Current_Location);
end if;
end if;
Attribute_Reference
(In_Tree => In_Tree,
Reference => Reference,
+ Flags => Flags,
First_Attribute => Prj.Attr.Attribute_First,
Current_Project => Current_Project,
Current_Package => Empty_Node);
and then Expression_Kind_Of (Reference, In_Tree) = List
then
Error_Msg
- ("lists cannot appear in single string expression",
+ (Flags, "lists cannot appear in single string expression",
Current_Location);
end if;
end if;
External_Reference
(In_Tree => In_Tree,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
External_Value => Reference);
Set_Current_Term (Term, In_Tree, To => Reference);
when others =>
- Error_Msg ("cannot be part of an expression", Token_Ptr);
+ Error_Msg (Flags, "cannot be part of an expression", Token_Ptr);
Term := Empty_Node;
return;
end case;
(In_Tree => In_Tree,
Term => Next_Term,
Expr_Kind => Expr_Kind,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
Optional_Index => Optional_Index);
OSDN Git Service
