Taking a stab at TIP#288 implementation.aspect_tip288

Requires docs, removal of debugging, more comprehensive testing
and Tcl_WrongNumArgs() mods to handle "?arg ...?" properly.

Implementation and deviation from TIP guided by experience of
http://chiselapp.com/user/aspect/repository/tcl-hacks/finfo?name=modules/tip288-0.tm

1 files changed, 83 insertions, 0 deletions

diff --git a/tests/tip288.test b/tests/tip288.test
new file mode 100644
index 0000000..c65ce31
--- /dev/null
+++ b/tests/tip288.test
@@ -0,0 +1,83 @@
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+testConstraint procbodytest [expr {![catch {package require procbodytest}]}]
+testConstraint memory	    [llength [info commands memory]]
+
+set setup {
+    proc x {a args b} {
+        return "a=$a, args=$args, b=$b"
+    }
+    proc y {a {b x} args c} {
+        return "a=$a, b=$b, args=$args, c=$c"
+    }
+}
+set cleanup {rename x {}; rename y {}}
+
+test tip288-1.1 {Examples for TIP#288} -setup $setup -cleanup $cleanup -body {
+    x 1 2
+} -result {a=1, args=, b=2}
+
+test tip288-1.2 {Examples for TIP#288} -setup $setup -cleanup $cleanup -body {
+    x 1 2 3
+} -result {a=1, args=2, b=3}
+
+test tip288-1.3 {Examples for TIP#288} -setup $setup -cleanup $cleanup -body {
+    x 1
+} -returnCodes error -result {wrong # args: should be "x a ?arg ...? b"}
+
+test tip288-1.4 {Examples for TIP#288} -setup $setup -cleanup $cleanup -body {
+    y 1 2 3
+} -result {a=1, b=2, args=, c=3}
+
+test tip288-1.5 {Examples for TIP#288} -body {
+    proc z {a {b x} c args} {
+        return "a=$a, b=$b, c=$c, args=$args"
+    }
+} -returnCodes error -result {required args in the middle}
+
+set setup {
+    proc x {a b {c _c} {d _d} args {e _e} {f _f} g h} {
+        list a $a b $b c $c d $d e $e f $f g $g h $h args $args
+    }
+}
+set cleanup {rename x {}}
+
+test tip288-2.1 {Pathological arglist} -setup $setup -cleanup $cleanup -body {
+    x 1 2 3
+} -returnCodes error -result {wrong # args: should be "x a b ?c? ?d? ?arg ...? ?e? ?f? g h"}
+
+set i 1
+foreach {args result} {
+        {1 2 3 4}               {a 1 b 2 c _c d _d e _e f _f g 3 h 4  args {}}
+        {1 2 3 4 5}             {a 1 b 2 c 3  d _d e _e f _f g 4 h 5  args {}}
+        {1 2 3 4 5 6}           {a 1 b 2 c 3  d 4  e _e f _f g 5 h 6  args {}}
+        {1 2 3 4 5 6 7}         {a 1 b 2 c 3  d 4  e _e f 5  g 6 h 7  args {}}
+        {1 2 3 4 5 6 7 8}       {a 1 b 2 c 3  d 4  e 5  f 6  g 7 h 8  args {}}
+        {1 2 3 4 5 6 7 8 9}     {a 1 b 2 c 3  d 4  e 6  f 7  g 8 h 9  args 5}
+        {1 2 3 4 5 6 7 8 9 0}   {a 1 b 2 c 3  d 4  e 7  f 8  g 9 h 0  args {5 6}}
+} {
+    test tip288-2.[incr i] {Pathological arglist} -setup $setup -cleanup $cleanup -body [
+        list x {*}$args
+    ] -result [list {*}$result]
+}
+
+set setup {
+    proc stup {{chan stdout} text} {
+        list chan $chan text $text
+    }
+}
+set cleanup {rename stup {}}
+set i 0
+foreach {args code result} {
+        {}  error {wrong # args: should be "stup ?chan? text"}
+        {foo} ok {chan stdout text foo}
+        {foo bar} ok {chan foo text bar}
+        {foo bar baz}  error {wrong # args: should be "stup ?chan? text"}
+} {
+    test tip288-3.[incr i] {Pathological arglist} -setup $setup -cleanup $cleanup -body [
+        list stup {*}$args
+    ] -returnCodes $code -result $result
+}