summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--tests/scan.test36
-rw-r--r--tests/stack.test6
2 files changed, 33 insertions, 9 deletions
diff --git a/tests/scan.test b/tests/scan.test
index 1b2b3fa..4957f9f 100644
--- a/tests/scan.test
+++ b/tests/scan.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: scan.test,v 1.7 1999/10/29 03:04:37 hobbs Exp $
+# RCS: @(#) $Id: scan.test,v 1.8 1999/11/19 06:35:01 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -580,25 +580,49 @@ test scan-12.2 {Tcl_ScanObjCmd, inline case} {
test scan-12.3 {Tcl_ScanObjCmd, inline case} {
scan abc %s%c
} {abc {}}
-test scan-12.4 {Tcl_ScanObjCmd, inline case} {
+test scan-12.4 {Tcl_ScanObjCmd, inline case, underflow} {
scan abc abc%c
} {}
test scan-12.5 {Tcl_ScanObjCmd, inline case} {
scan abc bogus%c%c%c
} {{} {} {}}
test scan-12.6 {Tcl_ScanObjCmd, inline case} {
- list [catch {scan abc {%1$s}} msg] $msg
-} {1 {"%n$" argument index out of range}}
-test scan-12.7 {Tcl_ScanObjCmd, inline case} {
# degenerate case, behavior changed from 8.2 to 8.3
list [catch {scan foo foobar} msg] $msg
} {0 {}}
-test scan-9.2 {Tcl_ScanObjCmd, inline case lots of arguments} {
+test scan-12.7 {Tcl_ScanObjCmd, inline case lots of arguments} {
scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140\
150 160 170 180 190 200" \
"%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d"
} {10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200 {}}
+test scan-13.1 {Tcl_ScanObjCmd, inline XPG case} {
+ scan a {%1$c}
+} 97
+test scan-13.2 {Tcl_ScanObjCmd, inline XPG case} {
+ scan abc {%1$c%2$c%3$c%4$c}
+} {97 98 99 {}}
+test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} {
+ list [catch {scan abc {%1$c%1$c}} msg] $msg
+} {1 {variable is assigned by multiple "%n$" conversion specifiers}}
+test scan-13.4 {Tcl_ScanObjCmd, inline XPG case} {
+ scan abc {%2$s%1$c}
+} {{} abc}
+test scan-13.5 {Tcl_ScanObjCmd, inline XPG case, underflow} {
+ scan abc {abc%5$c}
+} {}
+test scan-13.6 {Tcl_ScanObjCmd, inline XPG case} {
+ catch {scan abc {bogus%1$c%5$c%10$c}} msg
+ list [llength $msg] $msg
+} {10 {{} {} {} {} {} {} {} {} {} {}}}
+test scan-13.7 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
+ scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" {%20$d %18$d %17$d %16$d %15$d %14$d %13$d %12$d %11$d %10$d %9$d %8$d %7$d %6$d %5$d %4$d %3$d %2$d %1$d}
+} {190 180 170 160 150 140 130 120 110 100 90 80 70 60 50 40 30 20 {} 10}
+test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
+ set msg [scan "10 20 30" {%100$d %5$d %200$d}]
+ list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
+} {200 10 20 30}
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/stack.test b/tests/stack.test
index 5beda5b..99f2a93 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: stack.test,v 1.4 1999/06/26 20:55:13 rjohnson Exp $
+# RCS: @(#) $Id: stack.test,v 1.5 1999/11/19 06:35:02 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -19,8 +19,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Note that a failure in this test results in a crash of the executable.
test stack-1.1 {maxNestingDepth reached on infinite recursion} {
- proc recurse {} { return [recurse] }
- catch {recurse} rv
+ proc recurse {i} { return [recurse [incr i]] }
+ catch {recurse 0} rv
rename recurse {}
set rv
} {too many nested calls to Tcl_EvalObj (infinite loop?)}