Clean up intermediate values in val_print_packed_array_elements

Following on Tom de Vries' work in the other array-printers, this
patch changes val_print_packed_array_elements to also avoid allocating
too many values when printing an Ada packed array.

diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
index eaeca0f6516176527ec752381d14c9e4c9f6a3bb..b32f1e506d1ae1581c597e30c04f54d64b53b3ac 100644 (file)
--- a/gdb/ada-valprint.c
+++ b/gdb/ada-valprint.c
@@ -150,6 +150,11 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
 
   while (i < len && things_printed < options->print_max)
     {
+      /* Both this outer loop and the inner loop that checks for
+        duplicates may allocate many values.  To avoid using too much
+        memory, both spots release values as they work.  */
+      scoped_value_mark outer_free_values;
+
       struct value *v0, *v1;
       int i0;
 
@@ -180,6 +185,9 @@ val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
                                           bitsize, elttype);
       while (1)
        {
+         /* Make sure to free any values in the inner loop.  */
+         scoped_value_mark free_values;
+
          i += 1;
          if (i >= len)
            break;

diff --git a/gdb/testsuite/gdb.ada/huge.exp b/gdb/testsuite/gdb.ada/huge.exp
index 71b440e8c597b6b40031fd226da6a22037f01468..7a2037af0d0a9b125809ee798669eb9cc1ca0f92 100644 (file)
--- a/gdb/testsuite/gdb.ada/huge.exp
+++ b/gdb/testsuite/gdb.ada/huge.exp
@@ -48,45 +48,47 @@ for { set size $max } { $size >= $min } { set size [expr $size / 2] } {
 }
 require {expr $compilation_succeeded}
 
-clean_restart ${testfile}
+foreach_with_prefix varname {Arr Packed_Arr} {
+    clean_restart ${testfile}
 
-save_vars { timeout } {
-    set timeout 30
+    save_vars { timeout } {
+       set timeout 30
 
-    if {![runto "foo"]} {
-       return
-    }
+       if {![runto "foo"]} {
+           return
+       }
 
-    gdb_test_no_output "set max-value-size unlimited"
-    gdb_test_no_output "maint set per-command space on"
-    set re1 \
-       [list \
-            [string_to_regexp $] \
-            $decimal \
-            " = " \
-            [string_to_regexp "(0 <repeats "] \
-            $decimal \
-            [string_to_regexp " times>)"]]
-    set re2 \
-       [list \
-            "Space used: $decimal" \
-            [string_to_regexp " (+"] \
-            "($decimal) for this command" \
-            [string_to_regexp ")"]]
-    set re [multi_line [join $re1 ""]  [join $re2 ""]]
-    set space_used -1
-    gdb_test_multiple "print Arr" "print a very large data object" {
-       -re -wrap $re {
-           set space_used $expect_out(1,string)
-           pass $gdb_test_name
+       gdb_test_no_output "set max-value-size unlimited"
+       gdb_test_no_output "maint set per-command space on"
+       set re1 \
+           [list \
+                [string_to_regexp $] \
+                $decimal \
+                " = " \
+                [string_to_regexp "(0 <repeats "] \
+                $decimal \
+                [string_to_regexp " times>)"]]
+       set re2 \
+           [list \
+                "Space used: $decimal" \
+                [string_to_regexp " (+"] \
+                "($decimal) for this command" \
+                [string_to_regexp ")"]]
+       set re [multi_line [join $re1 ""]  [join $re2 ""]]
+       set space_used -1
+       gdb_test_multiple "print $varname" "print a very large data object" {
+           -re -wrap $re {
+               set space_used $expect_out(1,string)
+               pass $gdb_test_name
+           }
        }
-    }
 
-    set test "not too much space used"
-    if { $space_used == -1 } {
-       unsupported $test
-    } else {
-       # At 56 passes with and without the fix, so use 55.
-       gdb_assert {$space_used < [expr 55 * 4 * $size] } $test
+       set test "not too much space used"
+       if { $space_used == -1 } {
+           unsupported $test
+       } else {
+           # At 56 passes with and without the fix, so use 55.
+           gdb_assert {$space_used < [expr 55 * 4 * $size] } $test
+       }
     }
 }

diff --git a/gdb/testsuite/gdb.ada/huge/pck.adb b/gdb/testsuite/gdb.ada/huge/pck.adb
index 09988fbeb255a0f66ef0e4a3032e2ece57406dcc..47e6e928ca2713b56051e4c48aff70357924812e 100644 (file)
--- a/gdb/testsuite/gdb.ada/huge/pck.adb
+++ b/gdb/testsuite/gdb.ada/huge/pck.adb
@@ -14,6 +14,7 @@
 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 package body Pck is
+   subtype Small_Int is Integer range 0 .. 7;
    type My_Int is range -2147483648 .. 2147483647;
 
 #if CRASHGDB = 16
@@ -75,6 +76,11 @@ package body Pck is
      array (Index) of My_Int;
    Arr : My_Int_Array := (others => 0);
 
+   type My_Packed_Array is array (Index) of Small_Int;
+   pragma Pack (My_Packed_Array);
+
+   Packed_Arr : My_Packed_Array := (others => 0);
+
    procedure Foo is
    begin
       null;