charset.exp

这个是LINUX下的GDB调度工具的源码

# This testcase is part of GDB, the GNU debugger.

# Copyright 2001, 2004 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 2 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, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  

# Please email any bugs, comments, and/or additions to this file to:
# [e-mail]

# Test GDB's character set support.

if $tracelevel then {
	strace $tracelevel
}

set prms_id 0
set bug_id 0

set testfile "charset"
set srcfile ${testfile}.c
set binfile ${objdir}/${subdir}/${testfile}
if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {
     gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail."
}

# Start with a fresh gdb.
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
gdb_load ${binfile}

# Parse the output from a `show charset' command.  Return the host
# and target charset as a two-element list.
proc parse_show_charset_output {testname} {
    global gdb_prompt

    gdb_expect {
        -re "The current host and target character set is `(.*)'\\.\[\r\n\]+$gdb_prompt $" {
            set host_charset $expect_out(1,string)
            set target_charset $expect_out(1,string)
	    set retlist [list $host_charset $target_charset]
            pass $testname
        }
        -re "The current host character set is `(.*)'\\.\[\r\n\]+The current target character set is `(.*)'\\.\[\r\n\]+$gdb_prompt $" {
            set host_charset $expect_out(1,string)
            set target_charset $expect_out(2,string)
	    set retlist [list $host_charset $target_charset]
            pass $testname
        }
        -re "The host character set is \"(.*)\"\\.\[\r\n\]+$gdb_prompt $" {
            set host_charset $expect_out(1,string)
	    set retlist [list $host_charset]
            pass $testname
        }
        -re "The target character set is \"(.*)\"\\.\[\r\n\]+$gdb_prompt $" {
            set target_charset $expect_out(1,string)
	    set retlist [list $target_charset]
            pass $testname
        }
        -re ".*$gdb_prompt $" {
            fail $testname
        }
        timeout {
            fail "$testname (timeout)"
        }
    }

    return $retlist
}


# Try the various `show charset' commands.  These are all aliases of each
# other; `show target-charset' and `show host-charset' actually print
# both the host and target charsets.

send_gdb "show charset\n"
set show_charset [parse_show_charset_output "show charset"]

send_gdb "show target-charset\n"
set show_target_charset [parse_show_charset_output "show target-charset"]

if {[lsearch $show_charset $show_target_charset] >= 0} {
    pass "check `show target-charset' against `show charset'"
} else {
    fail "check `show target-charset' against `show charset'"
}

send_gdb "show host-charset\n"
set show_host_charset [parse_show_charset_output "show host-charset"]

if {[lsearch $show_charset $show_host_charset] >= 0} {
    pass "check `show host-charset' against `show charset'"
} else {
    fail "check `show host-charset' against `show charset'"
}


# Get the list of supported (host) charsets as possible completions.
send_gdb "set charset \t\t"

# Check that we can at least use ASCII as a host character set.
sleep 1
gdb_expect {
    -re "^set charset .*\r\nASCII.*\r\n$gdb_prompt set charset " {
	# We got the output that we wanted, including ASCII as possible
	# charset. Send a newline to get us back to the prompt. This will
	# also generate an error message. Let's not check here that the error
	# message makes sense, we do that below, as a separate testcase.
        send_gdb "\n"
        gdb_expect {
	    -re ".*Requires an argument.*$gdb_prompt $" {
		pass "get valid character sets"
	    }
	    -re ".*$gdb_prompt $" {
		send_gdb "\n"
		gdb_expect {
		    -re ".*$gdb_prompt $" {
			fail "get valid character sets"
		    }
		}
	    }
	    timeout {
		fail "(timeout) get valid character sets"
	    }
	}
    }
    -re ".*$gdb_prompt $" {
	# We got some output that ended with a regular prompt
        fail "get valid character sets"
    }
    -re ".*$gdb_prompt set charset.*$" {
	# We got some other output, send a cntrl-c to gdb to get us back
        # to the prompt.
	send_gdb "\003"
        fail "get valid character sets"
    }
    timeout {
        fail "get valid character sets (timeout)"
    }
}

# Try a malformed `set charset'.
gdb_test "set charset" \
         "Requires an argument. Valid arguments are.*" \
         "try malformed `set charset'"

# Try using `set host-charset' on an invalid character set.
gdb_test "set host-charset my_grandma_bonnie" \
         "Undefined item: \"my_grandma_bonnie\"." \
         "try `set host-charset' with invalid charset"

# Try using `set target-charset' on an invalid character set.
gdb_test "set target-charset my_grandma_bonnie" \
         "Undefined item: \"my_grandma_bonnie\"." \
         "try `set target-charset' with invalid charset"

# A Tcl array mapping the names of all the character sets we've seen
# to "1" if the character set can be used as a host character set, or
# "0" otherwise.  We can use `array names charsets' just to get a list
# of all character sets.
array set charsets {}

proc all_charset_names {} {
    global charsets
    return [array names charsets]
}

proc valid_host_charset {charset} {
    global charsets
    return $charsets($charset)
}

send_gdb "set host-charset\n"
gdb_expect {
    -re "Requires an argument. Valid arguments are (\[^ \t\n\r,.\]*)" {
	#set host_charset_list $expect_out(1,string)
	set charsets($expect_out(1,string)) 1
	exp_continue
	#pass "capture valid host charsets"
    }

    -re ", (\[^ \t\n\r,.\]*)" {
	#set host_charset_list $expect_out(1,string)
	set charsets($expect_out(1,string)) 1
	exp_continue
	#pass "capture valid host charsets"
    }

    -re "\\.\r\n$gdb_prompt $" {
	#set host_charset_list $expect_out(1,string)
	pass "capture valid host charsets"
    }

    -re ".*$gdb_prompt $" {
	fail "capture valid host charsets"
    }
    timeout {
	fail "(timeout) capture valid host charsets"
    }
}


send_gdb "set target-charset\n"
gdb_expect {
    -re "Requires an argument. Valid arguments are (\[^ \t\n\r,.\]*)" {
	set target_charset $expect_out(1,string)
	if {! [info exists charsets($target_charset)]} {
	    set charsets($target_charset) 0
	}
	exp_continue
    }

    -re ", (\[^ \t\n\r,.\]*)" {
	set target_charset $expect_out(1,string)
	if {! [info exists charsets($target_charset)]} {
	    set charsets($target_charset) 0
	}
	exp_continue
    }

    -re "\\.\r\n$gdb_prompt $" {
	pass "capture valid target charsets"

    }

    -re ".*$gdb_prompt $" {
	fail "capture valid target charsets"
    }

    timeout {
	fail "(timeout) capture valid target charsets"
    }
}

# Make sure that GDB supports every host/target charset combination.
foreach host_charset [all_charset_names] {
    if {[valid_host_charset $host_charset]} {

        set testname "try `set host-charset $host_charset'"
        send_gdb "set host-charset $host_charset\n"
        gdb_expect {
            -re "GDB doesn't know of any character set named.*\[\r\n]+${gdb_prompt} $" {
                # How did it get into `charsets' then?
                fail "$testname (didn't recognize name)"
            }
            -re "GDB can't use `.*' as its host character set\\.\[\r\n]+${gdb_prompt} $" {
                # Well, then why does its `charsets' entry say it can?
                fail $testname
            }
            -re "${gdb_prompt} $" {
                pass $testname
            }
            timeout {
                fail "$testname (timeout)"
            }
        }

        # Check that the command actually had its intended effect:
        # $host_charset should now be the host character set.
        send_gdb "show charset\n"
        set result [parse_show_charset_output "parse `show charset' after `set host-charset $host_charset'"]
        if {! [string compare [lindex $result 0] $host_charset]} {
            pass "check effect of `set host-charset $host_charset'"