gdb/testsuite/gdb.testsuite/foreach_with_prefix.exp

# Copyright 2019-2024 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/>.

# 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"
}