From 2dd84967ea821e7bf650b8efcb8297122b83ad9b Mon Sep 17 00:00:00 2001 From: Steve Bennett Date: Mon, 23 May 2011 21:27:05 +1000 Subject: Improve list parsing Also add additional tests Signed-off-by: Steve Bennett --- tests/misc.test | 107 +++++++++++++++++++++++++++++++++++++++++++++++++ tests/parse.test | 82 +++++++++++++++++++++++++++++++++++++ tests/rename.test | 14 +++---- tests/string.test | 18 +++++++++ tests/stringmatch.test | 7 ++++ 5 files changed, 221 insertions(+), 7 deletions(-) (limited to 'tests') diff --git a/tests/misc.test b/tests/misc.test index f259185..706ee5e 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -366,4 +366,111 @@ test sharing-1.4 "Problems with ref sharing in arrays: lset" { set a(c) } {2 3} +test jimexpr-1.1 "integer ** operator" { + expr {2 ** 3} +} 8 + +test jimexpr-1.2 "integer ** operator" { + expr {0 ** 3} +} 0 + +test jimexpr-1.3 "integer ** operator" { + expr {2 ** 0} +} 1 + +test jimexpr-1.4 "integer ** operator" { + expr {-2 ** 1} +} -2 + +test jimexpr-1.5 "integer ** operator" { + expr {3 ** -2} +} 0 + +test jimexpr-1.6 "+ command" { + + 1 +} 1 + +test jimexpr-1.7 "+ command" { + + 2 3.5 +} 5.5 + +test jimexpr-1.8 "+ command" { + + 2 3 4 -6 +} 3 + +test jimexpr-1.9 "* command" { + * 4 +} 4 + +test jimexpr-1.10 "* command" { + * 4 2 +} 8 + +test jimexpr-1.11 "* command" { + * 4 2 -0.5 +} -4.0 + +test jimexpr-1.12 "/ command" { + / 2 +} 0.5 + +test jimexpr-1.12 "/ command" { + / 0.5 +} 2.0 + +test jimexpr-1.13 "/ command" { + / 12 3 +} 4 + +test jimexpr-1.14 "/ command" { + / 12 3 2.0 +} 2.0 + +test jimexpr-1.15 "- command" { + - 6 +} -6 + +test jimexpr-1.15 "- command" { + - 6.5 +} -6.5 + +test jimexpr-1.16 "- command" { + - 6 3 +} 3 + +test jimexpr-1.17 "- command" { + - 6 3 1.5 +} 1.5 + +test jimexpr-1.18 "errors in math commands" { + list [catch /] [catch {/ x}] [catch -] [catch {+ x y}] [catch {* x}] +} {1 1 1 1 1} + +# May be supported if support compiled in +test jimexpr-2.1 "double ** operator" { + catch {expr {2.0 ** 3}} result + expr {$result in {unsupported 8.0}} +} 1 + +# This one is for test coverage of an unusual case +test jimobj-1.1 "duplicate obj with no dupIntRepProc" { + proc "x x" {} { return 2 } + set a "x x" + # force it to be a command object + set b [$a] + # A second reference + set c $a + # Now force it to be duplicated + lset a 1 x + # force the duplicate object it to be a command object again + set b [$a] + # And get the string rep + set x "y $a" +} "y x x" + +test jim-badvar-1.1 "invalid variable name" { + set x b\0c + catch {set $x 5} +} 1 + testreport diff --git a/tests/parse.test b/tests/parse.test index dc09798..a897ab8 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -137,4 +137,86 @@ test parse-1.26 "newline in braced var" { b} } var1 +test parse-1.27 "backslash escape in dict sugar" { + unset -nocomplain a + set a(b\x55d) 5 + set x $a(b\x55d) +} 5 + +test parse-1.28 "nested dict sugar" { + set a(V) 5 + set b(5) five + set x $b($a(V)) +} five + +set dq {"} +set script "set x ${dq}hello" + +test parse-1.29 "missing quote" jim { + eval $script +} hello + +test parse-1.30 "missing quote" { + info complete $script +} 0 + +test parse-1.31 "backslash newline in bare context" { + list abc\ + 123 +} {abc 123} + +test parse-1.32 "comment as last line of script" { + set script {set x 3; # this is a comment} + eval $script +} 3 + +test parse-1.33 "upper case hex escapes" { + list \x4A \x4F \x3C +} {J O <} + +test parse-1.34 "octal escapes" { + list \112 \117 \074 +} {J O <} + +test parse-1.35 "invalid hex escape" { + list \xZZ +} xZZ + +test parse-1.36 "unicode escape" jim { + list \u00b5 +} \xc2\xb5 + +test parse-1.37 "invalid unicode escape after unicode" jim { + list \ub5x +} \xc2\xb5x + +test parse-1.38 "invalid unicode escape" { + list \ux +} ux + +test parse-1.39 "octal escape followed by invalid" { + list \76x +} >x + +test parse-1.40 "list containing quoted trailing backslash" jim { + set x "abc \"def\\" + lindex $x 1 +} def\\ + +test parse-1.41 "list containing quoted newline" { + set x {abc "def +ghi"} + lindex $x 1 +} def\nghi + +test parse-1.42 "list containing missing quote" jim { + set x {abc "def} + lindex $x 1 +} def + +test parse-1.43 "list containing trailing backslash" { + set x "abc def\\" + lindex $x 1 +} def\\ + testreport diff --git a/tests/rename.test b/tests/rename.test index 6b4afa5..00d6c6d 100644 --- a/tests/rename.test +++ b/tests/rename.test @@ -110,23 +110,23 @@ if {[info command testdel] == "testdel"} { set env(value) } {deleted} test rename-4.6 {reentrancy issues with command deletion and renaming} { - proc kill args { + proc killx args { interp delete foo } set env(value) before interp create foo - foo alias kill kill - testdel foo cmd {set env(value) deleted; kill} + foo alias killx killx + testdel foo cmd {set env(value) deleted; killx} list [catch {foo eval {rename cmd {}}} msg] $msg $env(value) } {0 {} deleted} test rename-4.7 {reentrancy issues with command deletion and renaming} { - proc kill args { + proc killx args { interp delete foo } set env(value) before interp create foo - foo alias kill kill - testdel foo cmd {set env(value) deleted; kill} + foo alias killx killx + testdel foo cmd {set env(value) deleted; killx} list [catch {interp delete foo} msg] $msg $env(value) } {0 {} deleted} if {[info exists env(value)]} { @@ -150,6 +150,6 @@ if {[info commands split.old] != {}} { catch {rename split.old split} } catch {rename x {}} -catch {rename kill {}} +catch {rename killx {}} testreport diff --git a/tests/string.test b/tests/string.test index 6a70b79..5da52df 100644 --- a/tests/string.test +++ b/tests/string.test @@ -179,6 +179,21 @@ test string-4.8 {string first} { test string-4.14 {string first, start index} { string first a abcabc end-4 } 3 +test string-4.15 {string first, empty needle} { + string first "" b +} -1 +test string-4.16 {string first, empty haystack} { + string first a "" +} -1 +test string-4.17 {string first, needle bigger than haystack} { + string first aaa b +} -1 +test string-4.18 {string first, negative index} { + string first a aaa -4 +} 0 +test string-4.19 {string first, not found} { + string first a bcd +} -1 test string-5.1 {string index} { list [catch {string index} msg] @@ -408,6 +423,9 @@ test string-7.15 {string last, start index} { test string-7.16 {string last, start index} utf8 { string last \u00dca \u00dcad\u00dcad end-1 } 3 +test string-7.17 {string last, too few args} { + string last abc def +} -1 test string-9.1 {string length} { list [catch {string length} msg] } {1} diff --git a/tests/stringmatch.test b/tests/stringmatch.test index dcb0586..7fe3fcc 100644 --- a/tests/stringmatch.test +++ b/tests/stringmatch.test @@ -214,5 +214,12 @@ test stringmatch-6.6 {charset with ^} { string match {a[\]]c} {a]c} } 0 +test stringmatch=7.1 {short string with ?} { + string match {ab?} ab +} 0 + +test stringmatch=7.1 {multiple * to end} { + string match {ab**} ab +} 1 testreport -- cgit v1.1