utils.c (update_pointer_to): Finalize named pointer types.

	* gcc-interface/utils.c (update_pointer_to): Finalize named pointer
	types.

From-SVN: r171887

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ced5b7a6b9c61e9711089086ced36af8f1fe5493..2a1eba4a9e0160ca73be71c903f0f282c59c08c5 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,8 +1,13 @@
+2011-04-02  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/utils.c (update_pointer_to): Finalize named pointer
+       types.
+
 2011-04-02  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/lang.opt (feliminate-unused-debug-types): Delete.
        * gcc-interface/misc.c (gnat_handle_option): Remove special handling
-       code for -feliminate-unused-debug-types
+       code for -feliminate-unused-debug-types.
        (gnat_post_options): Likewise.
 
 2011-04-02  Eric Botcazou  <ebotcazou@adacore.com>

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index bd6badd5929c6fbe40cd18c91d04cab76e5df6d7..dc743740cfee8356ee2e311c9c06ca5a1bdc987c 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3559,7 +3559,12 @@ update_pointer_to (tree old_type, tree new_type)
       for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
        for (t = TYPE_MAIN_VARIANT (ptr); t; t = TYPE_NEXT_VARIANT (t))
          TREE_TYPE (t) = new_type;
-      TYPE_POINTER_TO (old_type) = NULL_TREE;
+
+      /* If we have adjusted named types, finalize them.  This is necessary
+        since we had forced a DWARF typedef for them in gnat_pushdecl.  */
+      for (ptr = TYPE_POINTER_TO (old_type); ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
+       if (TYPE_NAME (ptr) && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL)
+         rest_of_type_decl_compilation (TYPE_NAME (ptr));
 
       /* Chain REF and its variants at the end.  */
       new_ref = TYPE_REFERENCE_TO (new_type);
@@ -3576,6 +3581,8 @@ update_pointer_to (tree old_type, tree new_type)
       for (; ref; ref = TYPE_NEXT_REF_TO (ref))
        for (t = TYPE_MAIN_VARIANT (ref); t; t = TYPE_NEXT_VARIANT (t))
          TREE_TYPE (t) = new_type;
+
+      TYPE_POINTER_TO (old_type) = NULL_TREE;
       TYPE_REFERENCE_TO (old_type) = NULL_TREE;
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d1d5b9eb85462e36916d78942c345c741b64c638..7f19c13ece114297cc09bc141e7b5b6af6249b1b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2011-04-02  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/debug2.ad[sb]: New test.
+       * gnat.dg/debug2_pkg.ads: New helper.
+       * gnat.dg/debug3.ad[sb]: New test.
+
 2011-04-01  Uros Bizjak  <ubizjak@gmail.com>
 
        * go.test/go-test.exp (go-set-goarch): Recognize alpha*-*-*.

diff --git a/gcc/testsuite/gnat.dg/debug2.adb b/gcc/testsuite/gnat.dg/debug2.adb
new file mode 100644 (file)
index 0000000..f962243
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug2.adb
@@ -0,0 +1,40 @@
+-- { dg-do compile }
+-- { dg-options "-g" }
+
+with Debug2_Pkg; use Debug2_Pkg;
+
+package body Debug2 is
+
+    procedure Proc is
+
+        function F return String_List_Ptr is
+        begin
+            return new String_List'(Singleton);
+        end;
+
+        A : String_List_Ptr := F;
+
+    begin
+        null;
+    end;
+
+    function Get return Integer is
+    begin
+        return 0;
+    end;
+
+    Failed : exception;
+
+    A: String_Ptr;
+
+begin
+
+    declare
+        Server_Args : Integer;
+    begin
+        Server_Args := Get;
+    exception
+        when X : Failed => A := To_Heap;
+    end;
+
+end Debug2;

diff --git a/gcc/testsuite/gnat.dg/debug2.ads b/gcc/testsuite/gnat.dg/debug2.ads
new file mode 100644 (file)
index 0000000..dbdf534
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug2.ads
@@ -0,0 +1,5 @@
+package Debug2 is
+
+    procedure Proc;
+
+end Debug2;

diff --git a/gcc/testsuite/gnat.dg/debug2_pkg.ads b/gcc/testsuite/gnat.dg/debug2_pkg.ads
new file mode 100644 (file)
index 0000000..fc68249
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug2_pkg.ads
@@ -0,0 +1,19 @@
+package Debug2_Pkg is
+
+    type String_Ptr is access all String;
+
+    function To_Heap return String_Ptr;
+
+    type String_List(Chars_Length: Positive) is private;
+
+    type String_List_Ptr is access constant String_List;
+
+    function Singleton return String_List;
+
+private
+
+    type String_List(Chars_Length: Positive) is record
+        Chars: String(1..Chars_Length);
+    end record;
+
+end Debug2_Pkg;

diff --git a/gcc/testsuite/gnat.dg/debug3.adb b/gcc/testsuite/gnat.dg/debug3.adb
new file mode 100644 (file)
index 0000000..6ed6b1a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug3.adb
@@ -0,0 +1,31 @@
+-- { dg-do compile }
+-- { dg-options "-g" }
+
+with Ada.Unchecked_Conversion;
+with System;
+
+package body Debug3 is
+
+  type Rec is record
+     I : Integer;
+  end record;
+  for Rec'Alignment use 1;
+
+  type Ptr is access Rec;
+
+  function To_Ptr is new Ada.Unchecked_Conversion(System.Address, Ptr);
+
+  procedure Proc is
+
+    function Get (S1 : String) return Ptr is
+    begin
+       return To_Ptr (S1'Address);
+    end;
+
+    M : Ptr;
+
+    begin
+      M := Get ("");
+    end;
+
+end Debug3;

diff --git a/gcc/testsuite/gnat.dg/debug3.ads b/gcc/testsuite/gnat.dg/debug3.ads
new file mode 100644 (file)
index 0000000..89d57cb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug3.ads
@@ -0,0 +1,5 @@
+package Debug3 is
+
+  procedure Proc;
+
+end Debug3;