summaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.gdb/observer.exp
blob: fed74a0e7f081bb5c9244e3875edb287753176df (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
# Copyright 2003, 2004, 2007, 2008, 2009, 2010 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/>.

# This file was written by Joel Brobecker (brobecker@gnat.com), derived
# from xfullpath.exp.

if $tracelevel then {
    strace $tracelevel
}


# are we on a target board
if { [is_remote target] || ![isnative] } then {
    return
}

proc setup_test { executable } {
    global gdb_prompt
    global timeout

    # load yourself into the debugger
    # This can take a relatively long time, particularly for testing where
    # the executable is being accessed over a network, or where gdb does not
    # support partial symbols for a particular target and has to load the
    # entire symbol table.  Set the timeout to 10 minutes, which should be
    # adequate for most environments (it *has* timed out with 5 min on a
    # SPARCstation SLC under moderate load, so this isn't unreasonable).
    # After gdb is started, set the timeout to 30 seconds for the duration
    # of this test, and then back to the original value.

    set oldtimeout $timeout
    set timeout 600
    verbose "Timeout is now $timeout seconds" 2

    global gdb_file_cmd_debug_info
    set gdb_file_cmd_debug_info "unset"

    set result [gdb_load $executable]
    set timeout $oldtimeout
    verbose "Timeout is now $timeout seconds" 2

    if { $result != 0 } then {
	return -1
    }

    if { $gdb_file_cmd_debug_info != "debug" } then {
	untested "No debug information, skipping testcase."
	return -1
    }

    # Set a breakpoint at main
    gdb_test "break captured_main" \
            "Breakpoint.*at.* file.*, line.*" \
            "breakpoint in captured_main"

    # run yourself
    # It may take a very long time for the inferior gdb to start (lynx),
    # so we bump it back up for the duration of this command.
    set timeout 600

    set description "run until breakpoint at captured_main"
    gdb_test_multiple "run -nw" "$description" {
        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.* at .*main.c:.*$gdb_prompt $" {
            pass "$description"
        }
        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.*$gdb_prompt $" {
            xfail "$description (line numbers scrambled?)"
        }
        -re "vfork: No more processes.*$gdb_prompt $" {
            fail "$description (out of virtual memory)"
            set timeout $oldtimeout
            verbose "Timeout is now $timeout seconds" 2
            return -1
        }
        -re ".*$gdb_prompt $" {
            fail "$description"
            set timeout $oldtimeout
            verbose "Timeout is now $timeout seconds" 2
            return -1
        }
    }

    set timeout $oldtimeout
    verbose "Timeout is now $timeout seconds" 2

    return 0
}

proc attach_first_observer { message } {
    gdb_test_no_output "set \$first_obs = observer_attach_test_notification (&observer_test_first_notification_function)" \
	"$message; attach first observer"
}

proc attach_second_observer { message } {
    gdb_test_no_output "set \$second_obs = observer_attach_test_notification (&observer_test_second_notification_function)" \
	"$message; attach second observer"
}

proc attach_third_observer { message } {
    gdb_test_no_output "set \$third_obs = observer_attach_test_notification (&observer_test_third_notification_function)" \
	"$message; attach third observer"
}

proc detach_first_observer { message } {
    gdb_test_no_output "call observer_detach_test_notification (\$first_obs)" \
	"$message; detach first observer"
}

proc detach_second_observer { message } {
    gdb_test_no_output "call observer_detach_test_notification (\$second_obs)" \
	"$message; detach second observer"
}

proc detach_third_observer { message } {
    gdb_test_no_output "call observer_detach_test_notification (\$third_obs)" \
	"$message; detach third observer"
}

proc check_counters { first second third message } {
    gdb_test "print observer_test_first_observer" \
	".\[0-9\]+ =.*$first" \
	"$message; check first observer counter value"
    gdb_test "print observer_test_second_observer" \
	".\[0-9\]+ =.*$second" \
	"$message; check second observer counter value"
    gdb_test "print observer_test_third_observer" \
	".\[0-9\]+ =.*$third" \
	"$message; check third observer counter value"
}

proc reset_counters { message } {
    gdb_test_no_output "set variable observer_test_first_observer = 0" \
	"$message; reset first observer counter"
    gdb_test_no_output "set variable observer_test_second_observer = 0" \
	"$message; reset second observer counter"
    gdb_test_no_output "set variable observer_test_third_observer = 0" \
	"$message; reset third observer counter"
}

proc test_notifications { first second third message args } {
    # Do any initialization
    for {set i 0} {$i < [llength $args]} {incr i} {
	[lindex $args $i] $message
    }
    reset_counters $message
    # Call observer_notify_test_notification.  Note that this procedure
    # takes one argument, but this argument is ignored by the observer
    # callbacks we have installed.  So we just pass an arbitrary value.
    gdb_test_no_output "call observer_notify_test_notification (0)" \
	"$message; sending notification"
    check_counters $first $second $third $message
}

proc test_observer { executable } {

    set setup_result [setup_test $executable]
    if {$setup_result <0} then {
        return -1
    }

    # First, try sending a notification without any observer attached.
    test_notifications 0 0 0 "no observer attached"

    # Now, attach one observer, and send a notification.
    test_notifications 0 1 0 "second observer attached" \
	attach_second_observer

    # Remove the observer, and send a notification.
    test_notifications 0 0 0 "second observer detached" \
	detach_second_observer

    # With a new observer.
    test_notifications 1 0 0 "1st observer added" \
	attach_first_observer

    # With 2 observers.
    test_notifications 1 1 0 "2nd observer added" \
	attach_second_observer

    # With 3 observers.
    test_notifications 1 1 1 "3rd observer added" \
	attach_third_observer

    # Remove middle observer.
    test_notifications 1 0 1 "2nd observer removed" \
	detach_second_observer

    # Remove first observer.
    test_notifications 0 0 1 "1st observer removed" \
	detach_first_observer

    # Remove last observer.
    test_notifications 0 0 0 "3rd observer removed" \
	detach_third_observer

    # Go back to 3 observers, and remove them in a different order...
    test_notifications 1 1 1 "three observers added" \
	attach_first_observer \
	attach_second_observer \
	attach_third_observer 

    # Remove the third observer.
    test_notifications 1 1 0 "third observer removed" \
	detach_third_observer

    # Remove the second observer.
    test_notifications 1 0 0 "second observer removed" \
	detach_second_observer

    # Remove the first observer, no more observers.
    test_notifications 0 0 0 "first observer removed" \
	detach_first_observer

    return 0
}

# Find a pathname to a file that we would execute if the shell was asked
# to run $arg using the current PATH.

proc find_gdb { arg } {

    # If the arg directly specifies an existing executable file, then
    # simply use it.

    if [file executable $arg] then {
	return $arg
    }

    set result [which $arg]
    if [string match "/" [ string range $result 0 0 ]] then {
	return $result
    }

    # If everything fails, just return the unqualified pathname as default
    # and hope for best.

    return $arg
}

# Run the test with self.
# Copy the file executable file in case this OS doesn't like to edit its own
# text space.

set GDB_FULLPATH [find_gdb $GDB]

# Remove any old copy lying around.
remote_file host delete x$tool

gdb_start
set file [remote_download host $GDB_FULLPATH x$tool]
set result [test_observer $file];
gdb_exit;
catch "remote_file host delete $file";

if {$result <0} then {
    warning "Couldn't test self"
    return -1
}