[gdb/exp] Clean up asap in value_print_array_elements

I've been running the test-suite on an i686-linux laptop with 1GB of memory,
and 1 GB of swap, and noticed problems after running gdb.base/huge.exp: gdb
not being able to spawn for a large number of test-cases afterwards.

So I investigated the memory usage, on my usual x86_64-linux development
platform.

The test-case is compiled with -DCRASH_GDB=2097152, so this:
...
static int a[CRASH_GDB], b[CRASH_GDB];
...
with sizeof (int) == 4 represents two arrays of 8MB each.

Say we add a loop around the "print a" command and print space usage
statistics:
...
gdb_test "maint set per-command space on"
for {set i 0} {$i < 100} {incr i} {
    gdb_test "print a"
}
...

This gets us:
...
(gdb) print a^M
$1 = {0 <repeats 2097152 times>}^M
Space used: 478248960 (+469356544 for this command)^M
(gdb) print a^M
$2 = {0 <repeats 2097152 times>}^M
Space used: 486629376 (+8380416 for this command)^M
(gdb) print a^M
$3 = {0 <repeats 2097152 times>}^M
Space used: 495009792 (+8380416 for this command)^M
  ...
(gdb) print a^M
$100 = {0 <repeats 2097152 times>}^M
Space used: 1308721152 (+8380416 for this command)^M
...

In other words, we start out at 8MB, and the first print costs us about 469MB,
and subsequent prints 8MB, which accumulates to 1.3 GB usage. [ On the
i686-linux laptop, the first print costs us 335MB. ]

The subsequent 8MBs are consistent with the values being saved into the value
history, but the usage for the initial print seems somewhat excessive.

There is a PR open about needing sparse representation of large arrays
(PR8819), but this memory usage points to an independent problem.

The function value_print_array_elements contains a scoped_value_mark to free
allocated values in the outer loop, but it doesn't prevent the inner loop from
allocating a lot of values.

Fix this by adding a scoped_value_mark in the inner loop, after which we have:
...
(gdb) print a^M
$1 = {0 <repeats 2097152 times>}^M
Space used: 8892416 (+0 for this command)^M
(gdb) print a^M
$2 = {0 <repeats 2097152 times>}^M
Space used: 8892416 (+0 for this command)^M
(gdb) print a^M
$3 = {0 <repeats 2097152 times>}^M
Space used: 8892416 (+0 for this command)^M
  ...
(gdb) print a^M
$100 = {0 <repeats 2097152 times>}^M
Space used: 8892416 (+0 for this command)^M
...

Note that the +0 here just means that the mallocs did not trigger an sbrk.
This is dependent on malloc (which can use either mmap or sbrk or some
pre-allocated memory) and will likely vary between different tunings, versions
and implementations, so this does not give us a reliable way detect the
problem in a minimal way.

A more reliable way of detecting the problem is:
...
 void
 value_free_to_mark (const struct value *mark)
 {
+  size_t before = all_values.size ();
   auto iter = std::find (all_values.begin (), all_values.end (), mark);
   if (iter == all_values.end ())
     all_values.clear ();
   else
     all_values.erase (iter + 1, all_values.end ());
+  size_t after = all_values.size ();
+  if (before - after >= 1024)
+    fprintf (stderr, "value_free_to_mark freed %zu items\n", before - after);
...
which without the fix tells us:
...
+print a
value_free_to_mark freed 2097152 items
$1 = {0 <repeats 2097152 times>}
...

Fix a similar problem for Fortran:
...
+print array1
value_free_to_mark freed 4194303 items
$1 = (0, <repeats 2097152 times>)
...
in fortran_array_printer_impl::process_element.

The problem also exists for Ada:
...
+print Arr
value_free_to_mark freed 2097152 items
$1 = (0 <repeats 2097152 times>)
...
but is fixed by the fix for C.

Add Fortran and Ada variants of the test-case.  The *.exp files are similar
enough to the original to keep the copyright years range.

While writing the Fortran test-case, I ran into needing an additional print
setting to print the entire array in repeat form, filed as PR exp/30817.

I managed to apply the compilation loop for the Ada variant as well, but with
a cumbersome repetition style.  I noticed no other test-case uses gnateD, so
perhaps there's a better way of implementing this.

The regression test included in the patch is formulated in its weakest
form, to avoid false positive FAILs, which also means that smaller regressions
may not get detected.

Tested on x86_64-linux.

Approved-By: Tom Tromey <tom@tromey.com>

7 files changed, 353 insertions, 3 deletions

diff --git a/gdb/testsuite/gdb.ada/huge.exp b/gdb/testsuite/gdb.ada/huge.exp
new file mode 100644
index 0000000..71b440e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/huge.exp
@@ -0,0 +1,92 @@
+# Copyright 2001-2023 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Copied from gdb.base/huge.exp, written by Michael Snyder
+# (msnyder@redhat.com).
+
+# Define if you want to skip this test
+# (could be very time-consuming on remote targets with slow connection).
+#
+require {!target_info exists gdb,skip_huge_test}
+
+load_lib "ada.exp"
+
+require allow_ada_tests
+
+standard_ada_testfile foo
+
+set max [expr 2 * 1024 * 1024]
+set min 16
+
+set opts {}
+lappend opts debug
+
+set compilation_succeeded 0
+for { set size $max } { $size >= $min } { set size [expr $size / 2] } {
+    set try_opts [concat $opts [list additional_flags=-gnateDCRASHGDB=$size]]
+    # Use gdb_compile_ada_1 to prevent failed compilations from producing a
+    # FAIL.
+    if {[gdb_compile_ada_1 "${srcfile}" "${binfile}" executable \
+	     $try_opts] != "" } {
+	continue
+    }
+
+    set compilation_succeeded 1
+    break
+}
+require {expr $compilation_succeeded}
+
+clean_restart ${testfile}
+
+save_vars { timeout } {
+    set timeout 30
+
+    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
+	}
+    }
+
+    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/foo.adb b/gdb/testsuite/gdb.ada/huge/foo.adb
new file mode 100644
index 0000000..ad86f43
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/huge/foo.adb
@@ -0,0 +1,20 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with Pck; use Pck;
+procedure Foo is
+begin
+   Pck.Foo;
+end Foo;
diff --git a/gdb/testsuite/gdb.ada/huge/pck.adb b/gdb/testsuite/gdb.ada/huge/pck.adb
new file mode 100644
index 0000000..09988fb
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/huge/pck.adb
@@ -0,0 +1,82 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package body Pck is
+   type My_Int is range -2147483648 .. 2147483647;
+
+#if CRASHGDB = 16
+    type Index is range 1 .. 16;
+#end if;
+#if CRASHGDB = 32
+    type Index is range 1 .. 32;
+#end if;
+#if CRASHGDB = 64
+    type Index is range 1 .. 64;
+#end if;
+#if CRASHGDB = 128
+    type Index is range 1 .. 128;
+#end if;
+#if CRASHGDB = 256
+    type Index is range 1 .. 256;
+#end if;
+#if CRASHGDB = 512
+    type Index is range 1 .. 512;
+#end if;
+#if CRASHGDB = 1024
+    type Index is range 1 .. 1024;
+#end if;
+#if CRASHGDB = 2048
+    type Index is range 1 ..  2048;
+#end if;
+#if CRASHGDB = 4096
+    type Index is range 1 .. 4096;
+#end if;
+#if CRASHGDB = 8192
+    type Index is range 1 .. 8192;
+#end if;
+#if CRASHGDB = 16384
+    type Index is range 1 .. 16384;
+#end if;
+#if CRASHGDB = 32768
+    type Index is range 1 .. 32768;
+#end if;
+#if CRASHGDB = 65536
+    type Index is range 1 .. 65536;
+#end if;
+#if CRASHGDB = 131072
+    type Index is range 1 .. 131072;
+#end if;
+#if CRASHGDB = 262144
+    type Index is range 1 .. 262144;
+#end if;
+#if CRASHGDB = 524288
+    type Index is range 1 .. 524288;
+#end if;
+#if CRASHGDB = 1048576
+    type Index is range 1 .. 1048576;
+#end if;
+#if CRASHGDB = 2097152
+    type Index is range 1 .. 2097152;
+#end if;
+
+   type My_Int_Array is
+     array (Index) of My_Int;
+   Arr : My_Int_Array := (others => 0);
+
+   procedure Foo is
+   begin
+      null;
+   end Foo;
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/huge/pck.ads b/gdb/testsuite/gdb.ada/huge/pck.ads
new file mode 100644
index 0000000..5878cf8
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/huge/pck.ads
@@ -0,0 +1,18 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Pck is
+   procedure Foo;
+end Pck;
diff --git a/gdb/testsuite/gdb.base/huge.exp b/gdb/testsuite/gdb.base/huge.exp
index fc8909d..ef80d76 100644
--- a/gdb/testsuite/gdb.base/huge.exp
+++ b/gdb/testsuite/gdb.base/huge.exp
@@ -53,7 +53,9 @@ save_vars { timeout } {
 
     gdb_test_no_output "set max-value-size unlimited"
 
-    set re \
+    gdb_test_no_output "maint set per-command space on"
+
+    set re1 \
 	[list \
 	     [string_to_regexp $] \
 	     $decimal \
@@ -61,6 +63,26 @@ save_vars { timeout } {
 	     [string_to_regexp "{0 <repeats "] \
 	     $decimal \
 	     [string_to_regexp " times>}"]]
-    set re [join $re ""]
-    gdb_test "print a" $re "print a very large data object"
+    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 a" "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
+    }
 }
diff --git a/gdb/testsuite/gdb.fortran/huge.F90 b/gdb/testsuite/gdb.fortran/huge.F90
new file mode 100644
index 0000000..70e3710
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/huge.F90
@@ -0,0 +1,21 @@
+! Copyright 2023 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+program huge
+  implicit none
+
+  integer, dimension(CRASH_GDB) :: array1
+  print *, array1(1)
+end program huge
diff --git a/gdb/testsuite/gdb.fortran/huge.exp b/gdb/testsuite/gdb.fortran/huge.exp
new file mode 100644
index 0000000..ad4382f
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/huge.exp
@@ -0,0 +1,95 @@
+# Copyright 2001-2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Copied from gdb.base/huge.exp, written by Michael Snyder
+# (msnyder@redhat.com).
+
+# Define if you want to skip this test
+# (could be very time-consuming on remote targets with slow connection).
+#
+require {!target_info exists gdb,skip_huge_test}
+
+require allow_fortran_tests
+
+load_lib fortran.exp
+
+standard_testfile .F90
+
+set max [expr 2 * 1024 * 1024]
+set min 16
+
+set opts {}
+lappend opts debug
+lappend opts f90
+
+set compilation_succeeded 0
+for { set size [expr $max] } { $size >= $min } { set size [expr $size / 2] } {
+    set try_opts [concat $opts [list additional_flags=-DCRASH_GDB=$size]]
+    if { [build_executable $testfile.exp $testfile $srcfile $try_opts] == -1 } {
+	continue
+    }
+
+    set compilation_succeeded 1
+    break
+}
+require {expr $compilation_succeeded}
+
+# Start with a fresh gdb.
+clean_restart ${binfile}
+
+save_vars { timeout } {
+    set timeout 30
+
+    if {![fortran_runto_main]} {
+	return -1
+    }
+
+    gdb_test_no_output "set max-value-size unlimited"
+
+    # Not needed for the C variant, see PR exp/30817.
+    gdb_test_no_output "set print elements 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 array1" "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 112 passes with and without the fix, so use 111.
+	gdb_assert {$space_used < [expr 111 * 4 * $size] } $test
+    }
+}