Attachment "440051.diff" to
ticket [440051ffff]
added by
andreas_kupries
2001-08-21 03:32:28.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.58
diff -u -r1.58 ChangeLog
--- ChangeLog 2001/07/17 19:49:16 1.58
+++ ChangeLog 2001/08/20 20:29:06
@@ -1,3 +1,8 @@
+2001-08-20 Andreas Kupries <[email protected]>
+
+ * all.tcl: Added ::tcltest::getErrorMessage in preparation of
+ fixing [440051], [440049] and [440046] reported by Larry Virden.
+
2001-07-17 Andreas Kupries <[email protected]>
* Bumped version to 1.0
Index: all.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/all.tcl,v
retrieving revision 1.5
diff -u -r1.5 all.tcl
--- all.tcl 2001/05/01 19:01:23 1.5
+++ all.tcl 2001/08/20 20:29:06
@@ -128,6 +128,22 @@
set ::tcltest::testSingleFile false
set ::tcltest::testsDirectory [pSet ::tcltest::testsDirectory]
#set ::tcltest::verbose ps
+
+ # Add a function to construct a proper error message for
+ # 'wrong#args' situations. The format of the messages changed
+ # for 8.4
+
+ proc ::tcltest::getErrorMessage {functionName argList missingIndex} {
+ # if oldstyle errors:
+ if { [info tclversion] < 8.4 } {
+ set msg "no value given for parameter "
+ append msg "\"[lindex $argList $missingIndex]\" to "
+ append msg "\"$functionName\""
+ } else {
+ set msg "wrong # args: should be \"$functionName $argList\""
+ }
+ return $msg
+ }
}
interp alias $c ::tcltest::cleanupTestsHook {} \
::tcltest::cleanupTestsHook $c
Index: modules/md5/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/ChangeLog,v
retrieving revision 1.7
diff -u -r1.7 ChangeLog
--- modules/md5/ChangeLog 2001/07/10 20:39:46 1.7
+++ modules/md5/ChangeLog 2001/08/20 20:29:06
@@ -1,3 +1,9 @@
+2001-08-20 Andreas Kupries <[email protected]>
+
+ * md5.test: Fixed broken error messages for 8.4. Using
+ [tcltest::getErrorMessage] now to get the correct message for
+ all versions of the core. Bug [440046] reported by Larry Virden.
+
2001-07-10 Andreas Kupries <[email protected]>
* md5.tcl: Frink 2.2 run, fixed dubious code.
Index: modules/md5/md5.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/md5.test,v
retrieving revision 1.2
diff -u -r1.2 md5.test
--- modules/md5/md5.test 2001/04/25 15:30:03 1.2
+++ modules/md5/md5.test 2001/08/20 20:29:06
@@ -26,17 +26,17 @@
test md5-1.0 {md5} {
catch {::md5::md5} result
set result
-} {no value given for parameter "msg" to "::md5::md5"}
+} [tcltest::getErrorMessage "::md5::md5" "msg" 0]
test md5-1.1 {md5} {
catch {::md5::hmac} result
set result
-} {no value given for parameter "key" to "::md5::hmac"}
+} [tcltest::getErrorMessage "::md5::hmac" "key text" 0]
test md5-1.2 {md5} {
catch {::md5::hmac key} result
set result
-} {no value given for parameter "text" to "::md5::hmac"}
+} [tcltest::getErrorMessage "::md5::hmac" "key text" 1]
foreach {n msg expected} {
Index: modules/report/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/report/ChangeLog,v
retrieving revision 1.4
diff -u -r1.4 ChangeLog
--- modules/report/ChangeLog 2001/07/10 20:39:47 1.4
+++ modules/report/ChangeLog 2001/08/20 20:29:06
@@ -1,3 +1,9 @@
+2001-08-20 Andreas Kupries <[email protected]>
+
+ * report.test: Fixed broken error messages for 8.4. Using
+ [tcltest::getErrorMessage] now to get the correct message for
+ all versions of the core. Bug [440049] reported by Larry Virden.
+
2001-07-10 Andreas Kupries <[email protected]>
* report.tcl: Frink 2.2 run, fixed dubious code.
Index: modules/report/report.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/report/report.test,v
retrieving revision 1.1
diff -u -r1.1 report.test
--- modules/report/report.test 2001/05/01 19:01:24 1.1
+++ modules/report/report.test 2001/08/20 20:29:06
@@ -42,22 +42,26 @@
test report-2.0 {style definition errors} {
catch {::report::defstyle} result
set result
-} {no value given for parameter "styleName" to "::report::defstyle"}
+} [tcltest::getErrorMessage "::report::defstyle" "styleName arguments body" 0]
test report-2.1 {style definition error} {
catch {::report::defstyle foo} result
set result
-} {no value given for parameter "arguments" to "::report::defstyle"}
+} [tcltest::getErrorMessage "::report::defstyle" "styleName arguments body" 1]
test report-2.2 {style definition errors} {
catch {::report::defstyle foo {}} result
set result
-} {no value given for parameter "body" to "::report::defstyle"}
+} [tcltest::getErrorMessage "::report::defstyle" "styleName arguments body" 2]
test report-2.3 {style definition errors} {
catch {::report::defstyle foo {} {} bla} result
set result
-} {called "::report::defstyle" with too many arguments}
+} [if {[info tclversion] < 8.4} {
+ set msg {called "::report::defstyle" with too many arguments}
+} else {
+ set msg {wrong # args: should be "::report::defstyle styleName arguments body"}
+}]
test report-2.4 {style definition errors} {
catch {::report::defstyle plain {} {}} result
@@ -73,7 +77,7 @@
test report-3.0 {style deletion errors} {
catch {::report::rmstyle} result
set result
-} {no value given for parameter "styleName" to "::report::rmstyle"}
+} [tcltest::getErrorMessage "::report::rmstyle" "styleName" 0]
test report-3.1 {style deletion errors} {
catch {::report::rmstyle plain} result
@@ -89,7 +93,7 @@
test report-4.0 {style introspection error} {
catch {::report::stylearguments} result
set result
-} {no value given for parameter "styleName" to "::report::stylearguments"}
+} [tcltest::getErrorMessage "::report::stylearguments" "styleName" 0]
test report-4.1 {style introspection error} {
catch {::report::stylearguments foo} result
@@ -99,7 +103,7 @@
test report-4.2 {style introspection error} {
catch {::report::stylebody} result
set result
-} {no value given for parameter "styleName" to "::report::stylebody"}
+} [tcltest::getErrorMessage "::report::stylebody" "styleName" 0]
test report-4.3 {style introspection error} {
catch {::report::stylebody foo} result
@@ -160,6 +164,8 @@
set result
} {no value given for parameter "a" to style "foo"}
+# [tcltest::getErrorMessage "foo" "a b" 0]
+
test report-5.3 {style application errors} {
::report::defstyle foo {a b} {}
catch {report myreport 5 style foo a b c d e} result
@@ -188,7 +194,7 @@
test report-6.0 {report errors} {
catch {report myreport} msg
set msg
-} {no value given for parameter "columns" to "report"}
+} [tcltest::getErrorMessage "report" "name columns args" 1]
test report-6.1 {report errors} {
catch {report myreport -5} msg
@@ -273,7 +279,7 @@
catch {myreport size} result
myreport destroy
set result
-} {no value given for parameter "column" to "::report::_size"}
+} [tcltest::getErrorMessage "::report::_size" "name column ?size?" 1]
test report-10.1 {column sizes} {
report myreport 3
@@ -384,7 +390,7 @@
catch {myreport pad} result
myreport destroy
set result
-} {no value given for parameter "column" to "::report::_pad"}
+} [tcltest::getErrorMessage "::report::_pad" "name column ?where? ?string?" 1]
test report-12.1 {padding} {
report myreport 3
@@ -439,7 +445,7 @@
catch {myreport justify} result
myreport destroy
set result
-} {no value given for parameter "column" to "::report::_justify"}
+} [tcltest::getErrorMessage "::report::_justify" "name column ?jvalue?" 1]
test report-13.1 {justification} {
report myreport 3
@@ -509,7 +515,7 @@
catch [list myreport $template] result
myreport destroy
set result
- } {no value given for parameter "cmd" to "::report::_tAction"}
+ } [tcltest::getErrorMessage "::report::_tAction" "name template cmd args" 2]
test report-$n.1 {separator templates} {
report myreport 1
@@ -591,7 +597,7 @@
catch [list myreport $template] result
myreport destroy
set result
- } {no value given for parameter "cmd" to "::report::_tAction"}
+ } [tcltest::getErrorMessage "::report::_tAction" "name template cmd args" 2]
test report-$n.1 {data templates} {
report myreport 1
@@ -680,7 +686,7 @@
catch {myreport printmatrix} result
myreport destroy
set result
-} {no value given for parameter "matrix" to "::report::_printmatrix"}
+} [tcltest::getErrorMessage "::report::_printmatrix" "name matrix" 1]
test report-27.1 {formatting errors} {
report myreport 5
@@ -886,7 +892,7 @@
catch {myreport printmatrix2channel} result
myreport destroy
set result
-} {no value given for parameter "matrix" to "::report::_printmatrix2channel"}
+} [tcltest::getErrorMessage "::report::_printmatrix2channel" "name matrix chan" 1]
test report-28.1 {formatting errors} {
report myreport 5
@@ -895,7 +901,7 @@
mymatrix destroy
myreport destroy
set result
-} {no value given for parameter "chan" to "::report::_printmatrix2channel"}
+} [tcltest::getErrorMessage "::report::_printmatrix2channel" "name matrix chan" 2]
test report-28.2 {formatting errors} {
report myreport 5
Index: modules/sha1/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/sha1/ChangeLog,v
retrieving revision 1.2
diff -u -r1.2 ChangeLog
--- modules/sha1/ChangeLog 2001/06/22 15:29:18 1.2
+++ modules/sha1/ChangeLog 2001/08/20 20:29:06
@@ -1,3 +1,9 @@
+2001-08-20 Andreas Kupries <[email protected]>
+
+ * sha1.test: Fixed broken error messages for 8.4. Using
+ [tcltest::getErrorMessage] now to get the correct message for
+ all versions of the core. Bug [440051] reported by Larry Virden.
+
2001-06-22 Andreas Kupries <[email protected]>
* md5.tcl: Fixed dubious code reported by frink.
Index: modules/sha1/sha1.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/sha1/sha1.test,v
retrieving revision 1.1
diff -u -r1.1 sha1.test
--- modules/sha1/sha1.test 2001/06/22 14:33:07 1.1
+++ modules/sha1/sha1.test 2001/08/20 20:29:06
@@ -26,17 +26,17 @@
test sha1-1.0 {sha1} {
catch {::sha1::sha1} result
set result
-} {no value given for parameter "msg" to "::sha1::sha1"}
+} [tcltest::getErrorMessage "::sha1::sha1" "msg" 0]
test sha1-1.1 {sha1} {
catch {::sha1::hmac} result
set result
-} {no value given for parameter "key" to "::sha1::hmac"}
+} [tcltest::getErrorMessage "::sha1::hmac" "key text" 0]
test sha1-1.2 {sha1} {
catch {::sha1::hmac key} result
set result
-} {no value given for parameter "text" to "::sha1::hmac"}
+} [tcltest::getErrorMessage "::sha1::hmac" "key text" 1]
foreach {n msg expected} {
