OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exp_ch4.adb (Raise_Accessibility_Error): New procedure

Browse Source 
2009-07-10  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Raise_Accessibility_Error): New procedure

From-SVN: r149463
This commit is contained in:
Robert Dewar 2009-07-10 11:11:16 +02:00 committed by Arnaud Charlet
parent 1ded1a1fae
commit 426908f87a
1 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/ada/exp_ch4.adb
View File

@ -7519,6 +7519,11 @@ package body Exp_Ch4 is
-- assignment to temporary. If there is no change of representation,
-- then the conversion node is unchanged.
procedure Raise_Accessibility_Error;
-- Called when we know that an accessibility check will fail. Rewrites
-- node N to an appropriate raise statement and outputs warning msgs.
-- The Etype of the raise node is set to Target_Type.
procedure Real_Range_Check;
-- Handles generation of range check for real target value
@ -7648,6 +7653,22 @@ package body Exp_Ch4 is
end if;
end Handle_Changed_Representation;
-------------------------------
-- Raise_Accessibility_Error --
-------------------------------
procedure Raise_Accessibility_Error is
begin
Rewrite (N,
Make_Raise_Program_Error (Sloc (N),
Reason => PE_Accessibility_Check_Failed));
Set_Etype (N, Target_Type);
Error_Msg_N ("?accessibility check failure", N);
Error_Msg_NE
("\?& will be raised at run time", N, Standard_Program_Error);
end Raise_Accessibility_Error;
----------------------
-- Real_Range_Check --
----------------------
@ -7884,10 +7905,7 @@ package body Exp_Ch4 is
and then Type_Access_Level (Operand_Type) >
Type_Access_Level (Target_Type)
then
Rewrite (N,
Make_Raise_Program_Error (Sloc (N),
Reason => PE_Accessibility_Check_Failed));
Set_Etype (N, Target_Type);
Raise_Accessibility_Error;
-- When the operand is a selected access discriminant the check needs
-- to be made against the level of the object denoted by the prefix
@ -7901,11 +7919,7 @@ package body Exp_Ch4 is
and then Object_Access_Level (Operand) >
Type_Access_Level (Target_Type)
then
Rewrite (N,
Make_Raise_Program_Error (Sloc (N),
Reason => PE_Accessibility_Check_Failed));
Set_Etype (N, Target_Type);
Raise_Accessibility_Error;
return;
end if;
end if;