summaryrefslogtreecommitdiffstats
path: root/tests/parseOld.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/parseOld.test')
-rw-r--r--tests/parseOld.test194
1 files changed, 96 insertions, 98 deletions
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 3f799d6..f3b1591 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -12,12 +12,17 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: parseOld.test,v 1.2 1999/04/16 00:47:32 stanton Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testwordend [llength [info commands testwordend]]
+
+# Save the argv value for restoration later
+set savedArgv $argv
proc fourArgs {a b c d} {
global arg1 arg2 arg3 arg4
@@ -159,38 +164,37 @@ test parseOld-5.6 {variable substitution} {
set msg
} {can't read "_non_existent_": no such variable}
test parseOld-5.7 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
set a(xyz) 123
set b $a(xyz)foo
set b
} 123foo
test parseOld-5.8 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
set "a(x y z)" 123
set b $a(x y z)foo
set b
} 123foo
test parseOld-5.9 {array variable substitution} {
- catch {unset a}; catch {unset qqq}
+ unset -nocomplain a qqq
set "a(x y z)" qqq
set $a([format x]\ y [format z]) foo
set qqq
} foo
test parseOld-5.10 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
list [catch {set b $a(22)} msg] $msg
} {1 {can't read "a(22)": no such variable}}
test parseOld-5.11 {array variable substitution} {
set b a$!
set b
} {a$!}
-test parseOld-5.12 {array variable substitution} {
- set b a$()
- set b
-} {a$()}
-catch {unset a}
+test parseOld-5.12 {empty array name support} {
+ list [catch {set b a$()} msg] $msg
+} {1 {can't read "()": no such variable}}
+unset -nocomplain a
test parseOld-5.13 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
set long {This is a very long variable, long enough to cause storage \
allocation to occur in Tcl_ParseVar. If that storage isn't getting \
freed up correctly, then a core leak will occur when this test is \
@@ -205,13 +209,13 @@ test parseOld-5.13 {array variable substitution} {
run. This text is probably beginning to sound like drivel, but I've \
run out of things to say and I need more characters still.}}}
test parseOld-5.14 {array variable substitution} {
- catch {unset a}; catch {unset b}; catch {unset a1}
+ unset -nocomplain a b a1
set a1(22) foo
set a(foo) bar
set b $a($a1(22))
set b
} bar
-catch {unset a}; catch {unset a1}
+unset -nocomplain a a1
test parseOld-7.1 {backslash substitution} {
set a "\a\c\n\]\}"
@@ -315,6 +319,7 @@ test parseOld-10.4 {syntax errors} {
catch {set a "bcd} msg
set msg
} {missing "}
+#" Emacs formatting >:^(
test parseOld-10.5 {syntax errors} {catch {set a "bcd"xy} msg} 1
test parseOld-10.6 {syntax errors} {
catch {set a "bcd"xy} msg
@@ -340,10 +345,15 @@ test parseOld-10.13 {syntax errors} {
{b}]
set a
} {a b}
+
+# The next test will fail on the Mac, 'cause the MSL uses a fixed sized
+# buffer for %d conversions (LAME!). I won't leave the test out, however,
+# since MetroWerks may some day fix this.
+
test parseOld-10.14 {syntax errors} {
- list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
+ list [catch {eval \$x[format "%01000d" 0](} msg] $msg $::errorInfo
} {1 {missing )} {missing )
- while compiling
+ while executing
"$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000..."
("eval" body line 1)
invoked from within
@@ -408,8 +418,7 @@ set i 0
foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] {
set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]
set test $test$test$test$test
- set i [expr $i+1]
- test parseOld-11.10 {long values} {
+ test parseOld-11.10-[incr i] {long values} {
set j
} $test
}
@@ -445,71 +454,71 @@ expr 1+1
]"
} {2}
-if {[info command testwordend] == "testwordend"} {
- test parseOld-14.1 {TclWordEnd procedure} {
- testwordend " \n abc"
- } {c}
- test parseOld-14.2 {TclWordEnd procedure} {
- testwordend " \\\n"
- } {}
- test parseOld-14.3 {TclWordEnd procedure} {
- testwordend " \\\n "
- } { }
- test parseOld-14.4 {TclWordEnd procedure} {
- testwordend {"abc"}
- } {"}
- test parseOld-14.5 {TclWordEnd procedure} {
- testwordend {{xyz}}
- } \}
- test parseOld-14.6 {TclWordEnd procedure} {
- testwordend {{a{}b{}\}} xyz}
- } "\} xyz"
- test parseOld-14.7 {TclWordEnd procedure} {
- testwordend {abc[this is a]def ghi}
- } {f ghi}
- test parseOld-14.8 {TclWordEnd procedure} {
- testwordend "puts\\\n\n "
- } "s\\\n\n "
- test parseOld-14.9 {TclWordEnd procedure} {
- testwordend "puts\\\n "
- } "s\\\n "
- test parseOld-14.10 {TclWordEnd procedure} {
- testwordend "puts\\\n xyz"
- } "s\\\n xyz"
- test parseOld-14.11 {TclWordEnd procedure} {
- testwordend {a$x.$y(a long index) foo}
- } ") foo"
- test parseOld-14.12 {TclWordEnd procedure} {
- testwordend {abc; def}
- } {; def}
- test parseOld-14.13 {TclWordEnd procedure} {
- testwordend {abc def}
- } {c def}
- test parseOld-14.14 {TclWordEnd procedure} {
- testwordend {abc def}
- } {c def}
- test parseOld-14.15 {TclWordEnd procedure} {
- testwordend "abc\ndef"
- } "c\ndef"
- test parseOld-14.16 {TclWordEnd procedure} {
- testwordend "abc"
- } {c}
- test parseOld-14.17 {TclWordEnd procedure} {
- testwordend "a\000bc"
- } {c}
- test parseOld-14.18 {TclWordEnd procedure} {
- testwordend \[a\000\]
- } {]}
- test parseOld-14.19 {TclWordEnd procedure} {
- testwordend \"a\000\"
- } {"}
- test parseOld-14.20 {TclWordEnd procedure} {
- testwordend a{\000}b
- } {b}
- test parseOld-14.21 {TclWordEnd procedure} {
- testwordend " \000b"
- } {b}
-}
+test parseOld-14.1 {TclWordEnd procedure} {testwordend} {
+ testwordend " \n abc"
+} {c}
+test parseOld-14.2 {TclWordEnd procedure} {testwordend} {
+ testwordend " \\\n"
+} {}
+test parseOld-14.3 {TclWordEnd procedure} {testwordend} {
+ testwordend " \\\n "
+} { }
+test parseOld-14.4 {TclWordEnd procedure} {testwordend} {
+ testwordend {"abc"}
+} {"}
+#" Emacs formatting :^(
+test parseOld-14.5 {TclWordEnd procedure} {testwordend} {
+ testwordend {{xyz}}
+} \}
+test parseOld-14.6 {TclWordEnd procedure} {testwordend} {
+ testwordend {{a{}b{}\}} xyz}
+} "\} xyz"
+test parseOld-14.7 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc[this is a]def ghi}
+} {f ghi}
+test parseOld-14.8 {TclWordEnd procedure} {testwordend} {
+ testwordend "puts\\\n\n "
+} "s\\\n\n "
+test parseOld-14.9 {TclWordEnd procedure} {testwordend} {
+ testwordend "puts\\\n "
+} "s\\\n "
+test parseOld-14.10 {TclWordEnd procedure} {testwordend} {
+ testwordend "puts\\\n xyz"
+} "s\\\n xyz"
+test parseOld-14.11 {TclWordEnd procedure} {testwordend} {
+ testwordend {a$x.$y(a long index) foo}
+} ") foo"
+test parseOld-14.12 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc; def}
+} {; def}
+test parseOld-14.13 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc def}
+} {c def}
+test parseOld-14.14 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc def}
+} {c def}
+test parseOld-14.15 {TclWordEnd procedure} {testwordend} {
+ testwordend "abc\ndef"
+} "c\ndef"
+test parseOld-14.16 {TclWordEnd procedure} {testwordend} {
+ testwordend "abc"
+} {c}
+test parseOld-14.17 {TclWordEnd procedure} {testwordend} {
+ testwordend "a\000bc"
+} {c}
+test parseOld-14.18 {TclWordEnd procedure} {testwordend} {
+ testwordend \[a\000\]
+} {]}
+test parseOld-14.19 {TclWordEnd procedure} {testwordend} {
+ testwordend \"a\000\"
+} {"}
+#" Emacs formatting :^(
+test parseOld-14.20 {TclWordEnd procedure} {testwordend} {
+ testwordend a{\000}b
+} {b}
+test parseOld-14.21 {TclWordEnd procedure} {testwordend} {
+ testwordend " \000b"
+} {b}
test parseOld-15.1 {TclScriptEnd procedure} {
info complete {puts [
@@ -530,17 +539,6 @@ test parseOld-15.5 {TclScriptEnd procedure} {
} {0}
# cleanup
+set argv $savedArgv
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
generated by cgit v0.12 at 2025-10-24 19:19:13 (GMT)