Choices_Initial : constant := 10;
Choices_Increment : constant := 100;
+ -- These should be in alloc.ads
Choice_Node_Low_Bound : constant := 0;
Choice_Node_High_Bound : constant := 099_999_999;
(Reference, In_Tree, To => Variable_Kind_Of (Current_Attribute));
Set_Case_Insensitive
(Reference, In_Tree,
- To => Attribute_Kind_Of (Current_Attribute) =
- Case_Insensitive_Associative_Array);
+ To => Attribute_Kind_Of (Current_Attribute) in
+ Case_Insensitive_Associative_Array ..
+ Optional_Index_Case_Insensitive_Associative_Array);
-- Scan past the attribute name
Choice_First := 0;
elsif Choice_Lasts.Last = 2 then
- -- This is the second case onstruction, set the tables to the first
+
+ -- This is the second case construction, set the tables to the first
Choice_Lasts.Set_Last (1);
Choices.Set_Last (Choice_Lasts.Table (1));
case Token is
when Tok_Right_Paren =>
-
- -- Scan past the right parenthesis
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past right paren
when Tok_Comma =>
-
- -- Scan past the comma
-
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past comma
-- Get the string expression for the default
Expect (Tok_Right_Paren, "`)`");
- -- Scan past the right parenthesis
-
if Token = Tok_Right_Paren then
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past right paren
end if;
when others =>
Found := False;
for Choice in Choice_First .. Choices.Last loop
if Choices.Table (Choice).The_String = Choice_String then
+
-- This label is part of the string type
Found := True;
if Choices.Table (Choice).Already_Used then
+
-- But it has already appeared in a choice list for this
- -- case construction; report an error.
+ -- case construction so report an error.
Error_Msg_Name_1 := Choice_String;
Error_Msg ("duplicate case label %%", Token_Ptr);
+
else
Choices.Table (Choice).Already_Used := True;
end if;
-- If there is no '|', we are done
if Token = Tok_Vertical_Bar then
+
-- Otherwise, declare the node of the next choice, link it to
-- Current_Choice and set Current_Choice to this new node.
begin
while Current /= Last_String loop
if String_Value_Of (Current, In_Tree) = String_Value then
+
-- This is a repetition, report an error
Error_Msg_Name_1 := String_Value;
-- Now, look if it can be a project name
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree, Names.Table (1).Name);
+ if Names.Table (1).Name =
+ Name_Of (Current_Project, In_Tree)
+ then
+ The_Project := Current_Project;
+
+ else
+ The_Project :=
+ Imported_Or_Extended_Project_Of
+ (Current_Project, In_Tree, Names.Table (1).Name);
+ end if;
if The_Project = Empty_Node then
+
-- If it is neither a project name nor a package name,
- -- report an error
+ -- report an error.
if First_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Names.Table (1).Name;
First_Attribute := Attribute_First;
else
- -- If it is a package name, check if the package
- -- has already been declared in the current project.
+ -- If it is a package name, check if the package has
+ -- already been declared in the current project.
The_Package :=
First_Package_Of (Current_Project, In_Tree);
while The_Package /= Empty_Node
and then Name_Of (The_Package, In_Tree) /=
- Names.Table (1).Name
+ Names.Table (1).Name
loop
The_Package :=
Next_Package_In_Project (The_Package, In_Tree);
-- Check if the long project is imported or extended
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree, Long_Project);
+ if Long_Project = Name_Of (Current_Project, In_Tree) then
+ The_Project := Current_Project;
+
+ else
+ The_Project :=
+ Imported_Or_Extended_Project_Of
+ (Current_Project,
+ In_Tree,
+ Long_Project);
+ end if;
-- If the long project exists, then this is the prefix
-- of the attribute.
-- Otherwise, check if the short project is imported
-- or extended.
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree,
- Short_Project);
+ if Short_Project =
+ Name_Of (Current_Project, In_Tree)
+ then
+ The_Project := Current_Project;
- -- If the short project does not exist, we report an
- -- error.
+ else
+ The_Project := Imported_Or_Extended_Project_Of
+ (Current_Project, In_Tree,
+ Short_Project);
+ end if;
+
+ -- If short project does not exist, report an error
if The_Project = Empty_Node then
Error_Msg_Name_1 := Long_Project;
case Names.Last is
when 0 =>
- -- Cannot happen
+ -- Cannot happen (so why null instead of raise PE???)
null;
-- First check for a possible project name
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree, Short_Project);
+ The_Project :=
+ Imported_Or_Extended_Project_Of
+ (Current_Project, In_Tree, Short_Project);
if The_Project = Empty_Node then
-- Unknown prefix, report an error
Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project;
- Error_Msg ("unknown projects % or %",
- Names.Table (1).Location);
+ Error_Msg
+ ("unknown projects % or %",
+ Names.Table (1).Location);
Look_For_Variable := False;
else
end loop;
if The_Package = Empty_Node then
- -- The package does not vexist, report an error
+
+ -- The package does not exist, report an error
Error_Msg_Name_1 := Names.Table (2).Name;
Error_Msg ("unknown package %",
if Specified_Project /= Empty_Node then
The_Project := Specified_Project;
-
else
The_Project := Current_Project;
end if;
if Specified_Package /= Empty_Node then
Current_Variable :=
First_Variable_Of (Specified_Package, In_Tree);
-
while Current_Variable /= Empty_Node
and then
Name_Of (Current_Variable, In_Tree) /= Variable_Name
then
Current_Variable :=
First_Variable_Of (Current_Package, In_Tree);
-
while Current_Variable /= Empty_Node
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop
if Current_Variable = Empty_Node then
Current_Variable := First_Variable_Of (The_Project, In_Tree);
-
while Current_Variable /= Empty_Node
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop
(Variable, In_Tree,
To => Expression_Kind_Of (Current_Variable, In_Tree));
- if
- Kind_Of (Current_Variable, In_Tree) = N_Typed_Variable_Declaration
+ if Kind_Of (Current_Variable, In_Tree) =
+ N_Typed_Variable_Declaration
then
Set_String_Type_Of
(Variable, In_Tree,
Current_String : Project_Node_Id;
begin
- -- Set Choice_First, depending on whether is the first case
+ -- Set Choice_First, depending on whether this is the first case
-- construction or not.
if Choice_First = 0 then
Choice_First := Choices.Last + 1;
end if;
- -- Add to table Choices the literal of the string type
+ -- Add the literal of the string type to the Choices table
if String_Type /= Empty_Node then
Current_String := First_Literal_String (String_Type, In_Tree);
-
while Current_String /= Empty_Node loop
Add (This_String => String_Value_Of (Current_String, In_Tree));
Current_String := Next_Literal_String (Current_String, In_Tree);
Choice_Lasts.Increment_Last;
Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last;
-
end Start_New_Case_Construction;
-----------
Scan (In_Tree);
else
- -- Otherwise, we parse the expression(s) in the literal string
- -- list.
+ -- Otherwise parse the expression(s) in the literal string list
loop
Current_Location := Token_Ptr;
when Tok_Project =>
- -- project can appear in an expression as the prefix of an
+ -- Project can appear in an expression as the prefix of an
-- attribute reference of the current project.
Current_Location := Token_Ptr;
end if;
when Tok_External =>
+
-- An external reference is always a single string
if Expr_Kind = Undefined then
-- If there is an '&', call Terms recursively
if Token = Tok_Ampersand then
-
- -- Scan past the '&'
-
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past ampersand
Terms
(In_Tree => In_Tree,
OSDN Git Service
