diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/debugger.exp | 16 | ||||
| -rwxr-xr-x | lib/dejagnu.exp | 2 | ||||
| -rw-r--r-- | lib/dg.exp | 30 | ||||
| -rw-r--r-- | lib/framework.exp | 74 | ||||
| -rw-r--r-- | lib/ftp.exp | 20 | ||||
| -rw-r--r-- | lib/kermit.exp | 16 | ||||
| -rw-r--r-- | lib/libgloss.exp | 100 | ||||
| -rw-r--r-- | lib/remote.exp | 110 | ||||
| -rw-r--r-- | lib/rlogin.exp | 12 | ||||
| -rw-r--r-- | lib/rsh.exp | 36 | ||||
| -rw-r--r-- | lib/target.exp | 134 | ||||
| -rw-r--r-- | lib/targetdb.exp | 16 | ||||
| -rw-r--r-- | lib/telnet.exp | 31 | ||||
| -rw-r--r-- | lib/tip.exp | 14 | ||||
| -rw-r--r-- | lib/utils.exp | 52 |
15 files changed, 332 insertions, 331 deletions
diff --git a/lib/debugger.exp b/lib/debugger.exp index 10c6fdc..fd1bd20 100644 --- a/lib/debugger.exp +++ b/lib/debugger.exp @@ -64,13 +64,13 @@ proc dumpwatch { args } { set tmp "" if { [catch "uplevel 1 array name $i" names] } { set tmp [uplevel 1 trace vinfo $i] - if ![string match "" $tmp] { + if {![string match "" $tmp]} { puts "$i $tmp" } } else { foreach k $names { set tmp [uplevel 1 trace vinfo [set i]($k)] - if ![string match "" $tmp] { + if {![string match "" $tmp]} { puts "[set i]($k) = $tmp" } } @@ -102,14 +102,14 @@ proc watchvar { v ignored op } { # proc watchunset { arg } { if { [catch "uplevel 1 array name $arg" names ] } { - if ![uplevel 1 info exists $arg] { + if {![uplevel 1 info exists $arg]} { puts stderr "$arg does not exist" return } uplevel 1 trace variable $arg u watchvar } else { foreach k $names { - if ![uplevel 1 info exists $arg] { + if {![uplevel 1 info exists $arg]} { puts stderr "$arg does not exist" return } @@ -122,14 +122,14 @@ proc watchunset { arg } { # proc watchwrite { arg } { if { [catch "uplevel 1 array name $arg" names ] } { - if ![uplevel 1 info exists $arg] { + if {![uplevel 1 info exists $arg]} { puts stderr "$arg does not exist" return } uplevel 1 trace variable $arg w watchvar } else { foreach k $names { - if ![uplevel 1 info exists $arg] { + if {![uplevel 1 info exists $arg]} { puts stderr "$arg does not exist" return } @@ -142,14 +142,14 @@ proc watchwrite { arg } { # proc watchread { arg } { if { [catch "uplevel 1 array name $arg" names ] } { - if ![uplevel 1 info exists $arg] { + if {![uplevel 1 info exists $arg]} { puts stderr "$arg does not exist" return } uplevel 1 trace variable $arg r watchvar } else { foreach k $names { - if ![uplevel 1 info exists $arg] { + if {![uplevel 1 info exists $arg]} { puts stderr "$arg does not exist" return } diff --git a/lib/dejagnu.exp b/lib/dejagnu.exp index d189f62..a293f2f 100755 --- a/lib/dejagnu.exp +++ b/lib/dejagnu.exp @@ -124,7 +124,7 @@ proc host_execute {args} { } verbose "The executable is $executable" 2 - if ![file exists ${executable}] { + if {![file exists ${executable}]} { perror "The executable, \"$executable\" is missing" 0 return "No source file found" } @@ -187,7 +187,7 @@ proc dg-get-options { prog } { set result "" set tmp [grep $prog "{\[ \t\]\+dg-\[-a-z\]\+\[ \t\]\+.*\[ \t\]\+}" line] - if ![string match "" $tmp] { + if {![string match "" $tmp]} { foreach i $tmp { #send_user "Found: $i\n" # FIXME: When to use "+" and "\+" isn't clear. @@ -221,9 +221,9 @@ proc dg-process-target { selector } { #send_user "dg-process-target: $selector\n" set selector [string trim $selector] - if [regexp "^xfail " $selector] { + if {[regexp "^xfail " $selector]} { set what xfail - } elseif [regexp "^target " $selector] { + } elseif {[regexp "^target " $selector]} { set what target } else { # The use of error here and in other dg-xxx utilities is intentional. @@ -233,11 +233,11 @@ proc dg-process-target { selector } { # ??? This should work but it doesn't. tcl bug? #if [regexp "^${what}(( \[^ \]+-\[^ \]+-\[^ \]+)|( native))+$" $selector tmp selector] - if [regexp "^${what}( \[^ \]+-\[^ \]+-\[^ \]+| native)+$" $selector] { + if {[regexp "^${what}( \[^ \]+-\[^ \]+-\[^ \]+| native)+$" $selector]} { regsub "^${what} " $selector "" selector #send_user "selector: $selector\n" foreach triplet $selector { - if [string match $triplet $target_triplet] { + if {[string match $triplet $target_triplet]} { set triplet_match 1 } elseif { $isnative && $triplet == "native" } { set triplet_match 1 @@ -573,7 +573,7 @@ proc dg-runtest { testcases flags default-extra-flags } { foreach testcase $testcases { # If we're only testing specific files and this isn't one of them, skip it. - if ![runtest_file_p $runtests $testcase] { + if {![runtest_file_p $runtests $testcase]} { continue } verbose "Testing [file tail [file dirname $testcase]]/[file tail $testcase]" @@ -644,7 +644,7 @@ proc dg-test { args } { # The point is to reduce the unnecessary noise in the logs. Don't strip # out too much because different testcases with the same name can confuse # `test-tool'. - if [string match "/*" $name] { + if {[string match "/*" $name]} { set name "[file tail [file dirname $prog]]/[file tail $prog]" } @@ -732,7 +732,7 @@ proc dg-test { args } { set pattern [lindex $i 2] 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] { + if {[regsub -all "(^|\n)(\[^\n\]+$line\[^\n\]*($pattern)\[^\n\]*\n?)+" $comp_output "\n" comp_output]} { set comp_output [string trimleft $comp_output] set ok pass set uhoh fail @@ -814,7 +814,7 @@ proc dg-test { args } { if ${dg-excess-errors-flag} { setup_xfail "*-*-*" } - if ![string match "" $comp_output] { + if {![string match "" $comp_output]} { fail "$name (test for excess errors)" send_log "Excess errors:\n$comp_output\n" } else { @@ -826,7 +826,7 @@ proc dg-test { args } { # FIXME: This is the only place where we assume a standard meaning to # the `keyword' argument of dg-do. This could be cleaned up. if { [lindex ${dg-do-what} 0] == "run" } { - if ![file exists $output_file] { + if {![file exists $output_file]} { unresolved "$name compilation failed to produce executable" } else { set status -1 @@ -857,7 +857,7 @@ proc dg-test { args } { } } elseif { "$status" == "fail" } { # It would be nice to get some info out of errorCode. - if [info exists errorCode] { + if {[info exists errorCode]} { verbose "Exec failed, errorCode: $errorCode" 3 } else { verbose "Exec failed, errorCode not defined!" 3 @@ -874,13 +874,13 @@ proc dg-test { args } { # of the program can be delayed until here. Ditto for other situations. # It would be a bit cumbersome though. - if ![string match ${dg-final-code} ""] { + if {![string match ${dg-final-code} ""]} { regsub -all "\\\\(\[{}\])" ${dg-final-code} "\\1" dg-final-code # Note that the use of `args' here makes this a varargs proc. proc dg-final-proc { args } ${dg-final-code} verbose "Running dg-final tests." 3 verbose "dg-final-proc:\n[info body dg-final-proc]" 4 - if [catch "dg-final-proc $prog" errmsg] { + if {[catch "dg-final-proc $prog" errmsg]} { perror "$name: error executing dg-final: $errmsg" # ??? The call to unresolved here is necessary to clear `errcnt'. # What we really need is a proc like perror that doesn't set errcnt. @@ -907,7 +907,7 @@ proc dg-finish { } { # The framework doesn't like to see any error remnants, so remove them. global errorInfo - if [info exists errorInfo] { + if {[info exists errorInfo]} { unset errorInfo } @@ -915,7 +915,7 @@ proc dg-finish { } { # There may be a bit of duplication (eg: resetting prms_id), leave it. # Let's keep these procs robust. global tool - if ![string match "" [info procs ${tool}_finish]] { + if {![string match "" [info procs ${tool}_finish]]} { ${tool}_finish } } diff --git a/lib/framework.exp b/lib/framework.exp index 2dd4a3b..af73723 100644 --- a/lib/framework.exp +++ b/lib/framework.exp @@ -26,7 +26,7 @@ set warning_threshold 3 set perror_threshold 1 proc mail_file { file to subject } { - if [file readable $file] { + if {[file readable $file]} { catch "exec mail -s \"$subject\" $to < $file" } } @@ -109,15 +109,15 @@ proc isbuild { pattern } { global build_triplet global host_triplet - if ![info exists build_triplet] { + if {![info exists build_triplet]} { set build_triplet ${host_triplet} } - if [string match "" $pattern] { + if {[string match "" $pattern]} { return $build_triplet } verbose "Checking pattern \"$pattern\" with $build_triplet" 2 - if [string match "$pattern" $build_triplet] { + if {[string match "$pattern" $build_triplet]} { return 1 } else { return 0 @@ -162,7 +162,7 @@ proc is_remote { board } { if { $board == "target" } { global current_target_name - if [info exists current_target_name] { + if {[info exists current_target_name]} { # This shouldn't happen, but we'll be paranoid anyway. if { $current_target_name != "target" } { return [is_remote $current_target_name] @@ -170,7 +170,7 @@ proc is_remote { board } { } return 0 } - if [board_info $board exists isremote] { + if {[board_info $board exists isremote]} { verbose "board is $board, isremote is [board_info $board isremote]" 3 return [board_info $board isremote] } @@ -184,7 +184,7 @@ proc is3way {} { global host_triplet global build_triplet - if ![info exists build_triplet] { + if {![info exists build_triplet]} { set build_triplet ${host_triplet} } verbose "Checking $host_triplet against $build_triplet" 2 @@ -200,12 +200,12 @@ proc is3way {} { proc ishost { pattern } { global host_triplet - if [string match "" $pattern] { + if {[string match "" $pattern]} { return $host_triplet } verbose "Checking pattern \"$pattern\" with $host_triplet" 2 - if [string match "$pattern" $host_triplet] { + if {[string match "$pattern" $host_triplet]} { return 1 } else { return 0 @@ -221,8 +221,8 @@ proc istarget { args } { global target_triplet # if no arg, return the config string - if [string match "" $args] { - if [info exists target_triplet] { + if {[string match "" $args]} { + if {[info exists target_triplet]} { return $target_triplet } else { perror "No target configuration names found." @@ -232,9 +232,9 @@ proc istarget { args } { set triplet [lindex $args 0] # now check against the cannonical name - if [info exists target_triplet] { + if {[info exists target_triplet]} { verbose "Checking \"$triplet\" against \"$target_triplet\"" 2 - if [string match $triplet $target_triplet] { + if {[string match $triplet $target_triplet]} { return 1 } } @@ -250,7 +250,7 @@ proc isnative { } { global target_triplet global build_triplet - if [string match $build_triplet $target_triplet] { + if {[string match $build_triplet $target_triplet]} { return 1 } return 0 @@ -264,10 +264,10 @@ proc unknown { args } { global exit_status clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist." - if [info exists errorCode] { + if {[info exists errorCode]} { send_error "The error code is $errorCode\n" } - if [info exists errorInfo] { + if {[info exists errorInfo]} { send_error "The info on the error is:\n$errorInfo\n" } @@ -398,7 +398,7 @@ proc log_summary { args } { # total count, so compare the reported number of testcases with the # expected number. Maintaining an accurate count in `testcnt' isn't easy # so it's not clear how often this will be used. - if [info exists testcnt] { + if {[info exists testcnt]} { if { $testcnt > 0 } { set totlcnt 0 # total all the testcases reported @@ -418,7 +418,7 @@ proc log_summary { args } { verbose "# of testcases run $testcnt" } - if [info exists mismatch] { + if {[info exists mismatch]} { clone_output "### ERROR: totals do not equal number of testcases run" clone_output "### ERROR: # of testcases expected $testcnt" clone_output "### ERROR: # of testcases reported $totlcnt" @@ -472,11 +472,11 @@ proc setup_xfail { args } { for { set i 0 } { $i < $argc } { incr i } { set sub_arg [ lindex $args $i ] # is a prms number. we assume this is a string with no '-' characters - if [regexp "^\[^\-\]+$" $sub_arg] { + if {[regexp "^\[^\-\]+$" $sub_arg]} { set xfail_prms $sub_arg continue } - if [istarget $sub_arg] { + if {[istarget $sub_arg]} { set xfail_flag 1 continue } @@ -502,11 +502,11 @@ proc setup_kfail { args } { for { set i 0 } { $i < $argc } { incr i } { set sub_arg [ lindex $args $i ] # is a prms number. we assume this is a string with no '-' characters - if [regexp "^\[^\-\]+$" $sub_arg] { + if {[regexp "^\[^\-\]+$" $sub_arg]} { set kfail_prms $sub_arg continue } - if [istarget $sub_arg] { + if {[istarget $sub_arg]} { set kfail_flag 1 continue } @@ -548,7 +548,7 @@ proc check_conditional_xfail { args } { set incl_hit 0 set excl_hit 0 foreach targ $target_list { - if [istarget $targ] { + if {[istarget $targ]} { # look through the compiler options for flags we want to see # this is really messy cause each set of options to look for # may also be a list. We also want to find each element of the @@ -565,7 +565,7 @@ proc check_conditional_xfail { args } { set opt [lindex $includes $i] verbose "Looking for $opt to include in the compiler flags" 2 foreach j "$opt" { - if [string match "* $j *" $compiler_flags] { + if {[string match "* $j *" $compiler_flags]} { verbose "Found $j to include in the compiler flags" 2 incr incl_hit } @@ -585,7 +585,7 @@ proc check_conditional_xfail { args } { set opt [lindex $excludes $i] verbose "Looking for $opt to exclude in the compiler flags" 2 foreach j "$opt" { - if [string match "* $j *" $compiler_flags] { + if {[string match "* $j *" $compiler_flags]} { verbose "Found $j to exclude in the compiler flags" 2 incr excl_hit } @@ -625,7 +625,7 @@ proc clear_xfail { args } { set sub_arg [ lindex $args $i ] switch $sub_arg { "*-*-*" { # is a configuration triplet - if [istarget $sub_arg] { + if {[istarget $sub_arg]} { set xfail_flag 0 set xfail_prms 0 } @@ -646,7 +646,7 @@ proc clear_kfail { args } { set sub_arg [ lindex $args $i ] switch $sub_arg { "*-*-*" { # is a configuration triplet - if [istarget $sub_arg] { + if {[istarget $sub_arg]} { set kfail_flag 0 set kfail_prms 0 } @@ -674,7 +674,7 @@ proc record_test { type message args } { } else { set count 1 } - if [info exists pf_prefix] { + if {[info exists pf_prefix]} { set message [concat $pf_prefix " " $message] } @@ -692,7 +692,7 @@ proc record_test { type message args } { if { $xml } { global errorInfo set error "" - if [info exists errorInfo] { + if {[info exists errorInfo]} { set error $errorInfo } global expect_out @@ -826,8 +826,8 @@ proc pass { message } { global xfail_flag kfail_flag compiler_conditional_xfail_data # if we have a conditional xfail setup, then see if our compiler flags match - if [ info exists compiler_conditional_xfail_data ] { - if [check_conditional_xfail $compiler_conditional_xfail_data] { + if {[ info exists compiler_conditional_xfail_data ]} { + if {[check_conditional_xfail $compiler_conditional_xfail_data]} { set xfail_flag 1 } unset compiler_conditional_xfail_data @@ -848,8 +848,8 @@ proc fail { message } { global xfail_flag kfail_flag compiler_conditional_xfail_data # if we have a conditional xfail setup, then see if our compiler flags match - if [ info exists compiler_conditional_xfail_data ] { - if [check_conditional_xfail $compiler_conditional_xfail_data] { + if {[ info exists compiler_conditional_xfail_data ]} { + if {[check_conditional_xfail $compiler_conditional_xfail_data]} { set xfail_flag 1 } unset compiler_conditional_xfail_data @@ -926,7 +926,7 @@ proc warning { args } { clone_output "WARNING: $message" global errorInfo - if [info exists errorInfo] { + if {[info exists errorInfo]} { unset errorInfo } } @@ -949,7 +949,7 @@ proc perror { args } { clone_output "ERROR: $message" global errorInfo - if [info exists errorInfo] { + if {[info exists errorInfo]} { unset errorInfo } } @@ -1031,7 +1031,7 @@ proc incr_count { name args } { } else { set count [lindex $args 0] } - if [info exists test_counts($name,count)] { + if {[info exists test_counts($name,count)]} { incr test_counts($name,count) $count incr test_counts($name,total) $count } else { @@ -1043,7 +1043,7 @@ proc incr_count { name args } { # For compatibility with old versions. # global argv0 -if ![info exists argv0] { +if {![info exists argv0]} { proc exp_continue { } { continue -expect } diff --git a/lib/ftp.exp b/lib/ftp.exp index 0061145..a9510bb 100644 --- a/lib/ftp.exp +++ b/lib/ftp.exp @@ -23,15 +23,15 @@ proc ftp_open {host} { set prompt "ftp>" global board_info - if [board_info $host exists name] { + if {[board_info $host exists name]} { set host [board_info $host name] } - if [board_info $host exists ftp_fileid] { + if {[board_info $host exists ftp_fileid]} { return [board_info $host ftp_fileid] } - if [board_info $host exists hostname] { + if {[board_info $host exists hostname]} { set remotehost [board_info $host hostname] } else { set remotehost $host @@ -62,8 +62,8 @@ proc ftp_open {host} { return -1 } set board_info($host,ftp_fileid) $spawn_id - if [board_info $host exists ftp_username] { - if [board_info $host exists ftp_password] { + if {[board_info $host exists ftp_username]} { + if {[board_info $host exists ftp_password]} { set command "user [board_info $host ftp_username] [board_info $host ftp_password]\n" } else { set command "user [board_info $host ftp_username]\n" @@ -88,7 +88,7 @@ proc ftp_open {host} { return -1 } } - if [board_info $host exists ftp_directory] { + if {[board_info $host exists ftp_directory]} { send "cd [board_info $host ftp_directory]\n" expect { -i $spawn_id -re "250.*$prompt" { } @@ -100,7 +100,7 @@ proc ftp_open {host} { } } - if [board_info $host exists ftp_no_passive] { + if {[board_info $host exists ftp_no_passive]} { send "passive\n" expect { -i $spawn_id -re "Passive mode off.*$prompt" { } @@ -165,7 +165,7 @@ proc ftp_download {host localfile remotefile} { verbose "putting $localfile $remotefile" - if [board_info $host exists hostname] { + if {[board_info $host exists hostname]} { set remotehost [board_info $host hostname] } else { set remotehost $host @@ -220,11 +220,11 @@ proc ftp_download {host localfile remotefile} { proc ftp_close {host} { global board_info - if [board_info $host exists name] { + if {[board_info $host exists name]} { set host [board_info $host name] } - if ![board_info $host exists ftp_fileid] { + if {![board_info $host exists ftp_fileid]} { return "" } diff --git a/lib/kermit.exp b/lib/kermit.exp index 0d7a0b3..19a5c40 100644 --- a/lib/kermit.exp +++ b/lib/kermit.exp @@ -27,13 +27,13 @@ proc kermit_open {dest args} { global spawn_id global board_info - if [board_info $dest exists name] { + if {[board_info $dest exists name]} { set dest [board_info $dest name] } - if [board_info ${dest} exists serial] { + if {[board_info ${dest} exists serial]} { set port [board_info ${dest} serial] set device "-l [board_info ${dest} serial]" - if [board_info ${dest} exists baud] { + if {[board_info ${dest} exists baud]} { append device " -b [board_info ${dest} baud]" } } else { @@ -89,7 +89,7 @@ proc kermit_open {dest args} { if {$result < 0} { perror "Couldn't connect after $tries tries." - if [info exists board_info($dest,fileid)] { + if {[info exists board_info($dest,fileid)]} { unset board_info($dest,fileid) } return -1 @@ -97,7 +97,7 @@ proc kermit_open {dest args} { verbose "Kermit connection established with spawn_id $spawn_id." set board_info($dest,fileid) $spawn_id kermit_command $dest "set file type binary" "set transfer display none" - if [board_info $dest exists transmit_pause] { + if {[board_info $dest exists transmit_pause]} { kermit_command $dest "set transmit pause [board_info $dest transmit_pause]" } return $spawn_id @@ -107,7 +107,7 @@ proc kermit_open {dest args} { # Send a list of commands to the Kermit session connected to DEST. # proc kermit_command {dest args} { - if [board_info $dest exists name] { + if {[board_info $dest exists name]} { set dest [board_info $dest name] } set shell_id [board_info $dest fileid] @@ -151,7 +151,7 @@ proc kermit_command {dest args} { # Send STRING to DEST. # proc kermit_send {dest string args} { - if [board_info $dest exists transmit_pause] { + if {[board_info $dest exists transmit_pause]} { set f [open "/tmp/fff" "w"] puts -nonewline $f "$string" close $f @@ -167,7 +167,7 @@ proc kermit_send {dest string args} { # No translation is performed. # proc kermit_transmit {dest file args} { - if [board_info $dest exists transmit_pause] { + if {[board_info $dest exists transmit_pause]} { kermit_command $dest "transmit $file" return "" } else { diff --git a/lib/libgloss.exp b/lib/libgloss.exp index 376d46a..ed133e5 100644 --- a/lib/libgloss.exp +++ b/lib/libgloss.exp @@ -30,13 +30,13 @@ proc libgloss_link_flags { args } { global srcdir # libgloss doesn't work native - if [isnative] { + if {[isnative]} { return "" } # if we're on a remote host, we can't search for the file, so we can only # use an installed compiler, so we don't add any paths here. - if [is_remote host] { + if {[is_remote host]} { return "" } @@ -86,7 +86,7 @@ proc libgloss_link_flags { args } { if { $gloss_srcdir == "" } { return "" } - if [file exists [file join $gccpath libgloss $cpu]] { + if {[file exists [file join $gccpath libgloss $cpu]]} { verbose "Libgloss path is $gccpath/libgloss/$cpu" 2 return "-B$gccpath/libgloss/$cpu/ -L$gccpath/libgloss/$cpu -L$gloss_srcdir" } else { @@ -107,13 +107,13 @@ proc newlib_link_flags { args } { global tool_root_dir # libgloss doesn't work native - if [isnative] { + if {[isnative]} { return "" } # if we're on a remote host, we can't search for the file, so we can only # use an installed compiler, so we don't add any paths here. - if [is_remote host] { + if {[is_remote host]} { return "" } @@ -127,7 +127,7 @@ proc newlib_link_flags { args } { set gccpath "[get_multilibs]" verbose "Looking for $gccpath/newlib" - if [file exists [file join $gccpath newlib]] { + if {[file exists [file join $gccpath newlib]]} { verbose "Newlib path is $gccpath/newlib" return "$result -B$gccpath/newlib/ -L$gccpath/newlib" } else { @@ -139,17 +139,17 @@ proc newlib_link_flags { args } { proc newlib_include_flags { args } { global srcdir - if [isnative] { + if {[isnative]} { return "" } - if [is_remote host] { + if {[is_remote host]} { return "" } set gccpath "[get_multilibs]" - if [file exists [file join $gccpath newlib]] { + if {[file exists [file join $gccpath newlib]]} { verbose "Newlib path is $gccpath/newlib" set newlib_dir [lookfor_file ${srcdir} newlib/libc/include/assert.h] @@ -172,7 +172,7 @@ proc libio_include_flags { args } { global srcdir global tool_root_dir - if [is_remote host] { + if {[is_remote host]} { return "" } @@ -206,7 +206,7 @@ proc libio_include_flags { args } { } proc libio_link_flags { args } { - if [is_remote host] { + if {[is_remote host]} { return "" } @@ -224,7 +224,7 @@ proc g++_include_flags { args } { global srcdir global target_alias - if [is_remote host] { + if {[is_remote host]} { return "" } @@ -266,25 +266,25 @@ proc g++_link_flags { args } { set ld_library_path "." if { $gccpath != "" } { - if [file exists [file join ${gccpath} lib libstdc++.a]] { + if {[file exists [file join ${gccpath} lib libstdc++.a]]} { append ld_library_path ":${gccpath}/lib" } - if [file exists [file join ${gccpath} libg++ libg++.a]] { + if {[file exists [file join ${gccpath} libg++ libg++.a]]} { append flags "-L${gccpath}/libg++ " append ld_library_path ":${gccpath}/libg++" } - if [file exists [file join ${gccpath} libstdc++ libstdc++.a]] { + if {[file exists [file join ${gccpath} libstdc++ libstdc++.a]]} { append flags "-L${gccpath}/libstdc++ " append ld_library_path ":${gccpath}/libstdc++" } - if [file exists [file join ${gccpath} libstdc++-v3 src .libs libstdc++.a]] { + if {[file exists [file join ${gccpath} libstdc++-v3 src .libs libstdc++.a]]} { append flags "-L${gccpath}/libstdc++-v3/src/.libs " append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" } - if [file exists [file join ${gccpath} libiberty libiberty.a]] { + if {[file exists [file join ${gccpath} libiberty libiberty.a]]} { append flags "-L${gccpath}/libiberty " } - if [file exists [file join ${gccpath} librx librx.a]] { + if {[file exists [file join ${gccpath} librx librx.a]]} { append flags "-L${gccpath}/librx " } } else { @@ -316,7 +316,7 @@ proc libstdc++_include_flags { args } { global srcdir global target_alias - if [is_remote host] { + if {[is_remote host]} { return "" } @@ -354,14 +354,14 @@ proc libstdc++_link_flags { args } { set flags "" if { $gccpath != "" } { - if [file exists [file join ${gccpath} libstdc++ libstdc++.a]] { + if {[file exists [file join ${gccpath} libstdc++ libstdc++.a]]} { append flags "-L${gccpath}/libstdc++ " append ld_library_path ":${gccpath}/libstdc++" } - if [file exists [file join ${gccpath} libiberty libiberty.a]] { + if {[file exists [file join ${gccpath} libiberty libiberty.a]]} { append flags "-L${gccpath}/libiberty " } - if [file exists [file join ${gccpath} librx librx.a]] { + if {[file exists [file join ${gccpath} librx librx.a]]} { append flags "-L${gccpath}/librx " } } else { @@ -395,18 +395,18 @@ proc get_multilibs { args } { # if we're on a remote host, we can't search for the file, so we can only # use an installed compiler, so we don't add any paths here. - if [is_remote host] { + if {[is_remote host]} { return "" } - if [info exists board] { + if {[info exists board]} { set target_board $board } else { set target_board [target_info name] } if { [llength $args] == 0 } { - if [board_info $target_board exists multitop] { + if {[board_info $target_board exists multitop]} { return "[board_info $target_board multitop]" } @@ -424,7 +424,7 @@ proc get_multilibs { args } { } foreach x "$compiler" { - if [regexp "^-B" "$x"] { + if {[regexp "^-B" "$x"]} { regsub "^-B" "$x" "" comp_base_dir set comp_base_dir [file dirname $comp_base_dir] break @@ -490,7 +490,7 @@ proc get_multilibs { args } { } } - if ![info exists comp_base_dir] { + if {![info exists comp_base_dir]} { set comp_base_dir [file dirname [file dirname [file dirname [file dirname [file dirname [exec $compiler --print-prog-name=cc1]]]]]] } @@ -579,13 +579,13 @@ proc get_multilibs { args } { } } } - if ![info exists multitop] { + if {![info exists multitop]} { return "" } verbose "gccpath is $gccpath" 3 - if [file exists [file join $multitop $gccpath]] { + if {[file exists [file join $multitop $gccpath]]} { verbose "GCC path is $multitop/$gccpath" 3 if { [llength $args] == 0 } { set board_info($target_board,multitop) "$multitop/$gccpath" @@ -603,7 +603,7 @@ proc get_multilibs { args } { proc find_binutils_prog { name } { global tool_root_dir - if ![is_remote host] { + if {![is_remote host]} { set file [lookfor_file $tool_root_dir $name] if { $file == "" } { @@ -629,7 +629,7 @@ proc find_binutils_prog { name } { proc find_gcc {} { global tool_root_dir - if ![is_remote host] { + if {![is_remote host]} { set file [lookfor_file $tool_root_dir xgcc] if { $file == "" } { set file [lookfor_file $tool_root_dir gcc/xgcc] @@ -648,7 +648,7 @@ proc find_gcc {} { proc find_gcj {} { global tool_root_dir - if ![is_remote host] { + if {![is_remote host]} { set file [lookfor_file $tool_root_dir gcj] if { $file == "" } { set file [lookfor_file $tool_root_dir gcc/gcj] @@ -667,7 +667,7 @@ proc find_gcj {} { proc find_g++ {} { global tool_root_dir - if ![is_remote host] { + if {![is_remote host]} { set file [lookfor_file $tool_root_dir g++] if { $file == "" } { set file [lookfor_file $tool_root_dir gcc/g++] @@ -686,7 +686,7 @@ proc find_g++ {} { proc find_g77 {} { global tool_root_dir - if ![is_remote host] { + if {![is_remote host]} { set file [lookfor_file $tool_root_dir g77] if { $file == "" } { set file [lookfor_file $tool_root_dir gcc/g77] @@ -708,7 +708,7 @@ proc find_gnatmake {} { set root "$tool_root_dir/gcc" set GM "" - if ![is_remote host] { + if {![is_remote host]} { set file [lookfor_file $root gnatmake] if { $file != "" } { set GM "$file -I$root/ada/rts --GCC=$root/xgcc --GNATBIND=$root/gnatbind --GNATLINK=$root/gnatlink -cargs -B$root -largs --GCC=$root/xgcc -margs"; @@ -726,7 +726,7 @@ proc find_nm {} { global tool_root_dir set NM "" - if ![is_remote host] { + 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] @@ -745,7 +745,7 @@ proc process_multilib_options { args } { set is_gdb_remote 0 - if [board_info $board exists multilib_flags] { + if {[board_info $board exists multilib_flags]} { return } eval add_multilib_option $args @@ -809,7 +809,7 @@ proc process_multilib_options { args } { proc add_multilib_option { args } { global board_variant_list - if ![info exists board_variant_list] { + if {![info exists board_variant_list]} { set board_variant_list "" } set board_variant_list [concat $args $board_variant_list] @@ -820,7 +820,7 @@ proc find_gas { } { set AS "" - if ![is_remote host] { + if {![is_remote host]} { set AS [lookfor_file $tool_root_dir as-new] if { $AS == "" } { set AS [lookfor_file $tool_root_dir gas/as-new] @@ -837,7 +837,7 @@ proc find_ld { } { set LD "" - if ![is_remote host] { + if {![is_remote host]} { set LD [lookfor_file $tool_root_dir ld-new] if { $LD == "" } { set LD [lookfor_file $tool_root_dir ld/ld-new] @@ -853,23 +853,23 @@ proc build_wrapper { gluefile } { global libdir global tool - if [target_info exists wrap_m68k_aout] { + if {[target_info exists wrap_m68k_aout]} { set flags "additional_flags=-DWRAP_M68K_AOUT" set result "" - } elseif [target_info exists uses_underscores] { + } elseif {[target_info exists uses_underscores]} { set flags "additional_flags=-DUNDERSCORES" set result "-Wl,-wrap,_exit -Wl,-wrap,__exit -Wl,-wrap,_main -Wl,-wrap,_abort" } else { set flags "" - if [target_info exists is_vxworks] { + if {[target_info exists is_vxworks]} { set flags "additional_flags=-DVXWORKS" set result "-Wl,-wrap,exit -Wl,-wrap,_exit -Wl,-wrap,main -Wl,-wrap,abort" } else { set result "-Wl,-wrap,exit -Wl,-wrap,_exit -Wl,-wrap,main -Wl,-wrap,abort" } } - if [target_info exists wrap_compile_flags] { + if {[target_info exists wrap_compile_flags]} { lappend flags "additional_flags=[target_info wrap_compile_flags]" } if { [target_compile ${libdir}/testglue.c ${gluefile} object $flags] == "" } { @@ -884,17 +884,17 @@ proc build_wrapper { gluefile } { proc winsup_include_flags { args } { global srcdir - if [isnative] { + if {[isnative]} { return "" } - if [is_remote host] { + if {[is_remote host]} { return "" } set gccpath "[get_multilibs]" - if [file exists [file join $gccpath winsup]] { + if {[file exists [file join $gccpath winsup]]} { verbose "Winsup path is $gccpath/winsup" set winsup_dir [lookfor_file ${srcdir} winsup/include/windows.h] @@ -912,20 +912,20 @@ proc winsup_include_flags { args } { # proc winsup_link_flags { args } { # libgloss doesn't work native - if [isnative] { + if {[isnative]} { return "" } # if we're on a remote host, we can't search for the file, so we can only # use an installed compiler, so we don't add any paths here. - if [is_remote host] { + if {[is_remote host]} { return "" } set gccpath "[get_multilibs]" verbose "Looking for $gccpath/winsup" - if [file exists [file join $gccpath winsup]] { + if {[file exists [file join $gccpath winsup]]} { verbose "Winsup path is $gccpath/newlib" return "-B$gccpath/winsup/ -L$gccpath/winsup" } else { diff --git a/lib/remote.exp b/lib/remote.exp index b493791..dadbb65 100644 --- a/lib/remote.exp +++ b/lib/remote.exp @@ -138,7 +138,7 @@ proc local_exec { commandline inp outp timeout } { verbose "pid is $pid $pgid" if { $result != 0 || $result2 != 0 } { # This shouldn't happen. - if [info exists errorInfo] { + if {[info exists errorInfo]} { set foo $errorInfo } else { set foo "" @@ -290,12 +290,12 @@ proc remote_raw_close { host } { proc standard_close { host } { global board_info - if [board_info ${host} exists fileid] { + if {[board_info ${host} exists fileid]} { set shell_id [board_info ${host} fileid] set pid -1 verbose "Closing the remote shell $shell_id" 2 - if [board_info ${host} exists fileid_origid] { + if {[board_info ${host} exists fileid_origid]} { set oid [board_info ${host} fileid_origid] set pid [pid $oid] unset board_info(${host},fileid_origid) @@ -318,7 +318,7 @@ proc standard_close { host } { } verbose "pid is $pid" catch "close -i $shell_id" - if [info exists oid] { + if {[info exists oid]} { catch "close $oid" } catch "wait -i $shell_id" @@ -347,7 +347,7 @@ proc remote_reboot { host } { # procedures will fail. # remote_close $host set status [call_remote "" reboot "$host"] - if [board_info $host exists name] { + if {[board_info $host exists name]} { set host [board_info $host name] } if { [info proc ${host}_init] != "" } { @@ -378,7 +378,7 @@ proc remote_download { dest file args } { return $file } else { set result [catch "exec cp -p $file $destfile" output] - if [regexp "same file|are identical" $output] { + if {[regexp "same file|are identical" $output]} { set result 0 set output "" } else { @@ -403,9 +403,9 @@ proc remote_download { dest file args } { proc standard_download {dest file destfile} { set orig_destfile $destfile - if [board_info $dest exists nfsdir] { + if {[board_info $dest exists nfsdir]} { set destdir [board_info $dest nfsdir] - if [board_info $dest exists nfsroot_server] { + if {[board_info $dest exists nfsroot_server]} { set dest [board_info $dest nfsroot_server] } else { set dest "" @@ -423,7 +423,7 @@ proc standard_download {dest file destfile} { } set result [catch "exec cp -p $file $destfile" output] - if [regexp "same file|are identical" $output] { + if {[regexp "same file|are identical" $output]} { set result 0 set output "" } else { @@ -460,9 +460,9 @@ proc remote_upload {dest srcfile args} { proc standard_upload { dest srcfile destfile } { set orig_srcfile $srcfile - if [board_info $dest exists nfsdir] { + if {[board_info $dest exists nfsdir]} { set destdir [board_info $dest nfsdir] - if [board_info $dest exists nfsroot_server] { + if {[board_info $dest exists nfsroot_server]} { set dest [board_info $dest nfsroot_server] } else { set dest "" @@ -475,7 +475,7 @@ proc standard_upload { dest srcfile destfile } { } set result [catch "exec cp -p $srcfile $destfile" output] - if [regexp "same file|are identical" $output] { + if {[regexp "same file|are identical" $output]} { set result 0 set output "" } else { @@ -498,7 +498,7 @@ proc standard_upload { dest srcfile destfile } { # and then finally it will call standard_$proc. # proc call_remote { type proc dest args } { - if [board_info $dest exists name] { + if {[board_info $dest exists name]} { set dest [board_info $dest name] } @@ -511,7 +511,7 @@ proc call_remote { type proc dest args } { if { ![board_info $dest exists name] } { global board - if [info exists board] { + if {[info exists board]} { blooie } load_board_description $dest @@ -524,7 +524,7 @@ proc call_remote { type proc dest args } { set high_prot "" if { $type != "raw" } { - if [board_info $dest exists protocol] { + if {[board_info $dest exists protocol]} { set high_prot "${dest} [board_info $dest protocol]" } else { set high_prot "${dest} [board_info $dest generic_name]" @@ -548,8 +548,8 @@ proc call_remote { type proc dest args } { verbose "calling ${ft}_${proc} $dest $args" 3 set result2 [eval ${ft}_${proc} \"$dest\" $args] } - if ![info exists result] { - if [info exists result2] { + if {![info exists result]} { + if {[info exists result2]} { set result $result2 } else { set result "" @@ -587,10 +587,10 @@ proc remote_raw_transmit { dest file } { # supplied file directly into the connection. # proc standard_transmit {dest file} { - if [board_info ${dest} exists name] { + if {[board_info ${dest} exists name]} { set dest [board_info ${dest} name] } - if [board_info ${dest} exists baud] { + if {[board_info ${dest} exists baud]} { set baud [board_info ${dest} baud] } else { set baud 9600 @@ -603,7 +603,7 @@ proc standard_transmit {dest file} { 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] { + if {[string match "write\(spawn_id=\[0-9\]+\):" $errmess]} { perror "sent \"$cur_line\" got expect error \"$errmess\"" catch "close $fd" return -1 @@ -631,14 +631,14 @@ proc remote_raw_send { dest string } { } proc standard_send { dest string } { - if ![board_info $dest exists fileid] { + if {![board_info $dest exists fileid]} { perror "no fileid for $dest" return "no fileid for $dest" } 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 - if [catch "send -i [board_info $dest fileid] -- {$string}" errorInfo] { + if {[catch "send -i [board_info $dest fileid] -- {$string}" errorInfo]} { return "$errorInfo" } else { return "" @@ -772,12 +772,12 @@ proc unix_clean_filename { dest file } { proc remote_spawn { dest commandline args } { global board_info - if ![is_remote $dest] { - if [info exists board_info($dest,fileid)] { + if {![is_remote $dest]} { + if {[info exists board_info($dest,fileid)]} { unset board_info($dest,fileid) } verbose "remote_spawn is local" 3 - if [board_info $dest exists name] { + if {[board_info $dest exists name]} { set dest [board_info $dest name] } @@ -804,7 +804,7 @@ proc remote_spawn { dest commandline args } { } else { # This shouldn't happen. global errorInfo - if [info exists errorInfo] { + if {[info exists errorInfo]} { set foo $errorInfo } else { set foo "" @@ -843,7 +843,7 @@ proc remote_raw_spawn { dest commandline } { proc standard_spawn { dest commandline } { global board_info - if ![board_info $dest exists rsh_prog] { + if {![board_info $dest exists rsh_prog]} { if { [which remsh] != 0 } { set RSH remsh } else { @@ -853,13 +853,13 @@ proc standard_spawn { dest commandline } { set RSH [board_info $dest rsh_prog] } - if [board_info $dest exists hostname] { + if {[board_info $dest exists hostname]} { set remote [board_info $dest hostname] } else { set remote $dest } - if ![board_info $dest exists username] { + if {![board_info $dest exists username]} { spawn $RSH $remote $commandline } else { spawn $RSH -l [board_info $dest username] $remote $commandline @@ -894,17 +894,17 @@ proc remote_load { dest prog args } { if $empty { global sum_program - if [info exists sum_program] { - if ![target_info exists objcopy] { + if {[info exists sum_program]} { + if {![target_info exists objcopy]} { set_currtarget_info objcopy [find_binutils_prog objcopy] } - if [is_remote host] { + if {[is_remote host]} { set dprog [remote_download host $prog "a.out"] } else { set dprog $prog } set status [remote_exec host "[target_info objcopy]" "-O srec $dprog ${dprog}.sum"] - if [is_remote host] { + if {[is_remote host]} { remote_file upload ${dprog}.sum ${prog}.sum } if { [lindex $status 0] == 0 } { @@ -918,9 +918,9 @@ proc remote_load { dest prog args } { } remote_file build delete ${prog}.sum } - if [file exists $cache] { + if {[file exists $cache]} { set same 0 - if [info exists sum_program] { + if {[info exists sum_program]} { set id [open $cache "r"] set oldsum [read $id] close $id @@ -940,18 +940,18 @@ proc remote_load { dest prog args } { } } } - if ![info exists result] { + if {![info exists result]} { set result [eval call_remote \"\" load \"$dname\" \"$prog\" $args] # Not quite happy about the "pass" condition, but it makes sense if # you think about it for a while-- *why* did the test not pass? if { $empty && [lindex $result 0] == "pass" } { if { [getenv LOAD_REMOTECACHE] != "" } { set dir "[getenv REMOTELOAD_CACHE]/$tool/$dname" - if ![file exists $dir] { + if {![file exists $dir]} { file mkdir $dir } - if [file exists $dir] { - if [info exists sum_program] { + if {[file exists $dir]} { + if {[info exists sum_program]} { set id [open $cache "w"] puts -nonewline $id "$sum" close $id @@ -989,22 +989,22 @@ proc standard_load { dest prog args } { set inp "" } - if ![file exists $prog] then { + if {![file exists $prog]} then { # We call both here because this should never happen. perror "$prog does not exist in standard_load." verbose -log "$prog does not exist." 3 return "untested" } - if [is_remote $dest] { + if {[is_remote $dest]} { set remotefile "/tmp/[file tail $prog].[pid]" set remotefile [remote_download $dest $prog $remotefile] if { $remotefile == "" } { verbose -log "Download of $prog to [board_info $dest name] failed." 3 return "unresolved" } - if [board_info $dest exists remote_link] { - if [[board_info $dest remote_link] $remotefile] { + if {[board_info $dest exists remote_link]} { + if {[[board_info $dest remote_link] $remotefile]} { verbose -log "Couldn't do remote link" remote_file target delete $remotefile return "unresolved" @@ -1023,7 +1023,7 @@ proc standard_load { dest prog args } { set status [lindex $status 0] verbose -log "Executed $prog, status $status" 2 - if ![string match "" $output] { + if {![string match "" $output]} { verbose -log -- "$output" 2 } if { $status == 0 } { @@ -1063,7 +1063,7 @@ proc standard_wait { dest timeout } { set output "" set status -1 - if [info exists exp_close_result] { + if {[info exists exp_close_result]} { unset exp_close_result } remote_expect $dest $timeout { @@ -1080,7 +1080,7 @@ proc standard_wait { dest timeout } { warning "program timed out." } eof { - if [board_info $dest exists fileid_origid] { + if {[board_info $dest exists fileid_origid]} { global board_info set id [board_info $dest fileid] @@ -1135,7 +1135,7 @@ proc check_for_board_status { variable } { set nomatch_return -1 } - if [regexp "(^|\[\r\n\])\\*\\*\\* EXIT code" $output] { + 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 @@ -1232,12 +1232,12 @@ proc remote_expect { board timeout args } { } } - if [info exists remote_suppress_flag] { + if {[info exists remote_suppress_flag]} { if { $remote_suppress_flag } { set code 1 } } - if ![info exists code] { + if {![info exists code]} { set res "\n-timeout $timeout $res" set body "expect \{\n-i $spawn_id -timeout $timeout $orig\}" set code [catch {uplevel $body} string] @@ -1276,18 +1276,18 @@ proc remote_push_conn { host } { return "fail" } - if ![board_info $host exists fileid] { + if {![board_info $host exists fileid]} { return "fail" } set fileid [board_info $host fileid] set conninfo [board_info $host conninfo] - if ![info exists board_info($name,fileid_stack)] { + if {![info exists board_info($name,fileid_stack)]} { set board_info($name,fileid_stack) {} } set board_info($name,fileid_stack) [list $fileid $conninfo $board_info($name,fileid_stack)] unset board_info($name,fileid) - if [info exists board_info($name,conninfo)] { + if {[info exists board_info($name,conninfo)]} { unset board_info($name,conninfo) } return "pass" @@ -1304,7 +1304,7 @@ proc remote_pop_conn { host } { if { $name == "" } { return "fail" } - if ![info exists board_info($name,fileid_stack)] { + if {![info exists board_info($name,fileid_stack)]} { return "fail" } set stack $board_info($name,fileid_stack) @@ -1323,12 +1323,12 @@ proc remote_swap_conn { host } { global board_info set name [board_info $host name] - if ![info exists board_info($name,fileid)] { + if {![info exists board_info($name,fileid)]} { return "fail" } set fileid $board_info($name,fileid) - if [info exists board_info($name,conninfo)] { + if {[info exists board_info($name,conninfo)]} { set conninfo $board_info($name,conninfo) } else { set conninfo {} diff --git a/lib/rlogin.exp b/lib/rlogin.exp index a56a2c3..47c22ca 100644 --- a/lib/rlogin.exp +++ b/lib/rlogin.exp @@ -26,29 +26,29 @@ proc rlogin_open { arg } { set tries 0 set result -1 - if [board_info $arg exists fileid] { + if {[board_info $arg exists fileid]} { return [board_info $arg fileid] } # get the hostname and port number from the config array - if [board_info $arg exists netport] { + if {[board_info $arg exists netport]} { set hostname [lindex [split [board_info $arg netport] ":"] 0] } else { set hostname $arg } - if ![board_info $arg exists shell_prompt] { + if {![board_info $arg exists shell_prompt]} { # if no prompt, then set it to something generic set shell_prompt ".*> " } else { set shell_prompt [board_info $arg shell_prompt] } - if [board_info $arg exists fileid] { + if {[board_info $arg exists fileid]} { unset board_info($arg,fileid) } # get the right version of rlogin - if ![board_info $arg exists rlogin_prog] { + if {![board_info $arg exists rlogin_prog]} { set RLOGIN rlogin } else { set RLOGIN [board_info $arg rlogin_prog] @@ -132,7 +132,7 @@ proc rlogin_open { arg } { # the command. # proc rlogin_spawn { dest cmdline } { - if ![board_info $dest exists shell_prompt] { + if {![board_info $dest exists shell_prompt]} { set shell_prompt "(^|\[\r\n\])\[^\r\n\]*>" } else { set shell_prompt [board_info $dest shell_prompt] diff --git a/lib/rsh.exp b/lib/rsh.exp index 6da99e9..7c6472f 100644 --- a/lib/rsh.exp +++ b/lib/rsh.exp @@ -25,7 +25,7 @@ proc rsh_open { hostname } { set tries 0 set result -1 - if ![board_info $hostname exists rsh_prog] { + if {![board_info $hostname exists rsh_prog]} { if { [which remsh] != 0 } { set RSH remsh } else { @@ -35,24 +35,24 @@ proc rsh_open { hostname } { set RSH [board_info $hostname rsh_prog] } - if [board_info $hostname exists username] { + if {[board_info $hostname exists username]} { set rsh_useropts "-l [board_info $hostname username]" } else { set rsh_useropts "" } # Get the hostname and port number from the config array. - if [board_info $hostname exists name] { + if {[board_info $hostname exists name]} { set hostname [board_info $hostname name] } set hostname [lindex [split [board_info ${hostname} netport] ":"] 0] - if [board_info ${hostname} exists shell_prompt] { + if {[board_info ${hostname} exists shell_prompt]} { set shell_prompt [board_info ${hostname} shell_prompt] } else { set shell_prompt ".*> " } - if [board_info $hostname exists fileid] { + if {[board_info $hostname exists fileid]} { unset board_info($hostname,fileid) } @@ -147,13 +147,13 @@ proc rsh_open { hostname } { # proc rsh_download {desthost srcfile destfile} { # must be done before desthost is rewritten - if [board_info $desthost exists rcp_prog] { + if {[board_info $desthost exists rcp_prog]} { set RCP [board_info $desthost rcp_prog] } else { set RCP rcp } - if [board_info $desthost exists rsh_prog] { + if {[board_info $desthost exists rsh_prog]} { set RSH [board_info $desthost rsh_prog] } else { if { [which remsh] != 0 } { @@ -163,7 +163,7 @@ proc rsh_download {desthost srcfile destfile} { } } - if [board_info $desthost exists username] { + if {[board_info $desthost exists username]} { set rsh_useropts "-l [board_info $desthost username]" set rcp_user "[board_info $desthost username]@" } else { @@ -171,11 +171,11 @@ proc rsh_download {desthost srcfile destfile} { set rcp_user "" } - if [board_info $desthost exists name] { + if {[board_info $desthost exists name]} { set desthost [board_info $desthost name] } - if [board_info $desthost exists hostname] { + if {[board_info $desthost exists hostname]} { set desthost [board_info $desthost hostname] } @@ -191,23 +191,23 @@ proc rsh_download {desthost srcfile destfile} { } proc rsh_upload {desthost srcfile destfile} { - if [board_info $desthost exists rcp_prog] { + if {[board_info $desthost exists rcp_prog]} { set RCP [board_info $desthost rcp_prog] } else { set RCP rcp } - if [board_info $desthost exists username] { + if {[board_info $desthost exists username]} { set rcp_user "[board_info $desthost username]@" } else { set rcp_user "" } - if [board_info $desthost exists name] { + if {[board_info $desthost exists name]} { set desthost [board_info $desthost name] } - if [board_info $desthost exists hostname] { + if {[board_info $desthost exists hostname]} { set desthost [board_info $desthost hostname] } @@ -238,7 +238,7 @@ proc rsh_exec { boardname cmd args } { verbose "Executing $boardname:$cmd $pargs < $inp" - if ![board_info $boardname exists rsh_prog] { + if {![board_info $boardname exists rsh_prog]} { if { [which remsh] != 0 } { set RSH remsh } else { @@ -248,17 +248,17 @@ proc rsh_exec { boardname cmd args } { set RSH [board_info $boardname rsh_prog] } - if [board_info $boardname exists username] { + if {[board_info $boardname exists username]} { set rsh_useropts "-l [board_info $boardname username]" } else { set rsh_useropts "" } - if [board_info $boardname exists name] { + if {[board_info $boardname exists name]} { set boardname [board_info $boardname name] } - if [board_info $boardname exists hostname] { + if {[board_info $boardname exists hostname]} { set hostname [board_info $boardname hostname] } else { set hostname $boardname diff --git a/lib/target.exp b/lib/target.exp index f5df432..6e6d8cc 100644 --- a/lib/target.exp +++ b/lib/target.exp @@ -84,7 +84,7 @@ proc push_config { type name } { global target_info verbose "pushing config for $type, name is $name" - if [info exists target_info($type,name)] { + if {[info exists target_info($type,name)]} { if { $target_info($type,name) == $name } { error "pushing config for $type, '$name' twice" } @@ -97,7 +97,7 @@ proc push_config { type name } { proc pop_config { type } { global target_info - if [info exists target_info(${type},name)] { + if {[info exists target_info(${type},name)]} { unset target_info(${type},name) } } @@ -128,15 +128,15 @@ proc prune_warnings { text } { # This is from sun4's. Do it for all machines for now. # The "\\1" is to try to preserve a "\n" but only if necessary. - if [ishost "sparc-*-sunos*"] { + if {[ishost "sparc-*-sunos*"]} { regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text } # See Brendan for the raison d'etre of this one. - if [ishost "alpha*-*-*"] { + if {[ishost "alpha*-*-*"]} { regsub -all "(^|\n)(/usr/(ucb|bin)/ld.*without exceptions was\[^\n\]+\n?)" $text "\\1" text } - if [ishost "hppa*-*-hpux*"] { + if {[ishost "hppa*-*-hpux*"]} { # Ignore the compiler's warnings about PA incompatibility. regsub -all "(^|\n)\[^\n\]*PA 2.0 object file \[^\n\]* was detected. The linked output may not run on a PA 1.x system." $text "" text @@ -244,7 +244,7 @@ proc prune_warnings { text } { regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text # See Brendan for the raison d'etre of this one. - if [string match "alpha*-*-*" $host_triplet] { + if {[string match "alpha*-*-*" $host_triplet]} { regsub -all "(^|\n)(/usr/(ucb|bin)/ld.*without exceptions was\[^\n\]+\n?)" $text "\\1" text } @@ -318,11 +318,11 @@ proc default_target_compile {source destfile type options} { set ldflags "" set dest [target_info name] - if [info exists CFLAGS_FOR_TARGET] { + if {[info exists CFLAGS_FOR_TARGET]} { append add_flags " $CFLAGS_FOR_TARGET" } - if [info exists target_info(host,name)] { + if {[info exists target_info(host,name)]} { set host [host_info name] } else { set host "unix" @@ -332,10 +332,10 @@ proc default_target_compile {source destfile type options} { if { $i == "ada" } { set compiler_type "ada" - if [board_info $dest exists adaflags] { + if {[board_info $dest exists adaflags]} { append add_flags " [target_info adaflags]" } - if [board_info $dest exists gnatmake] { + if {[board_info $dest exists gnatmake]} { set compiler [target_info gnatmake]; } else { set compiler [find_gnatmake]; @@ -344,11 +344,11 @@ proc default_target_compile {source destfile type options} { if { $i == "c++" } { set compiler_type "c++" - if [board_info $dest exists cxxflags] { + if {[board_info $dest exists cxxflags]} { append add_flags " [target_info cxxflags]" } append add_flags " [g++_include_flags]" - if [board_info $dest exists c++compiler] { + if {[board_info $dest exists c++compiler]} { set compiler [target_info c++compiler] } else { set compiler [find_g++] @@ -357,63 +357,63 @@ proc default_target_compile {source destfile type options} { if { $i == "f77" } { set compiler_type "f77" - if [board_info $dest exists f77flags] { + if {[board_info $dest exists f77flags]} { append add_flags " [target_info f77flags]" } - if [board_info $dest exists f77compiler] { + if {[board_info $dest exists f77compiler]} { set compiler [target_info f77compiler] } else { set compiler [find_g77] } } - if [regexp "^dest=" $i] { + if {[regexp "^dest=" $i]} { regsub "^dest=" $i "" tmp - if [board_info $tmp exists name] { + if {[board_info $tmp exists name]} { set dest [board_info $tmp name] } else { set dest $tmp } } - if [regexp "^compiler=" $i] { + if {[regexp "^compiler=" $i]} { regsub "^compiler=" $i "" tmp set compiler $tmp } - if [regexp "^additional_flags=" $i] { + if {[regexp "^additional_flags=" $i]} { regsub "^additional_flags=" $i "" tmp append add_flags " $tmp" } - if [regexp "^ldflags=" $i] { + if {[regexp "^ldflags=" $i]} { regsub "^ldflags=" $i "" tmp append ldflags " $tmp" } - if [regexp "^libs=" $i] { + if {[regexp "^libs=" $i]} { regsub "^libs=" $i "" tmp append libs " $tmp" } - if [regexp "^incdir=" $i] { + if {[regexp "^incdir=" $i]} { regsub "^incdir=" $i "-I" tmp append add_flags " $tmp" } - if [regexp "^libdir=" $i] { + if {[regexp "^libdir=" $i]} { regsub "^libdir=" $i "-L" tmp append add_flags " $tmp" } - if [regexp "^ldscript=" $i] { + if {[regexp "^ldscript=" $i]} { regsub "^ldscript=" $i "" ldscript } - if [regexp "^redirect=" $i] { + if {[regexp "^redirect=" $i]} { regsub "^redirect=" $i "" redirect } - if [regexp "^optimize=" $i] { + if {[regexp "^optimize=" $i]} { regsub "^optimize=" $i "" optimize } - if [regexp "^timeout=" $i] { + if {[regexp "^timeout=" $i]} { regsub "^timeout=" $i "" timeout } } - if [board_info $host exists cflags_for_target] { + if {[board_info $host exists cflags_for_target]} { append add_flags " [board_info $host cflags_for_target]" } @@ -422,25 +422,25 @@ proc default_target_compile {source destfile type options} { global F77_FOR_TARGET global GNATMAKE_FOR_TARGET - if [info exists GNATMAKE_FOR_TARGET] { + if {[info exists GNATMAKE_FOR_TARGET]} { if { $compiler_type == "ada" } { set compiler $GNATMAKE_FOR_TARGET } } - if [info exists CC_FOR_TARGET] { + if {[info exists CC_FOR_TARGET]} { if { $compiler == "" } { set compiler $CC_FOR_TARGET } } - if [info exists CXX_FOR_TARGET] { + if {[info exists CXX_FOR_TARGET]} { if { $compiler_type == "c++" } { set compiler $CXX_FOR_TARGET } } - if [info exists F77_FOR_TARGET] { + if {[info exists F77_FOR_TARGET]} { if { $compiler_type == "f77" } { set compiler $F77_FOR_TARGET } @@ -453,7 +453,7 @@ proc default_target_compile {source destfile type options} { } } - if ![is_remote host] { + if {![is_remote host]} { if { [which $compiler] == 0 } { return "default_target_compile: Can't find $compiler." } @@ -471,28 +471,28 @@ proc default_target_compile {source destfile type options} { append add_flags " -S" } - if [board_info $dest exists cflags] { + if {[board_info $dest exists cflags]} { append add_flags " [board_info $dest cflags]" } if { $type == "executable" } { - if [board_info $dest exists ldflags] { + if {[board_info $dest exists ldflags]} { append add_flags " [board_info $dest ldflags]" } if { $compiler_type == "c++" } { append add_flags " [g++_link_flags]" } - if [isnative] { + if {[isnative]} { # This is a lose. catch "glob -nocomplain $tool_root_dir/libstdc++/libstdc++.so* $tool_root_dir/libstdc++/libstdc++.sl" tmp if { ${tmp} != "" } { - if [regexp ".*solaris2.*" $target_triplet] { + if {[regexp ".*solaris2.*" $target_triplet]} { # Solaris 2 append add_flags " -R$tool_root_dir/libstdc++" - } elseif [regexp ".*(osf|irix5|linux).*" $target_triplet] { + } elseif {[regexp ".*(osf|irix5|linux).*" $target_triplet]} { # OSF/1 or IRIX 5 append add_flags " -Wl,-rpath,$tool_root_dir/libstdc++" - } elseif [regexp ".*hppa.*" $target_triplet] { + } elseif {[regexp ".*hppa.*" $target_triplet]} { # HP-UX append add_flags " -Wl,-a,shared_archive" } @@ -500,13 +500,13 @@ proc default_target_compile {source destfile type options} { } } - if ![info exists ldscript] { + if {![info exists ldscript]} { set ldscript [board_info $dest ldscript] } foreach i $options { if { $i == "debug" } { - if [board_info $dest exists debug_flags] { + if {[board_info $dest exists debug_flags]} { append add_flags " [board_info $dest debug_flags]" } else { append add_flags " -g" @@ -514,21 +514,21 @@ proc default_target_compile {source destfile type options} { } } - if [info exists optimize] { + if {[info exists optimize]} { append add_flags " $optimize" } if { $type == "executable" } { append add_flags " $ldflags" foreach x $libs { - if [file exists $x] { + if {[file exists $x]} { append source " $x" } else { append add_flags " $x" } } - if [board_info $dest exists libs] { + if {[board_info $dest exists libs]} { append add_flags " [board_info $dest libs]" } @@ -537,7 +537,7 @@ proc default_target_compile {source destfile type options} { # The math library must be linked in before the C library. The C # library is linked in by the linker script, so this must be before # the linker script. - if [board_info $dest exists mathlib] { + if {[board_info $dest exists mathlib]} { append add_flags " [board_info $dest mathlib]" } else { append add_flags " -lm" @@ -546,23 +546,23 @@ proc default_target_compile {source destfile type options} { # This must be added here. append add_flags " $ldscript" - if [board_info $dest exists remote_link] { + if {[board_info $dest exists remote_link]} { # Relink option. append add_flags " -Wl,-r" } - if [board_info $dest exists output_format] { + if {[board_info $dest exists output_format]} { append add_flags " -Wl,-oformat,[board_info $dest output_format]" } } - if [board_info $dest exists multilib_flags] { + if {[board_info $dest exists multilib_flags]} { append add_flags " [board_info $dest multilib_flags]" } verbose "doing compile" set sources "" - if [is_remote host] { + if {[is_remote host]} { foreach x $source { set file [remote_download host $x] if { $file == "" } { @@ -576,7 +576,7 @@ proc default_target_compile {source destfile type options} { set sources $source } - if [is_remote host] { + if {[is_remote host]} { append add_flags " -o a.out" remote_file host delete a.out } else { @@ -594,8 +594,8 @@ proc default_target_compile {source destfile type options} { set opts "$sources $add_flags" } - if [is_remote host] { - if [host_info exists use_at] { + if {[is_remote host]} { + if {[host_info exists use_at]} { set fid [open "atfile" "w"] puts $fid "$opts" close $fid @@ -606,11 +606,11 @@ proc default_target_compile {source destfile type options} { verbose "Invoking the compiler as $compiler $opts" 2 - if [info exists redirect] { + if {[info exists redirect]} { verbose "Redirecting output to $redirect" 2 set status [remote_exec host "$compiler $opts" "" "" $redirect] } else { - if [info exists timeout] { + if {[info exists timeout]} { verbose "Setting timeout to $timeout" 2 set status [remote_exec host "$compiler $opts" "" "" "" $timeout] } else { @@ -619,7 +619,7 @@ proc default_target_compile {source destfile type options} { } set compiler_flags $opts - if [is_remote host] { + if {[is_remote host]} { remote_upload host a.out $destfile remote_file host delete a.out } @@ -655,28 +655,28 @@ proc default_target_assemble { source destfile flags } { global AS_FOR_TARGET global ASFLAGS_FOR_TARGET - if [info exists AS_FOR_TARGET] { + if {[info exists AS_FOR_TARGET]} { set AS "$AS_FOR_TARGET" } else { - if ![board_info target exists assembler] { + if {![board_info target exists assembler]} { set AS [find_gas] } else { set AS [board_info target assembler] } } - if [info exists ASFLAGS_FOR_TARGET] { + if {[info exists ASFLAGS_FOR_TARGET]} { append flags " $ASFLAGS_FOR_TARGET" } - if [is_remote host] { + if {[is_remote host]} { set source [remote_download host $source] set dest "a.out" } else { set dest $destfile } set status [remote_exec host "$AS $source $flags -o $dest"] - if [is_remote host] { + if {[is_remote host]} { remote_upload host $dest $destfile } @@ -712,7 +712,7 @@ proc default_link { board objects destfile flags } { # to an option. set arg [lindex $ldflags $i] regsub "^-Wl," $arg "" arg - if [regexp "^-L" $arg] { + if {[regexp "^-L" $arg]} { # Is the directory in the next arg, or part of this one? if { "$arg" == "-L" } { if { $i + 1 < $len } { @@ -727,37 +727,37 @@ proc default_link { board objects destfile flags } { return $result } - if [info exists LD_FOR_TARGET] { + if {[info exists LD_FOR_TARGET]} { set LD "$LD_FOR_TARGET" } else { - if ![board_info target exists linker] { + if {![board_info target exists linker]} { set LD [find_ld] } else { set LD [board_info target linker] } } - if [info exists LDFLAGS_FOR_TARGET] { + if {[info exists LDFLAGS_FOR_TARGET]} { append flags " $LDFLAGS_FOR_TARGET" } # `ldflags' consists of arguments to gcc (that are then # passed to ld), not arguments to ld directly. # We need the -L's. - if [board_info $board exists ldflags] { + if {[board_info $board exists ldflags]} { set ldflags [board_info $board ldflags] set ldflags [only--Ls $ldflags] append flags " $ldflags" } - if [board_info $board exists ldscript] { + if {[board_info $board exists ldscript]} { # strip leading -Wl, if present set ldscript [board_info $board ldscript] regsub "^-Wl," $ldscript "" ldscript append flags " $ldscript" } - if [is_remote host] { + if {[is_remote host]} { foreach x $objects { set nobjects "$nobjects [remote_download host $x]" } @@ -767,7 +767,7 @@ proc default_link { board objects destfile flags } { set dest $destfile } set status [remote_exec host "$LD $objects $flags -o $dest"] - if [is_remote host] { + if {[is_remote host]} { remote_upload host $dest $destfile } diff --git a/lib/targetdb.exp b/lib/targetdb.exp index 3a72434..255be75 100644 --- a/lib/targetdb.exp +++ b/lib/targetdb.exp @@ -26,18 +26,18 @@ proc board_info { machine op args } { verbose "board_info $machine $op $args" 3 - if [info exists target_info($machine,name)] { + if {[info exists target_info($machine,name)]} { set machine $target_info($machine,name) } if { $op == "exists" } { if { [llength $args] == 0 } { - if [info exists board_info($machine,name)] { + if {[info exists board_info($machine,name)]} { return 1 } else { return 0 } } else { - if [info exists "board_info($machine,[lindex $args 0])"] { + if {[info exists "board_info($machine,[lindex $args 0])"]} { return 1 } else { return 0 @@ -46,7 +46,7 @@ proc board_info { machine op args } { } if { [llength $args] == 0 } { verbose "getting $machine $op" 3 - if [info exists board_info($machine,$op)] { + if {[info exists board_info($machine,$op)]} { return $board_info($machine,$op) } else { return "" @@ -68,7 +68,7 @@ proc host_info { op args } { proc set_board_info { entry value } { global board_info board - if ![info exists board_info($board,$entry)] { + if {![info exists board_info($board,$entry)]} { set board_info($board,$entry) $value } } @@ -80,7 +80,7 @@ proc set_currtarget_info { entry value } { set board [target_info name] - if ![info exists board_info($board,$entry)] { + if {![info exists board_info($board,$entry)]} { set board_info($board,$entry) $value } } @@ -90,7 +90,7 @@ proc set_currtarget_info { entry value } { proc unset_board_info { entry } { global board_info board - if [info exists board_info($board,$entry)] { + if {[info exists board_info($board,$entry)]} { unset board_info($board,$entry) } } @@ -102,7 +102,7 @@ proc unset_currtarget_info { entry } { set board [target_info name] - if [info exists board_info($board,$entry)] { + if {[info exists board_info($board,$entry)]} { unset board_info($board,$entry) } } diff --git a/lib/telnet.exp b/lib/telnet.exp index 38ad189..f379ef0 100644 --- a/lib/telnet.exp +++ b/lib/telnet.exp @@ -37,17 +37,17 @@ proc telnet_open { hostname args } { } set port 23 - if [board_info $hostname exists name] { + if {[board_info $hostname exists name]} { set connhost [board_info $hostname name] } else { set connhost $hostname } - if [board_info $connhost exists hostname] { + if {[board_info $connhost exists hostname]} { set hostname [board_info $connhost hostname] } - if [file exists /usr/kerberos/bin/telnet] { + if {[file exists /usr/kerberos/bin/telnet]} { set telnet /usr/kerberos/bin/telnet } else { set telnet telnet @@ -55,12 +55,12 @@ proc telnet_open { hostname args } { # Instead of unsetting it, let's return it. One connection at a # time, please. - if [board_info $connhost exists fileid] { + if {[board_info $connhost exists fileid]} { return [board_info $connhost fileid] } # Get the hostname and port number from the config array. - if [board_info $connhost exists netport] { + if {[board_info $connhost exists netport]} { set type $hostname set hosttmp [split [board_info $connhost netport] ":"] set hostname [lindex $hosttmp 0] @@ -72,10 +72,11 @@ proc telnet_open { hostname args } { set type target } - if [board_info $connhost exists shell_prompt] { + if {[board_info $connhost exists shell_prompt]} { set shell_prompt [board_info $connhost shell_prompt] } - if ![info exists shell_prompt] { # if no prompt, then set it to something generic + if {![info exists shell_prompt]} { + # If no prompt, then set it to something generic. set shell_prompt ".*> " } @@ -97,11 +98,11 @@ proc telnet_open { hostname args } { set result 0 } -re "nt Name:|ogin:" { - if [board_info $connhost exists telnet_username] { + if {[board_info $connhost exists telnet_username]} { exp_send "[board_info $connhost telnet_username]\n" exp_continue } - if [board_info $connhost exists username] { + if {[board_info $connhost exists username]} { exp_send "[board_info $connhost username]\n" exp_continue } @@ -109,11 +110,11 @@ proc telnet_open { hostname args } { break } "assword:" { - if [board_info $connhost exists telnet_password] { + if {[board_info $connhost exists telnet_password]} { exp_send "[board_info $connhost telnet_password]\n" exp_continue } - if [board_info $connhost exists password] { + if {[board_info $connhost exists password]} { exp_send "[board_info $connhost password]\n" exp_continue } @@ -145,7 +146,7 @@ proc telnet_open { hostname args } { if { $raw || [board_info $connhost exists dont_wait_for_prompt] } { set result 0 } else { - if [board_info $connhost exists send_initial_cr] { + if {[board_info $connhost exists send_initial_cr]} { exp_send "\n" } exp_continue @@ -191,8 +192,8 @@ proc telnet_open { hostname args } { # We look for this here again cause it means something went wrong, # and it doesn't always show up in the expect in buffer till the # server times out. - if [info exists expect_out(buffer)] { - if [regexp "assword:|ogin:" $expect_out(buffer)] { + if {[info exists expect_out(buffer)]} { + if {[regexp "assword:|ogin:" $expect_out(buffer)]} { perror "telnet: need to supply a login and password." } } @@ -212,7 +213,7 @@ proc telnet_open { hostname args } { # Put the Telnet connection to HOSTNAME into binary mode. # proc telnet_binary { hostname } { - if [board_info $hostname exists fileid] { + if {[board_info $hostname exists fileid]} { remote_send $hostname " " remote_expect $hostname 5 { -re "telnet> *$" {} diff --git a/lib/tip.exp b/lib/tip.exp index 8c8674d..bafda76 100644 --- a/lib/tip.exp +++ b/lib/tip.exp @@ -28,18 +28,18 @@ proc tip_open { hostname } { set tries 0 set result -1 - if [board_info $hostname exists name] { + if {[board_info $hostname exists name]} { set hostname [board_info ${hostname} name] } set port [board_info ${hostname} tipname] - if [board_info ${hostname} exists shell_prompt] { + if {[board_info ${hostname} exists shell_prompt]} { set shell_prompt [board_info ${hostname} shell_prompt] } else { # Pick something reasonably generic. set shell_prompt ".*> " } - if [board_info ${hostname} exists fileid] { + if {[board_info ${hostname} exists fileid]} { unset board_info(${hostname},fileid) } spawn tip -v $port @@ -127,20 +127,20 @@ proc tip_download { dest file args } { global decimal global expect_out - if [board_info $dest exists shell_prompt] { + if {[board_info $dest exists shell_prompt]} { set shell_prompt [board_info $dest shell_prompt] } else { set shell_prompt ".*>" } set result "" - if ![board_info $dest exists fileid] { + if {![board_info $dest exists fileid]} { perror "tip_download: no connection to $dest." return $result } set shell_id [board_info $dest fileid] - if ![file exists $file] { + if {![file exists $file]} { perror "$file doesn't exist." return $result } @@ -163,7 +163,7 @@ proc tip_download { dest file args } { warning "Got an invalid command to the remote shell." } -i $shell_id -re ".*$decimal\r" { - if [info exists expect_out(buffer)] { + if {[info exists expect_out(buffer)]} { verbose "$expect_out(buffer)" exp_continue } diff --git a/lib/utils.exp b/lib/utils.exp index abfbd1f..9c9575d 100644 --- a/lib/utils.exp +++ b/lib/utils.exp @@ -49,7 +49,7 @@ proc getdirs { args } { catch "glob ${path}/${pattern}" tmp if { ${tmp} != "" } { foreach i ${tmp} { - if [file isdirectory $i] { + if {[file isdirectory $i]} { switch -- "[file tail $i]" { "testsuite" - "config" - @@ -61,7 +61,7 @@ proc getdirs { args } { continue } default { - if [file readable $i] { + if {[file readable $i]} { verbose "Found directory [file tail $i]" 3 lappend dirs $i if { $alldirs } { @@ -77,7 +77,7 @@ proc getdirs { args } { return "" } - if ![info exists dirs] { + if {![info exists dirs]} { return "" } else { return $dirs @@ -103,7 +103,7 @@ proc find { rootdir pattern } { foreach i $dirs { verbose "Looking in $i" 3 foreach match [glob -nocomplain $i/$pattern] { - if ![file isdirectory $match] { + if {![file isdirectory $match]} { lappend files $match verbose "Adding $match to file list" 3 } @@ -127,10 +127,10 @@ proc which { file } { # if it exists then the path must be OK # ??? What if $file has no path and "." isn't in $PATH? - if [file exists $file] { + if {[file exists $file]} { return $file } - if [info exists env(PATH)] { + if {[info exists env(PATH)]} { set path [split $env(PATH) ":"] } else { return 0 @@ -138,8 +138,8 @@ proc which { file } { foreach i $path { verbose "Checking against $i" 3 - if [file exists [file join $i $file]] { - if [file executable [file join $i $file]] { + if {[file exists [file join $i $file]]} { + if {[file executable [file join $i $file]]} { return [file join $i $file] } else { warning "[file join $i $file] exists but is not an executable" @@ -178,8 +178,8 @@ proc grep { args } { set fd [open $file r] while { [gets $fd cur_line]>=0 } { incr i - if [regexp -- "$pattern" $cur_line match] { - if ![string match "" $options] { + if {[regexp -- "$pattern" $cur_line match]} { + if {![string match "" $options]} { foreach opt $options { switch $opt { "line" { @@ -195,7 +195,7 @@ proc grep { args } { close $fd unset fd unset i - if ![info exists grep_out] { + if {![info exists grep_out]} { set grep_out "" } return $grep_out @@ -211,7 +211,7 @@ proc prune { list pattern } { set tmp {} foreach i $list { verbose "Checking pattern \"$pattern\" against $i" 3 - if ![string match $pattern $i] { + if {![string match $pattern $i]} { lappend tmp $i } else { verbose "Removing element $i from list" 3 @@ -226,8 +226,8 @@ proc prune { list pattern } { proc slay { name } { set in [open [concat "|ps"] r] while {[gets $in line]>-1} { - if ![string match "*expect*slay*" $line] { - if [string match "*$name*" $line] { + if {![string match "*expect*slay*" $line]} { + if {[string match "*$name*" $line]} { set pid [lindex $line 0] catch "exec kill -9 $pid" verbose "Killing $name, pid = $pid\n" @@ -241,7 +241,7 @@ proc slay { name } { # Convert a relative path to an absolute one on the local machine. # proc absolute { path } { - if [string match "." $path] { + if {[string match "." $path]} { return [pwd] } @@ -261,9 +261,9 @@ proc psource { file } { global errorCode unset errorInfo - if [file exists $file] { + if {[file exists $file]} { catch "source $file" - if [info exists errorInfo] { + if {[info exists errorInfo]} { send_error "ERROR: errors in $file\n" send_error "$errorInfo" return 1 @@ -285,12 +285,12 @@ proc psource { file } { # Eg: RUNTESTFLAGS="bar.exp=foo1.c foo2.c foo3*.c bar/baz*.c" # proc runtest_file_p { runtests testcase } { - if [string length [lindex $runtests 1]] { + if {[string length [lindex $runtests 1]]} { foreach ptn [lindex $runtests 1] { - if [string match "*/$ptn" $testcase] { + if {[string match "*/$ptn" $testcase]} { return 1 } - if [string match $ptn $testcase] { + if {[string match $ptn $testcase]} { return 1 } } @@ -318,14 +318,14 @@ proc diff { file_1 file_2 } { set eof -1 set differences 0 - if [file exists ${file_1}] { + if {[file exists ${file_1}]} { set file_a [open ${file_1} r] } else { warning "${file_1} doesn't exist" return 0 } - if [file exists ${file_2}] { + if {[file exists ${file_2}]} { set file_b [open ${file_2} r] } else { warning "${file_2} doesn't exist" @@ -336,7 +336,7 @@ proc diff { file_1 file_2 } { set list_a "" while { [gets ${file_a} line] != ${eof} } { - if [regexp "^#.*$" ${line}] { + if {[regexp "^#.*$" ${line}]} { continue } else { lappend list_a ${line} @@ -346,7 +346,7 @@ proc diff { file_1 file_2 } { set list_b "" while { [gets ${file_b} line] != ${eof} } { - if [regexp "^#.*$" ${line}] { + if {[regexp "^#.*$" ${line}]} { continue } else { lappend list_b ${line} @@ -359,7 +359,7 @@ proc diff { file_1 file_2 } { # 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 @@ -405,7 +405,7 @@ proc unsetenv { var } { proc getenv { var } { global env - if [info exists env($var)] { + if {[info exists env($var)]} { return $env($var) } else { return "" |