diff options
Diffstat (limited to 'gcc/testsuite/gcc.dg/guality/guality.exp')
| -rw-r--r-- | gcc/testsuite/gcc.dg/guality/guality.exp | 82 |
1 files changed, 6 insertions, 76 deletions
diff --git a/gcc/testsuite/gcc.dg/guality/guality.exp b/gcc/testsuite/gcc.dg/guality/guality.exp index b3f3319b102..d4ee6864ba4 100644 --- a/gcc/testsuite/gcc.dg/guality/guality.exp +++ b/gcc/testsuite/gcc.dg/guality/guality.exp @@ -1,6 +1,12 @@ # This harness is for tests that should be run at all optimisation levels. load_lib gcc-dg.exp +load_lib gcc-gdb-test.exp + +# Disable on darwin until radr://7264615 is resolved. +if { [istarget *-*-darwin*] } { + return +} proc check_guality {args} { set result [eval check_compile guality_check executable $args "-g -O0"] @@ -15,82 +21,6 @@ proc check_guality {args} { return $ret } -# Utility for testing variable values using gdb, invoked via dg-final. -# Call pass if variable has the desired value, otherwise fail. -# -# Argument 0 is the line number on which to put a breakpoint -# Argument 1 is the name of the variable to be checked -# Argument 2 is the expected value of the variable -# Argument 3 handles expected failures and the like -proc gdb-test { args } { - if { ![isnative] || [is_remote target] } { return } - - if { [llength $args] >= 4 } { - switch [dg-process-target [lindex $args 3]] { - "S" { } - "N" { return } - "F" { setup_xfail "*-*-*" } - "P" { } - } - } - - # This assumes that we are three frames down from dg-test, and that - # it still stores the filename of the testcase in a local variable "name". - # A cleaner solution would require a new DejaGnu release. - upvar 2 name testcase - upvar 2 prog prog - - set gdb_name $::env(GUALITY_GDB_NAME) - set testname "$testcase line [lindex $args 0] [lindex $args 1] == [lindex $args 2]" - set output_file "[file rootname [file tail $prog]].exe" - set cmd_file "[file rootname [file tail $prog]].gdb" - - set fd [open $cmd_file "w"] - puts $fd "break [lindex $args 0]" - puts $fd "run" - puts $fd "print [lindex $args 1]" - puts $fd "print [lindex $args 2]" - puts $fd "quit" - close $fd - - send_log "Spawning: $gdb_name -nx -nw -quiet -x $cmd_file ./$output_file\n" - set res [remote_spawn target "$gdb_name -nx -nw -quiet -x $cmd_file ./$output_file"] - if { $res < 0 || $res == "" } { - unsupported "$testname" - return - } - - remote_expect target [timeout_value] { - -re {[\n\r]\$1 = ([^\n\r]*)[\n\r]+\$2 = ([^\n\r]*)[\n\r]} { - set first $expect_out(1,string) - set second $expect_out(2,string) - if { $first == $second } { - pass "$testname" - } else { - send_log "$first != $second\n" - fail "$testname" - } - remote_close target - return - } - # Too old GDB - -re "Unhandled dwarf expression|Error in sourced command file" { - unsupported "$testname" - remote_close target - return - } - timeout { - unsupported "$testname" - remote_close target - return - } - } - - remote_close target - unsupported "$testname" - return -} - dg-init global GDB |