clang-tests-external/gdb/7.5/gdb/testsuite/gdb.gdb/observer.exp - llvm-archive - Git at Google

 # Copyright 2003-2004, 2007-2012 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.


 # 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
 }
	# Copyright 2003-2004, 2007-2012 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.


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