From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sat, 2 Apr 2011 09:20:38 +0000 (+0000)
Subject: utils.c (update_pointer_to): Finalize named pointer types.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=de9528f0291faf10d65dd7b00f7101005c2ee38a;p=gcc.git

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 ced5b7a6b9c..2a1eba4a9e0 100644
--- 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 bd6badd5929..dc743740cfe 100644
--- 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 d1d5b9eb854..7f19c13ece1 100644
--- 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
index 00000000000..f962243d6c3
--- /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
index 00000000000..dbdf5346dec
--- /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
index 00000000000..fc68249b821
--- /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
index 00000000000..6ed6b1a3d5a
--- /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
index 00000000000..89d57cb62f1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug3.ads
@@ -0,0 +1,5 @@
+package Debug3 is
+
+  procedure Proc;
+
+end Debug3;