2011-03-15 Ben Elliston <bje@gnu.org>
+ * runtest.exp: Whitespace cleanups.
+ * lib/dejagnu.exp, lib/dg.exp, lib/framework.exp,
+ lib/libgloss.exp, lib/remote.exp, lib/rsh.exp, lib/target.exp,
+ lib/telnet.exp, lib/tip.exp, lib/utils.exp: Likewise.
+
+2011-03-15 Ben Elliston <bje@gnu.org>
+
* runtest: Remove trailing semicolons.
* lib/rsh.exp: Likewise.
catch close
return ""
}
-
# Define our own "special function" `unknown' so we catch spelling errors.
# But first rename the existing one so we can restore it afterwards.
if { [info procs dg-save-unknown] == [list] } {
- rename unknown dg-save-unknown
- proc unknown { args } {
+ rename unknown dg-save-unknown
+ proc unknown { args } {
return -code error "unknown dg option: $args"
- }
+ }
}
set tmp [dg-get-options $prog]
# Restore normal error handling.
if { [info procs dg-save-unknown] != [list] } {
- rename unknown ""
- rename dg-save-unknown unknown
+ rename unknown ""
+ rename dg-save-unknown unknown
}
# If we're not supposed to try this test on this target, we're done.
set comment [lindex $i 3]
#send_user "Before:\n$comp_output\n"
if {[regsub -all "(^|\n)(\[^\n\]+$line\[^\n\]*($pattern)\[^\n\]*\n?)+" $comp_output "\n" comp_output]} {
- set comp_output [string trimleft $comp_output]
+ set comp_output [string trimleft $comp_output]
set ok pass
set uhoh fail
} else {
if { $xml } {
catch "exec rm -f $outdir/$tool.xml"
set xml_file [open [file join $outdir $tool.xml] w]
- xml_output "<?xml version=\"1.0\"?>"
- insertdtd
- xml_output "<testsuite>"
+ xml_output "<?xml version=\"1.0\"?>"
+ insertdtd
+ xml_output "<testsuite>"
}
catch "exec rm -f $outdir/$tool.log"
log_file -a "$outdir/$tool.log"
global xml_file
if { $xml } {
- xml_output "</testsuite>"
- catch "close $xml_file"
+ xml_output "</testsuite>"
+ catch "close $xml_file"
}
catch "close $sum_file"
set val $test_counts($x,$which)
if { $val > 0 } {
set mess "# of $test_counts($x,name)"
- if { $xml } {
- xml_output " <summary>"
- xml_output " <result>$x</result>"
- xml_output " <description>$mess</description>"
- xml_output " <total>$val</total>"
- xml_output " </summary>"
- }
+ if { $xml } {
+ xml_output " <summary>"
+ xml_output " <result>$x</result>"
+ xml_output " <description>$mess</description>"
+ xml_output " <total>$val</total>"
+ xml_output " </summary>"
+ }
if { [string length $mess] < 24 } {
append mess "\t"
}
if { $xml } {
global errorInfo
- set error ""
- if {[info exists errorInfo]} {
+ set error ""
+ if {[info exists errorInfo]} {
set error $errorInfo
- }
- global expect_out
+ }
+ global expect_out
set rio { "" "" }
if { [catch { set rio [split $expect_out(buffer) "\n"] } result]} {
#do nothing - leave as { "" "" }
}
-
- set output ""
+
+ set output ""
set output "expect_out(buffer)"
- xml_output " <test>"
- xml_output " <input>[string trimright [lindex $rio 0]]</input>"
- xml_output " <output>[string trimright [lindex $rio 1]]</output>"
- xml_output " <result>$type</result>"
- xml_output " <name>$message</name>"
-
xml_output " <prms_id>$prms_id</prms_id>"
- xml_output " </test>"
+ xml_output " <test>"
+ xml_output " <input>[string trimright [lindex $rio 0]]</input>"
+ xml_output " <output>[string trimright [lindex $rio 1]]</output>"
+ xml_output " <result>$type</result>"
+ xml_output " <name>$message</name>"
+ xml_output " <prms_id>$prms_id</prms_id>"
+ xml_output " </test>"
}
switch $type {
# extract the options and their directory names as know by gcc
foreach i "[exec $compiler --print-multi-lib]" {
- if {$extra != ""} {
+ if {$extra != ""} {
# string trimright would do the wrong thing if we included
# the leading @@ in $extra
set i [string trimright $i $extra]
if { [llength $args] > 0 } {
set override_opt [lindex $args 0]
foreach j $opts {
- if {$j == $override_opt} {
- set mopts $override_opt
- }
+ if {$j == $override_opt} {
+ set mopts $override_opt
+ }
}
}
}
if {![is_remote host]} {
set NM [lookfor_file $tool_root_dir nm-new]
if {$NM == ""} {
- set NM [lookfor_file $tool_root_dir binutils/nm-new]
+ set NM [lookfor_file $tool_root_dir binutils/nm-new]
}
}
if { $NM == ""} {
}
verbose "output is $output status $status"
if { $outp == "" || $outp == "|& cat" } {
- return [list $status $output]
+ return [list $status $output]
} else {
- return [list $status ""]
+ return [list $status ""]
}
}
set chars 0
set fd [open $file r]
while { [gets $fd cur_line] >= 0 } {
- set errmess ""
- catch "send -i $shell_id \"$cur_line\r\"" errmess
- if {[string match "write\(spawn_id=\[0-9\]+\):" $errmess]} {
- perror "sent \"$cur_line\" got expect error \"$errmess\""
- catch "close $fd"
- return -1
- }
+ set errmess ""
+ catch "send -i $shell_id \"$cur_line\r\"" errmess
+ if {[string match "write\(spawn_id=\[0-9\]+\):" $errmess]} {
+ perror "sent \"$cur_line\" got expect error \"$errmess\""
+ catch "close $fd"
+ return -1
+ }
set chars [expr {$chars + ([string length $cur_line] * 10)}]
if { $chars > $baud } {
sleep 1
set chars 0
}
- verbose "." 3
- verbose "Sent $cur_line" 4
+ verbose "." 3
+ verbose "Sent $cur_line" 4
incr lines
}
verbose "$lines lines transmitted" 2
} else {
set shell_id [board_info $dest fileid]
verbose "shell_id in standard_send is $shell_id" 3
- verbose "send -i [board_info $dest fileid] -- $string" 3
+ verbose "send -i [board_info $dest fileid] -- $string" 3
if {[catch "send -i [board_info $dest fileid] -- \$string" errorInfo]} {
return "$errorInfo"
} else {
global board_info
if {![board_info $dest exists rsh_prog]} {
- if { [which remsh] != 0 } {
- set RSH remsh
- } else {
- set RSH rsh
- }
+ if { [which remsh] != 0 } {
+ set RSH remsh
+ } else {
+ set RSH rsh
+ }
} else {
- set RSH [board_info $dest rsh_prog]
+ set RSH [board_info $dest rsh_prog]
}
if {[board_info $dest exists hostname]} {
}
if {![board_info $dest exists username]} {
- spawn $RSH $remote $commandline
+ spawn $RSH $remote $commandline
} else {
- spawn $RSH -l [board_info $dest username] $remote $commandline
+ spawn $RSH -l [board_info $dest username] $remote $commandline
}
set board_info($dest,fileid) $spawn_id
if {[regexp "(^|\[\r\n\])\\*\\*\\* EXIT code" $output]} {
regsub "^.*\\*\\*\\* EXIT code " $output "" result
regsub "\[\r\n\].*$" $result "" result
- regsub -all "(^|\[\r\n\]|\r\n)\\*\\*\\* EXIT code \[^\r\n\]*(\[\r\n\]\[\r\n\]?|$)" $output "" output
+ regsub -all "(^|\[\r\n\]|\r\n)\\*\\*\\* EXIT code \[^\r\n\]*(\[\r\n\]\[\r\n\]?|$)" $output "" output
regsub "^\[^0-9\]*" $result "" result
regsub "\[^0-9\]*$" $result "" result
verbose "got board status $result" 3
}
if {$code == 1} {
- if {[info exists string]} {send_user "ERROR OCCURED: $errorInfo $errorCode $string"}
+ if {[info exists string]} {send_user "ERROR OCCURED: $errorInfo $errorCode $string"}
if { $error_sect != "" } {
set code [catch {uplevel $error_sect} string]
if {[board_info $desthost exists rcp_prog]} {
set RCP [board_info $desthost rcp_prog]
} else {
- set RCP rcp
+ set RCP rcp
}
if {[board_info $desthost exists rsh_prog]} {
if {[board_info $desthost exists rcp_prog]} {
set RCP [board_info $desthost rcp_prog]
} else {
- set RCP rcp
+ set RCP rcp
}
if {[board_info $desthost exists username]} {
# See Brendan for the raison d'etre of this one.
if {[ishost "alpha*-*-*"]} {
- regsub -all "(^|\n)(/usr/(ucb|bin)/ld.*without exceptions was\[^\n\]+\n?)" $text "\\1" text
+ regsub -all "(^|\n)(/usr/(ucb|bin)/ld.*without exceptions was\[^\n\]+\n?)" $text "\\1" text
}
if {[ishost "hppa*-*-hpux*"]} {
# Ignore the compiler's warnings about PA incompatibility.
# See Brendan for the raison d'etre of this one.
if {[string match "alpha*-*-*" $host_triplet]} {
- regsub -all "(^|\n)(/usr/(ucb|bin)/ld.*without exceptions was\[^\n\]+\n?)" $text "\\1" text
+ regsub -all "(^|\n)(/usr/(ucb|bin)/ld.*without exceptions was\[^\n\]+\n?)" $text "\\1" text
}
# Don't pay attention to the AIX4 linker warnings.
proc target_compile {source destfile type options} {
set target [target_info name]
if { [info proc ${target}_compile] != "" } {
- return [${target}_compile $source $destfile $type $options]
+ return [${target}_compile $source $destfile $type $options]
} else {
- return [default_target_compile $source $destfile $type $options]
+ return [default_target_compile $source $destfile $type $options]
}
}
set compiler [find_gnatmake]
}
}
-
+
if { $i == "c++" } {
set compiler_type "c++"
if {[board_info $dest exists cxxflags]} {
if {[regexp "^ldscript=" $i]} {
regsub "^ldscript=" $i "" ldscript
}
- if {[regexp "^redirect=" $i]} {
- regsub "^redirect=" $i "" redirect
- }
- if {[regexp "^optimize=" $i]} {
- regsub "^optimize=" $i "" optimize
- }
- if {[regexp "^timeout=" $i]} {
- regsub "^timeout=" $i "" timeout
- }
+ if {[regexp "^redirect=" $i]} {
+ regsub "^redirect=" $i "" redirect
+ }
+ if {[regexp "^optimize=" $i]} {
+ regsub "^optimize=" $i "" optimize
+ }
+ if {[regexp "^timeout=" $i]} {
+ regsub "^timeout=" $i "" timeout
+ }
}
if {[board_info $host exists cflags_for_target]} {
# object, because otherwise, in some situations, libtool will
# become confused about the name of the actual source file.
if {$type == "object"} {
- set opts "$add_flags $sources"
+ set opts "$add_flags $sources"
} else {
- set opts "$sources $add_flags"
+ set opts "$sources $add_flags"
}
if {[is_remote host]} {
}
if {[board_info $connhost exists shell_prompt]} {
- set shell_prompt [board_info $connhost shell_prompt]
+ set shell_prompt [board_info $connhost shell_prompt]
}
if {![info exists shell_prompt]} {
# If no prompt, then set it to something generic.
"~\[set\]*" {
verbose "Setting verbose mode" 1
send "verbose\n\n\n"
- }
+ }
}
if { $result < 0 } {
perror "Timed out trying to download."
}
}
- }
+ }
timeout {
perror "Timed out waiting for response to put command."
}
- }
+ }
set timeout 10
return $result
}
# args: the first is the dir to look in, the next
# is the pattern to match. It
# defaults to *. Patterns are csh style
-# globbing rules
+# globbing rules
# options: -all search the tree recursively
# returns: a list of dirs or NULL; the root directory is not returned.
#
}
}
}
- }
+ }
} else {
perror "$tmp"
return ""
#
proc absolute { path } {
if {[string match "." $path]} {
- return [pwd]
+ return [pwd]
}
set basedir [pwd]
set differences 0
if {[file exists ${file_1}]} {
- set file_a [open ${file_1} r]
- fconfigure $file_a -encoding binary
+ set file_a [open ${file_1} r]
+ fconfigure $file_a -encoding binary
} else {
- warning "${file_1} doesn't exist"
- return 0
+ warning "${file_1} doesn't exist"
+ return 0
}
if {[file exists ${file_2}]} {
- set file_b [open ${file_2} r]
- fconfigure $file_b -encoding binary
+ set file_b [open ${file_2} r]
+ fconfigure $file_b -encoding binary
} else {
- warning "${file_2} doesn't exist"
- return 0
+ warning "${file_2} doesn't exist"
+ return 0
}
verbose "# Diff'ing: ${file_1} ${file_2}\n" 1
set list_a ""
while { [gets ${file_a} line] != ${eof} } {
- if {[regexp "^#.*$" ${line}]} {
- continue
- } else {
- lappend list_a ${line}
- }
+ if {[regexp "^#.*$" ${line}]} {
+ continue
+ } else {
+ lappend list_a ${line}
+ }
}
close ${file_a}
set list_b ""
while { [gets ${file_b} line] != ${eof} } {
- if {[regexp "^#.*$" ${line}]} {
- continue
- } else {
- lappend list_b ${line}
- }
+ if {[regexp "^#.*$" ${line}]} {
+ continue
+ } else {
+ lappend list_b ${line}
+ }
}
close ${file_b}
for { set i 0 } { $i < [llength $list_a] } { incr i } {
- set line_a [lindex ${list_a} ${i}]
- set line_b [lindex ${list_b} ${i}]
+ set line_a [lindex ${list_a} ${i}]
+ set line_b [lindex ${list_b} ${i}]
# verbose "\t${file_1}: ${i}: ${line_a}\n" 3
# verbose "\t${file_2}: ${i}: ${line_b}\n" 3
- if {[string compare ${line_a} ${line_b}]} {
+ if {[string compare ${line_a} ${line_b}]} {
verbose "line #${i}\n" 2
- verbose "\< ${line_a}\n" 2
- verbose "\> ${line_b}\n" 2
+ verbose "\< ${line_a}\n" 2
+ verbose "\> ${line_b}\n" 2
send_log "line #${i}\n"
- send_log "\< ${line_a}\n"
- send_log "\> ${line_b}\n"
+ send_log "\< ${line_a}\n"
+ send_log "\> ${line_b}\n"
- set differences -1
- }
+ set differences -1
+ }
}
if { $differences == -1 || [llength ${list_a}] != [llength ${list_b}] } {
verbose "Files not the same" 2
- set differences -1
+ set differences -1
} else {
verbose "Files are the same" 2
set differences 1
return ""
}
}
-
set newline 0
} elseif { [lindex $args $i] == "-log" } {
set logfile 1
- } elseif { [lindex $args $i] == "-x" } {
- set xml 1
+ } elseif { [lindex $args $i] == "-x" } {
+ set xml 1
} elseif { [string index [lindex $args $i] 0] == "-" } {
clone_output "ERROR: verbose: illegal argument: [lindex $args $i]"
return
set found 0
foreach file [lrange $args $i end] {
verbose "Looking for $file" 2
- # In Tcl7.5a2, "file exists" can fail if the filename looks
+ # In Tcl7.5a2, "file exists" can fail if the filename looks
# like ~/FILE and the environment variable HOME does not
# exist.
- if {! [catch {file exists $file} result] && $result} {
+ if {! [catch {file exists $file} result] && $result} {
set found 1
verbose "Found $file"
if { [catch "uplevel #0 source $file"] == 1 } {
# make all options have two hyphens
switch -glob -- $option {
- "--*" {
- }
- "-*" {
+ "--*" {
+ }
+ "-*" {
set option "-$option"
- }
+ }
}
# split out the argument for options that take them
"--ou*" -
"--sr*" -
"--str*" -
- "--ta*" -
+ "--ta*" -
"--di*" -
"--to*" {
incr i
set arg_build_triplet $optarg
continue
}
-
+
"--host_bo*" {
set host_board $optarg
continue
}
-
+
"--ho*" { # (--host) the host configuration
set arg_host_triplet $optarg
continue
set srcdir $optarg
continue
}
-
+
"--target_bo*" {
set target_list $optarg
continue
set tool $optarg
set comm_line_tool $optarg
continue
- }
+ }
"--di*" {
set cmdline_dir_to_run $optarg
# try getting it with who am i
unset tmp
catch "set logname [exec who am i]" tmp
- if {[string match "*Command not found*" $tmp]} {
+ if {[string match "*Command not found*" $tmp]} {
send_user "ERROR: couldn't get the users login name\n"
set logname "Unknown"
} else {
# make all options have two hyphens
switch -glob -- $option {
- "--*" {
- }
- "-*" {
+ "--*" {
+ }
+ "-*" {
set option "-$option"
- }
+ }
}
# split out the argument for options that take them
"--ou*" -
"--sr*" -
"--str*" -
- "--ta*" -
+ "--ta*" -
"--di*" -
"--to*" {
incr i
# Already parsed (and don't set again). Let $DEJAGNU rename it.
continue
}
-
+
"--ho*" { # (--host) the host configuration
# Already parsed (and don't set again). Let $DEJAGNU rename it.
continue
set target_list $optarg
continue
}
-
+
"--ta*" { # (--target) the target configuration
# Already parsed (and don't set again). Let $DEJAGNU rename it.
continue
verbose "Print all test output to screen"
continue
}
-
+
"--di*" {
# Already parsed (and don't set again). Let $DEJAGNU rename it.
# set cmdline_dir_to_run $optarg
continue
}
-
+
"--de*" { # (--debug) expect internal debugging
if {[file exists ./dbg.log]} {
catch "exec rm -f ./dbg.log"
verbose "Expect Debugging is ON"
continue
}
-
+
"--D[01]" { # (-Debug) turn on Tcl debugger
verbose "Tcl debugger is ON"
continue
}
-
+
"--m*" { # (--mail) mail the output
set mailing_list $optarg
- set mail_logs 1
+ set mail_logs 1
verbose "Mail results to $mailing_list"
continue
}
-
+
"--r*" { # (--reboot) reboot the target
set reboot 1
verbose "Will reboot the target (if supported)"
continue
}
-
+
"--ob*" { # (--objdir) where the test case object code lives
# Already parsed, but parse again to make sure command line
# options override any config file.
verbose "Using test binaries in $objdir"
continue
}
-
+
"--ou*" { # (--outdir) where to put the output files
set outdir $optarg
verbose "Test output put in $outdir"
continue
}
-
+
"*.exp" { # specify test names to run
set all_runtests($option) ""
verbose "Running only tests $option"
unset tmp
continue
}
-
+
"--ig*" { # (--ignore) specify test names to exclude
set ignoretests $optarg
verbose "Ignoring test $ignoretests"
set srcdir $optarg
continue
}
-
+
"--str*" { # (--strace) expect trace level
set tracelevel $optarg
strace $tracelevel
verbose "Source Trace level is now $tracelevel"
continue
}
-
+
"--sta*" { # (--status) exit status flag
set exit_error 1
verbose "Tcl errors will set an ERROR exit status"
continue
}
-
+
"--tool_opt*" {
continue
}
set tool $optarg
verbose "Testing $tool"
continue
- }
+ }
- "--x*" {
- set xml 1
- verbose "XML logging turned on"
- continue
+ "--x*" {
+ set xml 1
+ verbose "XML logging turned on"
+ continue
}
"--he*" { # (--help) help text
usage
- exit 0
+ exit 0
}
"[A-Z0-9_-.]*=*" { # skip makefile style args like CC=gcc, etc... (processed in first pass)
#
if {![exp_debug]} {
foreach sig "{SIGTERM {terminated}} \
- {SIGINT {interrupted by user}} \
- {SIGQUIT {interrupted by user}}" {
+ {SIGINT {interrupted by user}} \
+ {SIGQUIT {interrupted by user}}" {
set signal [lindex $sig 0]
set str [lindex $sig 1]
trap "send_error \"got a \[trap -name\] signal, $str \\n\"; log_and_exit;" $signal
foreach multipass_elem $multipass {
set multipass_name [lindex $multipass_elem 0]
if {$p == $multipass_name} {
- lappend passes $multipass_elem
+ lappend passes $multipass_elem
break
}
}
foreach dir "${test_top_dirs}" {
if { [string length ${prev_dir}] == 0 ||
[string first "${prev_dir}/" ${dir}] == -1} {
- # the first top dir entry, or an entry that
+ # the first top dir entry, or an entry that
# does not share the previous entry's entire
- # pathname, record it as a valid top dir entry.
+ # pathname, record it as a valid top dir entry.
#
lappend temp_top_dirs ${dir}
set prev_dir ${dir}
projects / platform / upstream / dejagnu.git / commitdiff