From 8bd88ae75ebf3df12baf9472747baf999a089c8c Mon Sep 17 00:00:00 2001 From: hobbs Date: Sat, 4 Dec 1999 06:16:48 +0000 Subject: * 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. --- tests/all.tcl | 12 +++++++++++- tests/env.test | 4 ++-- tests/expr-old.test | 10 +++++----- tests/expr.test | 10 ++++++++-- tests/parseExpr.test | 4 ++-- tests/string.test | 9 ++++++++- 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, -- cgit v0.12