This fixes the fallouts of the previous series of patches.
Tested on i586-suse-linux, applied on the mainline.
2011-04-02 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/utils.c (update_pointer_to): Finalize named pointer
types.
2011-04-02 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/debug2.ad[sb]: New test.
* gnat.dg/debug2_pkg.ads: New helper.
* gnat.dg/debug3.ad[sb]: New test.
--
Eric Botcazou
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 171885)
+++ gcc-interface/utils.c (working copy)
@@ -3559,7 +3559,12 @@ update_pointer_to (tree old_type, tree n
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 n
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;
}
-- { 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;
package Debug2 is
procedure Proc;
end Debug2;
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;
-- { 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;
package Debug3 is
procedure Proc;
end Debug3;
