Author: particle
Date: Thu Oct 6 07:25:55 2005
New Revision: 9366
Modified:
trunk/languages/tcl/lib/builtins/incr.pir
trunk/languages/tcl/t/cmd_incr.t
Log:
tcl: modify [incr] to use single quotes in heredocs to avoid escaping issues.
added test for [incr] failure condition.
Modified: trunk/languages/tcl/lib/builtins/incr.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/incr.pir (original)
+++ trunk/languages/tcl/lib/builtins/incr.pir Thu Oct 6 07:25:55 2005
@@ -27,9 +27,9 @@
register_num = value_num + 1
pir_code .= <<"END_PIR"
.local pmc read, set, number
-read = find_global "_Tcl", "__read"
-number = find_global "_Tcl", "__number"
-set = find_global "_Tcl", "__set"
+read = find_global '_Tcl', '__read'
+number = find_global '_Tcl', '__number'
+set = find_global '_Tcl', '__set'
END_PIR
pir_code .= "$P"
$S0 = register_num
@@ -68,9 +68,9 @@ got_increment:
register_num = value_num + 1
pir_code .= <<"END_PIR"
.local pmc read, set, number
-read = find_global "_Tcl", "__read"
-number = find_global "_Tcl", "__number"
-set = find_global "_Tcl", "__set"
+read = find_global '_Tcl', '__read'
+number = find_global '_Tcl', '__number'
+set = find_global '_Tcl', '__set'
END_PIR
pir_code .= "$P"
$S0 = register_num
@@ -109,7 +109,7 @@ END_PIR
error:
pir_code =<<"END_PIR"
-.throw (\"wrong # args: should be \\\"incr varName ?increment?\\\"\")
+.throw ('wrong # args: should be "incr varName ?increment?"')
END_PIR
.return (register_num,pir_code)
Modified: trunk/languages/tcl/t/cmd_incr.t
==============================================================================
--- trunk/languages/tcl/t/cmd_incr.t (original)
+++ trunk/languages/tcl/t/cmd_incr.t Thu Oct 6 07:25:55 2005
@@ -2,7 +2,7 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 5;
+use Parrot::Test tests => 6;
use Test::More;
language_output_is("tcl",<<'TCL',<<OUT,"simple");
@@ -44,3 +44,11 @@ language_output_is("tcl",<<'TCL',<<OUT,"
TCL
-1
OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"error");
+ set a 1
+ incr a 3 2
+ puts $a
+TCL
+wrong # args: should be "incr varName ?increment?"
+OUT
