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.
This commit is contained in:
Tom Tromey 2023-09-15 08:59:09 -06:00
parent a97875a518
commit 8f11ec2d3c
3 changed files with 52 additions and 36 deletions

View file

@ -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;

View file

@ -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
}
}

View file

@ -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;