Home | History | Annotate | Line # | Download | only in gdb.ada
      1 # Copyright 2001-2024 Free Software Foundation, Inc.
      2 #
      3 # This program is free software; you can redistribute it and/or modify
      4 # it under the terms of the GNU General Public License as published by
      5 # the Free Software Foundation; either version 3 of the License, or
      6 # (at your option) any later version.
      7 #
      8 # This program is distributed in the hope that it will be useful,
      9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
     10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     11 # GNU General Public License for more details.
     12 #
     13 # You should have received a copy of the GNU General Public License
     14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
     15 
     16 # Copied from gdb.base/huge.exp, written by Michael Snyder
     17 # (msnyder (at) redhat.com).
     18 
     19 # Define if you want to skip this test
     20 # (could be very time-consuming on remote targets with slow connection).
     21 #
     22 require {!target_info exists gdb,skip_huge_test}
     23 
     24 load_lib "ada.exp"
     25 
     26 require allow_ada_tests
     27 
     28 standard_ada_testfile foo
     29 
     30 set max [expr 2 * 1024 * 1024]
     31 set min 16
     32 
     33 set opts {}
     34 lappend opts debug
     35 
     36 set compilation_succeeded 0
     37 for { set size $max } { $size >= $min } { set size [expr $size / 2] } {
     38     set try_opts [concat $opts [list additional_flags=-gnateDCRASHGDB=$size]]
     39     # Use gdb_compile_ada_1 to prevent failed compilations from producing a
     40     # FAIL.
     41     if {[gdb_compile_ada_1 "${srcfile}" "${binfile}" executable \
     42 	     $try_opts] != "" } {
     43 	continue
     44     }
     45 
     46     set compilation_succeeded 1
     47     break
     48 }
     49 require {expr $compilation_succeeded}
     50 
     51 foreach_with_prefix varname {Arr Packed_Arr} {
     52     clean_restart ${testfile}
     53 
     54     save_vars { timeout } {
     55 	set timeout 30
     56 
     57 	if {![runto "foo"]} {
     58 	    return
     59 	}
     60 
     61 	gdb_test_no_output "set max-value-size unlimited"
     62 	gdb_test_no_output "maint set per-command space on"
     63 	set re1 \
     64 	    [list \
     65 		 [string_to_regexp $] \
     66 		 $decimal \
     67 		 " = " \
     68 		 [string_to_regexp "(0 <repeats "] \
     69 		 $decimal \
     70 		 [string_to_regexp " times>)"]]
     71 	set re2 \
     72 	    [list \
     73 		 "Space used: $decimal" \
     74 		 [string_to_regexp " (+"] \
     75 		 "($decimal) for this command" \
     76 		 [string_to_regexp ")"]]
     77 	set re [multi_line [join $re1 ""]  [join $re2 ""]]
     78 	set space_used -1
     79 	gdb_test_multiple "print $varname" "print a very large data object" {
     80 	    -re -wrap $re {
     81 		set space_used $expect_out(1,string)
     82 		pass $gdb_test_name
     83 	    }
     84 	}
     85 
     86 	set test "not too much space used"
     87 	if { $space_used == -1 } {
     88 	    unsupported $test
     89 	} else {
     90 	    # At 56 passes with and without the fix, so use 55.
     91 	    gdb_assert {$space_used < [expr 55 * 4 * $size] } $test
     92 	}
     93     }
     94 }
     95