Hi,
this is a regression present on mainline and 4.6 branch. The compiler crashes
during gimplification because there is a COMPOUND_EXPR shared between the
TYPE_SIZE and TYPE_SIZE_UNIT expressions of an array type. Now this isn't
supposed to happen because we run an unsharing pass before gimplification.
The problem here is that we have a forward declaration (DECL_EXPR) of a pointer
type to the array type. So, during the marking phase of the unsharing pass,
the array type gets marked as visited through the pointer, which prevents it
from being walked during the same phase when its own DECL_EXPR is processed.
This pointer/pointed-to type business is an old pattern. Five years ago,
Olivier changed gimplify_type_sizes like so:
2006-10-06 Olivier Hainque <hain...@adacore.com>
* gimplify.c (gimplify_type_sizes) [POINTER_TYPE, REFERENCE_TYPE]:
Don't recurse on the pointed-to type.
because of a related problem. It turns out that we need the same change in the
DECL_EXPR case of walk_tree_1 to fix the bug at hand, which is sort of logical
as there is a strong relationship between them:
case DECL_EXPR:
/* If this is a TYPE_DECL, walk into the fields of the type that it's
defining. We only want to walk into these fields of a type in this
case and not in the general case of a mere reference to the type.
The criterion is as follows: if the field can be an expression, it
must be walked only here. This should be in keeping with the fields
that are directly gimplified in gimplify_type_sizes in order for the
mark/copy-if-shared/unmark machinery of the gimplifier to work with
variable-sized types.
Note that DECLs get walked as part of processing the BIND_EXPR. */
Tested on x86_64-suse-linux, OK for mainline and 4.6 branch?
2011-07-14 Eric Botcazou <ebotca...@adacore.com>
PR middle-end/49732
* tree.c (walk_tree_1) <DECL_EXPR>: Do not walk a pointed-to type.
2011-07-14 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/pointer_controlled.adb: New test.
--
Eric Botcazou
Index: tree.c
===================================================================
--- tree.c (revision 176261)
+++ tree.c (working copy)
@@ -10596,9 +10596,14 @@ walk_tree_1 (tree *tp, walk_tree_fn func
if (result || !walk_subtrees)
return result;
- result = walk_type_fields (*type_p, func, data, pset, lh);
- if (result)
- return result;
+ /* But do not walk a pointed-to type since it may itself need to
+ be walked in the declaration case if it isn't anonymous. */
+ if (!POINTER_TYPE_P (*type_p))
+ {
+ result = walk_type_fields (*type_p, func, data, pset, lh);
+ if (result)
+ return result;
+ }
/* If this is a record type, also walk the fields. */
if (RECORD_OR_UNION_TYPE_P (*type_p))
-- PR ada/49732
-- Testcase by Vorfeed Canal
-- { dg-do compile }
-- { dg-options "-gnato" }
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Interfaces.C.Pointers;
procedure Pointer_Controlled is
function Create (Name : String) return size_t is
type Name_String is new char_array (0 .. Name'Length);
type Name_String_Ptr is access Name_String;
pragma Controlled (Name_String_Ptr);
Name_Str : constant Name_String_Ptr := new Name_String;
Name_Len : size_t;
begin
To_C (Name, Name_Str.all, Name_Len);
return 1;
end;
Test : size_t;
begin
Test := Create("ABC");
end;
