[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  <schonberg@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 524adfd1540e269dfcf36a667e70609416a49932..cb2acf31d61402a54fd3035148bd0b81435225aa 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2019-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <squirek@adacore.com>
 
        * 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 38fab902df8093d3c7d1d25c80d6d5e802c857f7..9e32cea6ad5144fd2ea2d15903eeb9455044de6a 100644 (file)
--- 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 d2b1c6b95caa4e9050104622c1895c3413491daa..91fa381708bb3a9e5bd8fafada1cf64e7563df9c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/predicate10.adb, gnat.dg/predicate10_pkg.adb,
+       gnat.dg/predicate10_pkg.ads: New testcase.
+
 2019-07-09  Justin Squirek  <squirek@adacore.com>
 
        * 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 (file)
index 0000000..019038d
--- /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 (file)
index 0000000..159530f
--- /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 (file)
index 0000000..e48cfe0
--- /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;