From 0a3763018e63de8cee68d98f877221275adb42bc Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Thu, 11 Apr 2013 15:26:40 +0000 Subject: [PATCH] check.ads, [...] (Install_Null_Excluding_Check): No check in interface thunks since it is performed at the caller side. 2013-04-11 Javier Miranda * check.ads, exp_ch6.adb (Install_Null_Excluding_Check): No check in interface thunks since it is performed at the caller side. (Expand_Simple_Function_Return): No accessibility check needed in thunks since the check is done by the target routine. From-SVN: r197810 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/checks.adb | 7 +++++++ gcc/ada/exp_ch6.adb | 4 ++++ 3 files changed, 18 insertions(+) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a691ec2168d2..53784aa47331 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2013-04-11 Javier Miranda + + * check.ads, exp_ch6.adb (Install_Null_Excluding_Check): No check in + interface thunks since it is performed at the caller side. + (Expand_Simple_Function_Return): No accessibility check needed in thunks + since the check is done by the target routine. + 2013-04-11 Ed Schonberg * sem_prag.adb (Analyze_Pragma, case Priority): pre-analyze diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 640f0127c3cb..39325af1e252 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6583,6 +6583,13 @@ package body Checks is return; end if; + -- No check needed in interface thunks since the runtime check is + -- already performed at the caller side. + + if Is_Thunk (Current_Scope) then + return; + end if; + -- No check needed for the Get_Current_Excep.all.all idiom generated by -- the expander within exception handlers, since we know that the value -- can never be null. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 85dc076bacd6..5c5c809e880f 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7485,12 +7485,16 @@ package body Exp_Ch6 is -- return expression has a specific type whose level is known not to -- be statically deeper than the function's result type. + -- No runtime check needed in interface thunks since it is performed + -- by the target primitive associated with the thunk. + -- Note: accessibility check is skipped in the VM case, since there -- does not seem to be any practical way to implement this check. elsif Ada_Version >= Ada_2005 and then Tagged_Type_Expansion and then Is_Class_Wide_Type (R_Type) + and then not Is_Thunk (Current_Scope) and then not Scope_Suppress.Suppress (Accessibility_Check) and then (Is_Class_Wide_Type (Etype (Exp)) -- 2.43.5