1#   Copyright (C) 2011-2018 Free Software Foundation, Inc.
2
3# This program is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 3 of the License, or
6# (at your option) any later version.
7#
8# This program is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with GCC; see the file COPYING3.  If not see
15# <http://www.gnu.org/licenses/>.
16
17load_lib timeout.exp
18
19# Utility for running a given test through the simulate-thread harness
20# using gdb.  This is invoked via dg-final.
21#
22# Adapted from the guality harness.
23#
24# Call 'fail' if a given test printed "FAIL:", otherwise call 'pass'.
25
26proc simulate-thread { args } {
27    if { ![isnative] || [is_remote target] } { return }
28
29    if { [llength $args] == 1 } {
30	switch [dg-process-target [lindex $args 0]] {
31		"F" { setup_xfail "*-*-*" }
32	}
33    }
34
35    # This assumes that we are three frames down from dg-test, and that
36    # it still stores the filename of the testcase in a local variable "name".
37    # A cleaner solution would require a new DejaGnu release.
38    upvar 2 name testcase
39    upvar 2 prog prog
40    upvar 2 srcdir testsuite_dir
41
42    set gdb_name $::env(GDB_FOR_GCC_TESTING)
43    set exec_file "[file rootname [file tail $prog]].exe"
44    set cmd_file "$testsuite_dir/gcc.dg/simulate-thread/simulate-thread.gdb"
45
46    if ![file exists $exec_file] {
47	return
48    }
49
50    set message "thread simulation test"
51
52    send_log "Spawning: $gdb_name -nx -nw -batch -x $cmd_file ./$exec_file\n"
53    set res [remote_spawn target "$gdb_name -nx -nw -batch -x $cmd_file ./$exec_file"]
54    if { $res < 0 || $res == "" } {
55	unsupported "$testcase $message"
56	return
57    }
58
59    set gdb_worked 0
60
61    remote_expect target [timeout_value] {
62	# Too old GDB
63	-re "Unhandled dwarf expression|Error in sourced command file" {
64	    unsupported "$testcase $message"
65	    remote_close target
66	    return
67	}
68	-re "FAIL:" {
69	    fail "$testcase $message"
70	    remote_close target
71	    return
72	}
73	# If the gdb output contained simulate_thread_done, assume
74	# that at the very least, we had a working gdb that was able
75	# to break in simulate_thread_done.
76	-re "simulate_thread_done" {
77	    set gdb_worked 1
78	    exp_continue
79	}
80	timeout {
81	    fail "$testcase $message"
82	    remote_close target
83	    return
84	}
85    }
86
87    remote_close target
88    if {$gdb_worked} {
89	pass "$testcase $message"
90    } else {
91	# Unsupported in the absence of a sane GDB.
92	unsupported "$testcase $message"
93    }
94    return
95}
96