* [Ada] Missing check on outbound parameter of a non-null access type
@ 2019-08-12 9:10 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2019-08-12 9:10 UTC (permalink / raw)
To: gcc-patches; +Cc: Ed Schonberg
[-- Attachment #1: Type: text/plain, Size: 761 bytes --]
This patch adds code to generate proper post-call checks when an actual
for an in-out or out parameter has a non-null access type. No
constraints are applied to an inbound access parameter, but on exit a
not-null check must be performed if the type of the actual requires it.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-08-12 Ed Schonberg <schonberg@adacore.com>
gcc/ada/
* exp_ch6.adb (Expand_Actuals. Add_Call_By_Copy_Code): Add code
to generate proper checks when an actual for an in-out or out
parameter has a non-null access type. No constraints are
applied to an inbound access parameter, but on exit a not-null
check must be performed if the type of the actual requires it.
gcc/testsuite/
* gnat.dg/null_check.adb: New testcase.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3228 bytes --]
--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -1406,6 +1406,16 @@ package body Exp_Ch6 is
Init := New_Occurrence_Of (Var, Loc);
end if;
+ -- Access types are passed in without checks, but if a copy-back is
+ -- required for a null-excluding check on an in-out or out parameter,
+ -- then the initial value is that of the actual.
+
+ elsif Is_Access_Type (E_Formal)
+ and then Can_Never_Be_Null (Etype (Actual))
+ and then not Can_Never_Be_Null (E_Formal)
+ then
+ Init := New_Occurrence_Of (Var, Loc);
+
else
Init := Empty;
end if;
@@ -1544,6 +1554,19 @@ package body Exp_Ch6 is
Type_Access_Level (E_Formal))));
else
+ if Is_Access_Type (E_Formal)
+ and then Can_Never_Be_Null (Etype (Actual))
+ and then not Can_Never_Be_Null (E_Formal)
+ then
+ Append_To (Post_Call,
+ Make_Raise_Constraint_Error (Loc,
+ Condition =>
+ Make_Op_Eq (Loc,
+ Left_Opnd => New_Occurrence_Of (Temp, Loc),
+ Right_Opnd => Make_Null (Loc)),
+ Reason => CE_Access_Check_Failed));
+ end if;
+
Append_To (Post_Call,
Make_Assignment_Statement (Loc,
Name => Lhs,
@@ -1942,7 +1965,8 @@ package body Exp_Ch6 is
Apply_Constraint_Check (Actual, E_Formal);
-- Out parameter case. No constraint checks on access type
- -- RM 6.4.1 (13)
+ -- RM 6.4.1 (13), but on return a null-excluding check may be
+ -- required (see below).
elsif Is_Access_Type (E_Formal) then
null;
@@ -2049,11 +2073,14 @@ package body Exp_Ch6 is
-- formal subtype are not the same, requiring a check.
-- It is necessary to exclude tagged types because of "downward
- -- conversion" errors.
+ -- conversion" errors, but null-excluding checks on return may be
+ -- required.
elsif Is_Access_Type (E_Formal)
- and then not Same_Type (E_Formal, E_Actual)
and then not Is_Tagged_Type (Designated_Type (E_Formal))
+ and then (not Same_Type (E_Formal, E_Actual)
+ or else (Can_Never_Be_Null (E_Actual)
+ and then not Can_Never_Be_Null (E_Formal)))
then
Add_Call_By_Copy_Code;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/null_check.adb
@@ -0,0 +1,19 @@
+-- { dg-do run }
+
+procedure Null_Check with SPARK_Mode is
+ type Int_Ptr is access Integer;
+ subtype Not_Null_Int_Ptr is not null Int_Ptr;
+
+ procedure Set_To_Null (X : out Int_Ptr) with Global => null is
+ begin
+ X := null;
+ end Set_To_Null;
+
+ X : Not_Null_Int_Ptr := new Integer'(12);
+begin
+ Set_To_Null (X);
+ raise Program_Error;
+exception
+ when Constraint_Error =>
+ null;
+end Null_Check;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2019-08-12 9:10 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-08-12 9:10 [Ada] Missing check on outbound parameter of a non-null access type Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).