-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2007, 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- --
-- 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. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Err_Vars; use Err_Vars;
-with Namet; use Namet;
-with Prj.Attr; use Prj.Attr;
-with Prj.Err; use Prj.Err;
-with Prj.Tree; use Prj.Tree;
-with Scans; use Scans;
+with Err_Vars; use Err_Vars;
+with Prj.Attr; use Prj.Attr;
+with Prj.Err; use Prj.Err;
with Snames;
with Table;
-with Types; use Types;
-with Uintp; use Uintp;
+with Uintp; use Uintp;
package body Prj.Strt is
-- been used (to avoid duplicate case labels).
Choices_Initial : constant := 10;
- Choices_Increment : constant := 50;
+ Choices_Increment : constant := 100;
Choice_Node_Low_Bound : constant := 0;
Choice_Node_High_Bound : constant := 099_999_999;
Choice_Node_Low_Bound;
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.
+ new Table.Table
+ (Table_Component_Type => Choice_String,
+ Table_Index_Type => Choice_Node_Id'Base,
+ 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 => 10,
- Table_Increment => 100,
- Table_Name => "Prj.Strt.Choice_Lasts");
+ new Table.Table
+ (Table_Component_Type => Choice_Node_Id,
+ Table_Index_Type => Nat,
+ Table_Low_Bound => 1,
+ Table_Initial => 10,
+ Table_Increment => 100,
+ Table_Name => "Prj.Strt.Choice_Lasts");
-- Used to store the indices of the choices in table Choices,
-- to distinguish nested case constructions.
-- Store the identifier and the location of a simple name
package Names is
- new Table.Table (Table_Component_Type => Name_Location,
- Table_Index_Type => Nat,
- Table_Low_Bound => 1,
- Table_Initial => 10,
- Table_Increment => 100,
- Table_Name => "Prj.Strt.Names");
+ new Table.Table
+ (Table_Component_Type => Name_Location,
+ Table_Index_Type => Nat,
+ Table_Low_Bound => 1,
+ Table_Initial => 10,
+ Table_Increment => 100,
+ Table_Name => "Prj.Strt.Names");
-- Used to accumulate the single names of a name
procedure Add (This_String : Name_Id);
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
External_Value : out Project_Node_Id);
- -- Parse an external reference. Current token is "external".
+ -- Parse an external reference. Current token is "external"
procedure Attribute_Reference
(In_Tree : Project_Node_Tree_Ref;
First_Attribute : Attribute_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id);
- -- Parse an attribute reference. Current token is an apostrophe.
+ -- Parse an attribute reference. Current token is an apostrophe
procedure Terms
(In_Tree : Project_Node_Tree_Ref;
if Current_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Token_Name;
- Error_Msg ("unknown attribute %", Token_Ptr);
+ Error_Msg ("unknown attribute %%", Token_Ptr);
Reference := Empty_Node;
-- Scan past the attribute name
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 ("?value %% is not used as label", Case_Location);
-- If several are not used, report a warning for each one of them
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 ("\?%%", Case_Location);
end if;
end loop;
end if;
-- case construction; report an error.
Error_Msg_Name_1 := Choice_String;
- Error_Msg ("duplicate case label {", Token_Ptr);
+ Error_Msg ("duplicate case label %%", Token_Ptr);
else
Choices.Table (Choice).Already_Used := True;
end if;
if not Found then
Error_Msg_Name_1 := Choice_String;
- Error_Msg ("illegal case label {", Token_Ptr);
+ Error_Msg ("illegal case label %%", Token_Ptr);
end if;
-- Scan past the label
-- This is a repetition, report an error
Error_Msg_Name_1 := String_Value;
- Error_Msg ("duplicate value { in type", Token_Ptr);
+ Error_Msg ("duplicate value %% in type", Token_Ptr);
exit;
end if;
OSDN Git Service
