diff options
| -rw-r--r-- | gcc/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/pointer_controlled.adb | 31 | ||||
| -rw-r--r-- | gcc/tree.c | 11 |
4 files changed, 48 insertions, 3 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 8608327..84e9ad5 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,8 @@ +2011-07-17 Eric Botcazou <ebotcazou@adacore.com> + + PR middle-end/49732 + * tree.c (walk_tree_1) <DECL_EXPR>: Do not walk a pointed-to type. + 2011-07-16 Matthias Klose <doko@ubuntu.com> * doc/install.texi: Document --enable-static-libjava. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6abed53..2e5683c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2011-07-17 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/pointer_controlled.adb: New test. + 2011-07-17 Tobias Burnus <burnus@net-b.de> PR fortran/49624 diff --git a/gcc/testsuite/gnat.dg/pointer_controlled.adb b/gcc/testsuite/gnat.dg/pointer_controlled.adb new file mode 100644 index 0000000..1d85b53 --- /dev/null +++ b/gcc/testsuite/gnat.dg/pointer_controlled.adb @@ -0,0 +1,31 @@ +-- 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; @@ -10596,9 +10596,14 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data, 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)) |