From: Tom Tromey <tromey@adacore.com>
Date: Fri, 15 Sep 2023 14:59:09 +0000 (-0600)
Subject: Clean up intermediate values in val_print_packed_array_elements
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8f11ec2d3c57f3fb41f968e19bec3d4d58359171;p=binutils-gdb.git

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 eaeca0f6516..b32f1e506d1 100644
--- 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 71b440e8c59..7a2037af0d0 100644
--- 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 09988fbeb25..47e6e928ca2 100644
--- 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;