forked from Imagelibrary/binutils-gdb
2bf4cc2b92
gdb.fortran/lbound-ubound.exp reads the expected lbound and ubound
values by reading some output from the inferior. This is racy when
running on boards where the inferior I/O is on a separate TTY than
GDB's, such as native-gdbserver.
I sometimes see this behavior:
(gdb) continue
Continuing.
Breakpoint 2, do_test (lb=..., ub=...) at /home/jenkins/workspace/binutils-gdb_master_linuxbuild/platform/jammy-amd64/target_board/nati
ve-gdbserver/src/binutils-gdb/gdb/testsuite/gdb.fortran/lbound-ubound.F90:45
45 print *, "" ! Test Breakpoint
(gdb) Remote debugging from host ::1, port 37496
Expected GDB Output:
LBOUND = (-8, -10)
UBOUND = (-1, -2)
APB: Run a test here
APB: Expected lbound '(-8, -10)'
APB: Expected ubound ''
What happened is that expect read the output from GDB before the output
from the inferior, triggering this gdb_test_multiple clause:
-re "$gdb_prompt $" {
set found_prompt true
if {$found_dealloc_breakpoint
|| ($expected_lbound != "" && $expected_ubound != "")} {
# We're done.
} else {
exp_continue
}
}
So it set found_prompt, but the gdb_test_multiple kept going because
found_dealloc_breakpoint is false (this is the flag indicating that the
test is finished) and we still don't have expected_lbound and
expected_ubound. Then, expect reads in the inferior I/O, triggering
this clause:
-re ".*LBOUND = (\[^\r\n\]+)\r\n" {
set expected_lbound $expect_out(1,string)
if {!$found_prompt} {
exp_continue
}
}
This sets expected_lbound, but since found_prompt is true, we don't do
exp_continue, and exit the gdb_test_multiple, without having an
expected_ubound.
Change the test to read the values from the lb and ub function
parameters instead. As far as I understand, this still exercises what
we want to test. These variables contain the return values of the
lbound and ubound functions as computed by the program. We'll use them
to check the return values of the lbound and ubound functions as
computed by GDB.
Change-Id: I3c4d3d17d9291870a758a42301d15a007821ebb5
Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=30414
218 lines
7.2 KiB
Plaintext
218 lines
7.2 KiB
Plaintext
# Copyright 2021-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/> .
|
|
|
|
# Testing GDB's implementation of LBOUND and UBOUND.
|
|
|
|
require allow_fortran_tests
|
|
|
|
standard_testfile ".F90"
|
|
load_lib fortran.exp
|
|
|
|
if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
|
|
{debug f90}]} {
|
|
return -1
|
|
}
|
|
|
|
# Avoid shared lib symbols.
|
|
gdb_test_no_output "set auto-solib-add off"
|
|
|
|
if ![fortran_runto_main] {
|
|
return -1
|
|
}
|
|
|
|
# Avoid libc symbols, in particular the 'array' type.
|
|
gdb_test_no_output "nosharedlibrary"
|
|
|
|
gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
|
|
gdb_breakpoint [gdb_get_line_number "Breakpoint before deallocate\."]
|
|
gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
|
|
|
|
set found_dealloc_breakpoint false
|
|
|
|
# We place a limit on the number of tests that can be run, just in
|
|
# case something goes wrong, and GDB gets stuck in an loop here.
|
|
set test_count 0
|
|
while { $test_count < 500 } {
|
|
with_test_prefix "test $test_count" {
|
|
incr test_count
|
|
|
|
set expected_lbound ""
|
|
set expected_ubound ""
|
|
set found_prompt false
|
|
gdb_test_multiple "continue" "continue" {
|
|
-re -wrap "! Test Breakpoint.*" {
|
|
# We stopped at the next test case.
|
|
pass $gdb_test_name
|
|
}
|
|
|
|
-re -wrap "! Breakpoint before deallocate.*" {
|
|
# There are no more test cases.
|
|
pass $gdb_test_name
|
|
set found_dealloc_breakpoint true
|
|
}
|
|
}
|
|
|
|
if ($found_dealloc_breakpoint) {
|
|
break
|
|
}
|
|
|
|
set expected_lbound [get_valueof "" "lb" "" "get expected lbound"]
|
|
set expected_ubound [get_valueof "" "ub" "" "get expected ubound"]
|
|
|
|
if { $expected_lbound == "" } {
|
|
error "failed to extract expected results for lbound"
|
|
}
|
|
|
|
if { $expected_ubound == "" } {
|
|
error "failed to extract expected results for ubound"
|
|
}
|
|
|
|
verbose -log "APB: Run a test here"
|
|
verbose -log "APB: Expected lbound '$expected_lbound'"
|
|
verbose -log "APB: Expected ubound '$expected_ubound'"
|
|
|
|
# We want to take a look at the line in the previous frame that
|
|
# called the current function. I couldn't find a better way of
|
|
# doing this than 'up', which will print the line, then 'down'
|
|
# again.
|
|
#
|
|
# I don't want to fill the log with passes for these up/down
|
|
# commands, so we don't report any. If something goes wrong then we
|
|
# should get a fail from gdb_test_multiple.
|
|
set array_name ""
|
|
set xfail_data ""
|
|
gdb_test_multiple "up" "up" {
|
|
-re "\r\n\[0-9\]+\[ \t\]+DO_TEST \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
|
|
set array_name $expect_out(1,string)
|
|
}
|
|
}
|
|
|
|
if { $array_name == "" } {
|
|
error "failed to extract array name"
|
|
}
|
|
|
|
# Check GDB can correctly print complete set of upper and
|
|
# lower bounds for an array.
|
|
set pattern [string_to_regexp " = $expected_lbound"]
|
|
gdb_test "p lbound ($array_name)" "$pattern" \
|
|
"check value of lbound ('$array_name') expression"
|
|
set pattern [string_to_regexp " = $expected_ubound"]
|
|
gdb_test "p ubound ($array_name)" "$pattern" \
|
|
"check value of ubound ('$array_name') expression"
|
|
|
|
# Now ask for each bound in turn and check it against the
|
|
# expected results.
|
|
#
|
|
# First ask for bound 0. This should fail, but will also tell
|
|
# us the actual bounds of the array. Thanks GDB.
|
|
set upper_dim ""
|
|
gdb_test_multiple "p lbound ($array_name, 0)" "" {
|
|
-re "\r\nLBOUND dimension must be from 1 to (\[0-9\]+)\r\n$gdb_prompt $" {
|
|
set upper_dim $expect_out(1,string)
|
|
}
|
|
}
|
|
|
|
gdb_assert { ![string eq $upper_dim ""] } \
|
|
"extracted the upper dimension value"
|
|
|
|
# Check that asking for the ubound dimension 0 gives the same
|
|
# dimension range as in the lbound case.
|
|
gdb_test_multiple "p ubound ($array_name, 0)" "" {
|
|
-re "\r\nUBOUND dimension must be from 1 to (\[0-9\]+)\r\n$gdb_prompt $" {
|
|
gdb_assert {$upper_dim == $expect_out(1,string)} \
|
|
"ubound limit matches lbound limit"
|
|
}
|
|
}
|
|
|
|
# Now ask for the upper and lower bound for each dimension in
|
|
# turn. Add these results into a string which, when complete,
|
|
# will look like the expected results seen above.
|
|
set lbound_str ""
|
|
set ubound_str ""
|
|
set prefix "("
|
|
for { set i 1 } { $i <= $upper_dim } { incr i } {
|
|
set v [get_valueof "/d" "lbound ($array_name, $i)" "???"]
|
|
set lbound_str "${lbound_str}${prefix}${v}"
|
|
|
|
set v [get_valueof "/d" "ubound ($array_name, $i)" "???"]
|
|
set ubound_str "${ubound_str}${prefix}${v}"
|
|
|
|
set prefix ", "
|
|
}
|
|
|
|
# Add closing parenthesis.
|
|
set lbound_str "${lbound_str})"
|
|
set ubound_str "${ubound_str})"
|
|
|
|
gdb_assert [string eq ${lbound_str} $expected_lbound] \
|
|
"lbounds match"
|
|
gdb_assert [string eq ${ubound_str} $expected_ubound] \
|
|
"ubounds match"
|
|
|
|
# Finally, check that asking for a dimension above the valid
|
|
# range gives the expected error.
|
|
set bad_dim [expr $upper_dim + 1]
|
|
gdb_test "p lbound ($array_name, $bad_dim)" \
|
|
"LBOUND dimension must be from 1 to $upper_dim" \
|
|
"check error message for lbound of dim = $bad_dim"
|
|
|
|
gdb_test "p ubound ($array_name, $bad_dim)" \
|
|
"UBOUND dimension must be from 1 to $upper_dim" \
|
|
"check error message for ubound of dim = $bad_dim"
|
|
|
|
# Move back up a frame just so we finish the test in frame 0.
|
|
gdb_test_multiple "down" "down" {
|
|
-re "\r\n$gdb_prompt $" {
|
|
# Don't issue a pass here.
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
gdb_assert {$found_dealloc_breakpoint} "ran all compiled in tests"
|
|
|
|
# Test the kind parameter of ubound and lbound a few times.
|
|
gdb_test "p lbound(array_1d_1bytes_overflow, 1, 1)" "= 127"
|
|
gdb_test "p lbound(array_1d_1bytes_overflow, 1, 2)" "= -129"
|
|
gdb_test "p ubound(array_1d_1bytes_overflow, 1, 1)" "= -117"
|
|
|
|
gdb_test "p lbound(array_1d_2bytes_overflow, 1, 2)" "= 32757"
|
|
gdb_test "p ubound(array_1d_2bytes_overflow, 1, 2)" "= -32766"
|
|
gdb_test "p ubound(array_1d_2bytes_overflow, 1, 4)" "= 32770"
|
|
|
|
# On 32-bit machines most compilers will complain when trying to allocate an
|
|
# array with ranges outside the 4 byte integer range. As the behavior is
|
|
# compiler implementation dependent, we do not run these test on 32 bit targets.
|
|
if {[is_64_target]} {
|
|
gdb_test "p lbound(array_1d_4bytes_overflow, 1, 4)" "= 2147483644"
|
|
gdb_test "p lbound(array_1d_4bytes_overflow, 1, 8)" "= -2147483652"
|
|
gdb_test "p ubound(array_1d_4bytes_overflow, 1, 4)" "= -2147483637"
|
|
gdb_test "p lbound(array_1d_4bytes_overflow)" "= \\(2147483644\\)"
|
|
}
|
|
|
|
# Ensure we reached the final breakpoint. If more tests have been added
|
|
# to the test script, and this starts failing, then the safety 'while'
|
|
# loop above might need to be increased.
|
|
gdb_continue_to_breakpoint "Final Breakpoint"
|
|
|
|
# Now for some final tests. This is mostly testing that GDB gives the
|
|
# correct errors in certain cases.
|
|
foreach var {str_1 an_int} {
|
|
foreach func {lbound ubound} {
|
|
gdb_test "p ${func} ($var)" \
|
|
"[string toupper $func] can only be applied to arrays"
|
|
}
|
|
}
|