[Ada] Wrong code in array aggregates of Ada coextensions

The compiler generates wrong code when an array aggregate with an others choice
whose expression has nested object allocations (ie. others => new R (new S)) is
used to initialize an array of access to discriminated types whose discriminant
is an access type.

2018-06-11  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* sinfo.ads (Is_Dynamic_Coextension): Adding documentation.
	(Is_Static_Coextension): Adding documentation.
	* sinfo.adb (Is_Dynamic_Coextension): Extending the assertion.
	(Is_Static_Coextension): Extending the assertion.
	* sem_util.adb (Mark_Allocator): Clear Is_Static_Coextension when
	setting flag Is_Dynamic_Coextension (and vice versa).

gcc/testsuite/

	* gnat.dg/aggr23.adb, gnat.dg/aggr23_q.adb, gnat.dg/aggr23_tt.ads: New
	testcase.

From-SVN: r261406

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 401c5d27f92ac4257dc22c2fdb3b58f1f9e60572..1946e5480174668cfe249eb470d9da45cc9f10c2 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2018-06-11  Javier Miranda  <miranda@adacore.com>
+
+       * sinfo.ads (Is_Dynamic_Coextension): Adding documentation.
+       (Is_Static_Coextension): Adding documentation.
+       * sinfo.adb (Is_Dynamic_Coextension): Extending the assertion.
+       (Is_Static_Coextension): Extending the assertion.
+       * sem_util.adb (Mark_Allocator): Clear Is_Static_Coextension when
+       setting flag Is_Dynamic_Coextension (and vice versa).
+
 2018-06-11  Ed Schonberg  <schonberg@adacore.com>
 
        * exp_unst.adb (Search_Subprograms): Handle explicitly stubs at the top

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3902d6eb80655cf458b1f7fac00fdd35f0db56cc..69934f018ca735c0f235a1cccb5a1b1c27d515f4 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -18472,6 +18472,7 @@ package body Sem_Util is
       begin
          if Nkind (N) = N_Allocator then
             if Is_Dynamic then
+               Set_Is_Static_Coextension (N, False);
                Set_Is_Dynamic_Coextension (N);
 
             --  If the allocator expression is potentially dynamic, it may
@@ -18482,8 +18483,10 @@ package body Sem_Util is
             elsif Nkind (Expression (N)) = N_Qualified_Expression
               and then Nkind (Expression (Expression (N))) = N_Op_Concat
             then
+               Set_Is_Static_Coextension (N, False);
                Set_Is_Dynamic_Coextension (N);
             else
+               Set_Is_Dynamic_Coextension (N, False);
                Set_Is_Static_Coextension (N);
             end if;
          end if;

diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index acb32155f208fe4940a46b91ec71b261c20f085e..45f2867cce7eb3d46b4a7de419adc6c5e94fd9ca 100644 (file)
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -5350,6 +5350,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Allocator);
+      pragma Assert (not Val
+        or else not Is_Static_Coextension (N));
       Set_Flag18 (N, Val);
    end Set_Is_Dynamic_Coextension;
 
@@ -5613,6 +5615,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Allocator);
+      pragma Assert (not Val
+        or else not Is_Dynamic_Coextension (N));
       Set_Flag14 (N, Val);
    end Set_Is_Static_Coextension;
 

diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 22d71955d7e4ec2614fbd5c6480781d00b587482..c6e04e7920a4c91ba4466085af104308cbf7e63f 100644 (file)
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1738,7 +1738,8 @@ package Sinfo is
    --    Present in allocator nodes, to indicate that this is an allocator
    --    for an access discriminant of a dynamically allocated object. The
    --    coextension must be deallocated and finalized at the same time as
-   --    the enclosing object.
+   --    the enclosing object. The partner flag Is_Static_Coextension must
+   --    be cleared before setting this flag to True.
 
    --  Is_Effective_Use_Clause (Flag1-Sem)
    --    Present in both N_Use_Type_Clause and N_Use_Package_Clause to indicate
@@ -1949,7 +1950,9 @@ package Sinfo is
 
    --  Is_Static_Coextension (Flag14-Sem)
    --    Present in N_Allocator nodes. Set if the allocator is a coextension
-   --    of an object allocated on the stack rather than the heap.
+   --    of an object allocated on the stack rather than the heap. The partner
+   --    flag Is_Dynamic_Coextension must be cleared before setting this flag
+   --    to True.
 
    --  Is_Static_Expression (Flag6-Sem)
    --    Indicates that an expression is a static expression according to the

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6d5e9644f99cfc26eb7dfab17b1c99560a7ef63d..0b16f0ccac4b9a302be6da942c0522acb36473b9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-06-11  Javier Miranda  <miranda@adacore.com>
+
+       * gnat.dg/aggr23.adb, gnat.dg/aggr23_q.adb, gnat.dg/aggr23_tt.ads: New
+       testcase.
+
 2018-06-11  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/inline_always1.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/aggr23.adb b/gcc/testsuite/gnat.dg/aggr23.adb
new file mode 100644 (file)
index 0000000..a75396f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr23.adb
@@ -0,0 +1,9 @@
+--  { dg-options "-gnatws" }
+--  { dg-do run }
+
+with Aggr23_Q;
+
+procedure Aggr23 is
+begin
+   Aggr23_Q (2);
+end;

diff --git a/gcc/testsuite/gnat.dg/aggr23_q.adb b/gcc/testsuite/gnat.dg/aggr23_q.adb
new file mode 100644 (file)
index 0000000..5ab8883
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr23_q.adb
@@ -0,0 +1,14 @@
+--  { dg-options "-gnatws" }
+
+with Ada.Text_IO; use Ada.Text_IO;
+
+with Aggr23_TT; use Aggr23_TT;
+
+procedure Aggr23_Q (Count : Natural) is
+   Ts : array (1 .. Count) of TA
+         := (others => new T (new Integer));  --  Test
+begin
+   if Ts (1).D = Ts (2).D then
+      Put ("ERROR");
+   end if;
+end;

diff --git a/gcc/testsuite/gnat.dg/aggr23_tt.ads b/gcc/testsuite/gnat.dg/aggr23_tt.ads
new file mode 100644 (file)
index 0000000..42ee853
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr23_tt.ads
@@ -0,0 +1,4 @@
+package Aggr23_TT is
+   type T (D : not null access Integer) is null record;
+   type TA is access T;
+end;