summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-12-04 06:16:48 (GMT)
committerhobbs <hobbs>1999-12-04 06:16:48 (GMT)
commit8bd88ae75ebf3df12baf9472747baf999a089c8c (patch)
treede4d563d31e6b705edb459823af308d53d953c2b /tests
parent0cbb9c47d7cd5a71ca1189ab216bf3ded3800278 (diff)
downloadtcl-8bd88ae75ebf3df12baf9472747baf999a089c8c.zip
tcl-8bd88ae75ebf3df12baf9472747baf999a089c8c.tar.gz
tcl-8bd88ae75ebf3df12baf9472747baf999a089c8c.tar.bz2
* tests/env.test: removed knownBug limitation from working test
* tests/all.tcl: ensured that ::tcltest::testsDirectory would be set to an absolute path * tests/expr-old.test: * tests/parseExpr.test: * tests/string.test: * generic/tclGet.c: * generic/tclInt.h: * generic/tclObj.c: * generic/tclParseExpr.c: * generic/tclUtil.c: * generic/tclExecute.c: added TclCheckBadOctal routine to enhance error message checking for when users use invalid octal numbers (like 08), as well as replumbed the Expr*Funcs with a new VerifyExprObjType to simplify type handling.
Diffstat (limited to 'tests')
-rw-r--r--tests/all.tcl12
-rw-r--r--tests/env.test4
-rw-r--r--tests/expr-old.test10
-rw-r--r--tests/expr.test10
-rw-r--r--tests/parseExpr.test4
-rw-r--r--tests/string.test9
6 files changed, 36 insertions, 13 deletions
diff --git a/tests/all.tcl b/tests/all.tcl
index b4d132d..1b13adb 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: all.tcl,v 1.7 1999/06/29 20:14:17 jenn Exp $
+# RCS: @(#) $Id: all.tcl,v 1.8 1999/12/04 06:16:48 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -17,6 +17,16 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
set ::tcltest::testSingleFile false
set ::tcltest::testsDirectory [file dir [info script]]
+# We need to ensure that the testsDirectory is absolute
+#
+if {[string equal relative [file pathtype $::tcltest::testsDirectory]]} {
+ set cwd [pwd]
+ cd $::tcltest::testsDirectory
+ set ::tcltest::testsDirectory [pwd]
+ cd $cwd
+ unset cwd
+}
+
puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]"
puts stdout "Tests running in working dir: $::tcltest::testsDirectory"
if {[llength $::tcltest::skip] > 0} {
diff --git a/tests/env.test b/tests/env.test
index 087a23b..99a6a89 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: env.test,v 1.11 1999/09/21 06:37:26 hobbs Exp $
+# RCS: @(#) $Id: env.test,v 1.12 1999/12/04 06:16:48 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -216,7 +216,7 @@ test env-5.3 {corner cases - unset the env in master should unset child} {} {
interp delete i
set result
} {a 1}
-test env-5.4 {corner cases - unset the env array} {knownBug} {
+test env-5.4 {corner cases - unset the env array} {} {
# The info exist command should be in synch with the env array.
# Know Bug: 1737
diff --git a/tests/expr-old.test b/tests/expr-old.test
index e04aa95..ccb1438 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: expr-old.test,v 1.6 1999/06/26 03:54:13 jenn Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.7 1999/12/04 06:16:48 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -790,7 +790,7 @@ test expr-old-32.48 {math functions in expressions} {
} {1 {can't use floating-point value as argument to srand}}
test expr-old-32.49 {math functions in expressions} {
list [catch {expr srand("")} msg] $msg
-} {1 {can't use non-numeric string as argument to srand}}
+} {1 {argument to math function didn't have numeric value}}
test expr-old-32.50 {math functions in expressions} {
set result [expr round(srand(12345) * 1000)]
for {set i 0} {$i < 10} {incr i} {
@@ -800,7 +800,7 @@ test expr-old-32.50 {math functions in expressions} {
} {97 834 948 36 12 51 766 585 914 784 333}
test expr-old-32.51 {math functions in expressions} {
list [catch {expr {srand([lindex "6ty" 0])}} msg] $msg
-} {1 {can't use non-numeric string as argument to srand}}
+} {1 {argument to math function didn't have numeric value}}
test expr-old-33.1 {conversions and fancy args to math functions} {
expr hypot ( 3 , 4 )
@@ -871,11 +871,11 @@ if $gotT1 {
test expr-old-36.1 {ExprLooksLikeInt procedure} {
list [catch {expr 0289} msg] $msg
-} {1 {syntax error in expression "0289"}}
+} {1 {"0289" is an invalid octal number}}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0289
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use floating-point value as operand of "+"}}
+} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
list [catch {expr 0289.1} msg] $msg
} {0 289.1}
diff --git a/tests/expr.test b/tests/expr.test
index 656c993..042002a 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: expr.test,v 1.6 1999/08/19 03:00:13 hobbs Exp $
+# RCS: @(#) $Id: expr.test,v 1.7 1999/12/04 06:16:48 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -680,7 +680,7 @@ test expr-20.1 {wrong brace matching} {
set cmd "expr $l$q|$q == $q$r$q$r"
list [catch $cmd a] $a
} {1 {extra characters after close-brace}}
-test expr-20.2 {double invocation of variable traces} {knownBug} {
+test expr-20.2 {double invocation of variable traces} {
set exprtracecounter 0
proc exprtraceproc {args} {
upvar #0 exprtracecounter counter
@@ -711,6 +711,12 @@ test expr-20.5 {proper double evaluation compilation, working case} {
set a yellow
expr 1?{$a}:0
} yellow
+test expr-20.6 {handling of compile error in trial compile} {
+ list [catch {expr + {[incr]}} msg] $msg
+} {1 {wrong # args: should be "incr varName ?increment?"}}
+test expr-20.7 {handling of compile error in runtime case} {
+ list [catch {expr + {[error foo]}} msg] $msg
+} {1 foo}
# cleanup
if {[info exists a]} {
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 199f9e5..8ed4046 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: parseExpr.test,v 1.3 1999/06/26 03:54:19 jenn Exp $
+# RCS: @(#) $Id: parseExpr.test,v 1.4 1999/12/04 06:16:49 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -497,7 +497,7 @@ test parseExpr-14.5 {GetLexeme procedure, integer lexeme too big} {nonPortable}
} {1 {integer value too large to represent}}
test parseExpr-14.6 {GetLexeme procedure, bad integer lexeme} {
list [catch {testexprparser {0999} -1} msg] $msg
-} {1 {syntax error in expression "0999"}}
+} {1 {"0999" is an invalid octal number}}
test parseExpr-14.7 {GetLexeme procedure, double lexeme} {
testexprparser {0.999} -1
} {- {} 0 subexpr 0.999 1 text 0.999 0 {}}
diff --git a/tests/string.test b/tests/string.test
index 1e25073..349cba7 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: string.test,v 1.21 1999/10/21 02:17:57 hobbs Exp $
+# RCS: @(#) $Id: string.test,v 1.22 1999/12/04 06:16:49 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -249,6 +249,13 @@ test string-5.16 {string index, bytearray object with string obj shimmering} {
binary scan $str H* dump
string compare [string index $str 10] \x00
} 0
+test string-5.17 {string index, bad integer} {
+ list [catch {string index "abc" 08} msg] $msg
+} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}}
+test string-5.18 {string index, bad integer} {
+ list [catch {string index "abc" end-00289} msg] $msg
+} {1 {expected integer but got "-00289" (looks like invalid octal number)}}
+
proc largest_int {} {
# This will give us what the largest valid int on this machine is,