Attachment "3.diff" to
ticket [434202ffff]
added by
andreas_kupries
2001-06-18 22:58:34.
Also attachment "3.diff" to
ticket [433970ffff]
added by
andreas_kupries
2001-06-18 02:20:57.
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/17 19:12:43
@@ -1,3 +1,8 @@
+2001-06-15 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/17 19:12:44
@@ -1,3 +1,8 @@
+2001-06-15 Andreas Kupries <[email protected]>
+
+ * base64.tcl: Explained special construction with computed
+ variable name. 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/17 19:12:44
@@ -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
}
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/17 19:12:44
@@ -1,3 +1,7 @@
+2001-06-15 Andreas Kupries <[email protected]>
+
+ * typedCmdline.tcl: Fixed dubious code found by frink and procheck.
+
2000-05-03 Brent Welch <[email protected]>
* cmdline.tcl: Changed cmdline::getopt to set boolean arguments to
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/17 19:12:46
@@ -21,10 +21,14 @@
# String of character class names separated by "|" characters.
variable charclasses
+
+ # Hack, computes the number and names of the known character
+ # classes from the error string generated by [string is] for an
+ # invalid argument.
+ # FRINK: nocheck
catch {string is . .} charclasses
regexp {must be (.+)$} $charclasses dummy charclasses
regsub -all {, (or )?} $charclasses {|} charclasses
-
}
# cmdline::typedGetopt --
@@ -160,11 +164,11 @@
set retvar $opt
set argsList [lrange $argsList 1 end]
- } elseif {[regexp "\\.(arg|$charclasses)\$" $opt dummy charclass]
+ } elseif {[regexp -- "\\.(arg|$charclasses)\$" $opt dummy charclass]
|| [regexp {\.\(([^)]+)\)} $opt dummy charclass]} {
- if [string equal arg $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 +177,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]]} {
@@ -397,7 +401,7 @@
# Display something about multiple options
}
- if {[regexp "\\.(arg|$charclasses)\$" $name dummy charclass]
+ if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass]
|| [regexp {\.\(([^)]+)\)} $opt dummy charclass]} {
regsub "\\..+\$" $name {} name
set comment [lindex $opt 2]
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/17 19:12:46
@@ -1,3 +1,7 @@
+2001-06-15 Andreas Kupries <[email protected]>
+
+ * counter.tcl: Fixed dubious code found by frink and procheck.
+
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/17 19:12:48
@@ -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 -
@@ -406,7 +406,7 @@
}
}
# }
- return ""
+ return
}
# counter::exists --
Index: modules/csv/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/csv/ChangeLog,v
retrieving revision 1.1
diff -u -r1.1 ChangeLog
--- modules/csv/ChangeLog 2001/05/01 19:01:24 1.1
+++ modules/csv/ChangeLog 2001/06/17 19:12:48
@@ -1,3 +1,7 @@
+2001-06-15 Andreas Kupries <[email protected]>
+
+ * csv.tcl (::csv::writequeue): Fixed error found by procheck.
+
2001-05-01 Andreas Kupries <[email protected]>
* Committed to CVS head at SF.
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/17 19:12:50
@@ -262,12 +262,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/17 19:12:50
@@ -1,3 +1,7 @@
+2001-06-15 Tcl Project <[email protected]>
+
+ * fileutil.tcl: Fixed dubios code found 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/17 19:12:50
@@ -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/html/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/html/ChangeLog,v
retrieving revision 1.7
diff -u -r1.7 ChangeLog
--- modules/html/ChangeLog 2001/06/16 01:25:46 1.7
+++ modules/html/ChangeLog 2001/06/17 19:12:50
@@ -1,3 +1,7 @@
+2001-06-15 Andreas Kupries <[email protected]>
+
+ * html.tcl: Fixed dubious code reported by frink.
+
2001-06-15 Brent Welch <[email protected]>
* modules/html/html.tcl: Updated the version to 1.1
Index: modules/html/html.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/html/html.tcl,v
retrieving revision 1.19
diff -u -r1.19 html.tcl
--- modules/html/html.tcl 2001/06/16 01:25:46 1.19
+++ modules/html/html.tcl 2001/06/17 19:12:52
@@ -503,7 +503,7 @@
variable defaults
set pname [string tolower [lindex [split $key .] 1]]
set key [string tolower $key]
- ::if {![regexp -nocase "(\[ \]|^)$pname=" $param] &&
+ ::if {![regexp -nocase -- "(\[ \]|^)$pname=" $param] &&
[info exist defaults($key)] &&
[string length $defaults($key)]} {
return " $pname=\"$defaults($key)\""
@@ -1182,7 +1182,7 @@
# inside the "value" part of some other key word - some day
set bad \[^a-zA-Z\]+
- ::if {[regexp -nocase "$bad$key$bad" -$param-]} {
+ ::if {[regexp -nocase -- "$bad$key$bad" -$param-]} {
return 1
} else {
return 0
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/17 19:12:52
@@ -1,3 +1,7 @@
+2001-06-15 Tcl Project <[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/17 19:12:55
@@ -235,6 +235,9 @@
if {[string length $arg] == 0} {
return -code error "::htmlparse::parse : -$opt illegal argument (empty)"
}
+ # Each option has an associated variable with the same
+ # name ($opt contains the option with leading "-".
+ # FRINK: nocheck
set $opt $arg
}
split {
@@ -263,7 +266,7 @@
}
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.
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/17 19:12:55
@@ -1,3 +1,7 @@
+2001-06-15 Tcl Project <[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/17 19:12:56
@@ -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 ]
@@ -255,6 +255,8 @@
set fn [lindex [info level 0] 0]
error "wrong # args: should be \"$fn ?value1? ?value2?\""
}
+ # Should not come to this place
+ return 0
}
# ::math::sigma --
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/17 19:12:56
@@ -1,3 +1,8 @@
+2001-06-16 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/17 19:13:02
@@ -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
@@ -449,6 +449,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 +493,7 @@
# otherwise it just sets up the appropriate variables.
proc mime::parsepart {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -631,6 +633,7 @@
}
if {[string match message/* $state(content)]} {
+ # FRINK: nocheck
variable [set child $token-[incr state(cid)]]
set state(value) parts
@@ -674,7 +677,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 +737,7 @@
}
continue
}
-
+ # FRINK: nocheck
variable [set child $token-[incr state(cid)]]
lappend state(parts) $child
@@ -773,7 +776,7 @@
proc mime::parsetype {token string} {
global errorCode errorInfo
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -815,6 +818,7 @@
# tcl list.
proc mime::parsetypeaux {token string} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -904,6 +908,7 @@
# Returns an empty string.
proc mime::finalize {token args} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -936,6 +941,7 @@
foreach name [array names state] {
unset state($name)
}
+ # FRINK: nocheck
unset $token
}
@@ -971,6 +977,7 @@
# Returns the properties of a MIME part
proc mime::getproperty {token {property ""}} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1033,6 +1040,7 @@
# Returns the size in bytes of the MIME token.
proc mime::getsize {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1097,6 +1105,7 @@
# Returns the header of a MIME part.
proc mime::getheader {token {key ""}} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1155,6 +1164,7 @@
# Returns previous value associated with the specified key.
proc mime::setheader {token key value args} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1248,7 +1258,7 @@
proc mime::getbody {token args} {
global errorCode errorInfo
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1405,6 +1415,7 @@
# error if it is called with the reason of 'error'.
proc mime::getbodyaux {token reason {fragment ""}} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1448,7 +1459,7 @@
proc mime::copymessage {token channel} {
global errorCode errorInfo
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1481,6 +1492,7 @@
# is being written to the channel.
proc mime::copymessageaux {token channel} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1552,6 +1564,7 @@
file {
set closeP 1
if {[info exists state(root)]} {
+ # FRINK: nocheck
variable $state(root)
upvar 0 $state(root) root
@@ -1672,7 +1685,7 @@
proc mime::buildmessage {token} {
global errorCode errorInfo
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1707,6 +1720,7 @@
# Returns the message that has been built up in memory.
proc mime::buildmessageaux {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1779,6 +1793,7 @@
file {
set closeP 1
if {[info exists state(root)]} {
+ # FRINK: nocheck
variable $state(root)
upvar 0 $state(root) root
@@ -1884,6 +1899,7 @@
# or quoted-printable).
proc mime::encoding {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2043,6 +2059,7 @@
#
proc mime::fcopy {token count {error ""}} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2069,6 +2086,7 @@
# copied to the specified channel.
proc mime::scopy {token channel offset len blocksize} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2273,7 +2291,7 @@
variable mime
set token [namespace current]::[incr mime(uid)]
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2284,6 +2302,7 @@
foreach name [array names state] {
unset state($name)
}
+ # FRINK: nocheck
catch { unset $token }
return -code $code -errorinfo $einfo -errorcode $ecode $result
@@ -2324,6 +2343,7 @@
# specified in the argument.
proc mime::parseaddressaux {token string} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2435,7 +2455,7 @@
proc mime::addr_next {token} {
global errorCode errorInfo
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2511,6 +2531,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 +2645,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 +2700,7 @@
# syntax is found.
proc mime::addr_route {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2753,6 +2776,7 @@
# syntax is found.
proc mime::addr_domain {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2799,6 +2823,7 @@
# syntax is found.
proc mime::addr_local {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2843,6 +2868,7 @@
proc mime::addr_phrase {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2893,6 +2919,7 @@
# syntax is found.
proc mime::addr_group {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2936,6 +2963,7 @@
# syntax is found.
proc mime::addr_end {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -2970,7 +2998,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 +3212,7 @@
# Returns the next token found by the parser.
proc mime::parselexeme {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
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/17 19:13:06
@@ -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
}
@@ -574,9 +576,8 @@
global errorCode errorInfo
variable smtp
-
set token [namespace current]::[incr smtp(uid)]
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -711,7 +712,7 @@
proc smtp::finalize {token args} {
global errorCode errorInfo
-
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -751,6 +752,7 @@
foreach name [array names state] {
unset state($name)
}
+ # FRINK: nocheck
unset $token
return -code $code -errorinfo $einfo -errorcode $ecode $result
@@ -774,6 +776,7 @@
# error occurs, throw an exception.
proc smtp::winit {token originator {mode MAIL}} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -808,6 +811,7 @@
# error occurs, throw an exception.
proc smtp::waddr {token recipient} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -841,6 +845,7 @@
# error occurs, throw an exception.
proc smtp::wtext {token part} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -887,6 +892,7 @@
proc smtp::wtextaux {token part} {
global errorCode errorInfo
variable trf
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -939,6 +945,7 @@
# value.
proc smtp::wdata {token command buffer} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1022,6 +1029,7 @@
# an exception.
proc smtp::talk {token secs command} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1038,7 +1046,7 @@
}
if {$secs == 0} {
- return
+ return ""
}
return [smtp::hear $token $secs]
@@ -1056,6 +1064,7 @@
# Response is returned.
proc smtp::hear {token secs} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1142,6 +1151,7 @@
# 1 if reading from socket was successful
proc smtp::readable {token} {
+ # FRINK: nocheck
variable $token
upvar 0 $token state
@@ -1185,6 +1195,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/17 19:13:06
@@ -1,3 +1,7 @@
+2001-06-15 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/17 19:13:08
@@ -156,6 +156,7 @@
} else {
return ""
}
+ return $urlStub
}
# ncgi::query
@@ -717,8 +718,8 @@
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
}
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/17 19:13:08
@@ -1,3 +1,6 @@
+2001-06-15 Tcl Project <[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/17 19:13:09
@@ -388,7 +388,7 @@
set data(cmnd) "fetch"
if {![::nntp::command $name "IHAVE $msgid"]} {
- return
+ return ""
}
return [::nntp::squirt $name "$args"]
}
@@ -449,6 +449,10 @@
proc ::nntp::_newgroups {name since args} {
upvar 0 ::nntp::${name}data data
+ # Question: procheck tells us:
+ # "%y" generates a year without a century. consider using "%Y" to avoid Y2K errors.
+ # Is a 2digit year specified in the NNTP protocol ?
+
set since [clock format [clock scan "$since"] -format "%y%m%d %H%M%S"]
set dist ""
set data(cmnd) "fetch"
@@ -489,6 +493,11 @@
if {"$since" == ""} {
set since [clock format [clock scan "now - 1 day"]]
}
+
+ # Question: procheck tells us:
+ # "%y" generates a year without a century. consider using "%Y" to avoid Y2K errors.
+ # Is a 2digit year specified in the NNTP protocol ?
+
set since [clock format [clock scan $since] -format "%y%m%d %H%M%S"]
set dist ""
set data(cmnd) "fetch"
@@ -534,7 +543,7 @@
proc ::nntp::_post {name args} {
if {![::nntp::command $name "POST"]} {
- return
+ return ""
}
return [::nntp::squirt $name "$args"]
}
@@ -672,6 +681,11 @@
if {"$since" != ""} {
set since [clock seconds]
}
+
+ # Question: procheck tells us:
+ # "%y" generates a year without a century. consider using "%Y" to avoid Y2K errors.
+ # Is a 2digit year specified in the NNTP protocol ?
+
set since [clock format [clock scan $since] -format "%y%m%d %H%M%S"]
set data(cmnd) "fetch"
return [::nntp::command $name "XMOTD $since"]
@@ -725,7 +739,7 @@
proc ::nntp::_xsearch {name args} {
set res [::nntp::command $name "XSEARCH"]
if {!$res} {
- return
+ return ""
}
return [::nntp::squirt $name "$args"]
}
@@ -771,7 +785,7 @@
set res [::nntp::okprint $name]
if {!$res} {
- return
+ return ""
}
return $data(mesg)
}
@@ -785,6 +799,8 @@
$data(mesg) match count first last data(group)]} {
return [list $count $first $last $data(group)]
}
+
+ return ""
}
proc ::nntp::msgid {name} {
@@ -817,7 +833,7 @@
set eol "\012"
if {![::nntp::okprint $name]} {
- return
+ return ""
}
set sock $data(sock)
@@ -857,7 +873,7 @@
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/17 19:13:09
@@ -1,3 +1,8 @@
+2001-06-15 Tcl Project <[email protected]>
+
+ * pop3.tcl (pop3::send): Changed [expr 3+1] to "4". Unbraced
+ expression 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/17 19:13:11
@@ -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/17 19:13:11
@@ -1,3 +1,7 @@
+2001-06-15 Tcl Project <[email protected]>
+
+ * profiler.tcl: 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/17 19:13:12
@@ -29,6 +29,9 @@
set ms [ clock clicks -milliseconds ]
set us [ clock clicks ]
regsub -all {:} $tag {} tag
+
+ # Per tag a variable is created within the profiler namespace.
+ # FRINK: nocheck
set ::profiler::T$tag [ list $us $ms ]
return
}
@@ -46,17 +49,27 @@
# time, in microseconds.
proc ::profiler::tMark { { tag "" } } {
- set ut [ clock clicks ]
- set mt [ clock clicks -milliseconds ]
- regsub -all {:} $tag {} tag
- set ust [ lindex [ set ::profiler::T$tag ] 0 ]
- set mst [ lindex [ set ::profiler::T$tag ] 1 ]
- set udt [ expr { ($ut-$ust) } ]
- set mdt [ expr { ($mt-$mst) } ]000
- set dt $udt
- ;## handle wrapping of the microsecond clock
- if { $dt < 0 || $dt > 1000000 } { set dt $mdt }
- set dt
+ 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
+ set dt $udt
+ ;## handle wrapping of the microsecond clock
+ if { $dt < 0 || $dt > 1000000 } { set dt $mdt }
+ set dt
}
# ::profiler::stats --
Index: modules/report/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/report/ChangeLog,v
retrieving revision 1.1
diff -u -r1.1 ChangeLog
--- modules/report/ChangeLog 2001/05/01 19:01:24 1.1
+++ modules/report/ChangeLog 2001/06/17 19:13:12
@@ -1,3 +1,7 @@
+2001-06-15 Tcl Project <[email protected]>
+
+ * report.tcl: Fixed dubious code reported by frink.
+
2001-05-01 Andreas Kupries <[email protected]>
* Committed to CVS head at SF.
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/17 19:13:13
@@ -743,7 +743,7 @@
return -code error "Unknown template command \"$cmd\""
}
}
- return
+ return ""
}
# ::report::_tcaption --
@@ -772,7 +772,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 +782,7 @@
} else {
set tcaption $size
}
- return
+ return ""
}
# ::report::_bcaption --
@@ -811,7 +811,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 +821,7 @@
} else {
set bcaption $size
}
- return
+ return ""
}
# ::report::_size --
@@ -848,7 +848,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 +857,7 @@
return -code error "expected integer greater than zero, got \"$size\""
}
set csize($column) $size
- return
+ return ""
}
# ::report::_sizes --
@@ -903,7 +903,7 @@
set csize($i) $s
incr i
}
- return
+ return ""
}
# ::report::_pad --
@@ -945,7 +945,7 @@
return -code error "where: expected left, right, or both, got \"$where\""
}
}
- return
+ return ""
}
# ::report::_justify --
@@ -973,7 +973,7 @@
switch -exact -- $jvalue {
left - right - center {
set cjust($column) $jvalue
- return
+ return ""
}
}
return -code error "justification: expected, left, right, or center, got \"$jvalue\""
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/17 19:13:15
@@ -1,3 +1,7 @@
+2001-06-15 Tcl Project <[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/17 19:13:16
@@ -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 -
@@ -408,7 +408,7 @@
}
}
# }
- return ""
+ return
}
# stats::countExists --
Index: modules/struct/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/ChangeLog,v
retrieving revision 1.11
diff -u -r1.11 ChangeLog
--- modules/struct/ChangeLog 2001/05/20 11:22:09 1.11
+++ modules/struct/ChangeLog 2001/06/17 19:13:17
@@ -1,3 +1,8 @@
+2001-06-16 Tcl Project <[email protected]>
+
+ * tree.tcl:
+ * graph.tcl: Fixed dubious code reported by frink.
+
2001-05-20 Andreas Kupries <[email protected]>
* matrix.tcl (insert row/column): Fixed wrong references to the
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/17 19:13:19
@@ -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.
@@ -800,6 +801,7 @@
unset inArcs($node)
unset outArcs($node)
+ # FRINK: nocheck
unset ::struct::graph::graph${name}::node$node
}
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/17 19:13:21
@@ -205,8 +205,8 @@
# Remove all record of $node
unset parent($node)
unset children($node)
+ #FRINK: nocheck
unset ::struct::tree::tree${name}::node$node
-
return
}
@@ -250,6 +250,7 @@
unset children($node)
unset parent($node)
+ # FRINK: nocheck
unset ::struct::tree::tree${name}::node$node
while { [llength $st] > 0 } {
@@ -260,6 +261,7 @@
}
unset children($node)
unset parent($node)
+ # FRINK: nocheck
unset ::struct::tree::tree${name}::node$node
}
return
@@ -640,6 +642,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/17 19:13:21
@@ -1,3 +1,8 @@
+2001-06-15 Tcl Project <[email protected]>
+
+ * trim.tcl:
+ * split.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/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/17 19:13:21
@@ -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/17 19:13:21
@@ -68,4 +68,5 @@
return $StrR
}
+ error "Unknown ps \"$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/17 19:13:21
@@ -1,3 +1,7 @@
+2001-06-15 Tcl Project <[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/17 19:13:22
@@ -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
}
@@ -263,8 +263,14 @@
variable url ""
variable url2part
+ # We use only the schemes in $schemes, i.e. the ones which
+ # were defined before and therefore have a schempart
+ # variable. The [set] accessing them will therefore work.
+
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 |]
@@ -335,7 +341,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 +424,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 +435,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]
@@ -500,7 +506,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]
@@ -584,7 +590,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 +608,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 +642,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 +721,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 --
