[svn:parrot] r8906 - in trunk/languages/tcl: lib/commands t

[coke]

Author: coke
Date: Wed Aug 10 10:53:02 2005
New Revision: 8906

Modified:
   trunk/languages/tcl/lib/commands/namespace.pir
   trunk/languages/tcl/t/cmd_namespace.t
Log:
tcl: Add stubs with error messages for some [namespace] commands.



Modified: trunk/languages/tcl/lib/commands/namespace.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/namespace.pir      (original)
+++ trunk/languages/tcl/lib/commands/namespace.pir      Wed Aug 10 10:53:02 2005
@@ -88,8 +88,44 @@ not_done:
 
 .sub "exists" # XXX 
   .param pmc argv
+
+  .local int argc
+  argc = argv
+  if argc != 1 goto bad_args
   # canonicalize namespace.
   $P1 = new TclInt
   $P1 = 0
   .return(TCL_OK,$P1)
+
+bad_args:
+  $P1 = new TclString
+  $P1 = "wrong # args: should be \"namespace exists name\"" 
+  .return(TCL_ERROR, $P1)
+.end
+
+.sub "qualifiers"
+  .param pmc argv
+  
+  .local int argc
+  if argc != 1 goto bad_args
+
+  bad_args:
+  $P1 = new String
+  $P1 = "wrong # args: should be \"namespace qualifiers string\""
+  .return (TCL_ERROR,$P1)
+
 .end
+
+.sub "tail"
+  .param pmc argv
+  
+  .local int argc
+  if argc != 1 goto bad_args
+
+  bad_args:
+  $P1 = new String
+  $P1 = "wrong # args: should be \"namespace tail string\""
+  .return (TCL_ERROR,$P1)
+
+.end
+

Modified: trunk/languages/tcl/t/cmd_namespace.t
==============================================================================
--- trunk/languages/tcl/t/cmd_namespace.t       (original)
+++ trunk/languages/tcl/t/cmd_namespace.t       Wed Aug 10 10:53:02 2005
@@ -18,9 +18,6 @@ TCL
 bad option "asdf": must be children, code, current, delete, eval, exists, 
export, forget, import, inscope, origin, parent, qualifiers, tail, or which
 OUT
 
-TODO: {
- local $TODO = "unimplemented";
-
 language_output_is("tcl",<<'TCL',<<OUT,"namespace qualifiers: no args");
    namespace qualifiers
 TCL
@@ -33,6 +30,8 @@ TCL
 wrong # args: should be "namespace qualifiers string"
 OUT
 
+TODO: {
+  local $TODO = "unimplemented";
 language_output_is("tcl",<<'TCL',<<OUT,"namespace qualifiers: simple");
    puts [namespace qualifiers ::a::b::c]
 TCL
@@ -44,6 +43,7 @@ language_output_is("tcl",<<'TCL',<<OUT,"
 TCL
 ::a::b
 OUT
+}
 
 language_output_is("tcl",<<'TCL',<<OUT,"namespace tail: no args");
    namespace tail
@@ -57,6 +57,8 @@ TCL
 wrong # args: should be "namespace tail string"
 OUT
 
+TODO: {
+  local $TODO = "unimplemented";
 language_output_is("tcl",<<'TCL',<<OUT,"namespace tail: simple");
    puts [namespace tail ::a::b::c]
 TCL
@@ -77,15 +79,13 @@ wrong # args: should be "namespace curre
 OUT
 
 # TODO : more tests once we can *change* the namespace
+
 language_output_is("tcl",<<'TCL',<<OUT,"namespace current: too many args");
    puts [namespace current]
 TCL
 ::
 OUT
 
-TODO: {
- local $TODO = "unimplemented";
-
 language_output_is("tcl",<<'TCL',<<OUT,"namespace exists: no args");
    namespace exists
 TCL
@@ -97,7 +97,6 @@ language_output_is("tcl",<<'TCL',<<OUT,"
 TCL
 wrong # args: should be "namespace exists name"
 OUT
-} 
 
 language_output_is("tcl",<<'TCL',<<OUT,"namespace exists: failure");
    puts [namespace exists a]
@@ -106,8 +105,7 @@ TCL
 OUT
 
 TODO: {
- local $TODO = "unimplemented";
-
+  local $TODO = "unimplemented";
 language_output_is("tcl",<<'TCL',<<OUT,"namespace exists: global implicit");
    puts [namespace exists {}]
 TCL
@@ -119,5 +117,4 @@ language_output_is("tcl",<<'TCL',<<OUT,"
 TCL
 1
 OUT
-
 }