From fc623251c41e7edc35e58613f4ee867f94e961d1 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Fri, 19 Nov 1999 06:35:01 +0000
Subject: 	* tests/scan.test: 	* generic/tclScan.c: finished support
 for inline scan by 	supporting XPG identifiers.

---
 tests/scan.test  | 36 ++++++++++++++++++++++++++++++------
 tests/stack.test |  6 +++---
 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?)}
-- 
cgit v0.12