Tk Library Source Code

Artifact [aef36b0a7a]
Login

Artifact aef36b0a7a5b2b4bede6b888e3b6019eceacf6bc:

Attachment "5.diff" to ticket [433970ffff] added by andreas_kupries 2001-06-21 06:17:41.
? frinked
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.53
diff -u -r1.53 ChangeLog
--- ChangeLog	2001/05/01 19:01:23	1.53
+++ ChangeLog	2001/06/20 23:08:22
@@ -1,3 +1,8 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* Ran frink and procheck over all modules and fixed the reported
+	  problems. As far as they actually were problems.
+
 2001-05-01  Andreas Kupries <[email protected]>
 
 	* Makefile.in (MODULES):  Added module 'report'.
Index: modules/base64/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/ChangeLog,v
retrieving revision 1.7
diff -u -r1.7 ChangeLog
--- modules/base64/ChangeLog	2000/10/11 20:04:11	1.7
+++ modules/base64/ChangeLog	2001/06/20 23:08:24
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* base64.tcl: Fixed dubious code reported by frink.
+
 2000-10-11  Brent Welch  <[email protected]>
 
 	* base64.tcl: Fixed bug in base64::decode where trailing
Index: modules/base64/base64.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/base64.tcl,v
retrieving revision 1.8
diff -u -r1.8 base64.tcl
--- modules/base64/base64.tcl	2000/10/11 20:04:11	1.8
+++ modules/base64/base64.tcl	2001/06/20 23:08:24
@@ -70,6 +70,14 @@
 	    error "value for \"$arg\" missing"
 	}
 	set val [lindex $args $i]
+
+	# The name of the variable to assign the value to is extracted
+	# from the list of known options, all of which have an
+	# associated variable of the same name as the option without
+	# a leading "-". The [string range] command is used to strip
+	# of the leading "-" from the name of the option.
+	#
+	# FRINK: nocheck
 	set [string range [lindex $optionStrings $index] 1 end] $val
     }
     
@@ -90,7 +98,7 @@
 	    set length 0
 	}
 	scan $c %c x
-	switch [incr state] {
+	switch -exact -- [incr state] {
 	    1 {	append result $base64_en([expr {($x >>2) & 0x3F}]) }
 	    2 { append result \
 		$base64_en([expr {(($old << 4) & 0x30) | (($x >> 4) & 0xF)}]) }
@@ -99,15 +107,17 @@
 		append result $base64_en([expr {($x & 0x3F)}])
 		incr length
 		set state 0}
+	    default {error "Panic, illegal state, must not happen"}
 	}
 	set old $x
 	incr length
     }
     set x 0
-    switch $state {
+    switch -exact -- $state {
 	0 { # OK }
 	1 { append result $base64_en([expr {(($old << 4) & 0x30)}])== }
 	2 { append result $base64_en([expr {(($old << 2) & 0x3C)}])=  }
+	default {error "Panic, illegal state, must not happen"}
     }
     return $result
 }
Index: modules/cmdline/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/cmdline/ChangeLog,v
retrieving revision 1.5
diff -u -r1.5 ChangeLog
--- modules/cmdline/ChangeLog	2000/06/02 18:43:53	1.5
+++ modules/cmdline/ChangeLog	2001/06/20 23:08:24
@@ -1,3 +1,8 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* typedCmdline.tcl:
+	* cmdline.tcl: Fixed dubious code reported by frink.
+
 2000-05-03  Brent Welch <[email protected]>
 
 	* cmdline.tcl: Changed cmdline::getopt to set boolean arguments to
Index: modules/cmdline/cmdline.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/cmdline/cmdline.tcl,v
retrieving revision 1.6
diff -u -r1.6 cmdline.tcl
--- modules/cmdline/cmdline.tcl	2000/06/02 18:43:53	1.6
+++ modules/cmdline/cmdline.tcl	2001/06/20 23:08:25
@@ -94,6 +94,9 @@
 		    set result -1
 		}
 	    }
+	    default {
+		# Skip ahead
+	    }
 	}
     }
 
Index: modules/cmdline/typedCmdline.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/cmdline/typedCmdline.tcl,v
retrieving revision 1.2
diff -u -r1.2 typedCmdline.tcl
--- modules/cmdline/typedCmdline.tcl	2000/06/02 18:43:53	1.2
+++ modules/cmdline/typedCmdline.tcl	2001/06/20 23:08:26
@@ -22,8 +22,8 @@
 
     variable charclasses
     catch {string is . .} charclasses
-    regexp {must be (.+)$} $charclasses dummy charclasses
-    regsub -all {, (or )?} $charclasses {|} charclasses
+    regexp -- {must be (.+)$} $charclasses dummy charclasses
+    regsub -all -- {, (or )?} $charclasses {|} charclasses
 
 }
 
@@ -151,7 +151,7 @@
                     set opt [lindex $optstring $i]
 
                     set quantifier "none"
-                    if {[regexp {\.[^.]+([?+*])$} $opt dummy quantifier]} {
+                    if {[regexp -- {\.[^.]+([?+*])$} $opt dummy quantifier]} {
                         set opt [string range $opt 0 end-1]
                     }
 
@@ -160,11 +160,11 @@
                         set retvar $opt
                         set argsList [lrange $argsList 1 end]
 
-                    } elseif {[regexp "\\.(arg|$charclasses)\$" $opt dummy charclass]
-                            || [regexp {\.\(([^)]+)\)} $opt dummy charclass]} {
-                        if [string equal arg $charclass] {
+                    } elseif {[regexp -- "\\.(arg|$charclasses)\$" $opt dummy charclass]
+                            || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} {
+				if {[string equal arg $charclass]} {
                             set type arg
-                        } elseif [regexp "^($charclasses)\$" $charclass] {
+			} elseif {[regexp -- "^($charclasses)\$" $charclass]} {
                             set type class
                         } else {
                             set type oneof
@@ -173,7 +173,7 @@
                         set argsList [lrange $argsList 1 end]
                         set opt [file rootname $opt]
 
-                        while 1 {
+                        while {1} {
                             if {[llength $argsList] == 0
                                     || [string equal "--" [lindex $argsList 0]]} {
                                 if {[string equal "--" [lindex $argsList 0]]} {
@@ -236,7 +236,7 @@
                                 }
                                 set quantifier ""
                             }
-                             if {![regexp {[+*]} $quantifier]} {
+                             if {![regexp -- {[+*]} $quantifier]} {
                                 break;
                             }
                         }
@@ -250,6 +250,9 @@
                     set retval -1
                 }
             }
+	    default {
+		# Skip ahead
+	    }
         }
     }
 
@@ -397,8 +400,8 @@
                 # Display something about multiple options
             }
 
-            if {[regexp "\\.(arg|$charclasses)\$" $name dummy charclass]
-                    || [regexp {\.\(([^)]+)\)} $opt dummy charclass]} {
+            if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass]
+                    || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} {
                    regsub "\\..+\$" $name {} name
                 set comment [lindex $opt 2]
                 set default "<[lindex $opt 1]>"
Index: modules/counter/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/counter/ChangeLog,v
retrieving revision 1.4
diff -u -r1.4 ChangeLog
--- modules/counter/ChangeLog	2000/10/04 20:01:46	1.4
+++ modules/counter/ChangeLog	2001/06/20 23:08:26
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* counter.tcl: Fixed dubious code reported by frink.
+
 2000-10-04  Brent Welch <[email protected]>
 
 	* counter.tcl: Fixed bug in counter::MergeDay
Index: modules/counter/counter.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/counter/counter.tcl,v
retrieving revision 1.4
diff -u -r1.4 counter.tcl
--- modules/counter/counter.tcl	2000/10/04 20:01:47	1.4
+++ modules/counter/counter.tcl	2001/06/20 23:08:28
@@ -129,12 +129,12 @@
 		    
 		    # Figure out what "hour" we are
 
-		    set delta [expr $startTime - $dayStart]
-		    set hourIndex [expr $delta / ($secsPerMinute * 60)]
-		    set day [expr $hourIndex / 24]
-		    set hourIndex [expr $hourIndex % 24]
+		    set delta [expr {$startTime - $dayStart}]
+		    set hourIndex [expr {$delta / ($secsPerMinute * 60)}]
+		    set day [expr {$hourIndex / 24}]
+		    set hourIndex [expr {$hourIndex % 24}]
 
-		    set hourBase [expr $dayStart + $day * $secsPerMinute * 60 * 24]
+		    set hourBase [expr {$dayStart + $day * $secsPerMinute * 60 * 24}]
 		    set minuteBase [expr {$hourBase + $hourIndex * 60 * $secsPerMinute}]
 
 		    set partialHour [expr {$startTime -
@@ -300,6 +300,7 @@
 	    }
 	    set args [list -timehist $counter::secsPerMinute]
 	}
+	default {#ignore}
     }
     unset counter
     eval {counter::init $tag} $args
@@ -404,9 +405,10 @@
 		}
 		set histogram($minute) [expr {$histogram($minute) + $delta}]
 	    }
+	    default {#ignore}
 	}
 #   }
-    return ""
+    return
 }
 
 # counter::exists --
@@ -902,6 +904,7 @@
 		append result "<td>[html::font][clock format $time \
 			-format "%b %d %k:%M"]</font></td></tr>\n"
 	    }
+	    default {#ignore}
 	}
 
     } else {
@@ -1112,6 +1115,7 @@
 		set deltaT [expr {$secsPerMinute * 60 * 24}]
 		set wrapDeltaT 0
 	    }
+	    default {#ignore}
 	}
 	# These are tick marks
 
Index: modules/csv/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/csv/ChangeLog,v
retrieving revision 1.2
diff -u -r1.2 ChangeLog
--- modules/csv/ChangeLog	2001/06/19 17:21:56	1.2
+++ modules/csv/ChangeLog	2001/06/20 23:08:29
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* csv.tcl: Fixed dubious code reported by frink and procheck.
+
 2001-06-19  Andreas Kupries <[email protected]>
 
 	* csv.n: Fixed nroff trouble.
Index: modules/csv/csv.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/csv/csv.tcl,v
retrieving revision 1.1
diff -u -r1.1 csv.tcl
--- modules/csv/csv.tcl	2001/05/01 19:01:24	1.1
+++ modules/csv/csv.tcl	2001/06/20 23:08:29
@@ -139,6 +139,7 @@
 		return -code error "wrong # args: ::csv::report printmatrix2channel matrix chan"
 	    }
 	    writematrix $matrix [lindex $args 0]
+	    return ""
 	}
 	default {
 	    return -code error "Unknown method $cmd"
@@ -164,7 +165,7 @@
 	    \"\"\"$sepChar \"\0$sepChar \
 	    \"\" \" \" \0 ] $line]
     set end 0
-    while {[regexp -indices -start $end {(\0)[^\0]*(\0)} $line -> start end]} {
+    while {[regexp -indices -start $end -- {(\0)[^\0]*(\0)} $line -> start end]} {
 	set start [lindex $start 0]
 	set end   [lindex $end 0]
 	set range [string range $line $start $end]
@@ -262,12 +263,12 @@
 #	None.
 
 proc ::csv::writequeue {q chan {sepChar ,}} {
-    while {[q size] > 0} {
-	puts $chan [join [q get] $sepChar]
+    while {[$q size] > 0} {
+	puts $chan [join [$q get] $sepChar]
     }
 
     # Memory intensive alternative:
-    # puts $chan [joinlist [q get [q size]] $sepChar]
+    # puts $chan [joinlist [$q get [$q size]] $sepChar]
     return
 }
 
Index: modules/fileutil/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/ChangeLog,v
retrieving revision 1.3
diff -u -r1.3 ChangeLog
--- modules/fileutil/ChangeLog	2001/03/26 16:50:21	1.3
+++ modules/fileutil/ChangeLog	2001/06/20 23:08:29
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* fileutil.tcl: Fixed dubious code reported by frink.
+
 2001-03-20  Andreas Kupries <[email protected]>
 
 	* fileutil.tcl: [Bug #410104, Patch #410106]
Index: modules/fileutil/fileutil.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.tcl,v
retrieving revision 1.5
diff -u -r1.5 fileutil.tcl
--- modules/fileutil/fileutil.tcl	2001/03/26 16:50:21	1.5
+++ modules/fileutil/fileutil.tcl	2001/06/20 23:08:29
@@ -33,7 +33,7 @@
 	set lnum 0
 	while {[gets stdin line] >= 0} {
 	    incr lnum
-	    if {[regexp $pattern $line]} {
+	    if {[regexp -- $pattern $line]} {
 		lappend result "${lnum}:${line}"
 	    }
 	}
@@ -43,7 +43,7 @@
 	    set lnum 0
 	    while {[gets $file line] >= 0} {
 		incr lnum
-		if {[regexp $pattern $line]} {
+		if {[regexp -- $pattern $line]} {
 		    lappend result "${filename}:${lnum}:${line}"
 		}
 	    }
Index: modules/ftp/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftp/ChangeLog,v
retrieving revision 1.8
diff -u -r1.8 ChangeLog
--- modules/ftp/ChangeLog	2000/10/02 02:23:44	1.8
+++ modules/ftp/ChangeLog	2001/06/20 23:08:31
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* ftpdemo.tcl:
+	* ftp.tcl: Fixed dubious code reported by frink.
 
 2000-10-01  Dan Kuchler <[email protected]>
 
Index: modules/ftp/ftp.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftp/ftp.tcl,v
retrieving revision 1.10
diff -u -r1.10 ftp.tcl
--- modules/ftp/ftp.tcl	2000/10/02 02:23:44	1.10
+++ modules/ftp/ftp.tcl	2001/06/20 23:08:35
@@ -242,7 +242,7 @@
 
             # get return code, check for multi-line text
             
-            regexp "(^\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line msgtext
+            regexp -- "(^\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line msgtext
             set buffer $bufline
 			
             # multi-line format detected ("-"), get all the lines
@@ -252,7 +252,7 @@
                 set number [gets $sock bufline]	
                 if { $number > 0 } {
                     append buffer \n "$bufline"
-                    regexp "(^\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line
+                    regexp -- "(^\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line
                 }
             }
         } elseif { [eof $ftp(CtrlSock)] } {
@@ -287,7 +287,7 @@
     }
 
     # use only the first digit 
-    regexp "^\[0-9\]?" $rc rc
+    regexp -- "^\[0-9\]?" $rc rc
 	
     switch -exact -- $ftp(State) {
         user { 
@@ -522,7 +522,7 @@
         size_sent {
             switch -exact -- $rc {
                 2 {
-                    regexp "^\[0-9\]+ (.*)$" $buffer all ftp(FileSize)
+                    regexp -- "^\[0-9\]+ (.*)$" $buffer all ftp(FileSize)
                     set complete_with 1
 		    set nextState 1
 		    Command $ftp(Command) size $ftp(File) $ftp(FileSize)
@@ -541,7 +541,7 @@
         modtime_sent {
             switch -exact -- $rc {
                 2 {
-                    regexp "^\[0-9\]+ (.*)$" $buffer all ftp(DateTime)
+                    regexp -- "^\[0-9\]+ (.*)$" $buffer all ftp(DateTime)
                     set complete_with 1
 		    set nextState 1
 		    Command $ftp(Command) modtime $ftp(File) [ModTimePostProcess $ftp(DateTime)]
@@ -560,7 +560,7 @@
         pwd_sent {
             switch -exact -- $rc {
                 2 {
-                    regexp "^.*\"(.*)\"" $buffer temp ftp(Dir)
+                    regexp -- "^.*\"(.*)\"" $buffer temp ftp(Dir)
                     set complete_with 1
 		    set nextState 1
 		    Command $ftp(Command) pwd $ftp(Dir)
@@ -735,7 +735,7 @@
             switch -exact -- $rc {
 		1 {
 		    # Keep going
-		    return {}
+		    return
 		}
                 2 {
                     set complete_with 1
@@ -979,6 +979,9 @@
                 }
             }
         }
+	default {
+	    error "Unknown state \"$ftp(State)\""
+	}
     }
 
     # finish waiting 
@@ -2147,6 +2150,7 @@
 
     catch {close $ftp(CtrlSock)}
     catch {unset ftp}
+    return 1
 }
 
 proc ftp::LazyClose {s } {
@@ -2162,7 +2166,7 @@
         set connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid) \
                 [after 5000 [list ftp::Close $s]]
     }
-    return
+    return 1
 }
 
 #############################################################################
@@ -2252,7 +2256,7 @@
             if { $DEBUG } {
                 DisplayMsg $s "  $option = $value"
             }
-            regexp {^-(.?)(.*)$} $option all first rest
+            regexp -- {^-(.?)(.*)$} $option all first rest
             set option "[string toupper $first]$rest"
             set ftp($option) $value
         } 
@@ -2374,7 +2378,7 @@
 
     # create local file for ftp::Get 
 
-    if { [regexp "^get" $ftp(State)]  && (!$ftp(inline))} {
+    if { [regexp -- "^get" $ftp(State)]  && (!$ftp(inline))} {
         set rc [catch {set ftp(DestCI) [open $ftp(LocalFilename) w]} msg]
         if { $rc != 0 } {
             DisplayMsg $s "$msg" error
@@ -2390,7 +2394,7 @@
 
     # append local file for ftp::Reget 
 
-    if { [regexp "^reget" $ftp(State)] } {
+    if { [regexp -- "^reget" $ftp(State)] } {
         set rc [catch {set ftp(DestCI) [open $ftp(LocalFilename) a]} msg]
         if { $rc != 0 } {
             DisplayMsg $s "$msg" error
@@ -2409,7 +2413,7 @@
     set ftp(Total) 0
     set ftp(Start_Time) [clock seconds]
     fcopy $ftp(SourceCI) $ftp(DestCI) -command [list [namespace current]::CopyNext $s] -size $ftp(Blocksize)
-    return
+    return 1
 }
 
 #############################################################################
@@ -2605,6 +2609,9 @@
                 set ftp(DestCI) $sock
 	    }			  
         }
+	default {
+	    error "Unknown state \"$ftp(State)\""
+	}
     }
 
     if { $VERBOSE } {
@@ -2667,7 +2674,7 @@
 proc ftp::OpenPassiveConn {s buffer} {
     upvar ::ftp::ftp$s ftp
 
-    if { [regexp {([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)} $buffer all a1 a2 a3 a4 p1 p2] } {
+    if { [regexp -- {([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)} $buffer all a1 a2 a3 a4 p1 p2] } {
         set ftp(LocalAddr) "$a1.$a2.$a3.$a4"
         set ftp(DataPort) "[expr {$p1 * 256 + $p2}]"
 
Index: modules/ftp/ftpdemo.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftp/ftpdemo.tcl,v
retrieving revision 1.2
diff -u -r1.2 ftpdemo.tcl
--- modules/ftp/ftpdemo.tcl	2000/07/09 20:13:34	1.2
+++ modules/ftp/ftpdemo.tcl	2001/06/20 23:08:38
@@ -259,7 +259,7 @@
 		set state ""
 	}
 	
-	switch $state {
+	switch -exact -- $state {
 	  data		{.msg.f.f2.text insert end "$msg\n" data}
 	  control	{.msg.f.f2.text insert end "$msg\n" control}
 	  error		{.msg.f.f2.text insert end "$msg\n" error; incr test(errors)}
@@ -327,7 +327,7 @@
 proc ProgressBar {state {bytes 0} {total {}} {filename {}}} {
 global progress
 	set w .progress
-	switch $state {
+	switch -exact -- $state {
 	  init	{
 		set progress(percent) "0%"
 		set progress(total) $total
@@ -378,6 +378,9 @@
 		destroy $w
 		update
 	  }
+	  default {
+	      error "Unknown state \"$state\""
+	  }
 	}
 }
 
@@ -691,7 +694,7 @@
 	set cnf(debug) 0
 	set cnf(verbose) 1
 	
-	if {[file exist $cnf(configfile)]} {
+	if {[file exists $cnf(configfile)]} {
 		set f [open $cnf(configfile) r]
 		array set cnf [read $f]
 		close $f
Index: modules/ftpd/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftpd/ChangeLog,v
retrieving revision 1.4
diff -u -r1.4 ChangeLog
--- modules/ftpd/ChangeLog	2000/11/22 17:28:49	1.4
+++ modules/ftpd/ChangeLog	2001/06/20 23:08:38
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* ftpd.tcl: Fixed dubious code reported by frink.
+
 2000-11-22  Eric Melski  <[email protected]>
 
 	* Integrated patch from Mark O'Conner.  Patch fixed file translation
Index: modules/ftpd/ftpd.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftpd/ftpd.tcl,v
retrieving revision 1.7
diff -u -r1.7 ftpd.tcl
--- modules/ftpd/ftpd.tcl	2000/11/22 17:28:49	1.7
+++ modules/ftpd/ftpd.tcl	2001/06/20 23:08:40
@@ -513,7 +513,7 @@
 	Finish $sock
 	return
     }
-    switch $data(state) {
+    switch -exact -- $data(state) {
 	command {
 	    gets $sock command
 	    set parts [split $command]
@@ -539,6 +539,9 @@
 		puts $sock "500 Unknown command $cmd"
 	    }
 	}
+	default {
+	    error "Unknown state \"$data(state)\""
+	}
     }
     return
 }
@@ -1115,6 +1118,7 @@
     ::ftpd::Log note "Closed $sock"
     puts $sock "221 Goodbye."
     close $sock
+    # FRINK: nocheck
     unset ::ftpd::$sock
     return
 }
@@ -1646,7 +1650,7 @@
     } else {
 	set docRoot $dir
     }
-    return
+    return ""
 }
 
 # ::ftpd::fsFile::fs --
@@ -1869,8 +1873,11 @@
                 puts $outchan "213 [file size $path]"
 	    }
         }
+	default {
+	    error "Unknown command \"$command\""
+	}
     }
-    return
+    return ""
 }
 
 # ::ftpd::fsFile::PermBits --
Index: modules/htmlparse/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/htmlparse/ChangeLog,v
retrieving revision 1.1
diff -u -r1.1 ChangeLog
--- modules/htmlparse/ChangeLog	2001/03/26 16:50:21	1.1
+++ modules/htmlparse/ChangeLog	2001/06/20 23:08:42
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* htmlparse.tcl: Fixed dubious code reported by frink.
+
 2001-03-23  Andreas Kupries <[email protected]>
 
 	* htmlparse.tcl: Changed the implementation to allow incremental
Index: modules/htmlparse/htmlparse.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/htmlparse/htmlparse.tcl,v
retrieving revision 1.1
diff -u -r1.1 htmlparse.tcl
--- modules/htmlparse/htmlparse.tcl	2001/03/26 16:50:21	1.1
+++ modules/htmlparse/htmlparse.tcl	2001/06/20 23:08:44
@@ -235,6 +235,8 @@
 		if {[string length $arg] == 0} {
 		    return -code error "::htmlparse::parse : -$opt illegal argument (empty)"
 		}
+		# Each option has an variable with the same name associated with it.
+		# FRINK: nocheck
 		set $opt $arg
 	    }
 	    split  {
@@ -243,6 +245,7 @@
 		}
 		set split $arg
 	    }
+	    default {# Can't happen}
 	}
     }
 
@@ -257,13 +260,13 @@
 
     # Handle incomplete HTML
 
-    if {[regexp {[^<]*(<[^>]*)$} [lindex "\{$html\}" end] -> trailer]} {
+    if {[regexp -- {[^<]*(<[^>]*)$} [lindex "\{$html\}" end] -> trailer]} {
 	if {$incvar == {}} {
 	    return -code error "::htmlparse::parse : HTML is incomplete, option -incvar is missing"
 	}
 	upvar $incvar incomplete
 	set incomplete $trailer
-	set html       [string range $html 0 [expr [string last "<" $html] - 1]]
+	set html       [string range $html 0 [expr {[string last "<" $html] - 1}]]
     }
 
     # Convert the HTML string into a script.
@@ -415,7 +418,7 @@
 proc ::htmlparse::mapEscapes {html} {
     # Find HTML escape characters of the form &xxx;
 
-    if {![regexp & $html]} {
+    if {![regexp -- & $html]} {
 	# HTML not containing escape sequences is returned unchanged.
 	return $html
     }
@@ -769,6 +772,9 @@
 	    # Removes this node and everything below it.
 	    $tree delete $node
 	}
+	default {
+	    # Ignore tag
+	}
     }
 }
 
@@ -792,6 +798,9 @@
 	form {
 	    $tree delete $node
 	}
+	default {
+	    # Ignore tag
+	}
     }
 }
 
@@ -829,6 +838,9 @@
 		}
 		$tree move $node end $sibling
 	    }
+	}
+	default {
+	    # Ignore tag
 	}
     }
 }
Index: modules/math/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/math/ChangeLog,v
retrieving revision 1.7
diff -u -r1.7 ChangeLog
--- modules/math/ChangeLog	2000/10/06 21:10:41	1.7
+++ modules/math/ChangeLog	2001/06/20 23:08:44
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* math.tcl: Fixed dubious code reported by frink.
+
 2000-10-06  Eric Melski  <[email protected]>
 
 	* math.test: 
Index: modules/math/math.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/math/math.tcl,v
retrieving revision 1.7
diff -u -r1.7 math.tcl
--- modules/math/math.tcl	2000/10/06 21:10:41	1.7
+++ modules/math/math.tcl	2001/06/20 23:08:44
@@ -93,12 +93,12 @@
      }   
      
      ;## are we dealing with x,y pairs?
-     if { [ expr $length % 2 ] } {
+     if { [ expr {$length % 2} ] } {
         return -code error "unmatched xy pair in input"
      }
      
      ;## are there an even number of pairs?  Augment.
-     if { ! [ expr $length % 4 ] } {
+     if { ! [ expr {$length % 4} ] } {
         set xy_pairs [ concat [ lindex $xy_pairs 0 ] 0 $xy_pairs ]
      }
      set x0   [ lindex $xy_pairs 0     ]
Index: modules/md5/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/ChangeLog,v
retrieving revision 1.3
diff -u -r1.3 ChangeLog
--- modules/md5/ChangeLog	2001/06/19 17:21:57	1.3
+++ modules/md5/ChangeLog	2001/06/20 23:08:44
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* md5.tcl: Fixed dubious code reported by frink.
+
 2001-06-19  Andreas Kupries <[email protected]>
 
 	* md5.n: Fixed nroff trouble.
Index: modules/md5/md5.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/md5.tcl,v
retrieving revision 1.2
diff -u -r1.2 md5.tcl
--- modules/md5/md5.tcl	2001/04/25 15:30:03	1.2
+++ modules/md5/md5.tcl	2001/06/20 23:08:46
@@ -151,7 +151,7 @@
     proc ::md5::time {} {
 	foreach len {10 50 100 500 1000 5000 10000} {
 	    set time [::time {md5 [format %$len.0s ""]} 10]
-	    regexp "\[0-9]*" $time msec
+	    regexp -- "\[0-9]*" $time msec
 	    puts "input length $len: [expr {$msec/1000}] milliseconds per interation"
 	}
     }
Index: modules/mime/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/mime/ChangeLog,v
retrieving revision 1.9
diff -u -r1.9 ChangeLog
--- modules/mime/ChangeLog	2001/02/04 08:28:35	1.9
+++ modules/mime/ChangeLog	2001/06/20 23:08:47
@@ -1,3 +1,8 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* smtp.tcl:
+	* mime.tcl: Fixed dubious code reported by frink and procheck.
+
 2001-01-30  Eric Melski  <[email protected]>
 
 	* mime.tcl: Applied patch from Peter MacDonald to correct problem
Index: modules/mime/mime.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/mime/mime.tcl,v
retrieving revision 1.12
diff -u -r1.12 mime.tcl
--- modules/mime/mime.tcl	2001/02/04 08:28:35	1.12
+++ modules/mime/mime.tcl	2001/06/20 23:08:52
@@ -238,7 +238,7 @@
     variable mime
 
     set token [namespace current]::[incr mime(uid)]
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -274,7 +274,7 @@
 
 proc mime::initializeaux {token args} {
     global errorCode errorInfo
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -418,6 +418,7 @@
                     }
                 }
             }
+	    default {# Go ahead}
         }
 
         if {[lsearch -exact $state(lowerL) content-id] < 0} {
@@ -449,6 +450,7 @@
 
     if {[set fileP [info exists state(file)]]} {
         if {[set openP [info exists state(root)]]} {
+	    # FRINK: nocheck
             variable $state(root)
             upvar 0 $state(root) root
 
@@ -492,6 +494,7 @@
 #       otherwise it just sets up the appropriate variables.
 
 proc mime::parsepart {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -631,6 +634,7 @@
         }
 
         if {[string match message/* $state(content)]} {
+	    # FRINK: nocheck
             variable [set child $token-[incr state(cid)]]
 
             set state(value) parts
@@ -674,7 +678,7 @@
             if {$pos > $last} {
         #        error "termination string missing in $state(content)"
                  set line "--$boundary--"
-            } {
+            } else {
               if {[set x [gets $state(fd) line]] < 0} {
                   error "end-of-file encountered while parsing $state(content)"
               }
@@ -734,7 +738,7 @@
             }
             continue
         }
-
+	# FRINK: nocheck
         variable [set child $token-[incr state(cid)]]
 
         lappend state(parts) $child
@@ -773,7 +777,7 @@
 
 proc mime::parsetype {token string} {
     global errorCode errorInfo
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -815,6 +819,7 @@
 #       tcl list.
 
 proc mime::parsetypeaux {token string} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -885,6 +890,8 @@
         }
         set params($attribute) $state(buffer)
     }
+    # Should not come here - added to benefit frink 2.1.3
+    return ""
 }
 
 # mime::finalize --
@@ -904,6 +911,7 @@
 #       Returns an empty string.
 
 proc mime::finalize {token args} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -936,6 +944,7 @@
     foreach name [array names state] {
         unset state($name)
     }
+    # FRINK: nocheck
     unset $token
 }
 
@@ -971,6 +980,7 @@
 #       Returns the properties of a MIME part
 
 proc mime::getproperty {token {property ""}} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1033,6 +1043,7 @@
 #       Returns the size in bytes of the MIME token.
 
 proc mime::getsize {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1063,6 +1074,9 @@
         string/1 {
             return [string length $state(string)]
         }
+	default {
+	    error "Unknown combination \"$state(value)/$state(canonicalP)\""
+	}
     }
 
     if {![string compare $state(encoding) base64]} {
@@ -1097,6 +1111,7 @@
 #       Returns the header of a MIME part.
 
 proc mime::getheader {token {key ""}} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1155,6 +1170,7 @@
 #       Returns previous value associated with the specified key.
 
 proc mime::setheader {token key value args} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1171,6 +1187,7 @@
         mime-version {
             error "key $key may not be set"
         }
+	default {# Skip key}
     }
 
     array set header $state(header)
@@ -1248,7 +1265,7 @@
 
 proc mime::getbody {token args} {
     global errorCode errorInfo
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1280,7 +1297,7 @@
                     }
                     incr pos [set len \
                                   [string length [set chunk [read $fd $cc]]]]
-                    switch -- $state(encoding) {
+                    switch -exact -- $state(encoding) {
                         base64
                             -
                         quoted-printable {
@@ -1292,6 +1309,12 @@
                             set chunk [$state(encoding) -mode decode \
                                                         -- $chunk]
                         }
+			"" {
+			    # Go ahead, leave chunk alone
+			}
+			default {
+			    error "Can't handle content encoding \"$state(encoding)\""
+			}
                     }
                     append fragment $chunk
 
@@ -1371,7 +1394,10 @@
             } result]
             set ecode $errorCode
             set einfo $errorInfo
-        }
+	}
+	default {
+	    error "Unknown combination \"$state(value)/$state(canonicalP)\""
+	}
     }
 
     set code [catch {
@@ -1405,12 +1431,14 @@
 #       error if it is called with the reason of 'error'.
 
 proc mime::getbodyaux {token reason {fragment ""}} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
     switch -- $reason {
         data {
             append state(getbody) $fragment
+	    return ""
         }
 
         end {
@@ -1428,6 +1456,10 @@
             catch { unset state(getbody) }
             error $reason
         }
+
+	default {
+	    error "Unknown reason \"$reason\""
+	}
     }
 }
 
@@ -1448,7 +1480,7 @@
 
 proc mime::copymessage {token channel} {
     global errorCode errorInfo
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1481,6 +1513,7 @@
 #       is being written to the channel.
 
 proc mime::copymessageaux {token channel} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1527,6 +1560,12 @@
                 quoted-printable {
                     set converter $encoding
                 }
+		"" {
+		    # Go ahead
+		}
+		default {
+		    error "Can't handle content encoding \"$encoding\""
+		}
             }
         }
     } elseif {([string match multipart/* $state(content)]) \
@@ -1552,6 +1591,7 @@
         file {
             set closeP 1
             if {[info exists state(root)]} {
+		# FRINK: nocheck
                 variable $state(root)
                 upvar 0 $state(root) root 
 
@@ -1644,6 +1684,9 @@
 		puts $channel $state(string)
 	    }
         }
+	default {
+	    error "Unknown value \"$state(value)\""
+	}
     }
 
     flush $channel
@@ -1672,7 +1715,7 @@
 
 proc mime::buildmessage {token} {
     global errorCode errorInfo
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1707,6 +1750,7 @@
 #       Returns the message that has been built up in memory.
 
 proc mime::buildmessageaux {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1754,6 +1798,12 @@
                 quoted-printable {
                     set converter $encoding
                 }
+		"" {
+		    # Go ahead
+		}
+		default {
+		    error "Can't handle content encoding \"$encoding\""
+		}
             }
         }
     } elseif {([string match multipart/* $state(content)]) \
@@ -1779,6 +1829,7 @@
         file {
             set closeP 1
             if {[info exists state(root)]} {
+		# FRINK: nocheck
                 variable $state(root)
                 upvar 0 $state(root) root 
 
@@ -1864,6 +1915,9 @@
 		append result "$state(string)\n"
 	    }
         }
+	default {
+	    error "Unknown value \"$state(value)\""
+	}
     }
 
     if {[info exists state(error)]} {
@@ -1884,6 +1938,7 @@
 #       or quoted-printable).
 
 proc mime::encoding {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1901,6 +1956,7 @@
         multipart/* {
             return ""
         }
+	default {# Skip}
     }
 
     set asciiP 1
@@ -1942,6 +1998,9 @@
                 }
             }
         }
+	default {
+	    error "Unknown value \"$state(value)\""
+	}
     }
 
     switch -glob -- $state(content) {
@@ -2043,6 +2102,7 @@
 # 
 
 proc mime::fcopy {token count {error ""}} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2069,6 +2129,7 @@
 #       copied to the specified channel.
 
 proc mime::scopy {token channel offset len blocksize} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2157,7 +2218,7 @@
     foreach line [split $string \n] {
 	while {[string length $line] > 72} {
 	    set chunk [string range $line 0 72]
-	    if {[regexp (=|=.)$ $chunk dummy end]} {
+	    if {[regexp -- (=|=.)$ $chunk dummy end]} {
 
 		# Don't break in the middle of a code
 
@@ -2273,7 +2334,7 @@
     variable mime
 
     set token [namespace current]::[incr mime(uid)]
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2284,6 +2345,7 @@
     foreach name [array names state] {
         unset state($name)
     }
+    # FRINK: nocheck
     catch { unset $token }
 
     return -code $code -errorinfo $einfo -errorcode $ecode $result
@@ -2324,6 +2386,7 @@
 #       specified in the argument.
 
 proc mime::parseaddressaux {token string} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2435,7 +2498,7 @@
 
 proc mime::addr_next {token} {
     global errorCode errorInfo
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2511,6 +2574,7 @@
 #	Returns 1 if there is another address, and 0 if there is not.
 
 proc mime::addr_specification {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2624,6 +2688,7 @@
 #	Returns 1 if there is another address, and 0 if there is not.
 
 proc mime::addr_routeaddr {token {checkP 1}} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2678,6 +2743,7 @@
 #       syntax is found.
 
 proc mime::addr_route {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2753,6 +2819,7 @@
 #       syntax is found.
 
 proc mime::addr_domain {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2799,6 +2866,7 @@
 #       syntax is found.
 
 proc mime::addr_local {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2843,6 +2911,7 @@
 
 
 proc mime::addr_phrase {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2893,6 +2962,7 @@
 #       syntax is found.
 
 proc mime::addr_group {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2923,6 +2993,8 @@
             }
         }
     }
+    # Added for frink 2.1.3
+    return ""
 }
 
 # mime::addr_end --
@@ -2936,6 +3008,7 @@
 #       syntax is found.
 
 proc mime::addr_end {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -2970,7 +3043,7 @@
 
 proc mime::addr_x400 {mbox key} {
     if {[set x [string first "/$key=" [string toupper $mbox]]] < 0} {
-        return
+        return ""
     }
     set mbox [string range $mbox [expr {$x+[string length $key]+2}] end]
 
@@ -3184,6 +3257,7 @@
 #	Returns the next token found by the parser.
 
 proc mime::parselexeme {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -3399,14 +3473,19 @@
     }
 
     set result "=?$encodings($charset)?"
-    switch -exact $method {
+    switch -exact -- $method {
 	base64 {
-	    append result "B?[base64::encode $string]?="
+	    append result "B?[string trimright [base64 -mode encode -- $string] \n]?="
 	}
-
 	quoted-printable {
 	    append result "Q?[qp_encode $string 1]?="
 	}
+	"" {
+	    # Go ahead
+	}
+	default {
+	    error "Can't handle content encoding \"$method\""
+	}
     }
 
     return $result
@@ -3426,7 +3505,7 @@
 
     variable reversemap
 
-    if {[regexp {=\?([^?]+)\?(.)\?([^?]*)\?=} $encoded \
+    if {[regexp -- {=\?([^?]+)\?(.)\?([^?]*)\?=} $encoded \
 		- charset method string] != 1} {
 	error "malformed word-encoded expression '$encoded'"
     }
@@ -3435,7 +3514,7 @@
 	error "unknown charset '$charset'"
     }
 
-    switch $method {
+    switch -exact -- $method {
 	B {
             set method base64
         }
@@ -3447,14 +3526,19 @@
         }
     }
 
-    switch -exact $method {
+    switch -exact -- $method {
 	base64 {
-	    set result [base64::decode $string]
+	    set result [base64 -mode decode -- $string]
 	}
-
 	quoted-printable {
 	    set result [qp_decode $string 1]
 	}
+	"" {
+	    # Go ahead
+	}
+	default {
+	    error "Can't handle content encoding \"$method\""
+	}
     }
 
     return [list $reversemap($charset) $method $result]
@@ -3478,7 +3562,7 @@
     set field [join $field]
 
     set result ""
-    while {[regexp -indices {=\?([^?]+)\?(.)\?([^?]*)\?=} $field indices]} {
+    while {[regexp -indices -- {=\?([^?]+)\?(.)\?([^?]*)\?=} $field indices]} {
 
 	# get the indices
 
Index: modules/mime/smtp.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/mime/smtp.tcl,v
retrieving revision 1.10
diff -u -r1.10 smtp.tcl
--- modules/mime/smtp.tcl	2000/09/20 18:32:58	1.10
+++ modules/mime/smtp.tcl	2001/06/20 23:08:55
@@ -206,7 +206,9 @@
 
     foreach mixed {From Sender To cc Dcc Bcc Date Message-ID} {
         set lower [string tolower $mixed]
+	# FRINK: nocheck
         set ${lower}L $prefixL$lower
+	# FRINK: nocheck
         set ${lower}M $prefixM$mixed
     }
 
@@ -576,7 +578,7 @@
     variable smtp
 
     set token [namespace current]::[incr smtp(uid)]
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -711,7 +713,7 @@
 
 proc smtp::finalize {token args} {
     global errorCode errorInfo
-
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -751,6 +753,7 @@
     foreach name [array names state] {
         unset state($name)
     }
+    # FRINK: nocheck
     unset $token
 
     return -code $code -errorinfo $einfo -errorcode $ecode $result
@@ -774,6 +777,7 @@
 #       error occurs, throw an exception.
 
 proc smtp::winit {token originator {mode MAIL}} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -808,6 +812,7 @@
 #       error occurs, throw an exception.
 
 proc smtp::waddr {token recipient} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -841,6 +846,7 @@
 #       error occurs, throw an exception.
 
 proc smtp::wtext {token part} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -887,6 +893,7 @@
 proc smtp::wtextaux {token part} {
     global errorCode errorInfo
     variable trf
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -939,6 +946,7 @@
 #       value.
 
 proc smtp::wdata {token command buffer} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1005,7 +1013,12 @@
             incr state(size) [string length $result]
             return $result
         }
+	default {
+	    error "Unknown command \"$command\""
+	}
     }
+
+    return ""
 }
 
 # smtp::talk --
@@ -1022,6 +1035,7 @@
 #       an exception.
 
 proc smtp::talk {token secs command} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1038,7 +1052,7 @@
     }
 
     if {$secs == 0} {
-        return
+        return ""
     }
 
     return [smtp::hear $token $secs]
@@ -1056,6 +1070,7 @@
 #	Response is returned.
 
 proc smtp::hear {token secs} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1142,6 +1157,7 @@
 #       1   if reading from socket was successful
 
 proc smtp::readable {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
@@ -1185,6 +1201,7 @@
 #	Sets state(readable) to -1 and state(error) to an error message.
 
 proc smtp::timer {token} {
+    # FRINK: nocheck
     variable $token
     upvar 0 $token state
 
Index: modules/ncgi/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ncgi/ChangeLog,v
retrieving revision 1.10
diff -u -r1.10 ChangeLog
--- modules/ncgi/ChangeLog	2001/06/16 01:26:36	1.10
+++ modules/ncgi/ChangeLog	2001/06/20 23:08:57
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* ncgi.tcl: Fixed dubious code reported by frink.
+
 2001-06-15  Melissa Chawla <[email protected]>
 
 	* ncgi.tcl: Applied George Wu's patch ([email protected]) to the
Index: modules/ncgi/ncgi.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ncgi/ncgi.tcl,v
retrieving revision 1.17
diff -u -r1.17 ncgi.tcl
--- modules/ncgi/ncgi.tcl	2001/06/16 01:26:36	1.17
+++ modules/ncgi/ncgi.tcl	2001/06/20 23:08:59
@@ -148,6 +148,7 @@
     variable urlStub
     if {[string length $url]} {
 	set urlStub $url
+	return ""
     } elseif {[info exist urlStub]} {
 	return $urlStub
     } elseif {[info exist env(SCRIPT_NAME)]} {
@@ -303,7 +304,7 @@
 	    foreach {x} [split [string trim $query] &] {
 		# Turns out you might not get an = sign,
 		# especially with <isindex> forms.
-		if {![regexp (.*)=(.*) $x dummy varname val]} {
+		if {![regexp -- (.*)=(.*) $x dummy varname val]} {
 		    set varname anonymous
 		    set val $x
 		}
@@ -379,7 +380,7 @@
 	if {!$exists} {
 	    lappend varlist $name
 	}
-	if {[regexp List$ $name]} {
+	if {[regexp -- List$ $name]} {
 	    # Accumulate a list of values for this name
 	    lappend value($name) $val
 	} elseif {$exists} {
@@ -614,7 +615,7 @@
 proc ncgi::redirect {url} {
     global env
 
-    if {![regexp {^[^:]+://} $url]} {
+    if {![regexp -- {^[^:]+://} $url]} {
 
 	# The url is relative (no protocol/server spec in it), so
 	# here we create a canonical URL.
@@ -650,13 +651,13 @@
 	# URL.  Otherwise use SERVER_NAME.  These could be different, e.g.,
 	# "pop.scriptics.com" vs. "pop"
 
-	if {![regexp {^https?://([^/:]*)} $env(REQUEST_URI) x server]} {
+	if {![regexp -- {^https?://([^/:]*)} $env(REQUEST_URI) x server]} {
 	    set server $env(SERVER_NAME)
 	}
 	if {[string match /* $url]} {
 	    set url $proto://$server$port$url
 	} else {
-	    regexp {^(.*/)[^/]*$} $request_uri match dirname
+	    regexp -- {^(.*/)[^/]*$} $request_uri match dirname
 	    set url $proto://$server$port$dirname$url
 	}
     }
@@ -713,12 +714,12 @@
     set results [list [string trim [lindex $parts 0]]]
     set paramList [list]
     foreach sub [lrange $parts 1 end] {
-	if {[regexp {([^=]+)=(.+)} $sub match key val]} {
+	if {[regexp -- {([^=]+)=(.+)} $sub match key val]} {
             set key [string trim [string tolower $key]]
             set val [string trim $val]
             # Allow single as well as double quotes
-            if {[regexp {^["']} $val quote]} { ;# need a " for balance
-                if {[regexp ^${quote}(\[^$quote\]*)$quote $val x val2]} {
+            if {[regexp -- {^["']} $val quote]} { ;# need a " for balance
+                if {[regexp -- ^${quote}(\[^$quote\]*)$quote $val x val2]} {
                     # Trim quotes and any extra crap after close quote
                     set val $val2
                 }
@@ -842,7 +843,7 @@
 	set headers [list]
 	set formName ""
         foreach line [split [string range $query $offset $off2] $lineDelim] {
-	    if {[regexp {([^:	 ]+):(.*)$} $line x hdrname value]} {
+	    if {[regexp -- {([^:	 ]+):(.*)$} $line x hdrname value]} {
 		set hdrname [string tolower $hdrname]
 		set valueList [parseMimeValue $value]
 		if {[string equal $hdrname "content-disposition"]} {
Index: modules/nntp/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/nntp/ChangeLog,v
retrieving revision 1.3
diff -u -r1.3 ChangeLog
--- modules/nntp/ChangeLog	2000/06/20 22:23:56	1.3
+++ modules/nntp/ChangeLog	2001/06/20 23:08:59
@@ -1,3 +1,6 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* nntp.tcl: Fixed dubious code reported by frink.
 
 2000-06-20  Dan Kuchler  <[email protected]>
 
Index: modules/nntp/nntp.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/nntp/nntp.tcl,v
retrieving revision 1.2
diff -u -r1.2 nntp.tcl
--- modules/nntp/nntp.tcl	2000/06/20 22:23:56	1.2
+++ modules/nntp/nntp.tcl	2001/06/20 23:09:01
@@ -388,7 +388,7 @@
 
     set data(cmnd) "fetch"
     if {![::nntp::command $name "IHAVE $msgid"]} {
-        return
+        return ""
     }
     return [::nntp::squirt $name "$args"]    
 }
@@ -474,7 +474,7 @@
     upvar 0 ::nntp::${name}data data
 
     if {$group != ""} {
-        if {[regexp {^[\w\.\-]+$} $group] == 0} {
+        if {[regexp -- {^[\w\.\-]+$} $group] == 0} {
             set since $group
             set group ""
         }
@@ -534,7 +534,7 @@
 proc ::nntp::_post {name args} {
     
     if {![::nntp::command $name "POST"]} {
-        return
+        return ""
     }
     return [::nntp::squirt $name "$args"]
 }
@@ -645,7 +645,7 @@
 proc ::nntp::_xhdr {name {header "message-id"} {list ""} {last ""}} {
     upvar 0 ::nntp::${name}data data
 
-    if {![regexp {\d+-\d+} $list]} {
+    if {![regexp -- {\d+-\d+} $list]} {
         if {"$last" != ""} {
             set list "$list-$last"
         } else {
@@ -679,7 +679,7 @@
 
 proc ::nntp::_xover {name {list ""} {last ""}} {
     upvar 0 ::nntp::${name}data data
-    if {![regexp {\d+-\d+} $list]} {
+    if {![regexp -- {\d+-\d+} $list]} {
         if {"$last" != ""} {
             set list "$list-$last"
         } else {
@@ -695,7 +695,7 @@
 
     set patterns ""
 
-    if {![regexp {\d+-\d+} $list]} {
+    if {![regexp -- {\d+-\d+} $list]} {
         if {("$last" != "") && ([string is digit $last])} {
             set list "$list-$last"
         }
@@ -725,7 +725,7 @@
 proc ::nntp::_xsearch {name args} {
     set res [::nntp::command $name "XSEARCH"]
     if {!$res} {
-        return
+        return ""
     }
     return [::nntp::squirt $name "$args"]    
 }
@@ -771,7 +771,7 @@
 
     set res [::nntp::okprint $name]
     if {!$res} {
-        return
+        return ""
     }
     return $data(mesg)
 }
@@ -781,10 +781,11 @@
 
     set data(group) ""
 
-    if {[::nntp::okprint $name] && [regexp {(\d+)\s+(\d+)\s+(\d+)\s+([\w\.]+)} \
+    if {[::nntp::okprint $name] && [regexp -- {(\d+)\s+(\d+)\s+(\d+)\s+([\w\.]+)} \
             $data(mesg) match count first last data(group)]} {
         return [list $count $first $last $data(group)]
     }
+    return ""
 }
 
 proc ::nntp::msgid {name} {
@@ -804,7 +805,7 @@
 
     set result ""
     if {[::nntp::okprint $name] && \
-            [regexp {\d+\s+<[^>]+>} $data(mesg) result]} {
+            [regexp -- {\d+\s+<[^>]+>} $data(mesg) result]} {
         return $result
     } else {
         return ""
@@ -817,7 +818,7 @@
     set eol "\012"
 
     if {![::nntp::okprint $name]} {
-        return
+        return ""
     }
     set sock $data(sock)
 
@@ -826,7 +827,7 @@
         gets $sock line
         regsub {\015?\012$} $line $data(eol) line
 
-        if {[regexp {^\.$} $line]} {
+        if {[regexp -- {^\.$} $line]} {
             break
         }
         regsub {^\.\.} $line {.} line
@@ -852,12 +853,12 @@
 
     regsub {\015?\012$} $line "" line
 
-    set result [regexp {^((\d\d)(\d))\s*(.*)} $line match \
+    set result [regexp -- {^((\d\d)(\d))\s*(.*)} $line match \
             data(code) val1 val2 data(mesg)]
     
     if {$result == 0} {
         puts stderr "nntp garbled response: $line\n";
-        return
+        return ""
     }
 
     if {$val1 == 20} {
Index: modules/pop3/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/pop3/ChangeLog,v
retrieving revision 1.5
diff -u -r1.5 ChangeLog
--- modules/pop3/ChangeLog	2001/05/02 15:03:33	1.5
+++ modules/pop3/ChangeLog	2001/06/20 23:09:01
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* pop3.tcl: Fixed dubious code reported by frink.
+
 2001-01-24  Scott Redman  <[email protected]>
 
 	* pop3.tcl: Fixed a bug when getting the "." back
Index: modules/pop3/pop3.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/pop3/pop3.tcl,v
retrieving revision 1.9
diff -u -r1.9 pop3.tcl
--- modules/pop3/pop3.tcl	2001/05/02 15:03:33	1.9
+++ modules/pop3/pop3.tcl	2001/06/20 23:09:02
@@ -295,7 +295,7 @@
    set popRet [string trim [gets $chan]]
 
    if {[string first "+OK" $popRet] == -1} {
-       error [string range $popRet [expr 3 + 1] end]
+       error [string range $popRet 4 end]
    }
 
    return [string range $popRet 3 end]
Index: modules/profiler/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/ChangeLog,v
retrieving revision 1.8
diff -u -r1.8 ChangeLog
--- modules/profiler/ChangeLog	2000/09/20 17:23:14	1.8
+++ modules/profiler/ChangeLog	2001/06/20 23:09:02
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* profilertcl: Fixed dubious code reported by frink.
+
 2000-09-20  Eric Melski  <[email protected]>
 
 	* profiler.tcl: Corrected some non-Tcl-style-guide conforming
Index: modules/profiler/profiler.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/profiler.tcl,v
retrieving revision 1.12
diff -u -r1.12 profiler.tcl
--- modules/profiler/profiler.tcl	2000/09/20 17:23:14	1.12
+++ modules/profiler/profiler.tcl	2001/06/20 23:09:02
@@ -29,6 +29,7 @@
     set ms [ clock clicks -milliseconds ]
     set us [ clock clicks ]
     regsub -all {:} $tag {} tag
+    # FRINK: nocheck
     set ::profiler::T$tag [ list $us $ms ] 
     return
 }
@@ -49,7 +50,16 @@
      set ut [ clock clicks ]
      set mt [ clock clicks -milliseconds ]
      regsub -all {:} $tag {} tag
+
+    # Per tag a variable was created within the profiler
+    # namespace. But we should check if the tag does ecxist.
+
+    if {![info exists ::profiler::T$tag]} {
+	error "Unknown tag \"$tag\""
+    }
+    # FRINK: nocheck
      set ust [ lindex [ set ::profiler::T$tag ] 0 ] 
+    # FRINK: nocheck
      set mst [ lindex [ set ::profiler::T$tag ] 1 ]
      set udt [ expr { ($ut-$ust) } ]
      set mdt [ expr { ($mt-$mst) } ]000
@@ -170,11 +180,11 @@
     # have an absolute namespace qualifier, we have to prepend the current
     # namespace to the command name
     if { ![string equal $ns "::"] } {
-	if { ![regexp "^::" $name] } {
+	if { ![regexp -- "^::" $name] } {
 	    set name "${ns}::${name}"
 	}
     }
-    if { ![regexp "^::" $name] } {
+    if { ![regexp -- "^::" $name] } {
 	set name "::$name"
     }
 
Index: modules/report/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/report/ChangeLog,v
retrieving revision 1.2
diff -u -r1.2 ChangeLog
--- modules/report/ChangeLog	2001/06/19 17:21:57	1.2
+++ modules/report/ChangeLog	2001/06/20 23:09:02
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* report.tcl: Fixed dubious code reported by frink.
+
 2001-06-19  Andreas Kupries <[email protected]>
 
 	* report.n: Fixed nroff trouble.
Index: modules/report/report.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/report/report.tcl,v
retrieving revision 1.1
diff -u -r1.1 report.tcl
--- modules/report/report.tcl	2001/05/01 19:01:24	1.1
+++ modules/report/report.tcl	2001/06/20 23:09:05
@@ -241,6 +241,9 @@
 	    2 {
 		set def 1
 	    }
+	    default {
+		error "Illegal length of value \"$v\""
+	    }
 	}
     }
     if {[string equal args [lindex $arguments end]]} {
@@ -548,8 +551,10 @@
 	    }
 	    return $column
 	}
+	default {
+	    return -code error "column: syntax error in index \"$column\""
+	}
     }
-    return -code error "column: syntax error in index \"$column\""
 }
 
 # ::report::CheckVerticals --
@@ -737,13 +742,14 @@
 		    upvar ::report::report${name}::enabled enabled
 		    return $enabled($template)
 		}
+		default {error "Can't happen, panic, run, shout"}
 	    }
 	}
 	default {
 	    return -code error "Unknown template command \"$cmd\""
 	}
     }
-    return
+    return ""
 }
 
 # ::report::_tcaption --
@@ -772,7 +778,7 @@
     }
     if {$size == $tcaption} {
 	# No change, nothing to do
-	return
+	return ""
     }
     if {($size > 0) && ($tcaption == 0)} {
 	# Perform a consistency check after the assignment, the
@@ -782,7 +788,7 @@
     } else {
 	set tcaption $size
     }
-    return
+    return ""
 }
 
 # ::report::_bcaption --
@@ -811,7 +817,7 @@
     }
     if {$size == $bcaption} {
 	# No change, nothing to do
-	return
+	return ""
     }
     if {($size > 0) && ($bcaption == 0)} {
 	# Perform a consistency check after the assignment, the
@@ -821,7 +827,7 @@
     } else {
 	set bcaption $size
     }
-    return
+    return ""
 }
 
 # ::report::_size --
@@ -848,7 +854,7 @@
     }
     if {[string equal $size dyn]} {
 	set csize($column) $size
-	return
+	return ""
     }
     if {![string is integer $size]} {
 	return -code error "expected integer greater than zero, got \"$size\""
@@ -857,7 +863,7 @@
 	return -code error "expected integer greater than zero, got \"$size\""
     }
     set csize($column) $size
-    return
+    return ""
 }
 
 # ::report::_sizes --
@@ -903,7 +909,7 @@
 	set csize($i) $s
 	incr i
     }
-    return
+    return ""
 }
 
 # ::report::_pad --
@@ -945,7 +951,7 @@
 	    return -code error "where: expected left, right, or both, got \"$where\""
 	}
     }
-    return
+    return ""
 }
 
 # ::report::_justify --
@@ -973,10 +979,12 @@
     switch -exact -- $jvalue {
 	left - right - center {
 	    set cjust($column) $jvalue
-	    return
+	    return ""
+	}
+	default {
+	    return -code error "justification: expected, left, right, or center, got \"$jvalue\""
 	}
     }
-    return -code error "justification: expected, left, right, or center, got \"$jvalue\""
 }
 
 # ::report::_printmatrix --
@@ -1360,6 +1368,9 @@
 	    set rcut [expr {$cut - $lcut}]
 
 	    return [string range $value $lcut end-$rcut]
+	}
+	default {
+	    error "Can't happen, panic, run, shout"
 	}
     }
 }
Index: modules/stats/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/stats/ChangeLog,v
retrieving revision 1.9
diff -u -r1.9 ChangeLog
--- modules/stats/ChangeLog	2000/10/02 16:24:15	1.9
+++ modules/stats/ChangeLog	2001/06/20 23:09:05
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* stats.tcl: Fixed dubious code reported by frink.
+
 2000-10-02  Brent Welch <[email protected]>
 
 	* modules/stats/stats.tcl: Added stats::htmlHistDisplayRow
Index: modules/stats/stats.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/stats/stats.tcl,v
retrieving revision 1.14
diff -u -r1.14 stats.tcl
--- modules/stats/stats.tcl	2000/10/03 18:01:46	1.14
+++ modules/stats/stats.tcl	2001/06/20 23:09:08
@@ -131,12 +131,12 @@
 		    
 		    # Figure out what "hour" we are
 
-		    set delta [expr $startTime - $dayStart]
-		    set hourIndex [expr $delta / ($secsPerMinute * 60)]
-		    set day [expr $hourIndex / 24]
-		    set hourIndex [expr $hourIndex % 24]
+		    set delta [expr {$startTime - $dayStart}]
+		    set hourIndex [expr {$delta / ($secsPerMinute * 60)}]
+		    set day [expr {$hourIndex / 24}]
+		    set hourIndex [expr {$hourIndex % 24}]
 
-		    set hourBase [expr $dayStart + $day * $secsPerMinute * 60 * 24]
+		    set hourBase [expr {$dayStart + $day * $secsPerMinute * 60 * 24}]
 		    set minuteBase [expr {$hourBase + $hourIndex * 60 * $secsPerMinute}]
 
 		    set partialHour [expr {$startTime -
@@ -302,6 +302,9 @@
 	    }
 	    set args [list -timehist $stats::secsPerMinute]
 	}
+	default {
+	    error "Unknown counter type \"$counter(type)\""
+	}
     }
     unset counter
     eval {stats::countInit $tag} $args
@@ -406,9 +409,12 @@
 		}
 		set histogram($minute) [expr {$histogram($minute) + $delta}]
 	    }
+	    default {
+		error "Unknown counter type \"$counter(type)\""
+	    }
 	}
 #   }
-    return ""
+    return
 }
 
 # stats::countExists --
@@ -903,6 +909,9 @@
 		append result "<td>[html::font][clock format $time \
 			-format "%b %d %k:%M"]</font></td></tr>\n"
 	    }
+	    default {
+		error "Unknown unit of time \"$options(-unit)\""
+	    }
 	}
 
     } else {
@@ -1106,6 +1115,9 @@
 		}
 		set deltaT [expr {$secsPerMinute * 60 * 24}]
 		set wrapDeltaT 0
+	    }
+	    default {
+		error "Unknown unit of time \"$options(-unit)\""
 	    }
 	}
 	# These are tick marks
Index: modules/struct/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/ChangeLog,v
retrieving revision 1.12
diff -u -r1.12 ChangeLog
--- modules/struct/ChangeLog	2001/06/19 17:21:57	1.12
+++ modules/struct/ChangeLog	2001/06/20 23:09:08
@@ -1,3 +1,8 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* tree.tcl:
+	* graph.tcl: Fixed dubious code reported by frink.
+
 2001-06-19  Andreas Kupries <[email protected]>
 
 	* matrix.n: Fixed nroff trouble.
Index: modules/struct/graph.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/graph.tcl,v
retrieving revision 1.2
diff -u -r1.2 graph.tcl
--- modules/struct/graph.tcl	2000/06/02 18:43:56	1.2
+++ modules/struct/graph.tcl	2001/06/20 23:09:10
@@ -206,6 +206,7 @@
 	foreach {source target} $arcNodes($arc) break ; # lassign
 
 	unset arcNodes($arc)
+	# FRINK: nocheck
 	unset ::struct::graph::graph${name}::arc$arc
 
 	# Remove arc from the arc lists of source and target nodes.
@@ -598,6 +599,7 @@
 		}
 	    }
 	}
+	default {error "Can't happen, panic"}
     }
 
     return $arcs
@@ -708,6 +710,9 @@
 	    set opt  [lindex $args 0]
 	    set node [lindex $args 1]
 	}
+	default {
+	    error "Wrong # arguments given to 'degree'"
+	}
     }
 
     # Validate the option.
@@ -756,6 +761,7 @@
 		}
 	    }
 	}
+	default {error "Can't happen, panic"}
     }
 
     return $result
@@ -800,6 +806,7 @@
 
 	unset inArcs($node)
 	unset outArcs($node)
+	# FRINK: nocheck
 	unset ::struct::graph::graph${name}::node$node
     }
 
@@ -1172,6 +1179,7 @@
 		}
 	    }
 	}
+	default {error "Can't happen, panic"}
     }
 
     return $nodes
@@ -1513,7 +1521,7 @@
 #	set	list representing the union of the argument lists.
 
 proc ::struct::graph::Union {args} {
-    switch [llength $args] {
+    switch -- [llength $args] {
 	0 {
 	    return {}
 	}
Index: modules/struct/tree.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/tree.tcl,v
retrieving revision 1.13
diff -u -r1.13 tree.tcl
--- modules/struct/tree.tcl	2000/06/02 18:43:56	1.13
+++ modules/struct/tree.tcl	2001/06/20 23:09:12
@@ -205,6 +205,7 @@
     # Remove all record of $node
     unset parent($node)
     unset children($node)
+    # FRINK: nocheck
     unset ::struct::tree::tree${name}::node$node
 
     return
@@ -250,6 +251,7 @@
 
     unset children($node)
     unset parent($node)
+    # FRINK: nocheck
     unset ::struct::tree::tree${name}::node$node
 
     while { [llength $st] > 0 } {
@@ -260,6 +262,7 @@
 	}
 	unset children($node)
 	unset parent($node)
+	# FRINK: nocheck
 	unset ::struct::tree::tree${name}::node$node
     }
     return
@@ -640,6 +643,7 @@
     if { ![_exists $name $node] } {
 	error "node \"$node\" does not exist in tree \"$name\""
     }
+    # FRINK: nocheck
     return [set ::struct::tree::tree${name}::parent($node)]
 }
 
Index: modules/textutil/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/ChangeLog,v
retrieving revision 1.4
diff -u -r1.4 ChangeLog
--- modules/textutil/ChangeLog	2001/03/26 16:50:21	1.4
+++ modules/textutil/ChangeLog	2001/06/20 23:09:13
@@ -1,3 +1,9 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* split.tcl:
+	* adjust.tcl:
+	* trim.tcl: Fixed dubious code reported by frink.
+
 2001-03-23 Andreas Kupries <[email protected]>
 
 	* textutil.tcl: Reworked the implementation of 'StrRepeat', made
Index: modules/textutil/adjust.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/adjust.tcl,v
retrieving revision 1.2
diff -u -r1.2 adjust.tcl
--- modules/textutil/adjust.tcl	2001/03/26 16:50:21	1.2
+++ modules/textutil/adjust.tcl	2001/06/20 23:09:13
@@ -244,6 +244,7 @@
 	return "${line}"
     }
 
+    error "Illegal justification key \"$justify\""
 }
 
 proc ::textutil::adjust::SortList { list dir index } {
Index: modules/textutil/split.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/split.tcl,v
retrieving revision 1.1
diff -u -r1.1 split.tcl
--- modules/textutil/split.tcl	2000/11/02 19:38:13	1.1
+++ modules/textutil/split.tcl	2001/06/20 23:09:13
@@ -39,12 +39,12 @@
 proc ::textutil::split::splitx [list str [list regexp "\[\t \r\n\]+"]] {
     set list  {}
     while {[regexp -indices -- $regexp $str match submatch]} {
-	lappend list [string range $str 0 [expr [lindex $match 0] -1]]
+	lappend list [string range $str 0 [expr {[lindex $match 0] -1}]]
 	if {[lindex $submatch 0]>=0} {
 	    lappend list [string range $str [lindex $submatch 0]\
 			      [lindex $submatch 1]]
 	}
-	set str [string range $str [expr [lindex $match 1]+1] end]
+	set str [string range $str [expr {[lindex $match 1]+1}] end]
     }
     lappend list $str
     return $list
Index: modules/textutil/trim.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/trim.tcl,v
retrieving revision 1.1
diff -u -r1.1 trim.tcl
--- modules/textutil/trim.tcl	2000/11/02 19:38:14	1.1
+++ modules/textutil/trim.tcl	2001/06/20 23:09:13
@@ -68,4 +68,5 @@
         return $StrR
     }
 
+    error "Panic, illegal position key \"$pos\""
 }
Index: modules/uri/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/ChangeLog,v
retrieving revision 1.4
diff -u -r1.4 ChangeLog
--- modules/uri/ChangeLog	2000/09/07 06:09:51	1.4
+++ modules/uri/ChangeLog	2001/06/20 23:09:13
@@ -1,3 +1,7 @@
+2001-06-21  Andreas Kupries <[email protected]>
+
+	* uri.tcl: Fixed dubious code reported by frink.
+
 2000-09-06  Brent Welch  <[email protected]>
 
 	* uri.tcl:
Index: modules/uri/uri.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/uri.tcl,v
retrieving revision 1.4
diff -u -r1.4 uri.tcl
--- modules/uri/uri.tcl	2000/09/07 06:09:51	1.4
+++ modules/uri/uri.tcl	2001/06/20 23:09:15
@@ -132,7 +132,7 @@
 		    "//${login}(/${path}(${typepart})?)?"
 
 	    variable	url		"ftp:${schemepart}"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes ftp
 	}
 
@@ -143,7 +143,7 @@
 
 	    variable	schemepart	"//(${host}|localhost)?/${path}"
 	    variable	url		"file:${schemepart}"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes file
 	}
 
@@ -162,7 +162,7 @@
 		    "//${hostOrPort}(/${path}(\\?${search})?)?"
 
 	    variable	url		"http:${schemepart}"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes http
 	}
 
@@ -178,7 +178,7 @@
 	    variable	schemepart	\
 		    "//${hostOrPort}(/(${type}(${selector}(%09${search}(%09${string})?)?)?)?)?"
 	    variable	url		"gopher:${schemepart}"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes gopher
 	}
 	
@@ -189,7 +189,7 @@
 
 	    variable	schemepart	"$xChar+(@${host})?"
 	    variable	url		"mailto:${schemepart}"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes mailto
 	}
 
@@ -206,7 +206,7 @@
 	    variable	article		"${aChar}+@${host}"
 	    variable	schemepart	"\\*|${group}|${article}"
 	    variable	url		"news:${schemepart}"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes news
 	}
 
@@ -232,7 +232,7 @@
 		    "//${hostOrPort}/${db}((\\?${search})|(/${type}/${path}))?"
 
 	    variable	url		"wais:${schemepart}"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes wais
 	}
 
@@ -251,7 +251,7 @@
 
 	    variable	schemepart	"//${hostOrPort}/${path}(${fieldspec})*"
 	    variable	url		"prospero:$schemepart"
-
+	    # FRINK: nocheck
 	    lappend [namespace current]::schemes prospero
 	}
 
@@ -264,7 +264,9 @@
 	variable url2part
 
 	foreach scheme $schemes {
+	    # FRINK: nocheck
 	    append url "(${scheme}:[set ${scheme}::schemepart])|"
+	    # FRINK: nocheck
 	    set url2part($scheme) "${scheme}:[set ${scheme}::schemepart]"
 	}
 	set   url [string trimright $url |]
@@ -290,7 +292,7 @@
     set scheme {}
 
     # RFC 1738:	scheme = 1*[ lowalpha | digit | "+" | "-" | "." ]
-    regexp {^([a-z0-9+-.][a-z0-9+-.]*):} $url dummy scheme
+    regexp -- {^([a-z0-9+-.][a-z0-9+-.]*):} $url dummy scheme
 
     if {$scheme == {}} {
 	set scheme http
@@ -335,7 +337,7 @@
 
     # slash off possible type specification
 
-    if {[regexp -indices "${ftptype}$" $url dummy ftype]} {
+    if {[regexp -indices -- "${ftptype}$" $url dummy ftype]} {
 	set from	[lindex $ftype 0]
 	set to		[lindex $ftype 1]
 
@@ -418,7 +420,7 @@
 
     # slash off possible query
 
-    if {[regexp -indices $searchPattern $url match query]} {
+    if {[regexp -indices -- $searchPattern $url match query]} {
 	set from [lindex $query 0]
 	set to   [lindex $query 1]
 
@@ -429,7 +431,7 @@
 
     # slash off possible fragment
 
-    if {[regexp -indices $fragmentPattern $url match fragment]} {
+    if {[regexp -indices -- $fragmentPattern $url match fragment]} {
 	set from [lindex $fragment 0]
 	set to   [lindex $fragment 1]
 
@@ -490,7 +492,7 @@
 	set url [string range $url 2 end]
 
 	set hostPattern "^($hostname|$hostnumber)"
-	switch $::tcl_platform(platform) {
+	switch -exact -- $::tcl_platform(platform) {
 	    windows {
 		# Catch drive letter
 		append hostPattern :?
@@ -500,7 +502,7 @@
 	    }
 	}
 
-	if {[regexp -indices $hostPattern $url match host]} {
+	if {[regexp -indices -- $hostPattern $url match host]} {
 	    set fh	[lindex $host 0]
 	    set th	[lindex $host 1]
 
@@ -524,7 +526,7 @@
     }
     array set components $args
 
-    switch $::tcl_platform(platform) {
+    switch -exact -- $::tcl_platform(platform) {
 	windows {
 	    if {[string length $components(host)]} {
 		return file://$components(host):$components(path)
@@ -543,7 +545,7 @@
     # @a url: The url to split, without! scheme specification.
     # @r List containing the constituents, suitable for 'array set'.
 
-    if {[regexp @ $url]} {
+    if {[regexp -- @ $url]} {
 	set url [::split $url @]
 	return [list user [lindex $url 0] host [lindex $url 1]]
     } else {
@@ -584,7 +586,7 @@
 
     set upPattern "^(${user})(:(${password}))?@"
 
-    if {[regexp -indices $upPattern $url dummy theUser c d thePassword]} {
+    if {[regexp -indices -- $upPattern $url dummy theUser c d thePassword]} {
 	set fu	[lindex $theUser 0]
 	set tu	[lindex $theUser 1]
 	    
@@ -602,7 +604,7 @@
 
     set hpPattern "^($hostname|$hostnumber)(:($port))?"
 
-    if {[regexp -indices $hpPattern $url match theHost c d e f g h thePort]} {
+    if {[regexp -indices -- $hpPattern $url match theHost c d e f g h thePort]} {
 	set fh	[lindex $theHost 0]
 	set th	[lindex $theHost 1]
 
@@ -636,7 +638,7 @@
 
     set pattern "^(${hostname}|${hostnumber})(:(${port}))?"
 
-    if {[regexp -indices $pattern $url match host c d e f g h thePort]} {
+    if {[regexp -indices -- $pattern $url match host c d e f g h thePort]} {
 	set fromHost	[lindex $host 0]
 	set toHost	[lindex $host 1]
 
@@ -715,7 +717,7 @@
 #	Returns 1 if the URL is relative, 0 otherwise
 
 proc uri::isrelative url {
-    return [expr ![regexp {^[a-z0-9+-.][a-z0-9+-.]*:} $url]]
+    return [expr {![regexp -- {^[a-z0-9+-.][a-z0-9+-.]*:} $url]}]
 }
 
 # geturl --
@@ -818,10 +820,10 @@
     # Remove single dots (.)  => pwd not changing
     # Remove double dots (..) => gobble previous segment of path
 
-    while {[regexp {/\./} $uri]} {
+    while {[regexp -- {/\./} $uri]} {
         regsub -all {/\./} $uri {/} uri
     }
-    while {[regexp {/\.\./} $uri]} {
+    while {[regexp -- {/\.\./} $uri]} {
 	if {![regsub {/[^./]*/\.\./} $uri {/} uri]} {
 	    # The regexp found 'foo://bar.com/../baz', but this
 	    # cannot be handled by the regsub. Simply remove the