sim/testsuite/lib/sim-defs.exp - binutils-gdb - Git at Google

 # Simulator dejagnu utilities.

 # Communicate simulator path from sim_init to sim_version.
 # For some reason [board_info target sim] doesn't work in sim_version.
 # [Presumubly because the target has been "popped" by then.  Odd though.]
 set sim_path "unknown-run"

 # Initialize the testrun.
 # Required by dejagnu.

 proc sim_init { args } {
     global sim_path
     set sim_path [board_info target sim]
     # Need to return an empty string (copied from GAS).
     return ""
 }

 # Print the version of the simulator being tested.
 # Required by dejagnu.

 proc sim_version {} {
     global sim_path
     set version 0.5
     clone_output "$sim_path $version\n"
 }

 # Cover function to target_compile.
 # Copied from gdb_compile.

 proc sim_compile { source dest type options } {
     set result [target_compile $source $dest $type $options]
     regsub "\[\r\n\]*$" "$result" "" result
     regsub "^\[\r\n\]*" "$result" "" result
     if { $result != "" } {
 	clone_output "sim compile output: $result"
     }
     return $result
 }

 # Run a program on the simulator.
 # Required by dejagnu (at least ${tool}_run used to be).
 #
 # SIM_OPTS are options for the simulator.
 # PROG_OPTS are options passed to the simulated program.
 # At present REDIR must be "" or "> foo".
 # OPTIONS is a list of options internal to this routine.
 # This is modelled after target_compile.  We want to be able to add new
 # options without having to update all our users.
 # Currently:
 #	env(foo)=val	- set environment variable foo to val for this run
 #	timeout=val	- set the timeout to val for this run
 #
 # The result is a list of two elements.
 # The first is one of pass/fail/etc.
 # The second is the program's output.
 #
 # This is different than the sim_load routine provided by
 # dejagnu/config/sim.exp.  It's not clear how to pass arguments to the
 # simulator (not the simulated program, the simulator) with sim_load.

 proc sim_run { prog sim_opts prog_opts redir options } {
     global SIMFLAGS

     # Set the default value of the timeout.
     # FIXME: The timeout value we actually want is a function of
     # host, target, and testcase.
     set testcase_timeout [board_info target sim_time_limit]
     if { "$testcase_timeout" == "" } {
 	set testcase_timeout [board_info host testcase_timeout]
     }
     if { "$testcase_timeout" == "" } {
 	set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
     }

     # Initial the environment we pass to the testcase.
     set testcase_env ""

     # Process OPTIONS ...
     foreach o $options {
 	if [regexp {^env\((.*)\)=(.*)} $o full var val] {
 	    set testcase_env "$testcase_env $var=$val"
 	} elseif [regexp {^timeout=(.*)} $o full val] {
 	    set testcase_timeout $val
 	}

     }

     verbose "testcase timeout is set to $testcase_timeout" 1

     set sim [board_info target sim]

     if [is_remote host] {
 	set prog [remote_download host $prog]
 	if { $prog == "" } {
 	    error "download failed"
 	    return -1;
 	}
     }

     set board [target_info name]
     if [board_info $board exists sim,options] {
 	set always_opts [board_info $board sim,options]
     } else {
 	set always_opts ""
     }

     # FIXME: this works for UNIX only
     if { "$testcase_env" != "" } {
 	set sim "env $testcase_env $sim"
     }

     send_log "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts\n"

     if { "$redir" == "" } {
 	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts"
     } else {
 	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts $redir" writeonly
     }
     set result [remote_wait host $testcase_timeout]

     set return_code [lindex $result 0]
     set output [lindex $result 1]
     # Remove the \r part of "\r\n" so we don't break all the patterns
     # we want to match.
     regsub -all -- "\r" $output "" output

     if [is_remote host] {
 	# clean up after ourselves.
 	remote_file host delete $prog
     }

     # ??? Not sure the test for pass/fail is right.
     # We just care that the simulator ran correctly, not whether the simulated
     # program return 0 or non-zero from `main'.
     set status fail
     if { $return_code == 0 } {
 	set status pass
     }

     return [list $status $output]
 }

 # Run testcase NAME.
 # NAME is either a fully specified file name, or just the file name in which
 # case $srcdir/$subdir will be prepended.
 # REQUESTED_MACHS is a list of machines to run the testcase on.  If NAME isn't
 # for the specified machine(s), it is ignored.
 # Typically REQUESTED_MACHS contains just one element, it is up to the caller
 # to iterate over the desired machine variants.
 #
 # The file can contain options in the form "# option(mach list): value".
 # Possibilities:
 # mach: [all | machine names]
 # as[(mach-list)]: <assembler options>
 # ld[(mach-list)]: <linker options>
 # sim[(mach-list)]: <simulator options>
 # output: program output pattern to match with string-match
 # xerror: program is expected to return with a "failure" exit code
 # If `output' is not specified, the program must output "pass" if !xerror or
 # "fail" if xerror.
 # The parens in "optname()" are optional if the specification is for all machs.

 proc run_sim_test { name requested_machs } {
     global subdir srcdir
     global SIMFLAGS
     global opts
     global cpu_option

     if [string match "*/*" $name] {
 	set file $name
 	set name [file tail $name]
     } else {
 	set file "$srcdir/$subdir/$name"
     }

     set opt_array [slurp_options "${file}"]
     if { $opt_array == -1 } {
 	unresolved $subdir/$name
 	return
     }
     # Clear default options
     set opts(as) ""
     set opts(ld) ""
     set opts(sim) ""
     set opts(output) ""
     set opts(mach) ""
     set opts(timeout) ""
     set opts(xerror) "no"

     # Clear any machine specific options specified in a previous test case
     foreach m $requested_machs {
 	if [info exists opts(as,$m)] {
 	    unset opts(as,$m)
 	}
 	if [info exists opts(ld,$m)] {
 	    unset opts(ld,$m)
 	}
 	if [info exists opts(sim,$m)] {
 	    unset opts(sim,$m)
 	}
     }

     foreach i $opt_array {
 	set opt_name [lindex $i 0]
 	set opt_machs [lindex $i 1]
 	set opt_val [lindex $i 2]
 	if ![info exists opts($opt_name)] {
 	    perror "unknown option $opt_name in file $file"
 	    unresolved $subdir/$name
 	    return
 	}
 	foreach m $opt_machs {
 	    set opts($opt_name,$m) $opt_val
 	}
 	if { "$opt_machs" == "" } {
 	    set opts($opt_name) $opt_val
 	}
     }

     set testname $name
     set sourcefile $file
     if { $opts(output) == "" } {
 	if { "$opts(xerror)" == "no" } {
 	    set opts(output) "pass\n"
 	} else {
 	    set opts(output) "fail\n"
 	}
     }
     # Change \n sequences to newline chars.
     regsub -all "\\\\n" $opts(output) "\n" opts(output)

     set testcase_machs $opts(mach)
     if { "$testcase_machs" == "all" } {
 	set testcase_machs $requested_machs
     }

     foreach mach $testcase_machs {
 	if { [lsearch $requested_machs $mach] < 0 } {
 	    verbose -log "Skipping $mach version of $name, not requested."
 	    continue
 	}

 	verbose -log "Testing $name on machine $mach."

 	if ![info exists opts(as,$mach)] {
 	    set opts(as,$mach) $opts(as)
 	}

 	set as_options "$opts(as,$mach) -I$srcdir/$subdir"
 	if [info exists cpu_option] {
 	    set as_options "$as_options $cpu_option=$mach"
 	}
 	set comp_output [target_assemble $sourcefile ${name}.o "$as_options"]

 	if ![string match "" $comp_output] {
 	    verbose -log "$comp_output" 3
 	    fail "$mach $testname (assembling)"
 	    continue
 	}

 	if ![info exists opts(ld,$mach)] {
 	    set opts(ld,$mach) $opts(ld)
 	}

 	set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach)"]

 	if ![string match "" $comp_output] {
 	    verbose -log "$comp_output" 3
 	    fail "$mach $testname (linking)"
 	    continue
 	}

 	# If no machine specific options, default to the general version.
 	if ![info exists opts(sim,$mach)] {
 	    set opts(sim,$mach) $opts(sim)
 	}

 	# Build the options argument.
 	set options ""
 	if { "$opts(timeout)" != "" } {
 	    set options "$options timeout=$opts(timeout)"
 	}

 	set result [sim_run ${name}.x "$opts(sim,$mach)" "" "" "$options"]
 	set status [lindex $result 0]
 	set output [lindex $result 1]

 	if { "$status" == "pass" } {
 	    if { "$opts(xerror)" == "no" } {
 		if [string match $opts(output) $output] {
 		    pass "$mach $testname"
 		} else {
 		    verbose -log "output:  $output" 3
 		    verbose -log "pattern: $opts(output)" 3
 		    fail "$mach $testname (execution)"
 		}
 	    } else {
 		verbose -log "`pass' return code when expecting failure" 3
 		fail "$mach $testname (execution)"
 	    }
 	} elseif { "$status" == "fail" } {
 	    if { "$opts(xerror)" == "no" } {
 		fail "$mach $testname (execution)"
 	    } else {
 		if [string match $opts(output) $output] {
 		    pass "$mach $testname"
 		} else {
 		    verbose -log "output:  $output" 3
 		    verbose -log "pattern: $opts(output)" 3
 		    fail "$mach $testname (execution)"
 		}
 	    }
 	} else {
 	    $status "$mach $testname"
 	}
     }
 }

 # Subroutine of run_sim_test to process options in FILE.

 proc slurp_options { file } {
     if [catch { set f [open $file r] } x] {
 	#perror "couldn't open `$file': $x"
 	perror "$x"
 	return -1
     }
     set opt_array {}
     # whitespace expression
     set ws  {[ 	]*}
     set nws {[^ 	]*}
     # whitespace is ignored anywhere except within the options list;
     # option names are alphabetic only
     set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
     # Allow comment as first line of file.
     set firstline 1
     while { [gets $f line] != -1 } {
 	set line [string trim $line]
 	# Whitespace here is space-tab.
 	if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 	    # match!
 	    lappend opt_array [list $opt_name $opt_machs $opt_val]
 	} else {
 	    if { ! $firstline } {
 		break
 	    }
 	}
 	set firstline 0
     }
     close $f
     return $opt_array
 }
	# Simulator dejagnu utilities.

	# Communicate simulator path from sim_init to sim_version.
	# For some reason [board_info target sim] doesn't work in sim_version.
	# [Presumubly because the target has been "popped" by then. Odd though.]
	set sim_path "unknown-run"

	# Initialize the testrun.
	# Required by dejagnu.

	proc sim_init { args } {
	global sim_path
	set sim_path [board_info target sim]
	# Need to return an empty string (copied from GAS).
	return ""
	}

	# Print the version of the simulator being tested.
	# Required by dejagnu.

	proc sim_version {} {
	global sim_path
	set version 0.5
	clone_output "$sim_path $version\n"
	}

	# Cover function to target_compile.
	# Copied from gdb_compile.

	proc sim_compile { source dest type options } {
	set result [target_compile $source $dest $type $options]
	regsub "\[\r\n\]*$" "$result" "" result
	regsub "^\[\r\n\]*" "$result" "" result
	if { $result != "" } {
	clone_output "sim compile output: $result"
	}
	return $result
	}

	# Run a program on the simulator.
	# Required by dejagnu (at least ${tool}_run used to be).
	#
	# SIM_OPTS are options for the simulator.
	# PROG_OPTS are options passed to the simulated program.
	# At present REDIR must be "" or "> foo".
	# OPTIONS is a list of options internal to this routine.
	# This is modelled after target_compile. We want to be able to add new
	# options without having to update all our users.
	# Currently:
	# env(foo)=val - set environment variable foo to val for this run
	# timeout=val - set the timeout to val for this run
	#
	# The result is a list of two elements.
	# The first is one of pass/fail/etc.
	# The second is the program's output.
	#
	# This is different than the sim_load routine provided by
	# dejagnu/config/sim.exp. It's not clear how to pass arguments to the
	# simulator (not the simulated program, the simulator) with sim_load.

	proc sim_run { prog sim_opts prog_opts redir options } {
	global SIMFLAGS

	# Set the default value of the timeout.
	# FIXME: The timeout value we actually want is a function of
	# host, target, and testcase.
	set testcase_timeout [board_info target sim_time_limit]
	if { "$testcase_timeout" == "" } {
	set testcase_timeout [board_info host testcase_timeout]
	}
	if { "$testcase_timeout" == "" } {
	set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
	}

	# Initial the environment we pass to the testcase.
	set testcase_env ""

	# Process OPTIONS ...
	foreach o $options {
	if [regexp {^env\((.)\)=(.)} $o full var val] {
	set testcase_env "$testcase_env $var=$val"
	} elseif [regexp {^timeout=(.*)} $o full val] {
	set testcase_timeout $val
	}

	}

	verbose "testcase timeout is set to $testcase_timeout" 1

	set sim [board_info target sim]

	if [is_remote host] {
	set prog [remote_download host $prog]
	if { $prog == "" } {
	error "download failed"
	return -1;
	}
	}

	set board [target_info name]
	if [board_info $board exists sim,options] {
	set always_opts [board_info $board sim,options]
	} else {
	set always_opts ""
	}

	# FIXME: this works for UNIX only
	if { "$testcase_env" != "" } {
	set sim "env $testcase_env $sim"
	}

	send_log "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts\n"

	if { "$redir" == "" } {
	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts"
	} else {
	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts $redir" writeonly
	}
	set result [remote_wait host $testcase_timeout]

	set return_code [lindex $result 0]
	set output [lindex $result 1]
	# Remove the \r part of "\r\n" so we don't break all the patterns
	# we want to match.
	regsub -all -- "\r" $output "" output

	if [is_remote host] {
	# clean up after ourselves.
	remote_file host delete $prog
	}

	# ??? Not sure the test for pass/fail is right.
	# We just care that the simulator ran correctly, not whether the simulated
	# program return 0 or non-zero from `main'.
	set status fail
	if { $return_code == 0 } {
	set status pass
	}

	return [list $status $output]
	}

	# Run testcase NAME.
	# NAME is either a fully specified file name, or just the file name in which
	# case $srcdir/$subdir will be prepended.
	# REQUESTED_MACHS is a list of machines to run the testcase on. If NAME isn't
	# for the specified machine(s), it is ignored.
	# Typically REQUESTED_MACHS contains just one element, it is up to the caller
	# to iterate over the desired machine variants.
	#
	# The file can contain options in the form "# option(mach list): value".
	# Possibilities:
	# mach: [all \| machine names]
	# as[(mach-list)]: <assembler options>
	# ld[(mach-list)]: <linker options>
	# sim[(mach-list)]: <simulator options>
	# output: program output pattern to match with string-match
	# xerror: program is expected to return with a "failure" exit code
	# If `output' is not specified, the program must output "pass" if !xerror or
	# "fail" if xerror.
	# The parens in "optname()" are optional if the specification is for all machs.

	proc run_sim_test { name requested_machs } {
	global subdir srcdir
	global SIMFLAGS
	global opts
	global cpu_option

	if [string match "/" $name] {
	set file $name
	set name [file tail $name]
	} else {
	set file "$srcdir/$subdir/$name"
	}

	set opt_array [slurp_options "${file}"]
	if { $opt_array == -1 } {
	unresolved $subdir/$name
	return
	}
	# Clear default options
	set opts(as) ""
	set opts(ld) ""
	set opts(sim) ""
	set opts(output) ""
	set opts(mach) ""
	set opts(timeout) ""
	set opts(xerror) "no"

	# Clear any machine specific options specified in a previous test case
	foreach m $requested_machs {
	if [info exists opts(as,$m)] {
	unset opts(as,$m)
	}
	if [info exists opts(ld,$m)] {
	unset opts(ld,$m)
	}
	if [info exists opts(sim,$m)] {
	unset opts(sim,$m)
	}
	}

	foreach i $opt_array {
	set opt_name [lindex $i 0]
	set opt_machs [lindex $i 1]
	set opt_val [lindex $i 2]
	if ![info exists opts($opt_name)] {
	perror "unknown option $opt_name in file $file"
	unresolved $subdir/$name
	return
	}
	foreach m $opt_machs {
	set opts($opt_name,$m) $opt_val
	}
	if { "$opt_machs" == "" } {
	set opts($opt_name) $opt_val
	}
	}

	set testname $name
	set sourcefile $file
	if { $opts(output) == "" } {
	if { "$opts(xerror)" == "no" } {
	set opts(output) "pass\n"
	} else {
	set opts(output) "fail\n"
	}
	}
	# Change \n sequences to newline chars.
	regsub -all "\\\\n" $opts(output) "\n" opts(output)

	set testcase_machs $opts(mach)
	if { "$testcase_machs" == "all" } {
	set testcase_machs $requested_machs
	}

	foreach mach $testcase_machs {
	if { [lsearch $requested_machs $mach] < 0 } {
	verbose -log "Skipping $mach version of $name, not requested."
	continue
	}

	verbose -log "Testing $name on machine $mach."

	if ![info exists opts(as,$mach)] {
	set opts(as,$mach) $opts(as)
	}

	set as_options "$opts(as,$mach) -I$srcdir/$subdir"
	if [info exists cpu_option] {
	set as_options "$as_options $cpu_option=$mach"
	}
	set comp_output [target_assemble $sourcefile ${name}.o "$as_options"]

	if ![string match "" $comp_output] {
	verbose -log "$comp_output" 3
	fail "$mach $testname (assembling)"
	continue
	}

	if ![info exists opts(ld,$mach)] {
	set opts(ld,$mach) $opts(ld)
	}

	set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach)"]

	if ![string match "" $comp_output] {
	verbose -log "$comp_output" 3
	fail "$mach $testname (linking)"
	continue
	}

	# If no machine specific options, default to the general version.
	if ![info exists opts(sim,$mach)] {
	set opts(sim,$mach) $opts(sim)
	}

	# Build the options argument.
	set options ""
	if { "$opts(timeout)" != "" } {
	set options "$options timeout=$opts(timeout)"
	}

	set result [sim_run ${name}.x "$opts(sim,$mach)" "" "" "$options"]
	set status [lindex $result 0]
	set output [lindex $result 1]

	if { "$status" == "pass" } {
	if { "$opts(xerror)" == "no" } {
	if [string match $opts(output) $output] {
	pass "$mach $testname"
	} else {
	verbose -log "output: $output" 3
	verbose -log "pattern: $opts(output)" 3
	fail "$mach $testname (execution)"
	}
	} else {
	verbose -log "`pass' return code when expecting failure" 3
	fail "$mach $testname (execution)"
	}
	} elseif { "$status" == "fail" } {
	if { "$opts(xerror)" == "no" } {
	fail "$mach $testname (execution)"
	} else {
	if [string match $opts(output) $output] {
	pass "$mach $testname"
	} else {
	verbose -log "output: $output" 3
	verbose -log "pattern: $opts(output)" 3
	fail "$mach $testname (execution)"
	}
	}
	} else {
	$status "$mach $testname"
	}
	}
	}

	# Subroutine of run_sim_test to process options in FILE.

	proc slurp_options { file } {
	if [catch { set f [open $file r] } x] {
	#perror "couldn't open `$file': $x"
	perror "$x"
	return -1
	}
	set opt_array {}
	# whitespace expression
	set ws {[ ]*}
	set nws {[^ ]*}
	# whitespace is ignored anywhere except within the options list;
	# option names are alphabetic only
	set pat "^#${ws}(\[a-zA-Z\])\\(?(\[^):\])\\)?$ws:${ws}(.*)$ws\$"
	# Allow comment as first line of file.
	set firstline 1
	while { [gets $f line] != -1 } {
	set line [string trim $line]
	# Whitespace here is space-tab.
	if [regexp $pat $line xxx opt_name opt_machs opt_val] {
	# match!
	lappend opt_array [list $opt_name $opt_machs $opt_val]
	} else {
	if { ! $firstline } {
	break
	}
	}
	set firstline 0
	}
	close $f
	return $opt_array
	}