[deliverable/binutils-gdb.git] / sim / testsuite / lib / sim-defs.exp

# 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"
		    file delete ${name}.o ${name}.x
		} 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"
		    file delete ${name}.o ${name}.x
		} 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 arbitrary lines until the first option is seen.
    set seen_opt 0
    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]
	    set seen_opt 1
	} else {
	    if { $seen_opt } {
		break
	    }
	}
    }
    close $f
    return $opt_array
}
Commit	Line	Data
c906108c SS	1	# Simulator dejagnu utilities.
	2
	3	# Communicate simulator path from sim_init to sim_version.
	4	# For some reason [board_info target sim] doesn't work in sim_version.
	5	# [Presumubly because the target has been "popped" by then. Odd though.]
	6	set sim_path "unknown-run"
	7
	8	# Initialize the testrun.
	9	# Required by dejagnu.
	10
	11	proc sim_init { args } {
	12	global sim_path
	13	set sim_path [board_info target sim]
	14	# Need to return an empty string (copied from GAS).
	15	return ""
	16	}
	17
	18	# Print the version of the simulator being tested.
	19	# Required by dejagnu.
	20
	21	proc sim_version {} {
	22	global sim_path
	23	set version 0.5
	24	clone_output "$sim_path $version\n"
	25	}
	26
	27	# Cover function to target_compile.
	28	# Copied from gdb_compile.
	29
	30	proc sim_compile { source dest type options } {
	31	set result [target_compile $source $dest $type $options]
	32	regsub "\[\r\n\]*$" "$result" "" result
	33	regsub "^\[\r\n\]*" "$result" "" result
	34	if { $result != "" } {
	35	clone_output "sim compile output: $result"
	36	}
	37	return $result
	38	}
	39
	40	# Run a program on the simulator.
	41	# Required by dejagnu (at least ${tool}_run used to be).
	42	#
	43	# SIM_OPTS are options for the simulator.
	44	# PROG_OPTS are options passed to the simulated program.
	45	# At present REDIR must be "" or "> foo".
	46	# OPTIONS is a list of options internal to this routine.
	47	# This is modelled after target_compile. We want to be able to add new
	48	# options without having to update all our users.
	49	# Currently:
	50	# env(foo)=val - set environment variable foo to val for this run
	51	# timeout=val - set the timeout to val for this run
	52	#
	53	# The result is a list of two elements.
	54	# The first is one of pass/fail/etc.
	55	# The second is the program's output.
	56	#
	57	# This is different than the sim_load routine provided by
	58	# dejagnu/config/sim.exp. It's not clear how to pass arguments to the
	59	# simulator (not the simulated program, the simulator) with sim_load.
	60
	61	proc sim_run { prog sim_opts prog_opts redir options } {
	62	global SIMFLAGS
	63
	64	# Set the default value of the timeout.
65	# FIXME: The timeout value we actually want is a function of
66	# host, target, and testcase.
67	set testcase_timeout [board_info target sim_time_limit]
68	if { "$testcase_timeout" == "" } {
69	set testcase_timeout [board_info host testcase_timeout]
70	}
71	if { "$testcase_timeout" == "" } {
72	set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
73	}
74
75	# Initial the environment we pass to the testcase.
76	set testcase_env ""
77
78	# Process OPTIONS ...
79	foreach o $options {
80	if [regexp {^env\((.)\)=(.)} $o full var val] {
81	set testcase_env "$testcase_env $var=$val"
82	} elseif [regexp {^timeout=(.*)} $o full val] {
83	set testcase_timeout $val
84	}
85
86	}
87
88	verbose "testcase timeout is set to $testcase_timeout" 1
89
90	set sim [board_info target sim]
91
92	if [is_remote host] {
93	set prog [remote_download host $prog]
94	if { $prog == "" } {
95	error "download failed"
bc81a370	96	return -1
c906108c SS	97	}
	98	}
	99
	100	set board [target_info name]
	101	if [board_info $board exists sim,options] {
	102	set always_opts [board_info $board sim,options]
	103	} else {
	104	set always_opts ""
	105	}
	106
	107	# FIXME: this works for UNIX only
	108	if { "$testcase_env" != "" } {
	109	set sim "env $testcase_env $sim"
	110	}
	111
	112	send_log "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts\n"
	113
	114	if { "$redir" == "" } {
	115	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts"
	116	} else {
	117	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts $redir" writeonly
	118	}
	119	set result [remote_wait host $testcase_timeout]
	120
	121	set return_code [lindex $result 0]
	122	set output [lindex $result 1]
	123	# Remove the \r part of "\r\n" so we don't break all the patterns
	124	# we want to match.
	125	regsub -all -- "\r" $output "" output
	126
	127	if [is_remote host] {
	128	# clean up after ourselves.
	129	remote_file host delete $prog
	130	}
	131
	132	# ??? Not sure the test for pass/fail is right.
	133	# We just care that the simulator ran correctly, not whether the simulated
	134	# program return 0 or non-zero from `main'.
	135	set status fail
	136	if { $return_code == 0 } {
	137	set status pass
	138	}
	139
	140	return [list $status $output]
	141	}
	142
	143	# Run testcase NAME.
	144	# NAME is either a fully specified file name, or just the file name in which
	145	# case $srcdir/$subdir will be prepended.
104c1213 JM	146	# REQUESTED_MACHS is a list of machines to run the testcase on. If NAME isn't
	147	# for the specified machine(s), it is ignored.
	148	# Typically REQUESTED_MACHS contains just one element, it is up to the caller
	149	# to iterate over the desired machine variants.
	150	#
	151	# The file can contain options in the form "# option(mach list): value".
c906108c SS	152	# Possibilities:
	153	# mach: [all \| machine names]
	154	# as[(mach-list)]: <assembler options>
	155	# ld[(mach-list)]: <linker options>
	156	# sim[(mach-list)]: <simulator options>
0ab7df8a DB	157	# output: program output pattern to match with string-match
0ab7df8a DB	158	# xerror: program is expected to return with a "failure" exit code
c906108c SS	159	# If `output' is not specified, the program must output "pass" if !xerror or
	160	# "fail" if xerror.
	161	# The parens in "optname()" are optional if the specification is for all machs.
	162
104c1213	163	proc run_sim_test { name requested_machs } {
c906108c	164	global subdir srcdir
104c1213	165	global SIMFLAGS
c906108c	166	global opts
0ab7df8a	167	global cpu_option
c906108c SS	168
	169	if [string match "/" $name] {
	170	set file $name
	171	set name [file tail $name]
	172	} else {
	173	set file "$srcdir/$subdir/$name"
	174	}
	175
	176	set opt_array [slurp_options "${file}"]
	177	if { $opt_array == -1 } {
	178	unresolved $subdir/$name
	179	return
	180	}
0ab7df8a DB	181	# Clear default options
	182	set opts(as) ""
	183	set opts(ld) ""
	184	set opts(sim) ""
	185	set opts(output) ""
	186	set opts(mach) ""
	187	set opts(timeout) ""
c906108c SS	188	set opts(xerror) "no"
c906108c SS	189
0ab7df8a DB	190	# Clear any machine specific options specified in a previous test case
	191	foreach m $requested_machs {
	192	if [info exists opts(as,$m)] {
	193	unset opts(as,$m)
	194	}
	195	if [info exists opts(ld,$m)] {
	196	unset opts(ld,$m)
	197	}
	198	if [info exists opts(sim,$m)] {
	199	unset opts(sim,$m)
	200	}
	201	}
	202
c906108c SS	203	foreach i $opt_array {
	204	set opt_name [lindex $i 0]
	205	set opt_machs [lindex $i 1]
	206	set opt_val [lindex $i 2]
	207	if ![info exists opts($opt_name)] {
	208	perror "unknown option $opt_name in file $file"
	209	unresolved $subdir/$name
	210	return
	211	}
	212	foreach m $opt_machs {
	213	set opts($opt_name,$m) $opt_val
	214	}
	215	if { "$opt_machs" == "" } {
	216	set opts($opt_name) $opt_val
	217	}
	218	}
	219
	220	set testname $name
	221	set sourcefile $file
	222	if { $opts(output) == "" } {
	223	if { "$opts(xerror)" == "no" } {
	224	set opts(output) "pass\n"
	225	} else {
	226	set opts(output) "fail\n"
	227	}
	228	}
	229	# Change \n sequences to newline chars.
	230	regsub -all "\\\\n" $opts(output) "\n" opts(output)
	231
104c1213 JM	232	set testcase_machs $opts(mach)
	233	if { "$testcase_machs" == "all" } {
	234	set testcase_machs $requested_machs
	235	}
	236
	237	foreach mach $testcase_machs {
	238	if { [lsearch $requested_machs $mach] < 0 } {
	239	verbose -log "Skipping $mach version of $name, not requested."
	240	continue
	241	}
	242
	243	verbose -log "Testing $name on machine $mach."
c906108c SS	244
	245	if ![info exists opts(as,$mach)] {
	246	set opts(as,$mach) $opts(as)
	247	}
104c1213	248
0ab7df8a DB	249	set as_options "$opts(as,$mach) -I$srcdir/$subdir"
	250	if [info exists cpu_option] {
	251	set as_options "$as_options $cpu_option=$mach"
	252	}
	253	set comp_output [target_assemble $sourcefile ${name}.o "$as_options"]
c906108c SS	254
	255	if ![string match "" $comp_output] {
	256	verbose -log "$comp_output" 3
f18ee7ef	257	fail "$mach $testname (assembling)"
c906108c SS	258	continue
	259	}
	260
	261	if ![info exists opts(ld,$mach)] {
	262	set opts(ld,$mach) $opts(ld)
	263	}
104c1213 JM	264
104c1213 JM	265	set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach)"]
c906108c SS	266
	267	if ![string match "" $comp_output] {
	268	verbose -log "$comp_output" 3
f18ee7ef	269	fail "$mach $testname (linking)"
c906108c SS	270	continue
	271	}
	272
	273	# If no machine specific options, default to the general version.
	274	if ![info exists opts(sim,$mach)] {
	275	set opts(sim,$mach) $opts(sim)
	276	}
	277
	278	# Build the options argument.
	279	set options ""
	280	if { "$opts(timeout)" != "" } {
	281	set options "$options timeout=$opts(timeout)"
	282	}
	283
	284	set result [sim_run ${name}.x "$opts(sim,$mach)" "" "" "$options"]
	285	set status [lindex $result 0]
	286	set output [lindex $result 1]
	287
	288	if { "$status" == "pass" } {
	289	if { "$opts(xerror)" == "no" } {
	290	if [string match $opts(output) $output] {
	291	pass "$mach $testname"
2345c93c	292	file delete ${name}.o ${name}.x
c906108c SS	293	} else {
	294	verbose -log "output: $output" 3
	295	verbose -log "pattern: $opts(output)" 3
f18ee7ef	296	fail "$mach $testname (execution)"
c906108c SS	297	}
	298	} else {
	299	verbose -log "`pass' return code when expecting failure" 3
f18ee7ef	300	fail "$mach $testname (execution)"
c906108c SS	301	}
	302	} elseif { "$status" == "fail" } {
	303	if { "$opts(xerror)" == "no" } {
f18ee7ef	304	fail "$mach $testname (execution)"
c906108c SS	305	} else {
	306	if [string match $opts(output) $output] {
	307	pass "$mach $testname"
2345c93c	308	file delete ${name}.o ${name}.x
c906108c SS	309	} else {
	310	verbose -log "output: $output" 3
	311	verbose -log "pattern: $opts(output)" 3
f18ee7ef	312	fail "$mach $testname (execution)"
c906108c SS	313	}
	314	}
	315	} else {
	316	$status "$mach $testname"
	317	}
	318	}
	319	}
	320
	321	# Subroutine of run_sim_test to process options in FILE.
	322
	323	proc slurp_options { file } {
	324	if [catch { set f [open $file r] } x] {
	325	#perror "couldn't open `$file': $x"
	326	perror "$x"
	327	return -1
	328	}
	329	set opt_array {}
	330	# whitespace expression
	331	set ws {[ ]*}
	332	set nws {[^ ]*}
	333	# whitespace is ignored anywhere except within the options list;
	334	# option names are alphabetic only
	335	set pat "^#${ws}(\[a-zA-Z\])\\(?(\[^):\])\\)?$ws:${ws}(.*)$ws\$"
fbd93201 DB	336	# Allow arbitrary lines until the first option is seen.
fbd93201 DB	337	set seen_opt 0
c906108c SS	338	while { [gets $f line] != -1 } {
	339	set line [string trim $line]
	340	# Whitespace here is space-tab.
	341	if [regexp $pat $line xxx opt_name opt_machs opt_val] {
	342	# match!
	343	lappend opt_array [list $opt_name $opt_machs $opt_val]
fbd93201	344	set seen_opt 1
c906108c	345	} else {
fbd93201	346	if { $seen_opt } {
c906108c SS	347	break
	348	}
	349	}
c906108c SS	350	}
	351	close $f
	352	return $opt_array
	353	}