If a procedure or entry has an formal out-parameter of a null-excluding access
type, there is no check applied to the actual before the call. This patch
removes a spurious access check on such parameters on entry calls.
Compiling and executing p.adb must yield;
Procedure version did not raise exception
Entry version did not raise exception
---
with Ada.Text_IO; use Ada.Text_IO;
procedure P is
type Integer_Access is access all Integer;
An_Integer : aliased Integer;
procedure Procedure_Version (A : out not null Integer_Access) is
begin
A := An_Integer'Access;
end Procedure_Version;
protected Object is
entry Entry_Version (A : out not null Integer_Access);
end Object;
protected body Object is
entry Entry_Version (A : out not null Integer_Access) when True is
Junk : integer := 0;
begin
A := An_Integer'Access;
end Entry_Version;
end Object;
A : Integer_Access;
begin
A := null;
Procedure_Version (A);
Put_Line ("Procedure version did not raise exception");
A := null;
Object.Entry_Version (A);
Put_Line ("Entry version did not raise exception");
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-07-29 Ed Schonberg <schonb...@adacore.com>
* exp_ch5.adb (Expand_N_Assignment_Statement): If the target type
is a null-excluding access type, do not generate a constraint
check if Suppress_Assignment_Checks is set on assignment node.
* exp_ch9.adb (Build_Simple_Entry_Call): If actual is an out
parameter of a null-excluding access type, there is access check
on entry, so set Suppress_Assignment_Checks on generated statement
that assigns actual to parameter block.
* sinfo.ads: Document additional use of Suppress_Assignment_Checks.
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 213163)
+++ exp_ch5.adb (working copy)
@@ -2001,6 +2001,7 @@
if Is_Access_Type (Typ)
and then Can_Never_Be_Null (Etype (Lhs))
and then not Can_Never_Be_Null (Etype (Rhs))
+ and then not Suppress_Assignment_Checks (N)
then
Apply_Constraint_Check (Rhs, Etype (Lhs));
end if;
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 213194)
+++ sinfo.ads (working copy)
@@ -2052,7 +2052,9 @@
-- and range checks in cases where the generated code knows that the
-- value being assigned is in range and satisfies any predicate. Also
-- can be set in N_Object_Declaration nodes, to similarly suppress any
- -- checks on the initializing value.
+ -- checks on the initializing value. In assignment statements it also
+ -- suppresses access checks in the generated code for out- and in-out
+ -- parameters in entry calls.
-- Suppress_Loop_Warnings (Flag17-Sem)
-- Used in N_Loop_Statement node to indicate that warnings within the
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 213159)
+++ exp_ch9.adb (working copy)
@@ -4755,7 +4755,8 @@
-- case of limited type. We cannot assign it unless the
-- Assignment_OK flag is set first. An out formal of an
-- access type must also be initialized from the actual,
- -- as stated in RM 6.4.1 (13).
+ -- as stated in RM 6.4.1 (13), but no constraint is applied
+ -- before the call.
if Ekind (Formal) /= E_Out_Parameter
or else Is_Access_Type (Etype (Formal))
@@ -4767,6 +4768,7 @@
Make_Assignment_Statement (Loc,
Name => N_Var,
Expression => Relocate_Node (Actual)));
+ Set_Suppress_Assignment_Checks (Last (Stats));
end if;
Append (N_Node, Decls);
