* runtest.exp: Fixes identified by the Frink static analyser:

	  (1) use -- in switch commands for safety,
	  (2) remove unreachable return commands after error commands,
	  (3) replace abbreviated "info proc" with "info procs",
	  (4) use -- in unset commands for safety where the variable name
	      is itself a variable.
	* lib/dg.exp: Likewise.
	* lib/debugger.exp: Likewise.
	* lib/framework.exp: Likewise.
	* lib/remote.exp: Likewise.
	* lib/target.exp: Likewise.
	* lib/targetdb.exp: Likewise.
	* lib/telnet.exp: Likewise.
	* lib/utils.exp: Likewise.

diff --git a/ChangeLog b/ChangeLog
index 059ea27..e370ce7 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,22 @@
 2016-03-28  Ben Elliston  <bje@gnu.org>
 
+       * runtest.exp: Fixes identified by the Frink static analyser:
+         (1) use -- in switch commands for safety,
+         (2) remove unreachable return commands after error commands,
+         (3) replace abbreviated "info proc" with "info procs",
+         (4) use -- in unset commands for safety where the variable name
+             is itself a variable.
+       * lib/dg.exp: Likewise.
+       * lib/debugger.exp: Likewise.
+       * lib/framework.exp: Likewise.
+       * lib/remote.exp: Likewise.
+       * lib/target.exp: Likewise.
+       * lib/targetdb.exp: Likewise.
+       * lib/telnet.exp: Likewise.
+       * lib/utils.exp: Likewise.
+
+2016-03-28  Ben Elliston  <bje@gnu.org>
+
        * Makefile.am: Remove references to Docbook and friends.
        * configure.ac: Likewise.
        * Makefile.in: Regenerate.

diff --git a/lib/debugger.exp b/lib/debugger.exp
index faeadd2..6b1ec65 100644 (file)
--- 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" }

diff --git a/lib/dg.exp b/lib/dg.exp
index 8b4e3c0..7a9f287 100644 (file)
--- a/lib/dg.exp
+++ b/lib/dg.exp
@@ -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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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

diff --git a/runtest.exp b/runtest.exp
index d435db8..6ec5e23 100644 (file)
--- a/runtest.exp
+++ b/runtest.exp
@@ -700,7 +700,7 @@ if {[expr {$build_triplet == "" && $host_triplet == ""}]} {
        exit 1
     }
     catch "exec $config_guess" build_triplet
-    switch $build_triplet {
+    switch -- $build_triplet {
        "No uname command or uname output not recognized" -
        "Unable to guess system type" {
            verbose "WARNING: Uname output not recognized"
@@ -826,7 +826,7 @@ proc setup_host_hook { name } {
     unset board
     unset board_type
     push_host $name
-    if { [info proc ${name}_init] != "" } {
+    if { [info procs ${name}_init] != "" } {
        ${name}_init $name
     }
 }
@@ -843,7 +843,7 @@ proc setup_build_hook { name } {
     unset board
     unset board_type
     push_build $name
-    if { [info proc ${name}_init] != "" } {
+    if { [info procs ${name}_init] != "" } {
        ${name}_init $name
     }
 }
@@ -1192,7 +1192,7 @@ for { set i 0 } { $i < $argc } { incr i } {
 
        default {
            if {[info exists tool]} {
-               if { [info proc ${tool}_option_proc] != "" } {
+               if { [info procs ${tool}_option_proc] != "" } {
                    if {[${tool}_option_proc $option]} {
                        continue
                    }
@@ -1898,7 +1898,7 @@ foreach current_target $target_list {
                    set [lindex $varval 0] [lindex $varval 1]
                } else {
                    verbose "Restoring [lindex $varval 0] to `unset'" 4
-                   unset [lindex $varval 0]
+                   unset -- [lindex $varval 0]
                }
            }
        }