===================================================================
@@ -4711,9 +4711,7 @@ package body Exp_Attr is
function Make_Range_Test return Node_Id;
-- Build the code for a range test of the form
- -- Btyp!(Pref) >= Btyp!(Ptyp'First)
- -- and then
- -- Btyp!(Pref) <= Btyp!(Ptyp'Last)
+ -- Btyp!(Pref) in Btyp!(Ptyp'First) .. Btyp!(Ptyp'Last)
---------------------
-- Make_Range_Test --
@@ -4732,24 +4730,17 @@ package body Exp_Attr is
end if;
return
- Make_And_Then (Loc,
- Left_Opnd =>
- Make_Op_Ge (Loc,
- Left_Opnd =>
- Unchecked_Convert_To (Btyp, Temp),
-
- Right_Opnd =>
+ Make_In (Loc,
+ Left_Opnd =>
+ Unchecked_Convert_To (Btyp, Temp),
+ Right_Opnd =>
+ Make_Range (Loc,
+ Low_Bound =>
Unchecked_Convert_To (Btyp,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
- Attribute_Name => Name_First))),
-
- Right_Opnd =>
- Make_Op_Le (Loc,
- Left_Opnd =>
- Unchecked_Convert_To (Btyp, Temp),
-
- Right_Opnd =>
+ Attribute_Name => Name_First)),
+ High_Bound =>
Unchecked_Convert_To (Btyp,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
===================================================================
@@ -469,6 +469,8 @@ package body Ada.Exceptions is
(File : System.Address; Line, Column : Integer);
procedure Rcheck_05_Ext
(File : System.Address; Line, Column, Index, First, Last : Integer);
+ procedure Rcheck_06_Ext
+ (File : System.Address; Line, Column, Index, First, Last : Integer);
procedure Rcheck_12_Ext
(File : System.Address; Line, Column, Index, First, Last : Integer);
@@ -509,6 +511,7 @@ package body Ada.Exceptions is
pragma Export (C, Rcheck_00_Ext, "__gnat_rcheck_00_ext");
pragma Export (C, Rcheck_05_Ext, "__gnat_rcheck_05_ext");
+ pragma Export (C, Rcheck_06_Ext, "__gnat_rcheck_06_ext");
pragma Export (C, Rcheck_12_Ext, "__gnat_rcheck_12_ext");
-- None of these procedures ever returns (they raise an exception!). By
@@ -551,6 +554,7 @@ package body Ada.Exceptions is
pragma No_Return (Rcheck_00_Ext);
pragma No_Return (Rcheck_05_Ext);
+ pragma No_Return (Rcheck_06_Ext);
pragma No_Return (Rcheck_12_Ext);
---------------------------------------------
@@ -1236,6 +1240,17 @@ package body Ada.Exceptions is
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
end Rcheck_05_Ext;
+ procedure Rcheck_06_Ext
+ (File : System.Address; Line, Column, Index, First, Last : Integer)
+ is
+ Msg : constant String :=
+ Rmsg_06 (Rmsg_06'First .. Rmsg_06'Last - 1) & ASCII.LF &
+ "value " & Image (Index) & " not in " & Image (First) &
+ ".." & Image (Last) & ASCII.NUL;
+ begin
+ Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
+ end Rcheck_06_Ext;
+
procedure Rcheck_12_Ext
(File : System.Address; Line, Column, Index, First, Last : Integer)
is
===================================================================
@@ -482,8 +482,9 @@ gigi (Node_Id gnat_root, int max_gnat_no
gnat_raise_decls_ext[i]
= build_raise_check (i, t,
i == CE_Index_Check_Failed
- || i == CE_Range_Check_Failed ?
- exception_range : exception_column);
+ || i == CE_Range_Check_Failed
+ || i == CE_Invalid_Data
+ ? exception_range : exception_column);
}
/* Set the types that GCC and Gigi use from the front end. */
@@ -5518,7 +5519,8 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = build_call_raise_column (reason, gnat_node);
}
else if ((reason == CE_Index_Check_Failed
- || reason == CE_Range_Check_Failed)
+ || reason == CE_Range_Check_Failed
+ || reason == CE_Invalid_Data)
&& Nkind (cond) == N_Op_Not
&& Nkind (Right_Opnd (cond)) == N_In
&& Nkind (Right_Opnd (Right_Opnd (cond))) == N_Range)