diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/debugger.exp | 4 | ||||
| -rw-r--r-- | lib/dg.exp | 44 | ||||
| -rw-r--r-- | lib/framework.exp | 8 | ||||
| -rw-r--r-- | lib/remote.exp | 17 | ||||
| -rw-r--r-- | lib/target.exp | 2 | ||||
| -rw-r--r-- | lib/targetdb.exp | 2 | ||||
| -rw-r--r-- | lib/telnet.exp | 2 | ||||
| -rw-r--r-- | lib/utils.exp | 8 |
8 files changed, 38 insertions, 49 deletions
diff --git a/lib/debugger.exp b/lib/debugger.exp index faeadd2..6b1ec65 100644 --- a/lib/debugger.exp +++ b/lib/debugger.exp @@ -82,7 +82,7 @@ proc dumpwatch { args } { # proc watcharray { array element op } { upvar [set array]($element) avar - switch $op { + switch -- $op { "w" { puts "New value of [set array]($element) is $avar" } "r" { puts "[set array]($element) (= $avar) was just read" } "u" { puts "[set array]($element) (= $avar) was just unset" } @@ -91,7 +91,7 @@ proc watcharray { array element op } { proc watchvar { v ignored op } { upvar $v var - switch $op { + switch -- $op { "w" { puts "New value of $v is $var" } "r" { puts "$v (=$var) was just read" } "u" { puts "$v (=$var) was just unset" } @@ -249,11 +249,10 @@ proc dg-process-target { selector } { # Tests for optional arguments are coded with ">=" to simplify adding new ones. # proc dg-prms-id { args } { - global prms_id ;# this is a testing framework variable + global prms_id if { [llength $args] > 2 } { error "[lindex $args 0]: too many arguments" - return } set prms_id [lindex $args 1] @@ -271,11 +270,10 @@ proc dg-options { args } { if { [llength $args] > 3 } { error "[lindex $args 0]: too many arguments" - return } if { [llength $args] >= 3 } { - switch [dg-process-target [lindex $args 2]] { + switch -- [dg-process-target [lindex $args 2]] { "S" { set extra-tool-flags [lindex $args 1] } "N" { } "F" { error "[lindex $args 0]: `xfail' not allowed here" } @@ -298,14 +296,13 @@ proc dg-do { args } { if { [llength $args] > 3 } { error "[lindex $args 0]: too many arguments" - return } set selected [lindex ${do-what} 1] ;# selected? (""/S/N) set expected [lindex ${do-what} 2] ;# expected to pass/fail (P/F) if { [llength $args] >= 3 } { - switch [dg-process-target [lindex $args 2]] { + switch -- [dg-process-target [lindex $args 2]] { "S" { set selected "S" } @@ -333,7 +330,7 @@ proc dg-do { args } { set expected P } - switch [lindex $args 1] { + switch -- [lindex $args 1] { "preprocess" { } "compile" { } "assemble" { } @@ -351,12 +348,11 @@ proc dg-error { args } { if { [llength $args] > 5 } { error "[lindex $args 0]: too many arguments" - return } set xfail "" if { [llength $args] >= 4 } { - switch [dg-process-target [lindex $args 3]] { + switch -- [dg-process-target [lindex $args 3]] { "F" { set xfail "X" } "P" { set xfail "" } "N" { @@ -367,7 +363,7 @@ proc dg-error { args } { } if { [llength $args] >= 5 } { - switch [lindex $args 4] { + switch -- [lindex $args 4] { "." { set line [dg-format-linenum [lindex $args 0]] } "0" { set line "" } "default" { set line [dg-format-linenum [lindex $args 4]] } @@ -384,12 +380,11 @@ proc dg-warning { args } { if { [llength $args] > 5 } { error "[lindex $args 0]: too many arguments" - return } set xfail "" if { [llength $args] >= 4 } { - switch [dg-process-target [lindex $args 3]] { + switch -- [dg-process-target [lindex $args 3]] { "F" { set xfail "X" } "P" { set xfail "" } "N" { @@ -400,7 +395,7 @@ proc dg-warning { args } { } if { [llength $args] >= 5 } { - switch [lindex $args 4] { + switch -- [lindex $args 4] { "." { set line [dg-format-linenum [lindex $args 0]] } "0" { set line "" } "default" { set line [dg-format-linenum [lindex $args 4]] } @@ -417,12 +412,11 @@ proc dg-bogus { args } { if { [llength $args] > 5 } { error "[lindex $args 0]: too many arguments" - return } set xfail "" if { [llength $args] >= 4 } { - switch [dg-process-target [lindex $args 3]] { + switch -- [dg-process-target [lindex $args 3]] { "F" { set xfail "X" } "P" { set xfail "" } "N" { @@ -433,7 +427,7 @@ proc dg-bogus { args } { } if { [llength $args] >= 5 } { - switch [lindex $args 4] { + switch -- [lindex $args 4] { "." { set line [dg-format-linenum [lindex $args 0]] } "0" { set line "" } "default" { set line [dg-format-linenum [lindex $args 4]] } @@ -450,12 +444,11 @@ proc dg-build { args } { if { [llength $args] > 4 } { error "[lindex $args 0]: too many arguments" - return } set xfail "" if { [ llength $args] >= 4 } { - switch [dg-process-target [lindex $args 3]] { + switch -- [dg-process-target [lindex $args 3]] { "F" { set xfail "X" } "P" { set xfail "" } "N" { @@ -473,11 +466,10 @@ proc dg-excess-errors { args } { if { [llength $args] > 3 } { error "[lindex $args 0]: too many arguments" - return } if { [llength $args] >= 3 } { - switch [dg-process-target [lindex $args 2]] { + switch -- [dg-process-target [lindex $args 2]] { "F" { set excess-errors-flag 1 } "S" { set excess-errors-flag 1 } } @@ -505,14 +497,13 @@ proc dg-output { args } { if { [llength $args] > 3 } { error "[lindex $args 0]: too many arguments" - return } # Allow target dependent output. set expected [lindex ${output-text} 0] if { [llength $args] >= 3 } { - switch [dg-process-target [lindex $args 2]] { + switch -- [dg-process-target [lindex $args 2]] { "N" { return } "S" { } "F" { set expected "F" } @@ -534,7 +525,6 @@ proc dg-final { args } { if { [llength $args] > 2 } { error "[lindex $args 0]: too many arguments" - return } append final-code "[lindex $args 1]\n" @@ -726,7 +716,7 @@ proc dg-test { args } { # $line will either be a formatted line number or a number all by # itself. Delete the formatting. scan $line ${dg-linenum-format} line - switch [lindex $i 1] { + switch -- [lindex $i 1] { "ERROR" { $ok "$name $comment (test for errors, line $line)" } @@ -759,9 +749,9 @@ proc dg-test { args } { # Remove messages from the tool that we can ignore. set comp_output [prune_warnings $comp_output] - if { [info proc ${tool}-dg-prune] != "" } { + if { [info procs ${tool}-dg-prune] != "" } { set comp_output [${tool}-dg-prune $target_triplet $comp_output] - switch -glob $comp_output { + switch -glob -- $comp_output { "::untested::*" { regsub "::untested::" $comp_output "" message untested "$name: $message" @@ -821,7 +811,7 @@ proc dg-test { args } { setup_xfail "*-*-*" } set texttmp [lindex ${dg-output-text} 1] - if { ![regexp $texttmp ${output}] } { + if { ![regexp -- $texttmp ${output}] } { fail "$name output pattern test" send_log "Output was:\n${output}\nShould match:\n$texttmp\n" verbose "Failed test for output pattern $texttmp" 3 diff --git a/lib/framework.exp b/lib/framework.exp index 5cf0201..8404b38 100644 --- a/lib/framework.exp +++ b/lib/framework.exp @@ -303,7 +303,7 @@ proc clone_output { message } { } regsub "^\[ \t\]*(\[^ \t\]+).*$" "$message" "\\1" firstword - switch -glob "$firstword" { + switch -glob -- "$firstword" { "PASS:" - "XFAIL:" - "KFAIL:" - @@ -628,7 +628,7 @@ proc clear_xfail { args } { set argc [ llength $args ] for { set i 0 } { $i < $argc } { incr i } { set sub_arg [ lindex $args $i ] - switch -glob $sub_arg { + switch -glob -- $sub_arg { "*-*-*" { # is a configuration triplet if {[istarget $sub_arg]} { set xfail_flag 0 @@ -649,7 +649,7 @@ proc clear_kfail { args } { set argc [ llength $args ] for { set i 0 } { $i < $argc } { incr i } { set sub_arg [ lindex $args $i ] - switch -glob $sub_arg { + switch -glob -- $sub_arg { "*-*-*" { # is a configuration triplet if {[istarget $sub_arg]} { set kfail_flag 0 @@ -717,7 +717,7 @@ proc record_test { type message args } { xml_output " </test>" } - switch $type { + switch -- $type { PASS { if {$prms_id} { set message [concat $message "\t(PRMS $prms_id)"] diff --git a/lib/remote.exp b/lib/remote.exp index 029d934..550f487 100644 --- a/lib/remote.exp +++ b/lib/remote.exp @@ -401,7 +401,7 @@ proc remote_reboot { host } { if {[board_info $host exists name]} { set host [board_info $host name] } - if { [info proc ${host}_init] != "" } { + if { [info procs ${host}_init] != "" } { ${host}_init $host } return $status @@ -589,7 +589,7 @@ proc call_remote { type proc dest args } { if { $proc == "close" || $proc == "open" } { foreach try "$high_prot [board_info $dest connect] telnet standard" { if { $try != "" } { - if { [info proc "${try}_${proc}"] != "" } { + if { [info procs "${try}_${proc}"] != "" } { verbose "call_remote calling ${try}_${proc}" 3 set result [eval ${try}_${proc} \"$dest\" $args] break @@ -597,7 +597,7 @@ proc call_remote { type proc dest args } { } } set ft "[board_info $dest file_transfer]" - if { [info proc "${ft}_${proc}"] != "" } { + if { [info procs "${ft}_${proc}"] != "" } { verbose "calling ${ft}_${proc} $dest $args" 3 set result2 [eval ${ft}_${proc} \"$dest\" $args] } @@ -613,7 +613,7 @@ proc call_remote { type proc dest args } { foreach try "${high_prot} [board_info $dest file_transfer] [board_info $dest connect] telnet standard" { verbose "looking for ${try}_${proc}" 4 if { $try != "" } { - if { [info proc "${try}_${proc}"] != "" } { + if { [info procs "${try}_${proc}"] != "" } { verbose "call_remote calling ${try}_${proc}" 3 return [eval ${try}_${proc} \"$dest\" $args] } @@ -623,7 +623,6 @@ proc call_remote { type proc dest args } { return "" } error "No procedure for '$proc' in call_remote" - return -1 } # Send FILE through the existing session established to DEST. @@ -721,7 +720,7 @@ proc standard_file { dest op args } { set file [lindex $args 0] verbose "dest in proc standard_file is $dest" 3 if { ![is_remote $dest] } { - switch $op { + switch -- $op { cmp { set otherfile [lindex $args 1] if { [file exists $file] && [file exists $otherfile] @@ -761,14 +760,14 @@ proc standard_file { dest op args } { file delete -force -- $x } } - return + return {} } } } else { - switch $op { + switch -- $op { exists { set status [remote_exec $dest "test -f $file"] - return [expr [lindex $status 0] == 0] + return [expr {[lindex $status 0] == 0}] } delete { set file "" diff --git a/lib/target.exp b/lib/target.exp index 6634345..4c73c61 100644 --- a/lib/target.exp +++ b/lib/target.exp @@ -296,7 +296,7 @@ proc prune_warnings { text } { # proc target_compile {source destfile type options} { set target [target_info name] - if { [info proc ${target}_compile] != "" } { + if { [info procs ${target}_compile] != "" } { return [${target}_compile $source $destfile $type $options] } else { return [default_target_compile $source $destfile $type $options] diff --git a/lib/targetdb.exp b/lib/targetdb.exp index e29886e..c92573d 100644 --- a/lib/targetdb.exp +++ b/lib/targetdb.exp @@ -33,7 +33,7 @@ proc board_info { machine op args } { if { [llength $args] == 0 } { return [info exists board_info($machine,name)] } else { - return [info exists "board_info($machine,[lindex $args 0])"] + return [info exists board_info($machine,[lindex $args 0])] } } if { [llength $args] == 0 } { diff --git a/lib/telnet.exp b/lib/telnet.exp index 8f4a211..8b9d43d 100644 --- a/lib/telnet.exp +++ b/lib/telnet.exp @@ -31,7 +31,7 @@ proc telnet_open { hostname args } { set raw 0 foreach arg $args { - switch $arg { + switch -- $arg { "raw" { set raw 1 } } } diff --git a/lib/utils.exp b/lib/utils.exp index c61785c..e6850b1 100644 --- a/lib/utils.exp +++ b/lib/utils.exp @@ -196,7 +196,7 @@ proc grep { args } { if {[regexp -- "$pattern" $cur_line match]} { if {![string match "" $options]} { foreach opt $options { - switch $opt { + switch -- $opt { "line" { lappend grep_out [concat $i $match] } @@ -219,12 +219,12 @@ proc grep { args } { # # Remove elements based on patterns. elements are delimited by spaces. # pattern is the pattern to look for using glob style matching -# list is the list to check against +# lst is the list to check against # returns the new list # -proc prune { list pattern } { +proc prune { lst pattern } { set tmp {} - foreach i $list { + foreach i $lst { verbose "Checking pattern \"$pattern\" against $i" 3 if {![string match $pattern $i]} { lappend tmp $i |