Author: mdiep
Date: Sun Aug 7 20:33:15 2005
New Revision: 8864
Modified:
trunk/languages/tcl/lib/commands/rename.pir
trunk/languages/tcl/t/cmd_rename.t
Log:
tcl: Fix the error message for rename with a non-existant command (with test)
Modified: trunk/languages/tcl/lib/commands/rename.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/rename.pir (original)
+++ trunk/languages/tcl/lib/commands/rename.pir Sun Aug 7 20:33:15 2005
@@ -18,7 +18,6 @@
.local string oldName
.local string newName
- .local pmc commands
oldName = old_p
oldName = "&" . oldName
@@ -31,24 +30,30 @@
if newName == "" goto delete
add:
- # Grab the original sub
- theSub = find_global "Tcl", oldName
+ # Grab the original sub
+ push_eh doesnt_exist
+ theSub = find_global "Tcl", oldName
+ clear_eh
# Create the new sub
store_global "Tcl", newName, theSub
delete:
null theSub
store_global "Tcl", oldName, theSub
-
goto done
+doesnt_exist:
+ return_type = TCL_ERROR
+ retval = "can't rename \""
+ $S0 = old_p
+ retval .= $S0
+ retval .= "\": command doesn't exist"
+ goto done
+
error:
return_type = TCL_ERROR
retval = "wrong # args: should be \"rename oldName newName\""
done:
-
- store_global "commands", commands
-
.return(return_type,retval)
.end
Modified: trunk/languages/tcl/t/cmd_rename.t
==============================================================================
--- trunk/languages/tcl/t/cmd_rename.t (original)
+++ trunk/languages/tcl/t/cmd_rename.t Sun Aug 7 20:33:15 2005
@@ -2,7 +2,7 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 3;
use Test::More;
language_output_is("tcl",<<'TCL',<<OUT,"rename");
@@ -19,3 +19,10 @@ language_output_is("tcl",<<'TCL',<<OUT,"
TCL
invalid command name "puts"
OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"non-existant command")
+ rename foo blah
+TCL
+can't rename "foo": command doesn't exist
+OUT
+
