-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, 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. --
Msg_Sloc : Source_Ptr)
is
function Lt_Choice (C1, C2 : Natural) return Boolean;
- -- Comparison routine for comparing Choice_Table entries.
- -- Use the lower bound of each Choice as the key.
+ -- Comparison routine for comparing Choice_Table entries. Use the lower
+ -- bound of each Choice as the key.
procedure Move_Choice (From : Natural; To : Natural);
- -- Move routine for sorting the Choice_Table.
+ -- Move routine for sorting the Choice_Table
procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id);
procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint);
C : Int;
begin
- -- For character, or wide character. If we are in 7-bit ASCII graphic
+ -- For character, or wide [wide] character. If 7-bit ASCII graphic
-- range, then build and return appropriate character literal name
if Rtp = Standard_Character
or else Rtp = Standard_Wide_Character
+ or else Rtp = Standard_Wide_Wide_Character
then
C := UI_To_Int (Value);
if Root_Type (Choice_Type) = Standard_Character
or else
Root_Type (Choice_Type) = Standard_Wide_Character
+ or else
+ Root_Type (Choice_Type) = Standard_Wide_Wide_Character
then
Set_Character_Literal_Name (Char_Code (UI_To_Int (Value)));
Lit := New_Node (N_Character_Literal, Loc);
Set_Chars (Lit, Name_Find);
- Set_Char_Literal_Value (Lit, Char_Code (UI_To_Int (Value)));
+ Set_Char_Literal_Value (Lit, Value);
Set_Etype (Lit, Choice_Type);
Set_Is_Static_Expression (Lit, True);
return Lit;
and then Comes_From_Source (Others_Choice)
and then Is_Empty_List (Choice_List)
then
- Error_Msg_N ("?others choice is empty", Others_Choice);
+ Error_Msg_N ("?OTHERS choice is redundant", Others_Choice);
+ Error_Msg_N ("\previous choices cover all values", Others_Choice);
end if;
end Expand_Others_Choice;
Raises_CE : out Boolean;
Others_Present : out Boolean)
is
+ pragma Assert (Choice_Table'First = 1);
+
E : Entity_Id;
Enode : Node_Id;
Bounds_Lo : Uint;
Bounds_Hi : Uint;
- -- The actual bounds of the above type.
+ -- The actual bounds of the above type
Expected_Type : Entity_Id;
-- The expected type of each choice. Equal to Choice_Type, except
function Number_Of_Choices (N : Node_Id) return Nat is
Alt : Node_Id;
- -- A case statement alternative or a record variant.
+ -- A case statement alternative or a record variant
Choice : Node_Id;
Count : Nat := 0;
begin
- if not Present (Get_Alternatives (N)) then
+ if No (Get_Alternatives (N)) then
return 0;
end if;