From 5e0f7ab2fb33372f298ad9333dd2dd2e44cf01cc Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 9 Jul 2019 07:55:38 +0000 Subject: [PATCH] [Ada] Access to uninitialized memory by predicate check This patch fixes an exception or erroneous execution, when the declaration for an object of a composite type that has a dynanic predicate is initialized with an aggregate that requires expansion into individual components. Prior to this patch the predicate check for the object appeared before intialization was performed, thus accessing uninitialized memory. 2019-07-09 Ed Schonberg gcc/ada/ * sem_ch3.adb (Analyze_Object_Declaration): If the object type is a composite type that has a dynamic predicate and, the expression in the declaration is an aggregate, the generated predicate check must appear after the expanded code for the aggregate, which will appear after the rewritten object declarastion. gcc/testsuite/ * gnat.dg/predicate10.adb, gnat.dg/predicate10_pkg.adb, gnat.dg/predicate10_pkg.ads: New testcase. From-SVN: r273293 --- gcc/ada/ChangeLog | 9 ++++++++ gcc/ada/sem_ch3.adb | 28 +++++++++++++++++++---- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gnat.dg/predicate10.adb | 9 ++++++++ gcc/testsuite/gnat.dg/predicate10_pkg.adb | 10 ++++++++ gcc/testsuite/gnat.dg/predicate10_pkg.ads | 13 +++++++++++ 6 files changed, 70 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/predicate10.adb create mode 100644 gcc/testsuite/gnat.dg/predicate10_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/predicate10_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 524adfd1540..cb2acf31d61 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-07-09 Ed Schonberg + + * sem_ch3.adb (Analyze_Object_Declaration): If the object type + is a composite type that has a dynamic predicate and, the + expression in the declaration is an aggregate, the generated + predicate check must appear after the expanded code for the + aggregate, which will appear after the rewritten object + declarastion. + 2019-07-09 Justin Squirek * sem_eval.adb (Expr_Value_E): Add conditional to correctly diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 38fab902df8..9e32cea6ad5 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3649,8 +3649,10 @@ package body Sem_Ch3 is -- Ghost mode. procedure Analyze_Object_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Id : constant Entity_Id := Defining_Identifier (N); + Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Identifier (N); + Next_Decl : constant Node_Id := Next (N); + Act_T : Entity_Id; T : Entity_Id; @@ -3912,6 +3914,11 @@ package body Sem_Ch3 is A_Id := Get_Aspect_Id (Chars (Identifier (A))); while Present (A) loop if A_Id = Aspect_Alignment or else A_Id = Aspect_Address then + + -- Set flag on object entity, for later processing at + -- the freeze point. + + Set_Has_Delayed_Aspects (Id); return True; end if; @@ -4495,8 +4502,21 @@ package body Sem_Ch3 is null; else - Insert_After (N, - Make_Predicate_Check (T, New_Occurrence_Of (Id, Loc))); + -- The check must be inserted after the expanded aggregate + -- expansion code, if any. + + declare + Check : constant Node_Id := + Make_Predicate_Check (T, New_Occurrence_Of (Id, Loc)); + + begin + if No (Next_Decl) then + Append_To (List_Containing (N), Check); + + else + Insert_Before (Next_Decl, Check); + end if; + end; end if; end if; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d2b1c6b95ca..91fa381708b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-09 Ed Schonberg + + * gnat.dg/predicate10.adb, gnat.dg/predicate10_pkg.adb, + gnat.dg/predicate10_pkg.ads: New testcase. + 2019-07-09 Justin Squirek * gnat.dg/image1.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/predicate10.adb b/gcc/testsuite/gnat.dg/predicate10.adb new file mode 100644 index 00000000000..019038d55cc --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate10.adb @@ -0,0 +1,9 @@ +-- { dg-do run } + +with Predicate10_Pkg; use Predicate10_Pkg; + +procedure Predicate10 is + X : I_Pointer := new Integer'(0); +begin + Foo (1, X); +end; diff --git a/gcc/testsuite/gnat.dg/predicate10_pkg.adb b/gcc/testsuite/gnat.dg/predicate10_pkg.adb new file mode 100644 index 00000000000..159530f2e0b --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate10_pkg.adb @@ -0,0 +1,10 @@ +package body Predicate10_Pkg is + procedure Foo ( + Length : Natural; + Initial : I_Pointer + ) is + A : NI_Array := (1 .. Length => Initial); + begin + null; + end Foo; +end; diff --git a/gcc/testsuite/gnat.dg/predicate10_pkg.ads b/gcc/testsuite/gnat.dg/predicate10_pkg.ads new file mode 100644 index 00000000000..e48cfe03612 --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate10_pkg.ads @@ -0,0 +1,13 @@ +package Predicate10_Pkg is + type I_Array is array (Positive range <>) of access Integer; + + subtype NI_Array is I_Array with Dynamic_Predicate => + (for all I of NI_Array => I /= null); + + type I_Pointer is access Integer; + + procedure Foo ( + Length : Natural; + Initial : I_Pointer + ); +end; -- 2.30.2