[Ada] Build-in-place aggregates and Address clauses

This patch fixes a bug in which if a limited volatile variable with
an Address aspect is initialized with a build-in-place aggregate
containing build-in-place function calls, the compiler can crash.

2018-05-23  Bob Duff  <duff@adacore.com>

gcc/ada/

	* freeze.adb: (Check_Address_Clause): Deal with build-in-place
	aggregates in addition to build-in-place calls.

gcc/testsuite/

	* gnat.dg/addr10.adb: New testcase.

From-SVN: r260574

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 98720a392a2194bc7a925c887554f99e796bd0b9..f9ad15908a6d98cda4f306bbe2e2005362cf1977 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-05-23  Bob Duff  <duff@adacore.com>
+
+       * freeze.adb: (Check_Address_Clause): Deal with build-in-place
+       aggregates in addition to build-in-place calls.
+
 2018-05-23  Bob Duff  <duff@adacore.com>
 
        * einfo.ads: Minor reformatting.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 66f9dcca62cecaa066bef46980a14ee02dde279a..032dcf516f8bf269b3e83eddcf5081d13b503b23 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -710,13 +710,12 @@ package body Freeze is
             end;
          end if;
 
-         --  Remove side effects from initial expression, except in the case
-         --  of a build-in-place call, which has its own later expansion.
+         --  Remove side effects from initial expression, except in the case of
+         --  limited build-in-place calls and aggregates, which have their own
+         --  expansion elsewhere. This exception is necessary to avoid copying
+         --  limited objects.
 
-         if Present (Init)
-           and then (Nkind (Init) /= N_Function_Call
-                      or else not Is_Expanded_Build_In_Place_Call (Init))
-         then
+         if Present (Init) and then not Is_Limited_View (Typ) then
             --  Capture initialization value at point of declaration, and make
             --  explicit assignment legal, because object may be a constant.
 
@@ -735,7 +734,7 @@ package body Freeze is
 
             Set_No_Initialization (Decl);
 
-            --  If the objet is tagged, check whether the tag must be
+            --  If the object is tagged, check whether the tag must be
             --  reassigned explicitly.
 
             Tag_Assign := Make_Tag_Assignment (Decl);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5a80e1d1a5c6149d6ff522d17b8c48163a08a347..b12fb9e2d3649f67e74c3dd1e89fbb7d5584e235 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-05-23  Bob Duff  <duff@adacore.com>
+
+       * gnat.dg/addr10.adb: New testcase.
+
 2018-05-23  Richard Biener  <rguenther@suse.de>
 
        PR middle-end/85874

diff --git a/gcc/testsuite/gnat.dg/addr10.adb b/gcc/testsuite/gnat.dg/addr10.adb
new file mode 100644 (file)
index 0000000..16efa28
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr10.adb
@@ -0,0 +1,24 @@
+--  { dg-do compile }
+
+with System;
+
+procedure Addr10 is
+   type Limited_Type is limited record
+      Element : Integer;
+   end record;
+
+   function Initial_State return Limited_Type is ((Element => 0));
+
+   type Double_Limited_Type is
+      record
+         A : Limited_Type;
+      end record;
+
+   Double_Limited : Double_Limited_Type :=
+      (A => Initial_State)
+   with
+      Volatile,
+      Address => System'To_Address (16#1234_5678#);
+begin
+   null;
+end Addr10;