diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 2ad89ac01f..7631cce62a 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-07-04 Pedro Alves + + * lib/gdb.exp (foreach_with_prefix): Don't return early if + body returned ok(0), break(3) or continue(4). + * gdb.testsuite/foreach_with_prefix.exp: New file. + 2019-07-04 Alan Hayward * gdb.server/unittest.exp: Allow 0 unit tests to run. diff --git a/gdb/testsuite/gdb.testsuite/foreach_with_prefix.exp b/gdb/testsuite/gdb.testsuite/foreach_with_prefix.exp new file mode 100644 index 0000000000..9cd41496c4 --- /dev/null +++ b/gdb/testsuite/gdb.testsuite/foreach_with_prefix.exp @@ -0,0 +1,98 @@ +# Copyright 2019 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 . + +# Testsuite self-tests for foreach_with_prefix. + +# Check that SEQVAR and EXPECTED_SEQ hold the same sequence. +proc check_sequence {seqvar expected_seq} { + verbose -log "\"$seqvar\" eq \"$expected_seq\"?" + + set test "sequence matches" + if {$seqvar eq $expected_seq} { + pass $test + } else { + fail $test + } +} + +# Test TCL_OK (0). +with_test_prefix "ok" { + set seq "" + foreach_with_prefix var1 {0 1} { + foreach_with_prefix var2 {0 1} { + lappend seq $var1 $var2 + } + } + + check_sequence $seq "0 0 0 1 1 0 1 1" +} + +# Test TCL_ERROR (1). +with_test_prefix "error" { + catch { + set seq "" + foreach_with_prefix var1 {0 1} { + foreach_with_prefix var2 {0 1} { + lappend seq $var1 $var2 + error $seq + } + } + return "unreachable" + } seq + + check_sequence $seq "0 0" +} + +# Test TCL_RETURN (2). +with_test_prefix "return" { + proc test_return {} { + set seq "" + foreach_with_prefix var1 {0 1} { + foreach_with_prefix var2 {0 1} { + lappend seq $var1 $var2 + return $seq + } + } + return $seq + } + + set seq [test_return] + check_sequence $seq "0 0" +} + +# Test TCL_BREAK (3). +with_test_prefix "break" { + set seq "" + foreach_with_prefix var1 {0 1} { + foreach_with_prefix var2 {0 1} { + lappend seq $var1 $var2 + break + } + } + + check_sequence $seq "0 0 1 0" +} + +# Test TCL_CONTINUE (4). +with_test_prefix "continue" { + set seq "" + foreach_with_prefix var1 {0 1} { + foreach_with_prefix var2 {0 1} { + lappend seq $var1 $var2 + continue + } + } + + check_sequence $seq "0 0 0 1 1 0 1 1" +} diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 41f0ef5839..49ec8b2a55 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -2031,7 +2031,9 @@ proc foreach_with_prefix {var list body} { if {$code == 1} { global errorInfo errorCode return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { + } elseif {$code == 3} { + break + } elseif {$code == 2} { return -code $code $result } }